source: flexpart.git/src/releaseparticles_mpi.f90 @ 3481cc1

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bug
Last change on this file since 3481cc1 was 3481cc1, checked in by Ignacio Pisso <ip@…>, 4 years ago

move license from headers to a different file

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