source: flexpart.git/src/releaseparticles_mpi.f90 @ f9ce123

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

Updated wet depo scheme

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