source: branches/command2nml/command2nml.f90 @ 7

Last change on this file since 7 was 7, checked in by hasod, 11 years ago

Initial import

  • namelist input for COMMAND
  • pathnames optionally as command line argument
  • conversion utility from COMMAND to COMMAND namelist
File size: 8.1 KB
Line 
1program command2nml
2
3  !*****************************************************************************
4  !                                                                            *
5  !     This program reads the command file in any known format and writes     *
6  !     it in namelist format to the output argument
7  !                                                                            *
8  !     Author: Harald Sodemann
9  !     29 Oct 2012                                                            *
10  !     
11  !     Input argument: COMMAND file
12  !     Output argument: COMMAND file in namelist format
13  !                                                                            *
14  !*****************************************************************************
15  !                                                                            *
16  ! Variables:                                                                 *
17  ! bdate                beginning date as Julian date                         *
18  ! ctl                  factor by which time step must be smaller than        *
19  !                      Lagrangian time scale                                 *
20  ! ibdate,ibtime        beginnning date and time (YYYYMMDD, HHMISS)           *
21  ! ideltas [s]          modelling period                                      *
22  ! iedate,ietime        ending date and time (YYYYMMDD, HHMISS)               *
23  ! ifine                reduction factor for vertical wind time step          *
24  ! outputforeachrel     for forward runs it is possible either to create      *
25  !                      one outputfield or several for each releasepoint      *
26  ! iflux                switch to turn on (1)/off (0) flux calculations       *
27  ! iout                 1 for conc. (residence time for backward runs) output,*
28  !                      2 for mixing ratio output, 3 both, 4 for plume        *
29  !                      trajectory output, 5 = options 1 and 4                *
30  ! ipin                 1 continue simulation with dumped particle data, 0 no *
31  ! ipout                0 no particle dump, 1 every output time, 3 only at end*
32  ! itsplit [s]          time constant for particle splitting                  *
33  ! loutaver [s]         concentration output is an average over loutaver      *
34  !                      seconds                                               *
35  ! loutsample [s]       average is computed from samples taken every [s]      *
36  !                      seconds                                               *
37  ! loutstep [s]         time interval of concentration output                 *
38  ! lsynctime [s]        synchronisation time interval for all particles       *
39  ! lagespectra          switch to turn on (1)/off (0) calculation of age      *
40  !                      spectra                                               *
41  ! lconvection          value of either 0 and 1 indicating mixing by          *
42  !                      convection                                            *
43  !                      = 0 .. no convection                                  *
44  !                      + 1 .. parameterisation of mixing by subgrid-scale    *
45  !                              convection = on                               *
46  ! lsubgrid             switch to turn on (1)/off (0) subgrid topography      *
47  !                      parameterization                                      *
48  ! method               method used to compute the particle pseudovelocities  *
49  ! mdomainfill          1 use domain-filling option, 0 not, 2 use strat. O3   *
50  !                                                                            *
51  ! Constants:                                                                 *
52  ! 10          unit connected to file COMMAND                        *
53  !                                                                            *
54  !*****************************************************************************
55
56  use com_mod
57
58  implicit none
59
60  real(kind=dp) :: juldate
61  character(len=50) :: line
62  logical :: old
63  integer :: readerror
64  character(256) :: infile
65  character(256) :: outfile
66
67  namelist /command/ &
68    ldirect, &
69    ibdate,ibtime, &
70    iedate,ietime, &
71    loutstep, &
72    loutaver, &
73    loutsample, &
74    itsplit, &
75    lsynctime, &
76    ctl, &
77    ifine, &
78    iout, &
79    ipout, &
80    lsubgrid, &
81    lconvection, &
82    lagespectra, &
83    ipin, &
84    ioutputforeachrelease, &
85    iflux, &
86    mdomainfill, &
87    ind_source, &
88    ind_receptor, &
89    mquasilag, &
90    nested_output, &
91    linit_cond
92
93  ! Presetting namelist command
94  ldirect=1
95  ibdate=20000101
96  ibtime=0
97  iedate=20000102
98  ietime=0
99  loutstep=10800
100  loutaver=10800
101  loutsample=900
102  itsplit=999999999
103  lsynctime=900
104  ctl=-5.0
105  ifine=4
106  iout=3
107  ipout=0
108  lsubgrid=1
109  lconvection=1
110  lagespectra=0
111  ipin=1
112  ioutputforeachrelease=0
113  iflux=1
114  mdomainfill=0
115  ind_source=1
116  ind_receptor=1
117  mquasilag=0
118  nested_output=0
119  linit_cond=0
120
121  print*,'command2nml V1.0 converts FLEXPART COMMAND files to namelist format'
122
123  select case (iargc())
124  case (2)
125    call getarg(1,infile)
126    call getarg(2,outfile)
127  case default
128    print*,'USAGE: command2nml COMMAND.input COMMAND.namelist.output'
129    stop
130  end select
131
132  ! Open the command file and read user options
133  ! Namelist input first: try to read as namelist file
134  !**************************************************************************
135  open(10,file=trim(infile),status='old', form='formatted',iostat=readerror)
136         
137  ! If fail, check if file does not exist
138  if (readerror.ne.0) then
139    print*,'***ERROR: file COMMAND not found at ',trim(infile)
140    stop
141  endif
142
143  read(10,command,iostat=readerror)
144  close(10)
145
146  ! If error in namelist format, try to open with old input code
147  if (readerror.ne.0) then
148
149    open(10,file=trim(infile),status='old', err=999)
150         
151    ! Check the format of the COMMAND file (either in free format,
152    ! or using formatted mask)
153    ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION'
154    !**************************************************************************
155
156    call skplin(9,10)
157    read (10,901) line
158  901   format (a)
159    if (index(line,'LDIRECT') .eq. 0) then
160      old = .false.
161    else
162      old = .true.
163    endif
164    rewind(10)
165
166    ! Read parameters
167    !****************
168
169    call skplin(7,10)
170    if (old) call skplin(1,10)
171
172    read(10,*) ldirect
173    if (old) call skplin(3,10)
174    read(10,*) ibdate,ibtime
175    if (old) call skplin(3,10)
176    read(10,*) iedate,ietime
177    if (old) call skplin(3,10)
178    read(10,*) loutstep
179    if (old) call skplin(3,10)
180    read(10,*) loutaver
181    if (old) call skplin(3,10)
182    read(10,*) loutsample
183    if (old) call skplin(3,10)
184    read(10,*) itsplit
185    if (old) call skplin(3,10)
186    read(10,*) lsynctime
187    if (old) call skplin(3,10)
188    read(10,*) ctl
189    if (old) call skplin(3,10)
190    read(10,*) ifine
191    if (old) call skplin(3,10)
192    read(10,*) iout
193    if (old) call skplin(3,10)
194    read(10,*) ipout
195    if (old) call skplin(3,10)
196    read(10,*) lsubgrid
197    if (old) call skplin(3,10)
198    read(10,*) lconvection
199    if (old) call skplin(3,10)
200    read(10,*) lagespectra
201    if (old) call skplin(3,10)
202    read(10,*) ipin
203    if (old) call skplin(3,10)
204    read(10,*) ioutputforeachrelease
205    if (old) call skplin(3,10)
206    read(10,*) iflux
207    if (old) call skplin(3,10)
208    read(10,*) mdomainfill
209    if (old) call skplin(3,10)
210    read(10,*) ind_source
211    if (old) call skplin(3,10)
212    read(10,*) ind_receptor
213    if (old) call skplin(3,10)
214    read(10,*) mquasilag
215    if (old) call skplin(3,10)
216    read(10,*) nested_output
217    if (old) call skplin(3,10)
218    read(10,*) linit_cond
219    close(10)
220
221  endif ! input format
222
223  print*,'Input file read from ',trim(infile)
224
225  ! write command file in namelist format to output directory if requested
226  open(11,file=trim(outfile),status='replace',err=998)
227  write(11,nml=command)
228  close(11)
229
230  print*,'Output file successfully created at ',trim(outfile)
231  stop
232
233998   print*,' ERROR: Output file not found at ',trim(outfile)
234  stop
235999   print*,' ERROR: Input file "COMMAND" not found at ',trim(infile)
236  stop
237end program command2nml
Note: See TracBrowser for help on using the repository browser.
hosted by ZAMG