Changeset 20 for trunk/src/readcommand.f90
- Timestamp:
- Dec 23, 2013, 6:23:38 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/src/readcommand.f90
r4 r20 80 80 character(len=50) :: line 81 81 logical :: old 82 82 logical :: nmlout=.true. !.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 surf_only 111 112 ! Presetting namelist command 113 ldirect=1 114 ibdate=20000101 115 ibtime=0 116 iedate=20000102 117 ietime=0 118 loutstep=10800 119 loutaver=10800 120 loutsample=900 121 itsplit=999999999 122 lsynctime=900 123 ctl=-5.0 124 ifine=4 125 iout=3 126 ipout=0 127 lsubgrid=1 128 lconvection=1 129 lagespectra=0 130 ipin=1 131 ioutputforeachrelease=1 132 iflux=1 133 mdomainfill=0 134 ind_source=1 135 ind_receptor=1 136 mquasilag=0 137 nested_output=0 138 linit_cond=0 139 surf_only=0 83 140 84 141 ! Open the command file and read user options 85 !******************************************** 86 87 142 ! Namelist input first: try to read as namelist file 143 !************************************************************************** 88 144 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 145 form='formatted',iostat=readerror) 146 ! If fail, check if file does not exist 147 if (readerror.ne.0) then 148 149 print*,'***ERROR: file COMMAND not found in ' 150 print*, path(1)(1:length(1))//'COMMAND' 151 print*, 'Check your pathnames file.' 152 stop 153 154 endif 155 156 read(unitcommand,command,iostat=readerror) 159 157 close(unitcommand) 160 158 159 ! If error in namelist format, try to open with old input code 160 if (readerror.ne.0) then 161 162 open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', & 163 err=999) 164 165 ! Check the format of the COMMAND file (either in free format, 166 ! or using formatted mask) 167 ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION' 168 !************************************************************************** 169 170 call skplin(9,unitcommand) 171 read (unitcommand,901) line 172 901 format (a) 173 if (index(line,'LDIRECT') .eq. 0) then 174 old = .false. 175 else 176 old = .true. 177 endif 178 rewind(unitcommand) 179 180 ! Read parameters 181 !**************** 182 183 call skplin(7,unitcommand) 184 if (old) call skplin(1,unitcommand) 185 186 read(unitcommand,*) ldirect 187 if (old) call skplin(3,unitcommand) 188 read(unitcommand,*) ibdate,ibtime 189 if (old) call skplin(3,unitcommand) 190 read(unitcommand,*) iedate,ietime 191 if (old) call skplin(3,unitcommand) 192 read(unitcommand,*) loutstep 193 if (old) call skplin(3,unitcommand) 194 read(unitcommand,*) loutaver 195 if (old) call skplin(3,unitcommand) 196 read(unitcommand,*) loutsample 197 if (old) call skplin(3,unitcommand) 198 read(unitcommand,*) itsplit 199 if (old) call skplin(3,unitcommand) 200 read(unitcommand,*) lsynctime 201 if (old) call skplin(3,unitcommand) 202 read(unitcommand,*) ctl 203 if (old) call skplin(3,unitcommand) 204 read(unitcommand,*) ifine 205 if (old) call skplin(3,unitcommand) 206 read(unitcommand,*) iout 207 if (old) call skplin(3,unitcommand) 208 read(unitcommand,*) ipout 209 if (old) call skplin(3,unitcommand) 210 read(unitcommand,*) lsubgrid 211 if (old) call skplin(3,unitcommand) 212 read(unitcommand,*) lconvection 213 if (old) call skplin(3,unitcommand) 214 read(unitcommand,*) lagespectra 215 if (old) call skplin(3,unitcommand) 216 read(unitcommand,*) ipin 217 if (old) call skplin(3,unitcommand) 218 read(unitcommand,*) ioutputforeachrelease 219 if (old) call skplin(3,unitcommand) 220 read(unitcommand,*) iflux 221 if (old) call skplin(3,unitcommand) 222 read(unitcommand,*) mdomainfill 223 if (old) call skplin(3,unitcommand) 224 read(unitcommand,*) ind_source 225 if (old) call skplin(3,unitcommand) 226 read(unitcommand,*) ind_receptor 227 if (old) call skplin(3,unitcommand) 228 read(unitcommand,*) mquasilag 229 if (old) call skplin(3,unitcommand) 230 read(unitcommand,*) nested_output 231 if (old) call skplin(3,unitcommand) 232 read(unitcommand,*) linit_cond 233 close(unitcommand) 234 235 endif ! input format 236 237 ! write command file in namelist format to output directory if requested 238 if (nmlout.eqv..true.) then 239 !open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist.out',status='new',err=1000) 240 open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000) 241 write(unitcommand,nml=command) 242 close(unitcommand) 243 ! open(unitheader,file=path(2)(1:length(2))//'header_nml',status='new',err=999) 244 ! write(unitheader,NML=COMMAND) 245 !close(unitheader) 246 endif 247 161 248 ifine=max(ifine,1) 162 163 249 164 250 ! Determine how Markov chain is formulated (for w or for w/sigw) … … 371 457 endif 372 458 373 if(lsubgrid.ne.1 ) then459 if(lsubgrid.ne.1.and.verbosity.eq.0) then 374 460 write(*,*) ' ---------------- ' 375 461 write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS' … … 505 591 stop 506 592 593 1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND" #### ' 594 write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY #### ' 595 write(*,'(a)') path(2)(1:length(1)) 596 stop 507 597 end subroutine readcommand
Note: See TracChangeset
for help on using the changeset viewer.