Changeset 36 for branches/petra/src/readcommand.f90
- Timestamp:
- Feb 16, 2015, 6:21:09 PM (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/petra/src/readcommand.f90
r30 r36 1 1 !********************************************************************** 2 ! Copyright 1998 ,1999,2000,2001,2002,2005,2007,2008,2009,2010*2 ! Copyright 1998-2015 * 3 3 ! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * 4 4 ! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * … … 29 29 ! * 30 30 ! 18 May 1996 * 31 ! HSO, 1 July 2014 * 32 ! Added optional namelist input * 31 ! 32 ! HSO, 1 July 2014: Added optional namelist input 33 ! PS 2/2015: add ldep_incr as optional command input 34 ! make new parameters (last 3) optional for bwd compatibility 33 35 ! * 34 36 !***************************************************************************** … … 69 71 ! mdomainfill 1 use domain-filling option, 0 not, 2 use strat. O3 * 70 72 ! * 73 ! ldep_incr .true. for incremental, 74 ! .false. for accumulated deposition output (DEFAULT) 71 75 ! Constants: * 72 76 ! unitcommand unit connected to file COMMAND * … … 79 83 implicit none 80 84 81 real (kind=dp) :: juldate82 character (len=50) :: line85 real (kind=dp) :: juldate 86 character (len=50) :: line 83 87 logical :: old 84 integer :: readerror88 integer :: ireaderror, icmdstat 85 89 86 90 namelist /command/ & … … 110 114 linit_cond, & 111 115 lnetcdfout, & 112 surf_only 113 114 ! Presetting namelist command 115 ldirect=0 116 ibdate=20000101 117 ibtime=0 118 iedate=20000102 119 ietime=0 120 loutstep=10800 121 loutaver=10800 122 loutsample=900 123 itsplit=999999999 124 lsynctime=900 125 ctl=-5.0 126 ifine=4 127 iout=3 128 ipout=0 129 lsubgrid=1 130 lconvection=1 131 lagespectra=0 132 ipin=1 133 ioutputforeachrelease=1 134 iflux=1 135 mdomainfill=0 136 ind_source=1 137 ind_receptor=1 138 mquasilag=0 139 nested_output=0 140 linit_cond=0 141 lnetcdfout=0 142 surf_only=0 116 surf_only, & 117 ldep_incr 118 119 ! Set default values for namelist command 120 ldirect = 0 121 ibdate = 20000101 122 ibtime = 0 123 iedate = 20000102 124 ietime = 0 125 loutstep = 10800 126 loutaver = 10800 127 loutsample = 900 128 itsplit = 999999999 129 lsynctime = 900 130 ctl = -5.0 131 ifine = 4 132 iout = 3 133 ipout = 0 134 lsubgrid = 1 135 lconvection = 1 136 lagespectra = 0 137 ipin = 1 138 ioutputforeachrelease = 1 139 iflux = 1 140 mdomainfill = 0 141 ind_source = 1 142 ind_receptor = 1 143 mquasilag = 0 144 nested_output = 0 145 linit_cond = 0 146 lnetcdfout = 0 147 surf_only = 0 148 ldep_incr = .false. 143 149 144 150 ! Open the command file and read user options … … 148 154 149 155 ! try namelist input (default) 150 read(unitcommand,command,iostat= readerror)156 read(unitcommand,command,iostat=ireaderror) 151 157 close(unitcommand) 152 158 153 159 ! distinguish namelist from fixed text input 154 if ((readerror.ne.0).or.(ldirect.eq.0)) then ! parse as text file format 160 if ((ireaderror .ne. 0) .or. (ldirect .eq. 0)) then 161 162 ! parse as text file format 155 163 156 164 open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', err=999) … … 225 233 read(unitcommand,*) nested_output 226 234 if (old) call skplin(3,unitcommand) 227 read(unitcommand,*) linit_cond 228 if (old) call skplin(3,unitcommand) 229 read(unitcommand,*) surf_only 235 read(unitcommand,*,iostat=icmdstat) linit_cond 236 if (icmdstat .gt. 0) & 237 print*, 'readcommand: linit_cond not read properly',icmdstat,linit_cond 238 if (old) call skplin(3,unitcommand) 239 read(unitcommand,*,iostat=icmdstat) surf_only 240 if (icmdstat .gt. 0) & 241 print*, 'readcommand: linit_cond not read properly',icmdstat,surf_only 242 if (old) call skplin(3,unitcommand) 243 read(unitcommand,*,iostat=icmdstat) ldep_incr 244 if (icmdstat .gt. 0) & 245 print*, 'readcommand: linit_cond not read properly',icmdstat, ldep_incr 230 246 close(unitcommand) 231 247 … … 233 249 234 250 ! write command file in namelist format to output directory if requested 235 if (nmlout .eqv..true.) then251 if (nmlout .eqv. .true.) then 236 252 open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000) 237 253 write(unitcommand,nml=command) … … 244 260 !*************************************************************** 245 261 246 if (ctl .ge.0.1) then262 if (ctl .ge. 0.1) then 247 263 turbswitch=.true. 248 264 else … … 308 324 !************************************************************************ 309 325 310 if (ldirect .eq.1) linit_cond=0311 if ((linit_cond .lt.0).or.(linit_cond.gt.2)) then326 if (ldirect .eq. 1) linit_cond=0 327 if ((linit_cond .lt. 0) .or. (linit_cond .gt. 2)) then 312 328 write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION #### ' 313 329 write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND". #### ' … … 318 334 !****************** 319 335 320 if (iedate .lt.ibdate) then336 if (iedate .lt. ibdate) then 321 337 write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE #### ' 322 338 write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE #### ' … … 324 340 write(*,*) ' #### "COMMAND". #### ' 325 341 stop 326 else if (iedate .eq.ibdate) then327 if (ietime .lt.ibtime) then342 else if (iedate .eq. ibdate) then 343 if (ietime .lt. ibtime) then 328 344 write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME #### ' 329 345 write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE #### ' … … 338 354 !************************************ 339 355 340 if (ctl .gt.0.) then356 if (ctl .gt. 0.) then 341 357 method=1 342 358 mintime=minstep … … 347 363 348 364 ! check for netcdf output switch (use for non-namelist input only!) 349 if (iout .ge.8) then365 if (iout .ge. 8) then 350 366 lnetcdfout = 1 351 367 iout = iout - 8 … … 360 376 !********************************************************************** 361 377 362 if ((iout .lt.1).or.(iout.gt.5)) then378 if ((iout .lt. 1) .or. (iout .gt. 5)) then 363 379 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 364 380 write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5 FOR #### ' … … 369 385 370 386 !AF check consistency between units and volume mixing ratio 371 if ( ((iout .eq.2).or.(iout.eq.3)).and.&372 (ind_source .gt.1 .or.ind_receptor.gt.1) ) then387 if ( ((iout .eq. 2) .or. (iout .eq. 3)) .and. & 388 (ind_source .gt. 1 .or. ind_receptor .gt. 1) ) then 373 389 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 374 390 write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED #### ' … … 381 397 !***************************************************************************** 382 398 383 if ((ioutputforeachrelease .eq.1).and.(mquasilag.eq.1)) then399 if ((ioutputforeachrelease .eq. 1) .and. (mquasilag .eq. 1)) then 384 400 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 385 401 write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####' … … 392 408 !***************************************************************************** 393 409 394 if ((ldirect .lt.0).and.(mquasilag.eq.1)) then410 if ((ldirect .lt. 0) .and. (mquasilag .eq. 1)) then 395 411 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 396 412 write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####' … … 404 420 !***************************************************************************** 405 421 406 if ((ldirect .lt.0).and.(ioutputforeachrelease.eq.0)) then422 if ((ldirect .lt. 0) .and. (ioutputforeachrelease .eq. 0)) then 407 423 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 408 424 write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####' … … 416 432 !***************************************************************************** 417 433 418 if ((mdomainfill .eq.1).and.(ioutputforeachrelease.eq.1)) then434 if ((mdomainfill .eq. 1) .and. (ioutputforeachrelease .eq. 1)) then 419 435 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 420 436 write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR ####' … … 429 445 !***************************************************************************** 430 446 431 if (ldirect .lt.0) then432 if ((iout .eq.2).or.(iout.eq.3)) then447 if (ldirect .lt. 0) then 448 if ((iout .eq. 2) .or. (iout .eq. 3)) then 433 449 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 434 450 write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####' … … 442 458 !***************************************************************************** 443 459 444 if (mdomainfill .ge.1) then445 if ((iout .eq.4).or.(iout.eq.5)) then460 if (mdomainfill .ge. 1) then 461 if ((iout .eq. 4) .or. (iout .eq. 5)) then 446 462 write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND: ####' 447 463 write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION, ####' … … 456 472 !**************************************************************** 457 473 458 if ((ipout .ne.0).and.(ipout.ne.1).and.(ipout.ne.2)) then474 if ((ipout .ne. 0) .and. (ipout .ne. 1) .and. (ipout .ne. 2)) then 459 475 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 460 476 write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3! #### ' … … 462 478 endif 463 479 464 if(lsubgrid .ne.1.and.verbosity.eq.0) then480 if(lsubgrid .ne. 1 .and. verbosity .eq. 0) then 465 481 write(*,*) ' ---------------- ' 466 482 write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS' … … 473 489 !*********************************************************** 474 490 475 if ((lconvection .ne.0).and.(lconvection.ne.1)) then491 if ((lconvection .ne. 0) .and. (lconvection .ne. 1)) then 476 492 write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND: #### ' 477 493 write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### ' … … 483 499 !************************************************************* 484 500 485 if (lsynctime .gt.(idiffnorm/2)) then501 if (lsynctime .gt. (idiffnorm/2)) then 486 502 write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION #### ' 487 503 write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER. #### ' … … 494 510 !***************************************************************************** 495 511 496 if (loutaver .eq.0) then512 if (loutaver .eq. 0) then 497 513 write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' 498 514 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 502 518 endif 503 519 504 if (loutaver .gt.loutstep) then520 if (loutaver .gt. loutstep) then 505 521 write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' 506 522 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 510 526 endif 511 527 512 if (loutsample .gt.loutaver) then528 if (loutsample .gt. loutaver) then 513 529 write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' 514 530 write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE #### ' … … 518 534 endif 519 535 520 if (mod(loutaver,lsynctime) .ne.0) then536 if (mod(loutaver,lsynctime) .ne. 0) then 521 537 write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' 522 538 write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE #### ' … … 525 541 endif 526 542 527 if ((loutaver/lsynctime) .lt.2) then543 if ((loutaver/lsynctime) .lt. 2) then 528 544 write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' 529 545 write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST #### ' … … 532 548 endif 533 549 534 if (mod(loutstep,lsynctime) .ne.0) then550 if (mod(loutstep,lsynctime) .ne. 0) then 535 551 write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' 536 552 write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### ' … … 539 555 endif 540 556 541 if ((loutstep/lsynctime) .lt.2) then557 if ((loutstep/lsynctime) .lt. 2) then 542 558 write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' 543 559 write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST #### ' … … 546 562 endif 547 563 548 if (mod(loutsample,lsynctime) .ne.0) then564 if (mod(loutsample,lsynctime) .ne. 0) then 549 565 write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' 550 566 write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE #### ' … … 553 569 endif 554 570 555 if (itsplit .lt.loutaver) then571 if (itsplit .lt. loutaver) then 556 572 write(*,*) ' #### FLEXPART MODEL ERROR! SPLITTING TIME FOR#### ' 557 573 write(*,*) ' #### PARTICLES IS TOO SHORT. PLEASE INCREASE #### ' … … 560 576 endif 561 577 562 if ((mquasilag .eq.1).and.(iout.ge.4)) then578 if ((mquasilag .eq. 1) .and. (iout .ge. 4)) then 563 579 write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING #### ' 564 580 write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME #### ' … … 571 587 572 588 outstep=real(abs(loutstep)) 573 if (ldirect .eq.1) then589 if (ldirect .eq. 1) then 574 590 bdate=juldate(ibdate,ibtime) 575 591 edate=juldate(iedate,ietime) 576 592 ideltas=nint((edate-bdate)*86400.) 577 else if (ldirect .eq.-1) then593 else if (ldirect .eq. -1) then 578 594 loutaver=-1*loutaver 579 595 loutstep=-1*loutstep
Note: See TracChangeset
for help on using the changeset viewer.