source: flexpart.git/src/releaseparticles_mpi.f90 @ 1228ef7

dev
Last change on this file since 1228ef7 was 1228ef7, checked in by Espen Sollum <eso@…>, 3 years ago

MPI: fix for mquasilag output

  • Property mode set to 100644
File size: 16.9 KB
Line 
1! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
2! SPDX-License-Identifier: GPL-3.0-or-later
3
4subroutine releaseparticles(itime)
5!                              o
6!*****************************************************************************
7!                                                                            *
8!     This subroutine releases particles from the release locations.         *
9!                                                                            *
10!     It searches for a "vacant" storage space and assigns all particle      *
11!     information to that space. A space is vacant either when no particle   *
12!     is yet assigned to it, or when it's particle is expired and, thus,     *
13!     the storage space is made available to a new particle.                 *
14!                                                                            *
15!     Author: A. Stohl                                                       *
16!                                                                            *
17!     29 June 2002                                                           *
18!                                                                            *
19!   CHANGES                                                                  *
20!     12/2014 eso: MPI version                                               *
21!                                                                            *
22!*****************************************************************************
23!                                                                            *
24! Variables:                                                                 *
25! itime [s]            current time                                          *
26! ireleasestart, ireleaseend          start and end times of all releases    *
27! npart(maxpoint)      number of particles to be released in total           *
28! numrel               number of particles to be released during this time   *
29!                      step                                                  *
30! addone               extra particle assigned to MPI process if             *
31!                      mod(npart(i),mp_partgroup_np) .ne. 0)                 *
32!*****************************************************************************
33
34  use point_mod
35  use xmass_mod
36  use par_mod
37  use com_mod
38  use random_mod, only: ran1
39  use mpi_mod, only: mp_partid, maxpart_mpi, mp_partgroup_np, mp_seed, mpif_mpi_barrier
40
41  implicit none
42
43!real xaux,yaux,zaux,ran1,rfraction,xmasssave(maxpoint)
44  real :: xaux,yaux,zaux,rfraction
45  real :: topo,rhoaux(2),r,t,rhoout,ddx,ddy,rddx,rddy,p1,p2,p3,p4
46  real :: dz1,dz2,dz,xtn,ytn,xlonav,timecorrect(maxspec),press,pressold
47  real :: presspart,average_timecorrect
48  integer :: itime,numrel,i,j,k,n,ix,jy,ixp,jyp,ipart,minpart,ii,addone
49  integer :: indz,indzp,kz,ngrid
50  integer :: nweeks,ndayofweek,nhour,jjjjmmdd,ihmmss,mm
51  real(kind=dp) :: juldate,julmonday,jul,jullocal,juldiff
52  real,parameter :: eps=nxmax/3.e5,eps2=1.e-6
53  integer :: mind2, numpartcount_mpi
54! mind2        eso: pointer to 2nd windfield in memory
55  integer :: idummy = -7
56!save idummy,xmasssave
57!data idummy/-7/,xmasssave/maxpoint*0./
58
59  logical :: first_call=.true.
60
61! Use different random seed for each process
62!*******************************************
63  if (first_call) then
64    idummy=idummy+mp_seed
65    first_call=.false.
66  end if
67
68  mind2=memind(2)
69
70! For mquasilag=1, assign unique particle ID across processes
71  numpartcount_mpi=mp_partid-mp_partgroup_np+1
72
73! Determine the actual date and time in Greenwich (i.e., UTC + correction for daylight savings time)
74!*****************************************************************************
75
76  julmonday=juldate(19000101,0)          ! this is a Monday
77  jul=bdate+real(itime,kind=dp)/86400._dp    ! this is the current day
78  call caldate(jul,jjjjmmdd,ihmmss)
79  mm=(jjjjmmdd-10000*(jjjjmmdd/10000))/100
80  if ((mm.ge.4).and.(mm.le.9)) jul=jul+1._dp/24._dp   ! daylight savings time in summer
81
82
83! For every release point, check whether we are in the release time interval
84!***************************************************************************
85
86  minpart=1
87  do i=1,numpoint
88    if ((itime.ge.ireleasestart(i)).and. &! are we within release interval?
89         (itime.le.ireleaseend(i))) then
90
91! Determine the local day and time
92!*********************************
93
94      xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx  ! longitude needed to determine local time
95      if (xlonav.lt.-180.) xlonav=xlonav+360.
96      if (xlonav.gt.180.) xlonav=xlonav-360.
97      jullocal=jul+real(xlonav,kind=dp)/360._dp   ! correct approximately for time zone to obtain local time
98
99      juldiff=jullocal-julmonday
100      nweeks=int(juldiff/7._dp)
101      juldiff=juldiff-real(nweeks,kind=dp)*7._dp
102      ndayofweek=int(juldiff)+1              ! this is the current day of week, starting with Monday
103      nhour=nint((juldiff-real(ndayofweek-1,kind=dp))*24._dp)    ! this is the current hour
104      if (nhour.eq.0) then
105        nhour=24
106        ndayofweek=ndayofweek-1
107        if (ndayofweek.eq.0) ndayofweek=7
108      endif
109
110! Calculate a species- and time-dependent correction factor, distinguishing between
111! area (those with release starting at surface) and point (release starting above surface) sources
112! Also, calculate an average time correction factor (species independent)
113!*****************************************************************************
114      average_timecorrect=0.
115      do k=1,nspec
116        if (zpoint1(i).gt.0.5) then      ! point source
117          timecorrect(k)=point_hour(k,nhour)*point_dow(k,ndayofweek)
118        else                             ! area source
119          timecorrect(k)=area_hour(k,nhour)*area_dow(k,ndayofweek)
120        endif
121        average_timecorrect=average_timecorrect+timecorrect(k)
122      end do
123      average_timecorrect=average_timecorrect/real(nspec)
124
125! Determine number of particles to be released this time; at start and at end of release,
126! only half the particles are released
127!*****************************************************************************
128
129      if (ireleasestart(i).ne.ireleaseend(i)) then
130        rfraction=abs(real(npart(i))*real(lsynctime)/ &
131             real(ireleaseend(i)-ireleasestart(i)))
132        if ((itime.eq.ireleasestart(i)).or. &
133             (itime.eq.ireleaseend(i))) rfraction=rfraction/2.
134
135! Take the species-average time correction factor in order to scale the
136! number of particles released this time
137! Also scale by number of MPI processes
138!**********************************************************************
139
140        rfraction=rfraction*average_timecorrect
141
142        rfraction=rfraction+xmasssave(i)  ! number to be released at this time
143
144! number to be released for one process
145        if (mp_partid.lt.mod(int(rfraction),mp_partgroup_np)) then
146          addone=1
147        else
148          addone=0
149        end if
150
151        numrel=int(rfraction/mp_partgroup_np) + addone
152
153        xmasssave(i)=rfraction-int(rfraction)
154
155      else
156! All particles are released in this time interval
157! ************************************************
158        if (mp_partid.lt.mod(npart(i),mp_partgroup_np)) then
159          addone=1
160        else
161          addone=0
162        end if
163
164        numrel=npart(i)/mp_partgroup_np+addone
165      endif
166
167      xaux=xpoint2(i)-xpoint1(i)
168      yaux=ypoint2(i)-ypoint1(i)
169      zaux=zpoint2(i)-zpoint1(i)
170      do j=1,numrel                       ! loop over particles to be released this time
171        do ipart=minpart,maxpart_mpi     ! search for free storage space
172
173! If a free storage space is found, attribute everything to this array element
174!*****************************************************************************
175
176          if (itra1(ipart).ne.itime) then
177
178! Particle coordinates are determined by using a random position within the release volume
179!*****************************************************************************
180
181! Determine horizontal particle position
182!***************************************
183
184            xtra1(ipart)=xpoint1(i)+ran1(idummy)*xaux
185            if (xglobal) then
186              if (xtra1(ipart).gt.real(nxmin1)) xtra1(ipart)= &
187                   xtra1(ipart)-real(nxmin1)
188              if (xtra1(ipart).lt.0.) xtra1(ipart)= &
189                   xtra1(ipart)+real(nxmin1)
190            endif
191            ytra1(ipart)=ypoint1(i)+ran1(idummy)*yaux
192
193! Assign mass to particle: Total mass divided by total number of particles.
194! Time variation has partly been taken into account already by a species-average
195! correction factor, by which the number of particles released this time has been
196! scaled. Adjust the mass per particle by the species-dependent time correction factor
197! divided by the species-average one
198!*****************************************************************************
199            do k=1,nspec
200              xmass1(ipart,k)=xmass(i,k)/real(npart(i)) &
201                   *timecorrect(k)/average_timecorrect
202              if (DRYBKDEP.or.WETBKDEP) then ! if there is no scavenging in wetdepo it will be set to 0
203!              if ( henry(k).gt.0 .or. &
204!                   crain_aero(k).gt.0. .or. csnow_aero(k).gt.0. .or. &
205!                   ccn_aero(k).gt.0. .or. in_aero(k).gt.0. )  then
206                xscav_frac1(ipart,k)=-1.
207               endif
208! Assign certain properties to particle
209!**************************************
210            end do
211            nclass(ipart)=min(int(ran1(idummy)*real(nclassunc))+1, &
212                 nclassunc)
213            numparticlecount=numparticlecount+1
214! Use a stride equal to number of processes for the MPI version
215            numpartcount_mpi=numpartcount_mpi+mp_partgroup_np
216            if (mquasilag.eq.0) then
217              npoint(ipart)=i
218            else
219              npoint(ipart)=numpartcount_mpi
220            endif
221            idt(ipart)=mintime               ! first time step
222            itra1(ipart)=itime
223            itramem(ipart)=itra1(ipart)
224            itrasplit(ipart)=itra1(ipart)+ldirect*itsplit
225
226
227! Determine vertical particle position
228!*************************************
229
230            ztra1(ipart)=zpoint1(i)+ran1(idummy)*zaux
231
232! Interpolation of topography and density
233!****************************************
234
235! Determine the nest we are in
236!*****************************
237
238            ngrid=0
239            do k=numbnests,1,-1
240              if ((xtra1(ipart).gt.xln(k)+eps).and. &
241                   (xtra1(ipart).lt.xrn(k)-eps).and. &
242                   (ytra1(ipart).gt.yln(k)+eps).and. &
243                   (ytra1(ipart).lt.yrn(k)-eps)) then
244                ngrid=k
245                goto 43
246              endif
247            end do
24843          continue
249
250! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
251!*****************************************************************************
252
253            if (ngrid.gt.0) then
254              xtn=(xtra1(ipart)-xln(ngrid))*xresoln(ngrid)
255              ytn=(ytra1(ipart)-yln(ngrid))*yresoln(ngrid)
256              ix=int(xtn)
257              jy=int(ytn)
258              ddy=ytn-real(jy)
259              ddx=xtn-real(ix)
260            else
261              ix=int(xtra1(ipart))
262              jy=int(ytra1(ipart))
263              ddy=ytra1(ipart)-real(jy)
264              ddx=xtra1(ipart)-real(ix)
265            endif
266            ixp=ix+1
267            jyp=jy+1
268            rddx=1.-ddx
269            rddy=1.-ddy
270            p1=rddx*rddy
271            p2=ddx*rddy
272            p3=rddx*ddy
273            p4=ddx*ddy
274
275            if (ngrid.gt.0) then
276              topo=p1*oron(ix ,jy ,ngrid) &
277                   + p2*oron(ixp,jy ,ngrid) &
278                   + p3*oron(ix ,jyp,ngrid) &
279                   + p4*oron(ixp,jyp,ngrid)
280            else
281              topo=p1*oro(ix ,jy) &
282                   + p2*oro(ixp,jy) &
283                   + p3*oro(ix ,jyp) &
284                   + p4*oro(ixp,jyp)
285            endif
286
287! If starting height is in pressure coordinates, retrieve pressure profile and convert zpart1 to meters
288!*****************************************************************************
289            if (kindz(i).eq.3) then
290              presspart=ztra1(ipart)
291              do kz=1,nz
292                if (ngrid.gt.0) then
293                  r=p1*rhon(ix ,jy ,kz,mind2,ngrid) &
294                       +p2*rhon(ixp,jy ,kz,mind2,ngrid) &
295                       +p3*rhon(ix ,jyp,kz,mind2,ngrid) &
296                       +p4*rhon(ixp,jyp,kz,mind2,ngrid)
297                  t=p1*ttn(ix ,jy ,kz,mind2,ngrid) &
298                       +p2*ttn(ixp,jy ,kz,mind2,ngrid) &
299                       +p3*ttn(ix ,jyp,kz,mind2,ngrid) &
300                       +p4*ttn(ixp,jyp,kz,mind2,ngrid)
301                else
302                  r=p1*rho(ix ,jy ,kz,mind2) &
303                       +p2*rho(ixp,jy ,kz,mind2) &
304                       +p3*rho(ix ,jyp,kz,mind2) &
305                       +p4*rho(ixp,jyp,kz,mind2)
306                  t=p1*tt(ix ,jy ,kz,mind2) &
307                       +p2*tt(ixp,jy ,kz,mind2) &
308                       +p3*tt(ix ,jyp,kz,mind2) &
309                       +p4*tt(ixp,jyp,kz,mind2)
310                endif
311                press=r*r_air*t/100.
312                if (kz.eq.1) pressold=press
313
314                if (press.lt.presspart) then
315                  if (kz.eq.1) then
316                    ztra1(ipart)=height(1)/2.
317                  else
318                    dz1=pressold-presspart
319                    dz2=presspart-press
320                    ztra1(ipart)=(height(kz-1)*dz2+height(kz)*dz1) &
321                         /(dz1+dz2)
322                  endif
323                  goto 71
324                endif
325                pressold=press
326              end do
32771            continue
328            endif
329
330! If release positions are given in meters above sea level, subtract the
331! topography from the starting height
332!***********************************************************************
333
334            if (kindz(i).eq.2) ztra1(ipart)=ztra1(ipart)-topo
335            if (ztra1(ipart).lt.eps2) ztra1(ipart)=eps2   ! Minimum starting height is eps2
336            if (ztra1(ipart).gt.height(nz)-0.5) ztra1(ipart)= &
337                 height(nz)-0.5 ! Maximum starting height is uppermost level - 0.5 meters
338
339
340
341! For special simulations, multiply particle concentration air density;
342! Simply take the 2nd field in memory to do this (accurate enough)
343!***********************************************************************
344!AF IND_SOURCE switches between different units for concentrations at the source
345!Af    NOTE that in backward simulations the release of particles takes place at the
346!Af         receptor and the sampling at the source.
347!Af          1="mass"
348!Af          2="mass mixing ratio"
349!Af IND_RECEPTOR switches between different units for concentrations at the receptor
350!Af          1="mass"
351!Af          2="mass mixing ratio"
352
353!Af switches for the releasefile:
354!Af IND_REL =  1 : xmass * rho
355!Af IND_REL =  0 : xmass * 1
356
357!Af ind_rel is defined in readcommand.f
358
359            if ((ind_rel .eq. 1).or.(ind_rel .eq. 3).or.(ind_rel .eq. 4)) then
360
361! Interpolate the air density
362!****************************
363
364              do ii=2,nz
365                if (height(ii).gt.ztra1(ipart)) then
366                  indz=ii-1
367                  indzp=ii
368                  goto 6
369                endif
370              end do
3716             continue
372
373              dz1=ztra1(ipart)-height(indz)
374              dz2=height(indzp)-ztra1(ipart)
375              dz=1./(dz1+dz2)
376
377              if (ngrid.gt.0) then
378                do n=1,2
379                  rhoaux(n)=p1*rhon(ix ,jy ,indz+n-1,mind2,ngrid) &
380                       +p2*rhon(ixp,jy ,indz+n-1,mind2,ngrid) &
381                       +p3*rhon(ix ,jyp,indz+n-1,mind2,ngrid) &
382                       +p4*rhon(ixp,jyp,indz+n-1,mind2,ngrid)
383                end do
384              else
385                do n=1,2
386                  rhoaux(n)=p1*rho(ix ,jy ,indz+n-1,mind2) &
387                       +p2*rho(ixp,jy ,indz+n-1,mind2) &
388                       +p3*rho(ix ,jyp,indz+n-1,mind2) &
389                       +p4*rho(ixp,jyp,indz+n-1,mind2)
390                end do
391              endif
392              rhoout=(dz2*rhoaux(1)+dz1*rhoaux(2))*dz
393              rho_rel(i)=rhoout
394
395
396! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
397!********************************************************************
398
399              do k=1,nspec
400                xmass1(ipart,k)=xmass1(ipart,k)*rhoout
401              end do
402            endif
403
404
405            numpart=max(numpart,ipart)
406            goto 34      ! Storage space has been found, stop searching
407          endif
408        end do
409        if (ipart.gt.maxpart_mpi) goto 996
410
41134      minpart=ipart+1
412      end do
413    endif
414  end do
415
416
417  return
418
419996 continue
420  write(*,*) '#####################################################'
421  write(*,*) '#### FLEXPART MODEL SUBROUTINE RELEASEPARTICLES: ####'
422  write(*,*) '####                                             ####'
423  write(*,*) '#### ERROR - TOTAL NUMBER OF PARTICLES REQUIRED  ####'
424  write(*,*) '#### EXCEEDS THE MAXIMUM ALLOWED NUMBER. REDUCE  ####'
425  write(*,*) '#### EITHER NUMBER OF PARTICLES PER RELEASE POINT####'
426  write(*,*) '#### OR REDUCE NUMBER OF RELEASE POINTS.         ####'
427  write(*,*) '#####################################################'
428  stop
429
430end subroutine releaseparticles
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG