source: branches/sabine/readcommand.f90 @ 6

Last change on this file since 6 was 6, checked in by saeck, 11 years ago

import to sabine

File size: 19.7 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 readcommand
23
24  !*****************************************************************************
25  !                                                                            *
26  !     This routine reads the user specifications for the current model run.  *
27  !                                                                            *
28  !     Author: A. Stohl                                                       *
29  !                                                                            *
30  !     18 May 1996                                                            *
31  !                                                                            *
32  !*****************************************************************************
33  !                                                                            *
34  ! Variables:                                                                 *
35  ! bdate                beginning date as Julian date                         *
36  ! ctl                  factor by which time step must be smaller than        *
37  !                      Lagrangian time scale                                 *
38  ! ibdate,ibtime        beginnning date and time (YYYYMMDD, HHMISS)           *
39  ! ideltas [s]          modelling period                                      *
40  ! iedate,ietime        ending date and time (YYYYMMDD, HHMISS)               *
41  ! ifine                reduction factor for vertical wind time step          *
42  ! outputforeachrel     for forward runs it is possible either to create      *
43  !                      one outputfield or several for each releasepoint      *
44  ! iflux                switch to turn on (1)/off (0) flux calculations       *
45  ! iout                 1 for conc. (residence time for backward runs) output,*
46  !                      2 for mixing ratio output, 3 both, 4 for plume        *
47  !                      trajectory output, 5 = options 1 and 4                *
48  ! ipin                 1 continue simulation with dumped particle data, 0 no *
49  ! ipout                0 no particle dump, 1 every output time, 3 only at end*
50  ! itsplit [s]          time constant for particle splitting                  *
51  ! loutaver [s]         concentration output is an average over loutaver      *
52  !                      seconds                                               *
53  ! loutsample [s]       average is computed from samples taken every [s]      *
54  !                      seconds                                               *
55  ! loutstep [s]         time interval of concentration output                 *
56  ! lsynctime [s]        synchronisation time interval for all particles       *
57  ! lagespectra          switch to turn on (1)/off (0) calculation of age      *
58  !                      spectra                                               *
59  ! lconvection          value of either 0 and 1 indicating mixing by          *
60  !                      convection                                            *
61  !                      = 0 .. no convection                                  *
62  !                      + 1 .. parameterisation of mixing by subgrid-scale    *
63  !                              convection = on                               *
64  ! lsubgrid             switch to turn on (1)/off (0) subgrid topography      *
65  !                      parameterization                                      *
66  ! method               method used to compute the particle pseudovelocities  *
67  ! mdomainfill          1 use domain-filling option, 0 not, 2 use strat. O3   *
68  !                                                                            *
69  ! Constants:                                                                 *
70  ! unitcommand          unit connected to file COMMAND                        *
71  !                                                                            *
72  !*****************************************************************************
73
74  use par_mod
75  use com_mod
76
77  implicit none
78
79  real(kind=dp) :: juldate
80  character(len=50) :: line
81  logical :: old
82
83
84  ! Open the command file and read user options
85  !********************************************
86
87
88  open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', &
89       err=999)
90
91  ! Check the format of the COMMAND file (either in free format,
92  ! or using formatted mask)
93  ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION'
94  !**************************************************************************
95
96  call skplin(9,unitcommand)
97  read (unitcommand,901) line
98901   format (a)
99  if (index(line,'LDIRECT') .eq. 0) then
100    old = .false.
101  else
102    old = .true.
103  endif
104  rewind(unitcommand)
105
106  ! Read parameters
107  !****************
108
109  call skplin(7,unitcommand)
110  if (old) call skplin(1,unitcommand)
111
112  read(unitcommand,*) ldirect
113  if (old) call skplin(3,unitcommand)
114  read(unitcommand,*) ibdate,ibtime
115  if (old) call skplin(3,unitcommand)
116  read(unitcommand,*) iedate,ietime
117  if (old) call skplin(3,unitcommand)
118  read(unitcommand,*) loutstep
119  if (old) call skplin(3,unitcommand)
120  read(unitcommand,*) loutaver
121  if (old) call skplin(3,unitcommand)
122  read(unitcommand,*) loutsample
123  if (old) call skplin(3,unitcommand)
124  read(unitcommand,*) itsplit
125  if (old) call skplin(3,unitcommand)
126  read(unitcommand,*) lsynctime
127  if (old) call skplin(3,unitcommand)
128  read(unitcommand,*) ctl
129  if (old) call skplin(3,unitcommand)
130  read(unitcommand,*) ifine
131  if (old) call skplin(3,unitcommand)
132  read(unitcommand,*) iout
133  if (old) call skplin(3,unitcommand)
134  read(unitcommand,*) ipout
135  if (old) call skplin(3,unitcommand)
136  read(unitcommand,*) lsubgrid
137  if (old) call skplin(3,unitcommand)
138  read(unitcommand,*) lconvection
139  if (old) call skplin(3,unitcommand)
140  read(unitcommand,*) lagespectra
141  if (old) call skplin(3,unitcommand)
142  read(unitcommand,*) ipin
143  if (old) call skplin(3,unitcommand)
144  read(unitcommand,*) ioutputforeachrelease
145  if (old) call skplin(3,unitcommand)
146  read(unitcommand,*) iflux
147  if (old) call skplin(3,unitcommand)
148  read(unitcommand,*) mdomainfill
149  if (old) call skplin(3,unitcommand)
150  read(unitcommand,*) ind_source
151  if (old) call skplin(3,unitcommand)
152  read(unitcommand,*) ind_receptor
153  if (old) call skplin(3,unitcommand)
154  read(unitcommand,*) mquasilag
155  if (old) call skplin(3,unitcommand)
156  read(unitcommand,*) nested_output
157  if (old) call skplin(3,unitcommand)
158  read(unitcommand,*) linit_cond
159  close(unitcommand)
160
161  ifine=max(ifine,1)
162
163
164  ! Determine how Markov chain is formulated (for w or for w/sigw)
165  !***************************************************************
166
167  if (ctl.ge.0.1) then
168    turbswitch=.true.
169  else
170    turbswitch=.false.
171    ifine=1
172  endif
173  fine=1./real(ifine)
174  ctl=1./ctl
175
176  ! Set the switches required for the various options for input/output units
177  !*************************************************************************
178  !AF Set the switches IND_REL and IND_SAMP for the release and sampling
179  !Af switches for the releasefile:
180  !Af IND_REL =  1 : xmass * rho
181  !Af IND_REL =  0 : xmass * 1
182
183  !Af switches for the conccalcfile:
184  !AF IND_SAMP =  0 : xmass * 1
185  !Af IND_SAMP = -1 : xmass / rho
186
187  !AF IND_SOURCE switches between different units for concentrations at the source
188  !Af   NOTE that in backward simulations the release of computational particles
189  !Af   takes place at the "receptor" and the sampling of p[articles at the "source".
190  !Af          1 = mass units
191  !Af          2 = mass mixing ratio units
192  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
193  !Af          1 = mass units
194  !Af          2 = mass mixing ratio units
195
196  if ( ldirect .eq. 1 ) then  ! FWD-Run
197  !Af set release-switch
198     if (ind_source .eq. 1 ) then !mass
199        ind_rel = 0
200     else ! mass mix
201        ind_rel = 1
202     endif
203  !Af set sampling switch
204     if (ind_receptor .eq. 1) then !mass
205        ind_samp = 0
206     else ! mass mix
207        ind_samp = -1
208     endif
209  elseif (ldirect .eq. -1 ) then !BWD-Run
210  !Af set sampling switch
211     if (ind_source .eq. 1 ) then !mass
212        ind_samp = -1
213     else ! mass mix
214        ind_samp = 0
215     endif
216  !Af set release-switch
217     if (ind_receptor .eq. 1) then !mass
218        ind_rel = 1
219     else ! mass mix
220        ind_rel = 0
221     endif
222  endif
223
224  !*************************************************************
225  ! Check whether valid options have been chosen in file COMMAND
226  !*************************************************************
227
228  ! Check options for initial condition output: Switch off for forward runs
229  !************************************************************************
230
231  if (ldirect.eq.1) linit_cond=0
232  if ((linit_cond.lt.0).or.(linit_cond.gt.2)) then
233    write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION    #### '
234    write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND".       #### '
235    stop
236  endif
237
238  ! Check input dates
239  !******************
240
241  if (iedate.lt.ibdate) then
242    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE    #### '
243    write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE      #### '
244    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
245    write(*,*) ' #### "COMMAND".                              #### '
246    stop
247  else if (iedate.eq.ibdate) then
248    if (ietime.lt.ibtime) then
249    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME    #### '
250    write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE      #### '
251    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
252    write(*,*) ' #### "COMMAND".                              #### '
253    stop
254    endif
255  endif
256
257
258  ! Determine kind of dispersion method
259  !************************************
260
261  if (ctl.gt.0.) then
262    method=1
263    mintime=minstep
264  else
265    method=0
266    mintime=lsynctime
267  endif
268
269  ! Check whether a valid option for gridded model output has been chosen
270  !**********************************************************************
271
272  if ((iout.lt.1).or.(iout.gt.5)) then
273    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
274    write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5!          #### '
275    stop
276  endif
277
278  !AF check consistency between units and volume mixing ratio
279  if ( ((iout.eq.2).or.(iout.eq.3)).and. &
280       (ind_source.gt.1 .or.ind_receptor.gt.1) ) then
281    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
282    write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED      #### '
283    write(*,*) ' #### FOR MASS UNITS (at the moment)          #### '
284    stop
285  endif
286
287
288
289  ! For quasilag output for each release is forbidden
290  !*****************************************************************************
291
292  if ((ioutputforeachrelease.eq.1).and.(mquasilag.eq.1)) then
293      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
294      write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####'
295      write(*,*) '#### MODE IS NOT POSSIBLE   !                ####'
296      stop
297  endif
298
299
300  ! For quasilag backward is forbidden
301  !*****************************************************************************
302
303  if ((ldirect.lt.0).and.(mquasilag.eq.1)) then
304      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
305      write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####'
306      write(*,*) '#### IS NOT POSSIBLE   !                     ####'
307      stop
308  endif
309
310
311  ! For backward runs one releasefield for all releases makes no sense,
312  ! For quasilag and domainfill ioutputforechrelease is forbidden
313  !*****************************************************************************
314
315  if ((ldirect.lt.0).and.(ioutputforeachrelease.eq.0)) then
316      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
317      write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####'
318      write(*,*) '#### MUST BE SET TO ONE!                     ####'
319      stop
320  endif
321
322
323  ! For backward runs one releasefield for all releases makes no sense,
324  ! and is "forbidden"
325  !*****************************************************************************
326
327  if ((mdomainfill.eq.1).and.(ioutputforeachrelease.eq.1)) then
328      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
329      write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR      ####'
330      write(*,*) '#### EACH RELEASE IS FORBIDDEN !             ####'
331      stop
332  endif
333
334
335  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
336  ! For backward runs, only residence time output (iout=1) or plume trajectories (iout=4),
337  ! or both (iout=5) makes sense; other output options are "forbidden"
338  !*****************************************************************************
339
340  if (ldirect.lt.0) then
341    if ((iout.eq.2).or.(iout.eq.3)) then
342      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
343      write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####'
344      stop
345    endif
346  endif
347
348
349  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
350  ! and is "forbidden"
351  !*****************************************************************************
352
353  if (mdomainfill.ge.1) then
354    if ((iout.eq.4).or.(iout.eq.5)) then
355      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
356      write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION,   ####'
357      write(*,*) '#### IOUT MUST NOT BE SET TO 4 OR 5.         ####'
358      stop
359    endif
360  endif
361
362
363
364  ! Check whether a valid options for particle dump has been chosen
365  !****************************************************************
366
367  if ((ipout.ne.0).and.(ipout.ne.1).and.(ipout.ne.2)) then
368    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
369    write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3!                #### '
370    stop
371  endif
372
373  if(lsubgrid.ne.1) then
374    write(*,*) '             ----------------               '
375    write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS'
376    write(*,*) ' NOT PARAMETERIZED DURING THIS SIMULATION.  '
377    write(*,*) '             ----------------               '
378  endif
379
380
381  ! Check whether convection scheme is either turned on or off
382  !***********************************************************
383
384  if ((lconvection.ne.0).and.(lconvection.ne.1)) then
385    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
386    write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### '
387    stop
388  endif
389
390
391  ! Check whether synchronisation interval is sufficiently short
392  !*************************************************************
393
394  if (lsynctime.gt.(idiffnorm/2)) then
395    write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION   #### '
396    write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER.      #### '
397    write(*,*) ' #### MINIMUM HAS TO BE: ', idiffnorm/2
398    stop
399  endif
400
401
402  ! Check consistency of the intervals, sampling periods, etc., for model output
403  !*****************************************************************************
404
405  if (loutaver.eq.0) then
406    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
407    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
408    write(*,*) ' #### ZERO.                                   #### '
409    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
410    stop
411  endif
412
413  if (loutaver.gt.loutstep) then
414    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
415    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
416    write(*,*) ' #### GREATER THAN INTERVAL OF OUTPUT.        #### '
417    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
418    stop
419  endif
420
421  if (loutsample.gt.loutaver) then
422    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
423    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
424    write(*,*) ' #### GREATER THAN TIME AVERAGE OF OUTPUT.    #### '
425    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
426    stop
427  endif
428
429  if (mod(loutaver,lsynctime).ne.0) then
430    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
431    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
432    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
433    stop
434  endif
435
436  if ((loutaver/lsynctime).lt.2) then
437    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
438    write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST    #### '
439    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
440    stop
441  endif
442
443  if (mod(loutstep,lsynctime).ne.0) then
444    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
445    write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### '
446    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
447    stop
448  endif
449
450  if ((loutstep/lsynctime).lt.2) then
451    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
452    write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST   #### '
453    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
454    stop
455  endif
456
457  if (mod(loutsample,lsynctime).ne.0) then
458    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
459    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
460    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
461    stop
462  endif
463
464  if (itsplit.lt.loutaver) then
465    write(*,*) ' #### FLEXPART MODEL ERROR! SPLITTING TIME FOR#### '
466    write(*,*) ' #### PARTICLES IS TOO SHORT. PLEASE INCREASE #### '
467    write(*,*) ' #### SPLITTING TIME CONSTANT.                #### '
468    stop
469  endif
470
471  if ((mquasilag.eq.1).and.(iout.ge.4)) then
472    write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING       #### '
473    write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME          #### '
474    write(*,*) ' #### TRAJECTORY OUTPUT IS IMPOSSIBLE.        #### '
475    stop
476  endif
477
478  ! Compute modeling time in seconds and beginning date in Julian date
479  !*******************************************************************
480
481  outstep=real(abs(loutstep))
482  if (ldirect.eq.1) then
483    bdate=juldate(ibdate,ibtime)
484    edate=juldate(iedate,ietime)
485    ideltas=nint((edate-bdate)*86400.)
486  else if (ldirect.eq.-1) then
487    loutaver=-1*loutaver
488    loutstep=-1*loutstep
489    loutsample=-1*loutsample
490    lsynctime=-1*lsynctime
491    bdate=juldate(iedate,ietime)
492    edate=juldate(ibdate,ibtime)
493    ideltas=nint((edate-bdate)*86400.)
494  else
495    write(*,*) ' #### FLEXPART MODEL ERROR! DIRECTION IN      #### '
496    write(*,*) ' #### FILE "COMMAND" MUST BE EITHER -1 OR 1.  #### '
497    stop
498  endif
499
500  return
501
502999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND"    #### '
503  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
504  write(*,'(a)') path(1)(1:length(1))
505  stop
506
507end subroutine readcommand
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG