Skip to content
GitLab
Commit d404d981 authored by Sabine's avatar Sabine
Browse files

Merge branch 'dev' of git.nilu.no:flexpart/flexpart into dev

parents 46706c74 861805ae
Expand all Hide whitespace changes
Inline Side-by-side
src/mpi_mod.f90
View file @ d404d981
This diff is collapsed.
src/releaseparticles_mpi.f90
View file @ d404d981
...@@ -20,34 +20,34 @@ ...@@ -20,34 +20,34 @@
!********************************************************************** !**********************************************************************
subroutine releaseparticles(itime) subroutine releaseparticles(itime)
! o ! o
!***************************************************************************** !*****************************************************************************
! * ! *
! This subroutine releases particles from the release locations. * ! This subroutine releases particles from the release locations. *
! * ! *
! It searches for a "vacant" storage space and assigns all particle * ! It searches for a "vacant" storage space and assigns all particle *
! information to that space. A space is vacant either when no particle * ! information to that space. A space is vacant either when no particle *
! is yet assigned to it, or when it's particle is expired and, thus, * ! is yet assigned to it, or when it's particle is expired and, thus, *
! the storage space is made available to a new particle. * ! the storage space is made available to a new particle. *
! * ! *
! Author: A. Stohl * ! Author: A. Stohl *
! * ! *
! 29 June 2002 * ! 29 June 2002 *
! * ! *
! CHANGES * ! CHANGES *
! 12/2014 eso: MPI version * ! 12/2014 eso: MPI version *
! * ! *
!***************************************************************************** !*****************************************************************************
! * ! *
! Variables: * ! Variables: *
! itime [s] current time * ! itime [s] current time *
! ireleasestart, ireleaseend start and end times of all releases * ! ireleasestart, ireleaseend start and end times of all releases *
! npart(maxpoint) number of particles to be released in total * ! npart(maxpoint) number of particles to be released in total *
! numrel number of particles to be released during this time * ! numrel number of particles to be released during this time *
! step * ! step *
! addpart extra particle assigned to MPI process if * ! addone extra particle assigned to MPI process if *
! mod(npart(i),mp_partgroup_np) .ne. 0) * ! mod(npart(i),mp_partgroup_np) .ne. 0) *
!***************************************************************************** !*****************************************************************************
use point_mod use point_mod
use xmass_mod use xmass_mod
...@@ -58,7 +58,7 @@ subroutine releaseparticles(itime) ...@@ -58,7 +58,7 @@ subroutine releaseparticles(itime)
implicit none implicit none
!real xaux,yaux,zaux,ran1,rfraction,xmasssave(maxpoint) !real xaux,yaux,zaux,ran1,rfraction,xmasssave(maxpoint)
real :: xaux,yaux,zaux,rfraction real :: xaux,yaux,zaux,rfraction
real :: topo,rhoaux(2),r,t,rhoout,ddx,ddy,rddx,rddy,p1,p2,p3,p4 real :: topo,rhoaux(2),r,t,rhoout,ddx,ddy,rddx,rddy,p1,p2,p3,p4
real :: dz1,dz2,dz,xtn,ytn,xlonav,timecorrect(maxspec),press,pressold real :: dz1,dz2,dz,xtn,ytn,xlonav,timecorrect(maxspec),press,pressold
...@@ -72,13 +72,13 @@ subroutine releaseparticles(itime) ...@@ -72,13 +72,13 @@ subroutine releaseparticles(itime)
! mind2 eso: pointer to 2nd windfield in memory ! mind2 eso: pointer to 2nd windfield in memory
integer :: idummy = -7 integer :: idummy = -7
!save idummy,xmasssave !save idummy,xmasssave
!data idummy/-7/,xmasssave/maxpoint*0./ !data idummy/-7/,xmasssave/maxpoint*0./
logical :: first_call=.true. logical :: first_call=.true.
! Use different seed for each process. ! Use different seed for each process.
!**************************************************************************** !****************************************************************************
if (first_call) then if (first_call) then
idummy=idummy+mp_seed idummy=idummy+mp_seed
first_call=.false. first_call=.false.
...@@ -86,8 +86,8 @@ subroutine releaseparticles(itime) ...@@ -86,8 +86,8 @@ subroutine releaseparticles(itime)
mind2=memind(2) mind2=memind(2)
! Determine the actual date and time in Greenwich (i.e., UTC + correction for daylight savings time) ! Determine the actual date and time in Greenwich (i.e., UTC + correction for daylight savings time)
!***************************************************************************** !*****************************************************************************
julmonday=juldate(19000101,0) ! this is a Monday julmonday=juldate(19000101,0) ! this is a Monday
jul=bdate+real(itime,kind=dp)/86400._dp ! this is the current day jul=bdate+real(itime,kind=dp)/86400._dp ! this is the current day
...@@ -96,16 +96,16 @@ subroutine releaseparticles(itime) ...@@ -96,16 +96,16 @@ subroutine releaseparticles(itime)
if ((mm.ge.4).and.(mm.le.9)) jul=jul+1._dp/24._dp ! daylight savings time in summer if ((mm.ge.4).and.(mm.le.9)) jul=jul+1._dp/24._dp ! daylight savings time in summer
! For every release point, check whether we are in the release time interval ! For every release point, check whether we are in the release time interval
!*************************************************************************** !***************************************************************************
minpart=1 minpart=1
do i=1,numpoint do i=1,numpoint
if ((itime.ge.ireleasestart(i)).and. &! are we within release interval? if ((itime.ge.ireleasestart(i)).and. &! are we within release interval?
(itime.le.ireleaseend(i))) then (itime.le.ireleaseend(i))) then
! Determine the local day and time ! Determine the local day and time
!********************************* !*********************************
xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx ! longitude needed to determine local time xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx ! longitude needed to determine local time
if (xlonav.lt.-180.) xlonav=xlonav+360. if (xlonav.lt.-180.) xlonav=xlonav+360.
...@@ -123,10 +123,10 @@ subroutine releaseparticles(itime) ...@@ -123,10 +123,10 @@ subroutine releaseparticles(itime)
if (ndayofweek.eq.0) ndayofweek=7 if (ndayofweek.eq.0) ndayofweek=7
endif endif
! Calculate a species- and time-dependent correction factor, distinguishing between ! Calculate a species- and time-dependent correction factor, distinguishing between
! area (those with release starting at surface) and point (release starting above surface) sources ! area (those with release starting at surface) and point (release starting above surface) sources
! Also, calculate an average time correction factor (species independent) ! Also, calculate an average time correction factor (species independent)
!***************************************************************************** !*****************************************************************************
average_timecorrect=0. average_timecorrect=0.
do k=1,nspec do k=1,nspec
if (zpoint1(i).gt.0.5) then ! point source if (zpoint1(i).gt.0.5) then ! point source
...@@ -138,9 +138,9 @@ subroutine releaseparticles(itime) ...@@ -138,9 +138,9 @@ subroutine releaseparticles(itime)
end do end do
average_timecorrect=average_timecorrect/real(nspec) average_timecorrect=average_timecorrect/real(nspec)
! Determine number of particles to be released this time; at start and at end of release, ! Determine number of particles to be released this time; at start and at end of release,
! only half the particles are released ! only half the particles are released
!***************************************************************************** !*****************************************************************************
if (ireleasestart(i).ne.ireleaseend(i)) then if (ireleasestart(i).ne.ireleaseend(i)) then
rfraction=abs(real(npart(i))*real(lsynctime)/ & rfraction=abs(real(npart(i))*real(lsynctime)/ &
...@@ -148,16 +148,16 @@ subroutine releaseparticles(itime) ...@@ -148,16 +148,16 @@ subroutine releaseparticles(itime)
if ((itime.eq.ireleasestart(i)).or. & if ((itime.eq.ireleasestart(i)).or. &
(itime.eq.ireleaseend(i))) rfraction=rfraction/2. (itime.eq.ireleaseend(i))) rfraction=rfraction/2.
! Take the species-average time correction factor in order to scale the ! Take the species-average time correction factor in order to scale the
! number of particles released this time ! number of particles released this time
! Also scale by number of MPI processes ! Also scale by number of MPI processes
!********************************************************************** !**********************************************************************
rfraction=rfraction*average_timecorrect rfraction=rfraction*average_timecorrect
rfraction=rfraction+xmasssave(i) ! number to be released at this time rfraction=rfraction+xmasssave(i) ! number to be released at this time
! number to be released for one process ! number to be released for one process
if (mp_partid.lt.mod(int(rfraction),mp_partgroup_np)) then if (mp_partid.lt.mod(int(rfraction),mp_partgroup_np)) then
addone=1 addone=1
else else
...@@ -179,23 +179,23 @@ subroutine releaseparticles(itime) ...@@ -179,23 +179,23 @@ subroutine releaseparticles(itime)
numrel=npart(i)/mp_partgroup_np+addone numrel=npart(i)/mp_partgroup_np+addone
endif endif
xaux=xpoint2(i)-xpoint1(i) xaux=xpoint2(i)-xpoint1(i)
yaux=ypoint2(i)-ypoint1(i) yaux=ypoint2(i)-ypoint1(i)
zaux=zpoint2(i)-zpoint1(i) zaux=zpoint2(i)-zpoint1(i)
do j=1,numrel ! loop over particles to be released this time do j=1,numrel ! loop over particles to be released this time
do ipart=minpart,maxpart_mpi ! search for free storage space do ipart=minpart,maxpart_mpi ! search for free storage space
! If a free storage space is found, attribute everything to this array element ! If a free storage space is found, attribute everything to this array element
!***************************************************************************** !*****************************************************************************
if (itra1(ipart).ne.itime) then if (itra1(ipart).ne.itime) then
! Particle coordinates are determined by using a random position within the release volume ! Particle coordinates are determined by using a random position within the release volume
!***************************************************************************** !*****************************************************************************
! Determine horizontal particle position ! Determine horizontal particle position
!*************************************** !***************************************
xtra1(ipart)=xpoint1(i)+ran1(idummy)*xaux xtra1(ipart)=xpoint1(i)+ran1(idummy)*xaux
if (xglobal) then if (xglobal) then
...@@ -206,18 +206,18 @@ subroutine releaseparticles(itime) ...@@ -206,18 +206,18 @@ subroutine releaseparticles(itime)
endif endif
ytra1(ipart)=ypoint1(i)+ran1(idummy)*yaux ytra1(ipart)=ypoint1(i)+ran1(idummy)*yaux
! Assign mass to particle: Total mass divided by total number of particles. ! Assign mass to particle: Total mass divided by total number of particles.
! Time variation has partly been taken into account already by a species-average ! Time variation has partly been taken into account already by a species-average
! correction factor, by which the number of particles released this time has been ! correction factor, by which the number of particles released this time has been
! scaled. Adjust the mass per particle by the species-dependent time correction factor ! scaled. Adjust the mass per particle by the species-dependent time correction factor
! divided by the species-average one ! divided by the species-average one
!***************************************************************************** !*****************************************************************************
do k=1,nspec do k=1,nspec
xmass1(ipart,k)=xmass(i,k)/real(npart(i)) & xmass1(ipart,k)=xmass(i,k)/real(npart(i)) &
*timecorrect(k)/average_timecorrect *timecorrect(k)/average_timecorrect
! write (*,*) 'xmass1: ',xmass1(ipart,k),ipart,k ! write (*,*) 'xmass1: ',xmass1(ipart,k),ipart,k
! Assign certain properties to particle ! Assign certain properties to particle
!************************************** !**************************************
end do end do
nclass(ipart)=min(int(ran1(idummy)*real(nclassunc))+1, & nclass(ipart)=min(int(ran1(idummy)*real(nclassunc))+1, &
nclassunc) nclassunc)
...@@ -233,16 +233,16 @@ subroutine releaseparticles(itime) ...@@ -233,16 +233,16 @@ subroutine releaseparticles(itime)
itrasplit(ipart)=itra1(ipart)+ldirect*itsplit itrasplit(ipart)=itra1(ipart)+ldirect*itsplit
! Determine vertical particle position ! Determine vertical particle position
!************************************* !*************************************
ztra1(ipart)=zpoint1(i)+ran1(idummy)*zaux ztra1(ipart)=zpoint1(i)+ran1(idummy)*zaux
! Interpolation of topography and density ! Interpolation of topography and density
!**************************************** !****************************************
! Determine the nest we are in ! Determine the nest we are in
!***************************** !*****************************
ngrid=0 ngrid=0
do k=numbnests,1,-1 do k=numbnests,1,-1
...@@ -256,8 +256,8 @@ subroutine releaseparticles(itime) ...@@ -256,8 +256,8 @@ subroutine releaseparticles(itime)
end do end do
43 continue 43 continue
! Determine (nested) grid coordinates and auxiliary parameters used for interpolation ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
!***************************************************************************** !*****************************************************************************
if (ngrid.gt.0) then if (ngrid.gt.0) then
xtn=(xtra1(ipart)-xln(ngrid))*xresoln(ngrid) xtn=(xtra1(ipart)-xln(ngrid))*xresoln(ngrid)
...@@ -293,8 +293,8 @@ subroutine releaseparticles(itime) ...@@ -293,8 +293,8 @@ subroutine releaseparticles(itime)
+ p4*oro(ixp,jyp) + p4*oro(ixp,jyp)
endif endif
! If starting height is in pressure coordinates, retrieve pressure profile and convert zpart1 to meters ! If starting height is in pressure coordinates, retrieve pressure profile and convert zpart1 to meters
!***************************************************************************** !*****************************************************************************
if (kindz(i).eq.3) then if (kindz(i).eq.3) then
presspart=ztra1(ipart) presspart=ztra1(ipart)
do kz=1,nz do kz=1,nz
...@@ -336,9 +336,9 @@ subroutine releaseparticles(itime) ...@@ -336,9 +336,9 @@ subroutine releaseparticles(itime)
71 continue 71 continue
endif endif
! If release positions are given in meters above sea level, subtract the ! If release positions are given in meters above sea level, subtract the
! topography from the starting height ! topography from the starting height
!*********************************************************************** !***********************************************************************
if (kindz(i).eq.2) ztra1(ipart)=ztra1(ipart)-topo if (kindz(i).eq.2) ztra1(ipart)=ztra1(ipart)-topo
if (ztra1(ipart).lt.eps2) ztra1(ipart)=eps2 ! Minimum starting height is eps2 if (ztra1(ipart).lt.eps2) ztra1(ipart)=eps2 ! Minimum starting height is eps2
...@@ -347,28 +347,28 @@ subroutine releaseparticles(itime) ...@@ -347,28 +347,28 @@ subroutine releaseparticles(itime)
! For special simulations, multiply particle concentration air density; ! For special simulations, multiply particle concentration air density;
! Simply take the 2nd field in memory to do this (accurate enough) ! Simply take the 2nd field in memory to do this (accurate enough)
!*********************************************************************** !***********************************************************************
!AF IND_SOURCE switches between different units for concentrations at the source !AF IND_SOURCE switches between different units for concentrations at the source
!Af NOTE that in backward simulations the release of particles takes place at the !Af NOTE that in backward simulations the release of particles takes place at the
!Af receptor and the sampling at the source. !Af receptor and the sampling at the source.
!Af 1="mass" !Af 1="mass"
!Af 2="mass mixing ratio" !Af 2="mass mixing ratio"
!Af IND_RECEPTOR switches between different units for concentrations at the receptor !Af IND_RECEPTOR switches between different units for concentrations at the receptor
!Af 1="mass" !Af 1="mass"
!Af 2="mass mixing ratio" !Af 2="mass mixing ratio"
!Af switches for the releasefile: !Af switches for the releasefile:
!Af IND_REL = 1 : xmass * rho !Af IND_REL = 1 : xmass * rho
!Af IND_REL = 0 : xmass * 1 !Af IND_REL = 0 : xmass * 1
!Af ind_rel is defined in readcommand.f !Af ind_rel is defined in readcommand.f
if (ind_rel .eq. 1) then if (ind_rel .eq. 1) then
! Interpolate the air density ! Interpolate the air density
!**************************** !****************************
do ii=2,nz do ii=2,nz
if (height(ii).gt.ztra1(ipart)) then if (height(ii).gt.ztra1(ipart)) then
...@@ -402,8 +402,8 @@ subroutine releaseparticles(itime) ...@@ -402,8 +402,8 @@ subroutine releaseparticles(itime)
rho_rel(i)=rhoout rho_rel(i)=rhoout
! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
!******************************************************************** !********************************************************************
do k=1,nspec do k=1,nspec
xmass1(ipart,k)=xmass1(ipart,k)*rhoout xmass1(ipart,k)=xmass1(ipart,k)*rhoout
...@@ -415,17 +415,18 @@ subroutine releaseparticles(itime) ...@@ -415,17 +415,18 @@ subroutine releaseparticles(itime)
goto 34 ! Storage space has been found, stop searching goto 34 ! Storage space has been found, stop searching
endif endif
end do end do
if (ipart.gt.maxpart) goto 996 ! ESO TODO: Here we could use dynamic allocation and increase array sizes
if (ipart.gt.maxpart_mpi) goto 996
34 minpart=ipart+1 34 minpart=ipart+1
end do end do
endif endif
end do end do
return return
996 continue 996 continue
write(*,*) '#####################################################' write(*,*) '#####################################################'
write(*,*) '#### FLEXPART MODEL SUBROUTINE RELEASEPARTICLES: ####' write(*,*) '#### FLEXPART MODEL SUBROUTINE RELEASEPARTICLES: ####'
write(*,*) '#### ####' write(*,*) '#### ####'
......
src/timemanager_mpi.f90
View file @ d404d981
...@@ -103,7 +103,7 @@ subroutine timemanager ...@@ -103,7 +103,7 @@ subroutine timemanager
implicit none implicit none
logical :: reqv_state=.false. ! .true. if waiting for a MPI_Irecv to complete logical :: reqv_state=.false. ! .true. if waiting for a MPI_Irecv to complete
integer :: j,ks,kp,l,n,itime=0,nstop,nstop1,memstat=0 !,mind integer :: j,ks,kp,l,n,itime=0,nstop,nstop1,memstat=0
! integer :: ksp ! integer :: ksp
integer :: ip integer :: ip
integer :: loutnext,loutstart,loutend integer :: loutnext,loutstart,loutend
...@@ -154,6 +154,7 @@ subroutine timemanager ...@@ -154,6 +154,7 @@ subroutine timemanager
do itime=0,ideltas,lsynctime do itime=0,ideltas,lsynctime
! Computation of wet deposition, OH reaction and mass transfer ! Computation of wet deposition, OH reaction and mass transfer
! between two species every lsynctime seconds ! between two species every lsynctime seconds
...@@ -165,7 +166,7 @@ subroutine timemanager ...@@ -165,7 +166,7 @@ subroutine timemanager
! changed by Petra Seibert 9/02 ! changed by Petra Seibert 9/02
!******************************************************************** !********************************************************************
if (mp_dev_mode) write(*,*) 'myid, itime: ',mp_pid,itime if (mp_dbg_mode) write(*,*) 'myid, itime: ',mp_pid,itime
if (WETDEP .and. itime .ne. 0 .and. numpart .gt. 0) then if (WETDEP .and. itime .ne. 0 .and. numpart .gt. 0) then
if (verbosity.gt.0) then if (verbosity.gt.0) then
...@@ -274,6 +275,12 @@ subroutine timemanager ...@@ -274,6 +275,12 @@ subroutine timemanager
if (mp_measure_time.and..not.(lmpreader.and.lmp_use_reader)) call mpif_mtime('getfields',1) if (mp_measure_time.and..not.(lmpreader.and.lmp_use_reader)) call mpif_mtime('getfields',1)
! For validation and tests: call the function below to set all fields to simple
! homogeneous values
! if (mp_dev_mode) call set_fields_synthetic
!*******************************************************************************
if (lmpreader.and.nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE' if (lmpreader.and.nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE'
! Reader process goes back to top of time loop (unless simulation end) ! Reader process goes back to top of time loop (unless simulation end)
...@@ -325,6 +332,11 @@ subroutine timemanager ...@@ -325,6 +332,11 @@ subroutine timemanager
endif endif
! Check if particles should be redistributed among processes
!***********************************************************
call mpif_calculate_part_redist(itime)
! Compute convective mixing for forward runs ! Compute convective mixing for forward runs
! for backward runs it is done before next windfield is read in ! for backward runs it is done before next windfield is read in
!************************************************************** !**************************************************************
...@@ -541,20 +553,20 @@ subroutine timemanager ...@@ -541,20 +553,20 @@ subroutine timemanager
! Decide whether to write an estimate of the number of particles released, ! Decide whether to write an estimate of the number of particles released,
! or exact number (require MPI reduce operation) ! or exact number (require MPI reduce operation)
if (mp_dev_mode) then if (mp_dbg_mode) then
numpart_tot_mpi = numpart numpart_tot_mpi = numpart
else else
numpart_tot_mpi = numpart*mp_partgroup_np numpart_tot_mpi = numpart*mp_partgroup_np
end if end if
if (mp_exact_numpart.and..not.(lmpreader.and.lmp_use_reader).and.& if (mp_exact_numpart.and..not.(lmpreader.and.lmp_use_reader).and.&
&.not.mp_dev_mode) then &.not.mp_dbg_mode) then
call MPI_Reduce(numpart, numpart_tot_mpi, 1, MPI_INTEGER, MPI_SUM, id_root, & call MPI_Reduce(numpart, numpart_tot_mpi, 1, MPI_INTEGER, MPI_SUM, id_root, &
& mp_comm_used, mp_ierr) & mp_comm_used, mp_ierr)
endif endif
!CGZ-lifetime: output species lifetime !CGZ-lifetime: output species lifetime
if (lroot.or.mp_dev_mode) then if (lroot.or.mp_dbg_mode) then
! write(*,*) 'Overview species lifetime in days', & ! write(*,*) 'Overview species lifetime in days', &
! real((species_lifetime(:,1)/species_lifetime(:,2))/real(3600.0*24.0)) ! real((species_lifetime(:,1)/species_lifetime(:,2))/real(3600.0*24.0))
! write(*,*) 'all info:',species_lifetime ! write(*,*) 'all info:',species_lifetime
...@@ -565,6 +577,10 @@ subroutine timemanager ...@@ -565,6 +577,10 @@ subroutine timemanager
! end if ! end if
end if end if
! Write particles for all processes
if (mp_dev_mode) write(*,*) "PID, itime, numpart", mp_pid,itime,numpart
45 format(i13,' SECONDS SIMULATED: ',i13, ' PARTICLES: Uncertainty: ',3f7.3) 45 format(i13,' SECONDS SIMULATED: ',i13, ' PARTICLES: Uncertainty: ',3f7.3)
46 format(' Simulated ',f7.1,' hours (',i13,' s), ',i13, ' particles') 46 format(' Simulated ',f7.1,' hours (',i13,' s), ',i13, ' particles')
if (ipout.ge.1) then if (ipout.ge.1) then
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment