source: flexpart.git/src/init_domainfill_mpi.f90 @ 38b7917

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

Parallelization of domain fill option (save/restart not implemented yet)

  • Property mode set to 100644
File size: 15.8 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 init_domainfill
23!
24!*****************************************************************************
25!                                                                            *
26! Initializes particles equally distributed over the first release location  *
27! specified in file RELEASES. This box is assumed to be the domain for doing *
28! domain-filling trajectory calculations.                                    *
29! All particles carry the same amount of mass which alltogether comprises the*
30! mass of air within the box.                                                *
31!                                                                            *
32!     Author: A. Stohl                                                       *
33!                                                                            *
34!     15 October 2002                                                        *
35!                                                                            *
36!  CHANGES                                                                   *
37!    12/2014 eso: MPI version                                                *
38!*****************************************************************************
39!                                                                            *
40! Variables:                                                                 *
41!                                                                            *
42! numparticlecount    consecutively counts the number of particles released  *
43! nx_we(2)       grid indices for western and eastern boundary of domain-    *
44!                filling trajectory calculations                             *
45! ny_sn(2)       grid indices for southern and northern boundary of domain-  *
46!                filling trajectory calculations                             *
47!                                                                            *
48!*****************************************************************************
49
50  use point_mod
51  use par_mod
52  use com_mod
53  use random_mod, only: ran1
54  use mpi_mod
55
56! :TODO: parallelize this
57
58  implicit none
59
60  integer :: j,ix,jy,kz,ncolumn,numparttot
61  real :: gridarea(0:nymax-1),pp(nzmax),ylat,ylatp,ylatm,hzone
62  real :: cosfactm,cosfactp,deltacol,dz1,dz2,dz,pnew,fractus
63  real,parameter :: pih=pi/180.
64  real :: colmass(0:nxmax-1,0:nymax-1),colmasstotal,zposition
65
66  integer :: ixm,ixp,jym,jyp,indzm,indzp,in,indzh,i,jj
67  real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2)
68
69  integer :: idummy = -11
70  logical :: first_call=.true.
71
72  ! Use different seed for each process
73  if (first_call) then
74    idummy=idummy+mp_seed
75    first_call=.false.
76  end if
77
78! Determine the release region (only full grid cells), over which particles
79! shall be initialized
80! Use 2 fields for west/east and south/north boundary
81!**************************************************************************
82
83  nx_we(1)=max(int(xpoint1(1)),0)
84  nx_we(2)=min((int(xpoint2(1))+1),nxmin1)
85  ny_sn(1)=max(int(ypoint1(1)),0)
86  ny_sn(2)=min((int(ypoint2(1))+1),nymin1)
87
88! For global simulations (both global wind data and global domain-filling),
89! set a switch, such that no boundary conditions are used
90!**************************************************************************
91  if (xglobal.and.sglobal.and.nglobal) then
92    if ((nx_we(1).eq.0).and.(nx_we(2).eq.nxmin1).and. &
93         (ny_sn(1).eq.0).and.(ny_sn(2).eq.nymin1)) then
94      gdomainfill=.true.
95    else
96      gdomainfill=.false.
97    endif
98  endif
99
100! Do not release particles twice (i.e., not at both in the leftmost and rightmost
101! grid cell) for a global domain
102!*****************************************************************************
103  if (xglobal) nx_we(2)=min(nx_we(2),nx-2)
104
105
106! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
107! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
108!************************************************************
109
110  do jy=ny_sn(1),ny_sn(2)      ! loop about latitudes
111    ylat=ylat0+real(jy)*dy
112    ylatp=ylat+0.5*dy
113    ylatm=ylat-0.5*dy
114    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
115      hzone=1./dyconst
116    else
117      cosfactp=cos(ylatp*pih)*r_earth
118      cosfactm=cos(ylatm*pih)*r_earth
119      if (cosfactp.lt.cosfactm) then
120        hzone=sqrt(r_earth**2-cosfactp**2)- &
121             sqrt(r_earth**2-cosfactm**2)
122      else
123        hzone=sqrt(r_earth**2-cosfactm**2)- &
124             sqrt(r_earth**2-cosfactp**2)
125      endif
126    endif
127    gridarea(jy)=2.*pi*r_earth*hzone*dx/360.
128  end do
129
130! Do the same for the south pole
131
132  if (sglobal) then
133    ylat=ylat0
134    ylatp=ylat+0.5*dy
135    ylatm=ylat
136    cosfactm=0.
137    cosfactp=cos(ylatp*pih)*r_earth
138    hzone=sqrt(r_earth**2-cosfactm**2)- &
139         sqrt(r_earth**2-cosfactp**2)
140    gridarea(0)=2.*pi*r_earth*hzone*dx/360.
141  endif
142
143! Do the same for the north pole
144
145  if (nglobal) then
146    ylat=ylat0+real(nymin1)*dy
147    ylatp=ylat
148    ylatm=ylat-0.5*dy
149    cosfactp=0.
150    cosfactm=cos(ylatm*pih)*r_earth
151    hzone=sqrt(r_earth**2-cosfactp**2)- &
152         sqrt(r_earth**2-cosfactm**2)
153    gridarea(nymin1)=2.*pi*r_earth*hzone*dx/360.
154  endif
155
156
157! Calculate total mass of each grid column and of the whole atmosphere
158!*********************************************************************
159
160  colmasstotal=0.
161  do jy=ny_sn(1),ny_sn(2)          ! loop about latitudes
162    do ix=nx_we(1),nx_we(2)      ! loop about longitudes
163      pp(1)=rho(ix,jy,1,1)*r_air*tt(ix,jy,1,1)
164      pp(nz)=rho(ix,jy,nz,1)*r_air*tt(ix,jy,nz,1)
165      ! Each MPI process is assigned an equal share of particles
166      colmass(ix,jy)=(pp(1)-pp(nz))/ga*gridarea(jy)/mp_partgroup_np
167      colmasstotal=colmasstotal+colmass(ix,jy)
168
169    end do
170  end do
171
172  if (lroot) write(*,*) 'Atm. mass: ',colmasstotal
173
174
175  if (ipin.eq.0) numpart=0
176
177! Determine the particle positions
178!*********************************
179
180  numparttot=0
181  numcolumn=0
182  do jy=ny_sn(1),ny_sn(2)      ! loop about latitudes
183    ylat=ylat0+real(jy)*dy
184    do ix=nx_we(1),nx_we(2)      ! loop about longitudes
185      ncolumn=nint(0.999*real(npart(1))*colmass(ix,jy)/ &
186           colmasstotal)
187      if (ncolumn.eq.0) goto 30
188      if (ncolumn.gt.numcolumn) numcolumn=ncolumn
189
190! Calculate pressure at the altitudes of model surfaces, using the air density
191! information, which is stored as a 3-d field
192!*****************************************************************************
193
194      do kz=1,nz
195        pp(kz)=rho(ix,jy,kz,1)*r_air*tt(ix,jy,kz,1)
196      end do
197
198
199      deltacol=(pp(1)-pp(nz))/real(ncolumn)
200      pnew=pp(1)+deltacol/2.
201      jj=0
202      do j=1,ncolumn
203        jj=jj+1
204
205
206! For columns with many particles (i.e. around the equator), distribute
207! the particles equally, for columns with few particles (i.e. around the
208! poles), distribute the particles randomly
209!***********************************************************************
210
211
212        if (ncolumn.gt.20) then
213          pnew=pnew-deltacol
214        else
215          pnew=pp(1)-ran1(idummy)*(pp(1)-pp(nz))
216        endif
217
218        do kz=1,nz-1
219          if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
220            dz1=pp(kz)-pnew
221            dz2=pnew-pp(kz+1)
222            dz=1./(dz1+dz2)
223
224! Assign particle position
225!*************************
226! Do the following steps only if particles are not read in from previous model run
227!*****************************************************************************
228            if (ipin.eq.0) then
229              xtra1(numpart+jj)=real(ix)-0.5+ran1(idummy)
230              if (ix.eq.0) xtra1(numpart+jj)=ran1(idummy)
231              if (ix.eq.nxmin1) xtra1(numpart+jj)= &
232                   real(nxmin1)-ran1(idummy)
233              ytra1(numpart+jj)=real(jy)-0.5+ran1(idummy)
234              ztra1(numpart+jj)=(height(kz)*dz2+height(kz+1)*dz1)*dz
235              if (ztra1(numpart+jj).gt.height(nz)-0.5) &
236                   ztra1(numpart+jj)=height(nz)-0.5
237
238
239! Interpolate PV to the particle position
240!****************************************
241              ixm=int(xtra1(numpart+jj))
242              jym=int(ytra1(numpart+jj))
243              ixp=ixm+1
244              jyp=jym+1
245              ddx=xtra1(numpart+jj)-real(ixm)
246              ddy=ytra1(numpart+jj)-real(jym)
247              rddx=1.-ddx
248              rddy=1.-ddy
249              p1=rddx*rddy
250              p2=ddx*rddy
251              p3=rddx*ddy
252              p4=ddx*ddy
253              do i=2,nz
254                if (height(i).gt.ztra1(numpart+jj)) then
255                  indzm=i-1
256                  indzp=i
257                  goto 6
258                endif
259              end do
2606             continue
261              dz1=ztra1(numpart+jj)-height(indzm)
262              dz2=height(indzp)-ztra1(numpart+jj)
263              dz=1./(dz1+dz2)
264              do in=1,2
265                indzh=indzm+in-1
266                y1(in)=p1*pv(ixm,jym,indzh,1) &
267                     +p2*pv(ixp,jym,indzh,1) &
268                     +p3*pv(ixm,jyp,indzh,1) &
269                     +p4*pv(ixp,jyp,indzh,1)
270              end do
271              pvpart=(dz2*y1(1)+dz1*y1(2))*dz
272              if (ylat.lt.0.) pvpart=-1.*pvpart
273
274
275! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
276!*****************************************************************************
277
278              if (((ztra1(numpart+jj).gt.3000.).and. &
279                   (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
280
281! Assign certain properties to the particle
282!******************************************
283                nclass(numpart+jj)=min(int(ran1(idummy)* &
284                     real(nclassunc))+1,nclassunc)
285                numparticlecount=numparticlecount+1
286                npoint(numpart+jj)=numparticlecount
287                idt(numpart+jj)=mintime
288                itra1(numpart+jj)=0
289                itramem(numpart+jj)=0
290                itrasplit(numpart+jj)=itra1(numpart+jj)+ldirect* &
291                     itsplit
292                xmass1(numpart+jj,1)=colmass(ix,jy)/real(ncolumn)
293                if (mdomainfill.eq.2) xmass1(numpart+jj,1)= &
294                     xmass1(numpart+jj,1)*pvpart*48./29.*ozonescale/10.**9
295              else
296                jj=jj-1
297              endif
298            endif
299          endif
300        end do
301      end do
302      numparttot=numparttot+ncolumn
303      if (ipin.eq.0) numpart=numpart+jj
30430    continue
305    end do
306  end do
307
308
309! Check whether numpart is really smaller than maxpart
310!*****************************************************
311
312  if (numpart.gt.maxpart) then
313    write(*,*) 'numpart too large: change source in init_atm_mass.f'
314    write(*,*) 'numpart: ',numpart,' maxpart: ',maxpart
315  endif
316
317
318  xmassperparticle=colmasstotal/real(numparttot)
319
320
321! Make sure that all particles are within domain
322!***********************************************
323
324  do j=1,numpart
325    if ((xtra1(j).lt.0.).or.(xtra1(j).ge.real(nxmin1)).or. &
326         (ytra1(j).lt.0.).or.(ytra1(j).ge.real(nymin1))) then
327      itra1(j)=-999999999
328    endif
329  end do
330
331
332
333
334! For boundary conditions, we need fewer particle release heights per column,
335! because otherwise it takes too long until enough mass has accumulated to
336! release a particle at the boundary (would take dx/u seconds), leading to
337! relatively large position errors of the order of one grid distance.
338! It's better to release fewer particles per column, but to do so more often.
339! Thus, use on the order of nz starting heights per column.
340! We thus repeat the above to determine fewer starting heights, that are
341! used furtheron in subroutine boundcond_domainfill.f.
342!****************************************************************************
343
344  fractus=real(numcolumn)/real(nz)
345  write(*,*) 'Total number of particles at model start: ',numpart
346  write(*,*) 'Maximum number of particles per column: ',numcolumn
347  write(*,*) 'If ',fractus,' <1, better use more particles'
348  fractus=sqrt(max(fractus,1.))/2.
349
350  do jy=ny_sn(1),ny_sn(2)      ! loop about latitudes
351    do ix=nx_we(1),nx_we(2)      ! loop about longitudes
352      ncolumn=nint(0.999/fractus*real(npart(1))*colmass(ix,jy) &
353           /colmasstotal)
354      if (ncolumn.gt.maxcolumn) stop 'maxcolumn too small'
355      if (ncolumn.eq.0) goto 80
356
357
358! Memorize how many particles per column shall be used for all boundaries
359! This is further used in subroutine boundcond_domainfill.f
360! Use 2 fields for west/east and south/north boundary
361!************************************************************************
362
363      if (ix.eq.nx_we(1)) numcolumn_we(1,jy)=ncolumn
364      if (ix.eq.nx_we(2)) numcolumn_we(2,jy)=ncolumn
365      if (jy.eq.ny_sn(1)) numcolumn_sn(1,ix)=ncolumn
366      if (jy.eq.ny_sn(2)) numcolumn_sn(2,ix)=ncolumn
367
368! Calculate pressure at the altitudes of model surfaces, using the air density
369! information, which is stored as a 3-d field
370!*****************************************************************************
371
372      do kz=1,nz
373        pp(kz)=rho(ix,jy,kz,1)*r_air*tt(ix,jy,kz,1)
374      end do
375
376! Determine the reference starting altitudes
377!*******************************************
378
379      deltacol=(pp(1)-pp(nz))/real(ncolumn)
380      pnew=pp(1)+deltacol/2.
381      do j=1,ncolumn
382        pnew=pnew-deltacol
383        do kz=1,nz-1
384          if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
385            dz1=pp(kz)-pnew
386            dz2=pnew-pp(kz+1)
387            dz=1./(dz1+dz2)
388            zposition=(height(kz)*dz2+height(kz+1)*dz1)*dz
389            if (zposition.gt.height(nz)-0.5) zposition=height(nz)-0.5
390
391! Memorize vertical positions where particles are introduced
392! This is further used in subroutine boundcond_domainfill.f
393!***********************************************************
394
395            if (ix.eq.nx_we(1)) zcolumn_we(1,jy,j)=zposition
396            if (ix.eq.nx_we(2)) zcolumn_we(2,jy,j)=zposition
397            if (jy.eq.ny_sn(1)) zcolumn_sn(1,ix,j)=zposition
398            if (jy.eq.ny_sn(2)) zcolumn_sn(2,ix,j)=zposition
399
400! Initialize mass that has accumulated at boundary to zero
401!*********************************************************
402
403            acc_mass_we(1,jy,j)=0.
404            acc_mass_we(2,jy,j)=0.
405            acc_mass_sn(1,jy,j)=0.
406            acc_mass_sn(2,jy,j)=0.
407          endif
408        end do
409      end do
41080    continue
411    end do
412  end do
413
414! If particles shall be read in to continue an existing run,
415! then the accumulated masses at the domain boundaries must be read in, too.
416! This overrides any previous calculations.
417!***************************************************************************
418
419! :TODO: eso: parallelize
420  if (ipin.eq.1) then
421    open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
422         form='unformatted')
423    read(unitboundcond) numcolumn_we,numcolumn_sn, &
424         zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
425    close(unitboundcond)
426  endif
427
428
429
430
431end subroutine init_domainfill
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG