program command2nml !***************************************************************************** ! * ! This program reads the command file in any known format and writes * ! it in namelist format to the output argument ! * ! Author: Harald Sodemann ! 29 Oct 2012 * ! ! Input argument: COMMAND file ! Output argument: COMMAND file in namelist format ! * !***************************************************************************** ! * ! Variables: * ! bdate beginning date as Julian date * ! ctl factor by which time step must be smaller than * ! Lagrangian time scale * ! ibdate,ibtime beginnning date and time (YYYYMMDD, HHMISS) * ! ideltas [s] modelling period * ! iedate,ietime ending date and time (YYYYMMDD, HHMISS) * ! ifine reduction factor for vertical wind time step * ! outputforeachrel for forward runs it is possible either to create * ! one outputfield or several for each releasepoint * ! iflux switch to turn on (1)/off (0) flux calculations * ! iout 1 for conc. (residence time for backward runs) output,* ! 2 for mixing ratio output, 3 both, 4 for plume * ! trajectory output, 5 = options 1 and 4 * ! ipin 1 continue simulation with dumped particle data, 0 no * ! ipout 0 no particle dump, 1 every output time, 3 only at end* ! itsplit [s] time constant for particle splitting * ! loutaver [s] concentration output is an average over loutaver * ! seconds * ! loutsample [s] average is computed from samples taken every [s] * ! seconds * ! loutstep [s] time interval of concentration output * ! lsynctime [s] synchronisation time interval for all particles * ! lagespectra switch to turn on (1)/off (0) calculation of age * ! spectra * ! lconvection value of either 0 and 1 indicating mixing by * ! convection * ! = 0 .. no convection * ! + 1 .. parameterisation of mixing by subgrid-scale * ! convection = on * ! lsubgrid switch to turn on (1)/off (0) subgrid topography * ! parameterization * ! method method used to compute the particle pseudovelocities * ! mdomainfill 1 use domain-filling option, 0 not, 2 use strat. O3 * ! * ! Constants: * ! 10 unit connected to file COMMAND * ! * !***************************************************************************** use com_mod implicit none real(kind=dp) :: juldate character(len=50) :: line logical :: old integer :: readerror character(256) :: infile character(256) :: outfile namelist /command/ & ldirect, & ibdate,ibtime, & iedate,ietime, & loutstep, & loutaver, & loutsample, & itsplit, & lsynctime, & ctl, & ifine, & iout, & ipout, & lsubgrid, & lconvection, & lagespectra, & ipin, & ioutputforeachrelease, & iflux, & mdomainfill, & ind_source, & ind_receptor, & mquasilag, & nested_output, & linit_cond ! Presetting namelist command ldirect=1 ibdate=20000101 ibtime=0 iedate=20000102 ietime=0 loutstep=10800 loutaver=10800 loutsample=900 itsplit=999999999 lsynctime=900 ctl=-5.0 ifine=4 iout=3 ipout=0 lsubgrid=1 lconvection=1 lagespectra=0 ipin=1 ioutputforeachrelease=0 iflux=1 mdomainfill=0 ind_source=1 ind_receptor=1 mquasilag=0 nested_output=0 linit_cond=0 print*,'command2nml V1.0 converts FLEXPART COMMAND files to namelist format' select case (iargc()) case (2) call getarg(1,infile) call getarg(2,outfile) case default print*,'USAGE: command2nml COMMAND.input COMMAND.namelist.output' stop end select ! Open the command file and read user options ! Namelist input first: try to read as namelist file !************************************************************************** open(10,file=trim(infile),status='old', form='formatted',iostat=readerror) ! If fail, check if file does not exist if (readerror.ne.0) then print*,'***ERROR: file COMMAND not found at ',trim(infile) stop endif read(10,command,iostat=readerror) close(10) ! If error in namelist format, try to open with old input code if (readerror.ne.0) then open(10,file=trim(infile),status='old', err=999) ! Check the format of the COMMAND file (either in free format, ! or using formatted mask) ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION' !************************************************************************** call skplin(9,10) read (10,901) line 901 format (a) if (index(line,'LDIRECT') .eq. 0) then old = .false. else old = .true. endif rewind(10) ! Read parameters !**************** call skplin(7,10) if (old) call skplin(1,10) read(10,*) ldirect if (old) call skplin(3,10) read(10,*) ibdate,ibtime if (old) call skplin(3,10) read(10,*) iedate,ietime if (old) call skplin(3,10) read(10,*) loutstep if (old) call skplin(3,10) read(10,*) loutaver if (old) call skplin(3,10) read(10,*) loutsample if (old) call skplin(3,10) read(10,*) itsplit if (old) call skplin(3,10) read(10,*) lsynctime if (old) call skplin(3,10) read(10,*) ctl if (old) call skplin(3,10) read(10,*) ifine if (old) call skplin(3,10) read(10,*) iout if (old) call skplin(3,10) read(10,*) ipout if (old) call skplin(3,10) read(10,*) lsubgrid if (old) call skplin(3,10) read(10,*) lconvection if (old) call skplin(3,10) read(10,*) lagespectra if (old) call skplin(3,10) read(10,*) ipin if (old) call skplin(3,10) read(10,*) ioutputforeachrelease if (old) call skplin(3,10) read(10,*) iflux if (old) call skplin(3,10) read(10,*) mdomainfill if (old) call skplin(3,10) read(10,*) ind_source if (old) call skplin(3,10) read(10,*) ind_receptor if (old) call skplin(3,10) read(10,*) mquasilag if (old) call skplin(3,10) read(10,*) nested_output if (old) call skplin(3,10) read(10,*) linit_cond close(10) endif ! input format print*,'Input file read from ',trim(infile) ! write command file in namelist format to output directory if requested open(11,file=trim(outfile),status='replace',err=998) write(11,nml=command) close(11) print*,'Output file successfully created at ',trim(outfile) stop 998 print*,' ERROR: Output file not found at ',trim(outfile) stop 999 print*,' ERROR: Input file "COMMAND" not found at ',trim(infile) stop end program command2nml