Ignore:
File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/FLEXPART_9.1.3/src/readcommand.f90

    r4 r13  
    8080  character(len=50) :: line
    8181  logical :: old
    82 
     82  logical :: nmlout=.false.
     83  integer :: readerror
     84
     85  namelist /command/ &
     86    ldirect, &
     87    ibdate,ibtime, &
     88    iedate,ietime, &
     89    loutstep, &
     90    loutaver, &
     91    loutsample, &
     92    itsplit, &
     93    lsynctime, &
     94    ctl, &
     95    ifine, &
     96    iout, &
     97    ipout, &
     98    lsubgrid, &
     99    lconvection, &
     100    lagespectra, &
     101    ipin, &
     102    ioutputforeachrelease, &
     103    iflux, &
     104    mdomainfill, &
     105    ind_source, &
     106    ind_receptor, &
     107    mquasilag, &
     108    nested_output, &
     109    linit_cond
     110
     111  ! Presetting namelist command
     112  ldirect=1
     113  ibdate=20000101
     114  ibtime=0
     115  iedate=20000102
     116  ietime=0
     117  loutstep=10800
     118  loutaver=10800
     119  loutsample=900
     120  itsplit=999999999
     121  lsynctime=900
     122  ctl=-5.0
     123  ifine=4
     124  iout=3
     125  ipout=0
     126  lsubgrid=1
     127  lconvection=1
     128  lagespectra=0
     129  ipin=1
     130  ioutputforeachrelease=0
     131  iflux=1
     132  mdomainfill=0
     133  ind_source=1
     134  ind_receptor=1
     135  mquasilag=0
     136  nested_output=0
     137  linit_cond=0
    83138
    84139  ! Open the command file and read user options
    85   !********************************************
    86 
    87 
     140  ! Namelist input first: try to read as namelist file
     141  !**************************************************************************
    88142  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
    98 901   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
     143         form='formatted',iostat=readerror)
     144  ! If fail, check if file does not exist
     145  if (readerror.ne.0) then
     146
     147    print*,'***ERROR: file COMMAND not found. Check your pathnames file.'
     148    stop
     149
     150  endif
     151
     152  read(unitcommand,command,iostat=readerror)
    159153  close(unitcommand)
    160154
     155  ! If error in namelist format, try to open with old input code
     156  if (readerror.ne.0) then
     157
     158    open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', &
     159         err=999)
     160
     161    ! Check the format of the COMMAND file (either in free format,
     162    ! or using formatted mask)
     163    ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION'
     164    !**************************************************************************
     165
     166    call skplin(9,unitcommand)
     167    read (unitcommand,901) line
     168  901   format (a)
     169    if (index(line,'LDIRECT') .eq. 0) then
     170      old = .false.
     171    else
     172      old = .true.
     173    endif
     174    rewind(unitcommand)
     175
     176    ! Read parameters
     177    !****************
     178
     179    call skplin(7,unitcommand)
     180    if (old) call skplin(1,unitcommand)
     181
     182    read(unitcommand,*) ldirect
     183    if (old) call skplin(3,unitcommand)
     184    read(unitcommand,*) ibdate,ibtime
     185    if (old) call skplin(3,unitcommand)
     186    read(unitcommand,*) iedate,ietime
     187    if (old) call skplin(3,unitcommand)
     188    read(unitcommand,*) loutstep
     189    if (old) call skplin(3,unitcommand)
     190    read(unitcommand,*) loutaver
     191    if (old) call skplin(3,unitcommand)
     192    read(unitcommand,*) loutsample
     193    if (old) call skplin(3,unitcommand)
     194    read(unitcommand,*) itsplit
     195    if (old) call skplin(3,unitcommand)
     196    read(unitcommand,*) lsynctime
     197    if (old) call skplin(3,unitcommand)
     198    read(unitcommand,*) ctl
     199    if (old) call skplin(3,unitcommand)
     200    read(unitcommand,*) ifine
     201    if (old) call skplin(3,unitcommand)
     202    read(unitcommand,*) iout
     203    if (old) call skplin(3,unitcommand)
     204    read(unitcommand,*) ipout
     205    if (old) call skplin(3,unitcommand)
     206    read(unitcommand,*) lsubgrid
     207    if (old) call skplin(3,unitcommand)
     208    read(unitcommand,*) lconvection
     209    if (old) call skplin(3,unitcommand)
     210    read(unitcommand,*) lagespectra
     211    if (old) call skplin(3,unitcommand)
     212    read(unitcommand,*) ipin
     213    if (old) call skplin(3,unitcommand)
     214    read(unitcommand,*) ioutputforeachrelease
     215    if (old) call skplin(3,unitcommand)
     216    read(unitcommand,*) iflux
     217    if (old) call skplin(3,unitcommand)
     218    read(unitcommand,*) mdomainfill
     219    if (old) call skplin(3,unitcommand)
     220    read(unitcommand,*) ind_source
     221    if (old) call skplin(3,unitcommand)
     222    read(unitcommand,*) ind_receptor
     223    if (old) call skplin(3,unitcommand)
     224    read(unitcommand,*) mquasilag
     225    if (old) call skplin(3,unitcommand)
     226    read(unitcommand,*) nested_output
     227    if (old) call skplin(3,unitcommand)
     228    read(unitcommand,*) linit_cond
     229    close(unitcommand)
     230
     231  endif ! input format
     232
     233  ! write command file in namelist format to output directory if requested
     234  if (nmlout.eqv..true.) then
     235    open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',status='new',err=999)
     236    write(unitcommand,nml=command)
     237    close(unitcommand)
     238  endif
     239
    161240  ifine=max(ifine,1)
    162 
    163241
    164242  ! Determine how Markov chain is formulated (for w or for w/sigw)
Note: See TracChangeset for help on using the changeset viewer.
hosted by ZAMG