source: flexpart.git/src/releaseparticles_mpi.f90 @ 7999df47

10.4.1_peseiGFS_025bugfixes+enhancementsdevrelease-10release-10.4.1scaling-bugunivie
Last change on this file since 7999df47 was 57c5b2e, checked in by Espen Sollum ATMOS <eso@…>, 9 years ago

Bug fixed where number of particles released (MPI version) was not always correct

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