source: flexpart.git/src/FLEXPART_MPI.f90 @ 02095e3

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

Renamed lnokernel, corrected default setting.

  • Property mode set to 100644
File size: 16.2 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
22program flexpart
23
24  !*****************************************************************************
25  !                                                                            *
26  !     This is the Lagrangian Particle Dispersion Model FLEXPART.             *
27  !     The main program manages the reading of model run specifications, etc. *
28  !     All actual computing is done within subroutine timemanager.            *
29  !                                                                            *
30  !     Author: A. Stohl                                                       *
31  !                                                                            *
32  !     18 May 1996                                                            *
33  !                                                                            *
34  !*****************************************************************************
35  ! Changes:                                                                   *
36  !   Unified ECMWF and GFS builds                                             *
37  !   Marian Harustak, 12.5.2017                                               *
38  !     - Added detection of metdata format using gributils routines           *
39  !     - Distinguished calls to ecmwf/gfs gridcheck versions based on         *
40  !       detected metdata format                                              *
41  !     - Passed metdata format down to timemanager                            *
42  !*****************************************************************************
43  !                                                                            *
44  ! Variables:                                                                 *
45  !                                                                            *
46  ! Constants:                                                                 *
47  !                                                                            *
48  !*****************************************************************************
49
50  use point_mod
51  use par_mod
52  use com_mod
53  use conv_mod
54  use mpi_mod
55  use netcdf_output_mod, only: writeheader_netcdf
56  use random_mod, only: gasdev1
57  use class_gribfile
58
59  implicit none
60
61  integer :: i,j,ix,jy,inest
62  integer :: idummy = -320
63  character(len=256) :: inline_options  !pathfile, flexversion, arg2
64  integer :: metdata_format = GRIBFILE_CENTRE_UNKNOWN
65  integer :: detectformat
66
67
68
69  ! Initialize mpi
70  !*********************
71  call mpif_init
72
73  if (mp_measure_time) call mpif_mtime('flexpart',0)
74
75  ! Initialize arrays in com_mod
76  !*****************************
77
78  if(.not.(lmpreader.and.lmp_use_reader)) call com_mod_allocate_part(maxpart_mpi)
79
80
81  ! Generate a large number of random numbers
82  !******************************************
83
84  ! eso: Different seed for each MPI process
85  idummy=idummy+mp_seed
86
87  do i=1,maxrand-1,2
88    call gasdev1(idummy,rannumb(i),rannumb(i+1))
89  end do
90  call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1))
91
92  ! FLEXPART version string
93  flexversion_major = '10' ! Major version number, also used for species file names
94  flexversion='Ver. '//trim(flexversion_major)//'.2beta MPI (2017-08-01)'
95  verbosity=0
96
97  ! Read the pathnames where input/output files are stored
98  !*******************************************************
99
100  inline_options='none'
101  select case (iargc())
102  case (2)
103    call getarg(1,arg1)
104    pathfile=arg1
105    call getarg(2,arg2)
106    inline_options=arg2
107  case (1)
108    call getarg(1,arg1)
109    pathfile=arg1
110    if (arg1(1:1).eq.'-') then
111      write(pathfile,'(a11)') './pathnames'
112      inline_options=arg1
113    endif
114  case (0)
115    write(pathfile,'(a11)') './pathnames'
116  end select
117 
118  if (lroot) then
119  ! Print the GPL License statement
120  !*******************************************************
121    print*,'Welcome to FLEXPART ', trim(flexversion)
122    print*,'FLEXPART is free software released under the GNU General Public License.'
123  endif
124 
125  if (inline_options(1:1).eq.'-') then
126    if (trim(inline_options).eq.'-v'.or.trim(inline_options).eq.'-v1') then
127      print*, 'Verbose mode 1: display detailed information during run'
128      verbosity=1
129    endif
130    if (trim(inline_options).eq.'-v2') then
131      print*, 'Verbose mode 2: display more detailed information during run'
132      verbosity=2
133    endif
134    if (trim(inline_options).eq.'-i') then
135      print*, 'Info mode: provide detailed run specific information and stop'
136      verbosity=1
137      info_flag=1
138    endif
139    if (trim(inline_options).eq.'-i2') then
140      print*, 'Info mode: provide more detailed run specific information and stop'
141      verbosity=2
142      info_flag=1
143    endif
144  endif
145           
146  if (verbosity.gt.0) then
147    write(*,*) 'call readpaths'
148  endif
149  call readpaths(pathfile)
150 
151  if (verbosity.gt.1) then !show clock info
152     !print*,'length(4)',length(4)
153     !count=0,count_rate=1000
154    call system_clock(count_clock0, count_rate, count_max)
155     !WRITE(*,*) 'SYSTEM_CLOCK',count, count_rate, count_max
156     !WRITE(*,*) 'SYSTEM_CLOCK, count_clock0', count_clock0
157     !WRITE(*,*) 'SYSTEM_CLOCK, count_rate', count_rate
158     !WRITE(*,*) 'SYSTEM_CLOCK, count_max', count_max
159  endif
160
161  ! Read the user specifications for the current model run
162  !*******************************************************
163
164  if (verbosity.gt.0) then
165    write(*,*) 'call readcommand'
166  endif
167  call readcommand
168  if (verbosity.gt.0 .and. lroot) then
169    write(*,*) '    ldirect=', ldirect
170    write(*,*) '    ibdate,ibtime=',ibdate,ibtime
171    write(*,*) '    iedate,ietime=', iedate,ietime
172    if (verbosity.gt.1) then   
173      CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
174      write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
175    endif
176  endif
177
178
179! Read the age classes to be used
180!********************************
181  if (verbosity.gt.0 .and. lroot) then
182    write(*,*) 'call readageclasses'
183  endif
184  call readageclasses
185
186  if (verbosity.gt.1 .and. lroot) then   
187    call system_clock(count_clock, count_rate, count_max)
188    write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
189  endif     
190
191  ! Read, which wind fields are available within the modelling period
192  !******************************************************************
193
194  if (verbosity.gt.0 .and. lroot) then
195    write(*,*) 'call readavailable'
196  endif 
197  call readavailable
198
199  ! Detect metdata format
200  !**********************
201
202  metdata_format = detectformat()
203
204  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
205    print *,'ECMWF metdata detected'
206  elseif (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
207    print *,'NCEP metdata detected'
208  else
209    print *,'Unknown metdata format'
210    return
211  endif
212
213
214
215  ! If nested wind fields are used, allocate arrays
216  !************************************************
217
218  if (verbosity.gt.0 .and. lroot) then
219    write(*,*) 'call com_mod_allocate_nests'
220  endif
221  call com_mod_allocate_nests
222
223! Read the model grid specifications,
224! both for the mother domain and eventual nests
225!**********************************************
226
227  if (verbosity.gt.0 .and. lroot) then
228    write(*,*) 'call gridcheck'
229  endif
230
231  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
232    call gridcheck_ecmwf
233  else
234    call gridcheck_gfs
235  end if
236
237
238  if (verbosity.gt.1 .and. lroot) then   
239    call system_clock(count_clock, count_rate, count_max)
240    write(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
241  endif     
242
243
244  if (verbosity.gt.0 .and. lroot) then
245    write(*,*) 'call gridcheck_nests'
246  endif 
247  call gridcheck_nests
248
249
250! Read the output grid specifications
251!************************************
252
253  if (verbosity.gt.0 .and. lroot) then
254    WRITE(*,*) 'call readoutgrid'
255  endif
256
257  call readoutgrid
258
259  if (nested_output.eq.1) then
260    call readoutgrid_nest
261    if (verbosity.gt.0.and.lroot) then
262      WRITE(*,*) '# readoutgrid_nest'
263    endif
264  endif
265
266  ! Read the receptor points for which extra concentrations are to be calculated
267  !*****************************************************************************
268
269  if (verbosity.eq.1 .and. lroot) then
270    print*,'call readreceptors'
271  endif
272  call readreceptors
273
274  ! Read the physico-chemical species property table
275  !*************************************************
276  !SEC: now only needed SPECIES are read in readreleases.f
277  !call readspecies
278
279
280  ! Read the landuse inventory
281  !***************************
282
283  if (verbosity.gt.0 .and. lroot) then
284    print*,'call readlanduse'
285  endif
286  call readlanduse
287
288
289! Assign fractional cover of landuse classes to each ECMWF grid point
290!********************************************************************
291
292  if (verbosity.gt.0 .and. lroot) then
293    print*,'call assignland'
294  endif
295  call assignland
296
297  ! Read the coordinates of the release locations
298  !**********************************************
299
300  if (verbosity.gt.0 .and. lroot) then
301    print*,'call readreleases'
302  endif
303  call readreleases
304
305
306! Read and compute surface resistances to dry deposition of gases
307!****************************************************************
308
309  if (verbosity.gt.0 .and. lroot) then
310    print*,'call readdepo'
311  endif
312  call readdepo
313
314  ! Convert the release point coordinates from geografical to grid coordinates
315  !***************************************************************************
316
317  call coordtrafo 
318  if (verbosity.gt.0 .and. lroot) then
319    print*,'call coordtrafo'
320  endif
321
322
323  ! Initialize all particles to non-existent
324  !*****************************************
325
326  if (verbosity.gt.0 .and. lroot) then
327    print*,'Initialize all particles to non-existent'
328  endif
329
330  if (.not.(lmpreader.and.lmp_use_reader)) then
331    do j=1, size(itra1) ! maxpart_mpi
332      itra1(j)=-999999999
333    end do
334  end if
335
336  ! For continuation of previous run, read in particle positions
337  !*************************************************************
338
339  if (ipin.eq.1) then
340    if (verbosity.gt.0 .and. lroot) then
341      print*,'call readpartpositions'
342    endif
343    ! readwind process skips this step
344    if (.not.(lmpreader.and.lmp_use_reader)) call readpartpositions
345  else
346    if (verbosity.gt.0 .and. lroot) then
347      print*,'numpart=0, numparticlecount=0'
348    endif
349    numpart=0
350    numparticlecount=0
351  endif
352
353
354  ! Calculate volume, surface area, etc., of all output grid cells
355  ! Allocate fluxes and OHfield if necessary
356  !***************************************************************
357
358
359  if (verbosity.gt.0 .and. lroot) then
360    print*,'call outgrid_init'
361  endif
362  call outgrid_init
363  if (nested_output.eq.1) call outgrid_init_nest
364
365  ! Read the OH field
366  !******************
367
368  if (OHREA.eqv..true.) then
369    if (verbosity.gt.0 .and. lroot) then
370      print*,'call readOHfield'
371    endif
372    call readOHfield
373  endif
374
375  ! Write basic information on the simulation to a file "header"
376  ! and open files that are to be kept open throughout the simulation
377  !******************************************************************
378
379  if (mp_measure_time) call mpif_mtime('iotime',0)
380  if (lroot) then ! MPI: this part root process only
381
382  if (lnetcdfout.eq.1) then
383    call writeheader_netcdf(lnest=.false.)
384  else
385    call writeheader
386  end if
387
388  if (nested_output.eq.1) then
389    if (lnetcdfout.eq.1) then
390      call writeheader_netcdf(lnest=.true.)
391    else
392      call writeheader_nest
393    endif
394  endif
395
396!
397    if (verbosity.gt.0) then
398      print*,'call writeheader'
399    endif
400
401    call writeheader
402! FLEXPART 9.2 ticket ?? write header in ASCII format
403    call writeheader_txt
404!if (nested_output.eq.1) call writeheader_nest
405    if (nested_output.eq.1.and.surf_only.ne.1) call writeheader_nest
406    if (nested_output.eq.1.and.surf_only.eq.1) call writeheader_nest_surf
407    if (nested_output.ne.1.and.surf_only.eq.1) call writeheader_surf
408  end if ! (mpif_pid == 0)
409
410  if (mp_measure_time) call mpif_mtime('iotime',0)
411
412  !open(unitdates,file=path(2)(1:length(2))//'dates')
413
414  if (verbosity.gt.0 .and. lroot) then
415    print*,'call openreceptors'
416  endif
417  call openreceptors
418  if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
419
420  ! Releases can only start and end at discrete times (multiples of lsynctime)
421  !***************************************************************************
422
423  if (verbosity.gt.0 .and. lroot) then
424    print*,'discretize release times'
425  endif
426  do i=1,numpoint
427    ireleasestart(i)=nint(real(ireleasestart(i))/real(lsynctime))*lsynctime
428    ireleaseend(i)=nint(real(ireleaseend(i))/real(lsynctime))*lsynctime
429  end do
430
431  ! Initialize cloud-base mass fluxes for the convection scheme
432  !************************************************************
433
434  if (verbosity.gt.0 .and. lroot) then
435    print*,'Initialize cloud-base mass fluxes for the convection scheme'
436  endif
437
438  do jy=0,nymin1
439    do ix=0,nxmin1
440      cbaseflux(ix,jy)=0.
441    end do
442  end do
443  do inest=1,numbnests
444    do jy=0,nyn(inest)-1
445      do ix=0,nxn(inest)-1
446        cbasefluxn(ix,jy,inest)=0.
447      end do
448    end do
449  end do
450
451  ! Inform whether output kernel is used or not
452  !*********************************************
453
454  if (lroot) then
455    if (.not.lusekerneloutput) then
456      write(*,*) "Concentrations are calculated without using kernel"
457    else
458      write(*,*) "Concentrations are calculated using kernel"
459    end if
460  end if
461
462! Calculate particle trajectories
463!********************************
464
465  if (verbosity.gt.0.and. lroot) then
466    if (verbosity.gt.1) then   
467      CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
468      WRITE(*,*) 'SYSTEM_CLOCK',(count_clock - count_clock0)/real(count_rate) !, count_rate, count_max
469    endif
470    print*,'call timemanager'
471  endif
472  if (info_flag.eq.1) then
473    print*, 'info only mode (stop)'   
474    call mpif_finalize
475    stop
476  endif
477
478
479  call timemanager(metdata_format)
480
481
482! NIK 16.02.2005
483  if (lroot) then
484    call MPI_Reduce(MPI_IN_PLACE, tot_blc_count, nspec, MPI_INTEGER8, MPI_SUM, id_root, &
485         & mp_comm_used, mp_ierr)
486    call MPI_Reduce(MPI_IN_PLACE, tot_inc_count, nspec, MPI_INTEGER8, MPI_SUM, id_root, &
487         & mp_comm_used, mp_ierr)
488  else
489    if (mp_partgroup_pid.ge.0) then ! Skip for readwind process
490      call MPI_Reduce(tot_blc_count, 0, nspec, MPI_INTEGER8, MPI_SUM, id_root, &
491           & mp_comm_used, mp_ierr)
492      call MPI_Reduce(tot_inc_count, 0, nspec, MPI_INTEGER8, MPI_SUM, id_root, &
493           & mp_comm_used, mp_ierr)
494    end if
495  end if
496
497  if (lroot) then
498    do i=1,nspec
499      write(*,*) '**********************************************'
500      write(*,*) 'Scavenging statistics for species ', species(i), ':'
501      write(*,*) 'Total number of occurences of below-cloud scavenging', &
502           & tot_blc_count(i)
503      write(*,*) 'Total number of occurences of in-cloud    scavenging', &
504           & tot_inc_count(i)
505      write(*,*) '**********************************************'
506    end do
507
508    write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
509         &XPART MODEL RUN!'
510  end if
511
512  if (mp_measure_time) call mpif_mtime('flexpart',1)
513
514  call mpif_finalize
515
516end program flexpart
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG