Add files via upload
This commit is contained in:
Xuesong (Steve)
783
code/reader.f
Normal file
783
code/reader.f
Normal file
@ -0,0 +1,783 @@
|
||||
! $Id: reader.f,v 1.2 2012/03/01 22:00:26 daven Exp $
|
||||
SUBROUTINE READER( FIRSTCHEM )
|
||||
!
|
||||
!******************************************************************************
|
||||
! Subroutine READER reads on/off switches and other settings for SMVGEAR II.
|
||||
! (M. Jacobson 1997; bdf, bmy, 4/18/03, 10/16/06)
|
||||
!
|
||||
! NOTES:
|
||||
! (1 ) Now force double-precision values with the "D" exponent. Also use
|
||||
! consistent physical constant values w/ GEOS-CHEM. Now use GEOS-CHEM
|
||||
! unit IU_FILE number to read the "mglob.dat" file. Now references
|
||||
! GEOS_CHEM_STOP from "error_mod.f". Now force double-precision with
|
||||
! the "D" exponent. Set KGLC = IU_CHEMDAT = 7 from "file_mod.f"
|
||||
! (bmy, 4/18/03)
|
||||
! (2 ) Remove obsolete variables AERSURF, MLOPJ, REARTHC, DENCONS, HALFDAY,
|
||||
! GRAVC, FOURPI, TWOPI, REARTH, RPRIMB, AVOG1, HALF, THIRD, THRPI2,
|
||||
! PID180, PID2, SCTWOPI, AMRGAS, TWPISC, REARTH. these aren't used w/in
|
||||
! "reader.f" anymore. Use F90-style variable declarations. Also
|
||||
! remove obsolete variables from documentation. (bmy, 7/16/03)
|
||||
! (3 ) Redefine CHEMINTV [s] to the value in "input.geos" so that we don't
|
||||
! have a discrepancy with the value in "mglob.dat". SLOW-J is now
|
||||
! obsolete; remove LSLOWJ #ifdef blocks (bmy, 6/23/05)
|
||||
! (4 ) Physical constants and some error tolerances are now defined as
|
||||
! parameters in "comode.h". In this way, their values will be defined
|
||||
! before the first call to READER for the offline aerosol simulation.
|
||||
! (bec, bmy, 3/29/06)
|
||||
! (5 ) Increase max # of products that a reaction can have from 12 to 14.
|
||||
! This coincides w/ the new globchem.dat. (bmy, 8/9/06)
|
||||
! (6 ) At the end of this subrouitne, now set NCS=NCSURBAN (=1) instead of
|
||||
! hardwiring it. (dbm, bmy, 10/16/06)
|
||||
!******************************************************************************
|
||||
!
|
||||
! References to F90 modules
|
||||
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
||||
USE FILE_MOD, ONLY : IU_FILE, IU_CHEMDAT, IU_SMV2LOG
|
||||
USE TIME_MOD, ONLY : GET_TS_CHEM
|
||||
|
||||
! adj_group: add for adjoint (dkh, 01/13/12, adj32_013)
|
||||
USE LOGICAL_ADJ_MOD, ONLY : LADJ
|
||||
USE TRACER_MOD, ONLY : ITS_AN_AEROSOL_SIM
|
||||
|
||||
IMPLICIT NONE
|
||||
|
||||
# include "CMN_SIZE" ! Size parameters
|
||||
# include "comode.h" ! SMVGEAR II arrays
|
||||
# include "CMN_GCTM" ! Re, PI
|
||||
C
|
||||
C *********************************************************************
|
||||
C * THIS SUBROUTINE OPENS ALL DATA FILES AND READS DATA FROM m.dat ***
|
||||
C * FOR DEFINITIONS OF THE PARAMETERS READ IN HERE, SEE define.dat ***
|
||||
C *********************************************************************
|
||||
C
|
||||
C RRRRRRR EEEEEEE A DDDDDDD EEEEEEE RRRRRRR
|
||||
C R R E A A D D E R R
|
||||
C RRRRRRR EEEEEEE A A D D EEEEEEE RRRRRRR
|
||||
C R R E AAAAAAA D D E R R
|
||||
C R R EEEEEEE A A DDDDDDD EEEEEEE R R
|
||||
C
|
||||
C
|
||||
C *********************************************************************
|
||||
C * NAMELIST DATA FOR DATA FILE m.dat *
|
||||
C *********************************************************************
|
||||
C
|
||||
C *********************************************************************
|
||||
C MAIN SWITCHES
|
||||
C *********************************************************************
|
||||
C IFSOLVE = 1: SOLVE CHEMICAL EQUATIONS WITH SMVGEAR
|
||||
C 0: DO NOT SOLVE ANY CHEMICAL EQUATIONS (mglob.dat)
|
||||
C IFPRAT = 1: USE DEFAULT PHOTORATES FROM photrate.dat;
|
||||
C = 0: USE DEFAULT PHOTORATES FROM globchem.dat
|
||||
C INCVMIX = 1: INTERPOLATE MIXING RATIO PROFILES FROM DATA IN MIXRATIO.DAT
|
||||
C ITESTGEAR = 1: CREATE EXACT SOLUTION TO COMPARE OTHER GEAR SOLUTIONS AGAINST
|
||||
C = 2: COMPARE CURRENT SOLUTION TO EXACT SOLUTION
|
||||
C
|
||||
C IFURBAN IFTROP IFSTRAT TYPE OF CHEMISTRY SOLVED
|
||||
C (U=URBAN, T=TROPOSPHERIC, S=STRATOSPHERIC)
|
||||
C ----------------------------------------------------------------------
|
||||
C 0 0 0 DO NOT SOLVE CHEMISTRY
|
||||
C 1 0 0 SOLVE U EVERYWHERE
|
||||
C 0 1 0 SOLVE T EVERYWHERE
|
||||
C 0 0 1 SOLVE S EVERYWHERE
|
||||
C 1 1 1 SOLVE U BELOW PLOURB, T BETWEEN PLOURB,
|
||||
C PLOTROP, AND S ABOVE PLOTROP
|
||||
C 0 2 2 SOLVE T/S CHEMISTRY EVERYWHERE
|
||||
C 2 2 2 SOLVE U/T/S CHEMISTRY EVERYWHERE
|
||||
C
|
||||
LOGICAL, INTENT(IN) :: FIRSTCHEM
|
||||
INTEGER :: K, M2, M1, MLOOP, KLOOP
|
||||
INTEGER :: JLOOP, IAVBLOK, IAVGSIZE, IREMAIN, JADD
|
||||
INTEGER :: IFCHEM, I, NALLREAC, NMPROD, I1
|
||||
INTEGER :: J, NK
|
||||
|
||||
REAL*8 :: ERRMAXU, YLOWU, YHIU, HMAXDAYU
|
||||
REAL*8 :: ERRMAXR, YLOWR, YHIR, HMAXDAYR
|
||||
REAL*8 :: ERRMAXS, YLOWS, YHIS, HMAXDAYS
|
||||
REAL*8 :: ABHI, ABLO
|
||||
|
||||
NAMELIST /CTLFLG/ IFSOLVE, ITESTGEAR,
|
||||
1 IFURBAN, IFTROP, IFSTRAT
|
||||
C
|
||||
C *********************************************************************
|
||||
C DIMENSIONS
|
||||
C *********************************************************************
|
||||
C NLAT = # SOUTH-NORTH GRID CELLS
|
||||
C NLONG = # WEST-EAST GRID CELLS
|
||||
C NVERT = # VERTICAL LAYERS
|
||||
C KULOOP = MAXIMUM ACTUAL # OF GRID CELLS IN A GRID BLOCK
|
||||
C LYOUT = SPECIFIC SOUTH-NORTH CELL FOR PRINTING
|
||||
C LXOUT = SPECIFIC WEST-EAST CELL FOR PRINTING
|
||||
C LZOUT = SPECIFIC VERTICAL LAYER FOR PRINTING
|
||||
C
|
||||
NAMELIST /CTLDIM/ KULOOP,
|
||||
1 LYOUT, LXOUT, LZOUT
|
||||
C
|
||||
C *********************************************************************
|
||||
C SWITCHES FOR TIME, TIME-STEPS, AND OUTPUT
|
||||
C *********************************************************************
|
||||
C CHEMINTV = TIME STEP FOR GAS AND RADIATIVE PROCESS CALCULATIONS
|
||||
C
|
||||
NAMELIST /CTLTIM/ CHEMINTV
|
||||
C
|
||||
C *********************************************************************
|
||||
C SWITCHES FOR OUTPUT
|
||||
C *********************************************************************
|
||||
C IPRATES = 1: PRINT CHEMICAL RATE COEFFICIENT DATA IN UPDATE.F
|
||||
C IPREADER = 1: PRINT INPUT DATA READ IN READER.F
|
||||
C IOREAC = 1: PRINT LIST OF REACTIONS IN READCHEM.F
|
||||
C APGASA..H = GASES FOR WHICH OUTPUT ARE PRINTED. OVERRIDES IPRMANY
|
||||
C
|
||||
NAMELIST /CTLPRT/ IPRATES, IPREADER,
|
||||
1 IOSPEC, IOREAC,
|
||||
3 APGASA, APGASB, APGASC,
|
||||
4 APGASD, APGASE, APGASF,
|
||||
5 APGASG, APGASH
|
||||
C
|
||||
C *********************************************************************
|
||||
C SWITCHES FOR CHEMISTRY
|
||||
C *********************************************************************
|
||||
C IFREORD = 1: REORDER GRID CELLS BY STIFFNESS DURING CHEMISTRY
|
||||
C FRACDEC = FRACTION THE TIME STEP IS DECREASED IF CONVERGENCE FAILS
|
||||
C PLOTROP = PRESSURE (MB) ABOVE WHICH STRAT CHEM IS SOLVED
|
||||
C PLOURB = PRESSURE (MB) BELOW WHICH URBAN CHEM IS SOLVED
|
||||
C ERRMAXU = RELATIVE ERROR TOLERANCE (FRACTION) FOR URBAN CHEMISTRY
|
||||
C ERRMAXR = RELATIVE ERROR TOLERANCE (FRACTION) FOR TROPOSPHERIC CHEMISTRY
|
||||
C ERRMAXS = RELATIVE ERROR TOLERANCE (FRACTION) FOR STRATOSPHERIC CHEMISTRY
|
||||
C YLOWU,YHIU = LOW /HIGH ABS. ERROR TOLERANCES (MOLEC. CM-3) FOR URBAN CHEM
|
||||
C YLOWR,YHIR = LOW /HIGH ABS. ERROR TOLERANCES (MOLEC. CM-3) FOR TROP. CHEM
|
||||
C YLOWS,YHIS = LOW /HIGH ABS. ERROR TOLERANCES (MOLEC. CM-3) FOR STRAT. CHEM
|
||||
C HMAXDAYU = MAXIMUM TIME STEP FOR DAYTIME URBAN CHEMISTRY (S)
|
||||
C HMAXDAYR = MAXIMUM TIME STEP FOR DAYTIME TROP. CHEMISTRY (S)
|
||||
C HMAXDAYS = MAXIMUM TIME STEP FOR DAYTIME STRAT. CHEMISTRY (S)
|
||||
C HMAXNIT = MAXIMUM TIME STEP FOR NIGHTTIME CHEMISTRY EVERYWHERE
|
||||
C
|
||||
NAMELIST /CLGEAR/ IFREORD, FRACDEC,
|
||||
2 PLOURB, PLOTROP,
|
||||
3 ERRMAXU, YLOWU, YHIU, HMAXDAYU,
|
||||
4 ERRMAXR, YLOWR, YHIR, HMAXDAYR,
|
||||
5 ERRMAXS, YLOWS, YHIS, HMAXDAYS,
|
||||
8 HMAXNIT
|
||||
C
|
||||
C *********************************************************************
|
||||
C *********************** OPEN CONTROL INPUT FILE *********************
|
||||
C *********************************************************************
|
||||
C
|
||||
! Echo info to stdout
|
||||
WRITE( 6, '(a)' ) ' - READER: Reading mglob.dat'
|
||||
|
||||
! Use GEOS-CHEM file unit to prevent conflicts (bmy, 4/7/03)
|
||||
OPEN( IU_FILE, FILE = 'mglob.dat' )
|
||||
READ( IU_FILE, 100 ) HEADING
|
||||
READ( IU_FILE, 100 ) COMMENT
|
||||
READ( IU_FILE, CTLFLG )
|
||||
READ( IU_FILE, CTLDIM )
|
||||
READ( IU_FILE, CTLTIM )
|
||||
READ( IU_FILE, CTLPRT )
|
||||
READ( IU_FILE, CLGEAR )
|
||||
CLOSE( IU_FILE )
|
||||
|
||||
! NOTE: Redefine CHEMINTV [s] to the value in "input.geos" so
|
||||
! that we don't have a discrepancy with the value in "mglob.dat"
|
||||
! (bmy, 5/10/05)
|
||||
CHEMINTV = GET_TS_CHEM() * 60d0
|
||||
C
|
||||
C *********************************************************************
|
||||
C * DEFINE SOME GRID PARAMETERS *
|
||||
C *********************************************************************
|
||||
C NLOOP = NUMBER OF GRID-CELLS IN A VERTICAL LAYER
|
||||
C NTLOOP = NUMBER OF GRID-CELLS IN THE ENTIRE GRID-DOMAIN
|
||||
C NLAYER = NVERT + 1
|
||||
C LX,Y,ZOUT = IDENTIFY GRID POINT WHERE OUTPUT IS PRINTED
|
||||
C INCVMIX = 1: INITIALIZE MIXING RATIOS FROM mixratio.dat
|
||||
C IFPRAT = 1: USE DEFAULT PHOTORATES FROM photrate.dat
|
||||
C ICOORD = 1: RECTANGULAR; 2: SPHERICAL; 3: GLOBAL SPHERICAL
|
||||
C IFBOX = 1: SETS UP BOX MODEL TO SOLVE URBAN/TROP/STRAT CHEM TOGETHER
|
||||
C USING DEFAULT PHOTORATES
|
||||
C ITESTGEAR = 1: SETS UP BOX MODEL TO COMPARE URBAN/TROP/STRAT
|
||||
C CHEMISTRY TO EXACT SOLUTION
|
||||
C = 2: SETS UP BOX MODEL TO CREATE URBAN/TROP/STRAT
|
||||
C CHEMISTRY EXACT SOLUTION
|
||||
C
|
||||
IF (ITESTGEAR.GT.0) THEN
|
||||
NLAT = 1
|
||||
NLONG = 1
|
||||
NVERT = 1
|
||||
ICOORD = 1
|
||||
LXOUT = 1
|
||||
LYOUT = 1
|
||||
LZOUT = 1
|
||||
ENDIF
|
||||
C
|
||||
! nlat and nlong are defined in chemdr.f (bdf, 4/1/03)
|
||||
!NLOOP = NLAT * NLONG
|
||||
!NTLOOP = NLOOP * NVERT
|
||||
|
||||
! needed in reader.f for kuloop (bdf, 4/1/03)
|
||||
NTLOOP = IIPAR*JJPAR*NVERT
|
||||
C
|
||||
NLAYER = LLTROP
|
||||
LXOUT = MIN0(LXOUT,NLONG)
|
||||
LYOUT = MIN0(LYOUT,NLAT)
|
||||
LZOUT = MIN0(LZOUT,NVERT)
|
||||
C
|
||||
C *********************************************************************
|
||||
C OPEN MORE FILES
|
||||
C *********************************************************************
|
||||
C
|
||||
IOUT = 6
|
||||
KGLC = IU_CHEMDAT
|
||||
C
|
||||
! Open chemistry mechanism file
|
||||
OPEN( KGLC, FILE ='globchem.dat' )
|
||||
|
||||
! Open "smv2.log" for echoback output as unit #93
|
||||
IO93 = IU_SMV2LOG
|
||||
OPEN( IO93, FILE='smv2.log', STATUS='UNKNOWN' )
|
||||
C
|
||||
C *********************************************************************
|
||||
C * PRINT INFORMATION FROM m.dat *
|
||||
C *********************************************************************
|
||||
C
|
||||
IF (IPREADER.EQ. 1 .AND. FIRSTCHEM) THEN
|
||||
WRITE( IO93, '(a)' ) REPEAT( '=', 79 )
|
||||
WRITE( IO93, '(a,/)' ) 'SMV2.LOG -- SMVGEAR II information'
|
||||
WRITE( IO93, '(a)' ) 'Switches in mglob.dat!'
|
||||
WRITE( IO93, '(a)' ) REPEAT( '=', 79 )
|
||||
WRITE( IO93, * ) 'IFSOLVE = ', IFSOLVE
|
||||
WRITE( IO93, * ) 'ITESTGEAR = ', ITESTGEAR
|
||||
WRITE( IO93, * ) 'IFURBAN = ', IFURBAN
|
||||
WRITE( IO93, * ) 'IFTROP = ', IFTROP
|
||||
WRITE( IO93, * ) 'IFSTRAT = ', IFSTRAT
|
||||
WRITE( IO93, * ) 'KULOOP = ', KULOOP
|
||||
WRITE( IO93, * ) 'LYOUT = ', LYOUT
|
||||
WRITE( IO93, * ) 'LXOUT = ', LXOUT
|
||||
WRITE( IO93, * ) 'LZOUT = ', LZOUT
|
||||
WRITE( IO93, * ) 'CHEMINTV = ', CHEMINTV
|
||||
WRITE( IO93, * ) 'IPRATES = ', IPRATES
|
||||
WRITE( IO93, * ) 'IPREADER = ', IPREADER
|
||||
WRITE( IO93, * ) 'IOSPEC = ', IOSPEC
|
||||
WRITE( IO93, * ) 'IOREAC = ', IOREAC
|
||||
WRITE( IO93, * ) 'APGASA = ', APGASA
|
||||
WRITE( IO93, * ) 'APGASB = ', APGASB
|
||||
WRITE( IO93, * ) 'APGASC = ', APGASC
|
||||
WRITE( IO93, * ) 'APGASD = ', APGASD
|
||||
WRITE( IO93, * ) 'APGASE = ', APGASE
|
||||
WRITE( IO93, * ) 'APGASF = ', APGASF
|
||||
WRITE( IO93, * ) 'APGASG = ', APGASG
|
||||
WRITE( IO93, * ) 'IFREORD = ', IFREORD
|
||||
WRITE( IO93, * ) 'FRACDEC = ', FRACDEC
|
||||
WRITE( IO93, * ) 'PLOURB = ', PLOURB
|
||||
WRITE( IO93, * ) 'PLOTROP = ', PLOTROP
|
||||
WRITE( IO93, * ) 'ERRMAXU = ', ERRMAXU
|
||||
WRITE( IO93, * ) 'YLOWU = ', YLOWU
|
||||
WRITE( IO93, * ) 'YHIU = ', YHIU
|
||||
WRITE( IO93, * ) 'HMAXDAYU = ', HMAXDAYU
|
||||
WRITE( IO93, * ) 'ERRMAXR = ', ERRMAXR
|
||||
WRITE( IO93, * ) 'YLOWR = ', YLOWR
|
||||
WRITE( IO93, * ) 'YHIR = ', YHIR
|
||||
WRITE( IO93, * ) 'HMAXDAYR = ', HMAXDAYR
|
||||
WRITE( IO93, * ) 'ERRMAXS = ', ERRMAXS
|
||||
WRITE( IO93, * ) 'YLOWS = ', YLOWS
|
||||
WRITE( IO93, * ) 'YHIS = ', YHIS
|
||||
WRITE( IO93, * ) 'HMAXDAYS = ', HMAXDAYS
|
||||
WRITE( IO93, * ) 'HMAXNIT = ', HMAXNIT
|
||||
WRITE( IO93, '(/,a)' ) 'Using U.C.I. Fast-J photolysis'
|
||||
WRITE( 6, '(a)' ) 'Using U.C.I. Fast-J photolysis'
|
||||
|
||||
! Write spacer line to "smv2.log
|
||||
WRITE( IO93, '(a)' )
|
||||
END IF
|
||||
C
|
||||
C *********************************************************************
|
||||
C ******* THE VALUES OF BASIC PARAMETERS *******
|
||||
C *********************************************************************
|
||||
C BOLTG = BOLTZMANN"S CONSTANT, 1.381E-16 ERG DEG K**-1 = RGAS / AVG
|
||||
C = (1 J = 10**7 ERG = 1 N-M = 1 KG M2 S-2)
|
||||
C RSTARG = UNIVERSAL GAS CONSTANT = 8.3145E+07 G CM2 S-2 MOLE-1 K-1
|
||||
C AVG = AVOGADRO"S NUMBER,MOL**-1
|
||||
C WTAIR = MOLECULAR WEIGHT OF AIR;
|
||||
C RGAS = GAS CONSTANT (ERG DEG K-1 MOL-1)
|
||||
C 1 ERG = 1 DYNE-CM = 10**-7 J
|
||||
C 1 ATM = 1.013 BAR = 10**5 PA. 1PA = 1 N M-2 = 10 DYNES CM-2.
|
||||
C SCDAY = SECONDS PER DAY
|
||||
C
|
||||
C
|
||||
NMASBAL = 9
|
||||
NAMEMB( 1) = 'SULFUR ATOMS'
|
||||
NAMEMB( 2) = 'NITROGEN NO3'
|
||||
NAMEMB( 3) = 'NITROGEN NH4'
|
||||
NAMEMB( 4) = 'CARBON ATOMS'
|
||||
NAMEMB( 5) = 'CHLORINE ATOMS'
|
||||
NAMEMB( 6) = 'BROMINE ATOMS'
|
||||
NAMEMB( 7) = 'FLOURINE ATOMS'
|
||||
NAMEMB( 8) = 'HYDROGEN ATOMS'
|
||||
NAMEMB( 9) = 'OXYGEN ATOMS'
|
||||
C
|
||||
C *********************************************************************
|
||||
C
|
||||
IF (NLAT.GT.ILAT.OR.NLONG.GT.ILONG.OR.NVERT.GT.IVERT) THEN
|
||||
WRITE(6,*)'READER: NLAT, NLONG, OR NVERT TOO BIG'
|
||||
CALL GEOS_CHEM_STOP
|
||||
END IF
|
||||
C
|
||||
C *********************************************************************
|
||||
C * SETUP LOOP-LOCATING ARRAYS *
|
||||
C *********************************************************************
|
||||
C
|
||||
C VALUE OF JLOOP CORRESPONDING TO EACH GRID-CELL FOR GRID
|
||||
C OF NLAT = 3, NLONG = 5, NVERT = 2.
|
||||
C
|
||||
C LAYER 1 (TOP) LAYER NVERT = 2 (BOTTOM)
|
||||
C M1 M1
|
||||
C 3 | 11 12 13 14 15 3 | 26 27 28 29 30
|
||||
C 2 | 6 7 8 9 10 2 | 21 22 23 24 25
|
||||
C 1 | 1 2 3 4 5 1 | 16 17 18 19 20
|
||||
C ------------------- -------------------
|
||||
C 1 2 3 4 5 M2 1 2 3 4 5 M2
|
||||
C
|
||||
DO 210 M2 = 1, NLONG
|
||||
DO 210 M1 = 1, NLAT
|
||||
MLOOP = (M1 - 1) * NLONG + M2
|
||||
210 MLOP(M1,M2) = MLOOP
|
||||
C
|
||||
! adj_group: update to allow aerosol only simulation
|
||||
! (yhmao, dkh, 01/13/12, adj32_013)
|
||||
!IF ( LADJ .and. ITS_AN_AEROSOL_SIM() ) THEN
|
||||
IF ( ITS_AN_AEROSOL_SIM() ) THEN
|
||||
LLOOP = 0
|
||||
ELSE
|
||||
DO 220 K = 1, NLAYER
|
||||
KLOOP = (K - 1) * NLOOP
|
||||
DO 220 M2 = 1, NLONG
|
||||
DO 220 M1 = 1, NLAT
|
||||
MLOOP = MLOP(M1,M2)
|
||||
JLOOP = MLOOP + KLOOP
|
||||
|
||||
! JLOP set differently in ruralbox (bdf, 4/1/03)
|
||||
JLOP_SMV(M1,M2,K) = JLOOP
|
||||
220 CONTINUE
|
||||
C
|
||||
LLOOP = JLOP_SMV(LYOUT,LXOUT,LZOUT)
|
||||
|
||||
ENDIF
|
||||
|
||||
C
|
||||
C *********************************************************************
|
||||
C DETERMINE HOW MANY PROCESSES SOLVED FOR IN SMVGEAR
|
||||
C *********************************************************************
|
||||
C
|
||||
C IFURBAN IFTROP IFSTRAT TYPE OF CHEMISTRY SOLVED
|
||||
C (U=URBAN, T=TROPOSPHERIC, S=STRATOSPHERIC)
|
||||
C ----------------------------------------------------------------------
|
||||
C 0 0 0 DO NOT SOLVE CHEMISTRY
|
||||
C 1 0 0 SOLVE U EVERYWHERE
|
||||
C 0 1 0 SOLVE T EVERYWHERE
|
||||
C 0 0 1 SOLVE S EVERYWHERE
|
||||
C 1 1 1 SOLVE U BELOW PLOURB, T BETWEEN PLOURB,
|
||||
C PLOTROP, AND S ABOVE PLOTROP
|
||||
C 0 2 2 SOLVE T/S CHEMISTRY EVERYWHERE
|
||||
C 2 2 2 SOLVE U/T/S CHEMISTRY EVERYWHERE
|
||||
C
|
||||
C IGLOBCHEM = -2 --> SOLVE ALL GAS CHEMISTRY WITH COMBINATION OF U/R/S SETS
|
||||
C = -1 --> SOLVE ALL GAS CHEMISTRY WITH COMBINATION OF R/S SETS
|
||||
C = 0 --> SOLVE ALL GAS CHEMISTRY WITH EITHER U, R, OR S SETS
|
||||
C = 1 --> SOLVE EACH REGION SEPARATELY WITH U, R, OR S SET
|
||||
C
|
||||
IF (IFURBAN.EQ.2.AND.IFTROP.EQ.2.AND.IFSTRAT.EQ.2) THEN
|
||||
IGLOBCHEM = -2
|
||||
NCSALL = 1
|
||||
NCSTRST = 0
|
||||
NCSURBAN = 0
|
||||
NCSTROP = 0
|
||||
NCSSTRAT = 0
|
||||
NCSGAS = 1
|
||||
NTLOOPNCS(NCSGAS) = NTLOOP
|
||||
ELSEIF (IFURBAN.EQ.0.AND.IFTROP.EQ.2.AND.IFSTRAT.EQ.2) THEN
|
||||
IGLOBCHEM = -1
|
||||
NCSALL = 0
|
||||
NCSTRST = 1
|
||||
NCSURBAN = 0
|
||||
NCSTROP = 0
|
||||
NCSSTRAT = 0
|
||||
NCSGAS = 1
|
||||
NTLOOPNCS(NCSGAS) = NTLOOP
|
||||
ELSEIF (IFURBAN.EQ.1.AND.IFTROP.EQ.1.AND.IFSTRAT.EQ.1) THEN
|
||||
IGLOBCHEM = 1
|
||||
NCSALL = 0
|
||||
NCSTRST = 0
|
||||
NCSURBAN = 1
|
||||
NCSTROP = 2
|
||||
NCSSTRAT = 3
|
||||
NCSGAS = 3
|
||||
ELSE
|
||||
IGLOBCHEM = 0
|
||||
NCSALL = 0
|
||||
NCSTRST = 0
|
||||
NCSURBAN = 0
|
||||
NCSTROP = 0
|
||||
NCSSTRAT = 0
|
||||
NCSGAS = 1
|
||||
IF (IFURBAN.EQ.1.AND.IFTROP.EQ.0.AND.IFSTRAT.EQ.0) THEN
|
||||
NTLOOPNCS(NCSGAS) = NTLOOP
|
||||
NCSURBAN = 1
|
||||
ELSEIF (IFURBAN.EQ.0.AND.IFTROP.EQ.1.AND.IFSTRAT.EQ.0) THEN
|
||||
NTLOOPNCS(NCSGAS) = NTLOOP
|
||||
NCSTROP = 1
|
||||
ELSEIF (IFURBAN.EQ.0.AND.IFTROP.EQ.0.AND.IFSTRAT.EQ.1) THEN
|
||||
NTLOOPNCS(NCSGAS) = NTLOOP
|
||||
NCSSTRAT = 1
|
||||
ELSEIF (IFURBAN.EQ.0.AND.IFTROP.EQ.0.AND.IFSTRAT.EQ.0) THEN
|
||||
IFCHEM = 0
|
||||
IFSOLVE = 0
|
||||
ELSE
|
||||
WRITE(6,265)
|
||||
CALL GEOS_CHEM_STOP
|
||||
ENDIF
|
||||
ENDIF
|
||||
C
|
||||
265 FORMAT('READER: NEED IFURBAN, IFSTRAT, IFTROP ALL = 1 OR JUST ',
|
||||
1 'ONE = 1')
|
||||
C
|
||||
C ITESTGEAR = 1: TEST SMVGEAR TO ACCURATE SOLUTION FOUND IN compare.dat
|
||||
C ITESTGEAR = 2: GENERATE SMVGEAR ACCURATE SOLUTION AND WRITE TO compare.dat
|
||||
C
|
||||
IF (ITESTGEAR.EQ.2) THEN
|
||||
ERRMAXU = 1.00d-09
|
||||
ERRMAXR = 1.00d-09
|
||||
ERRMAXS = 1.00d-09
|
||||
C
|
||||
YLOWU = 1.00d-10
|
||||
YLOWR = 1.00d-10
|
||||
YLOWS = 1.00d-10
|
||||
C
|
||||
YHIU = 1.00d-10
|
||||
YHIR = 1.00d-10
|
||||
YHIS = 1.00d-10
|
||||
ENDIF
|
||||
C
|
||||
DO 269 NCS = 1, ICS
|
||||
ABTOL(1,NCS) = 0.d0
|
||||
ABTOL(6,NCS) = 0.d0
|
||||
269 CONTINUE
|
||||
C
|
||||
C URBAN / REGIONAL / STRATOSPHERIC CHEMISTRY TOGETHER
|
||||
C
|
||||
IF (NCSALL.GT.0) THEN
|
||||
NCS = NCSALL
|
||||
NCSP = NCS + ICS
|
||||
CHEMTYP( NCS) = 'URB/REG/STR'
|
||||
ERRMAX( NCS) = ERRMAXU
|
||||
ABTOL(1, NCS) = YHIU
|
||||
ABTOL(6, NCS) = YLOWU
|
||||
TIMEINTV( NCS) = CHEMINTV
|
||||
ABST2( NCS) = 1. / (CHEMINTV * CHEMINTV)
|
||||
HMAXUSE( NCS) = HMAXDAYU
|
||||
HMAXUSE( NCSP) = HMAXNIT
|
||||
ENDIF
|
||||
C
|
||||
C REGIONAL / STRATOSPHERIC CHEMISTRY TOGETHER
|
||||
C
|
||||
IF (NCSTRST.GT.0) THEN
|
||||
NCS = NCSTRST
|
||||
NCSP = NCS + ICS
|
||||
CHEMTYP( NCS) = 'REG/STR'
|
||||
ERRMAX( NCS) = ERRMAXR
|
||||
ABTOL(1, NCS) = YHIR
|
||||
ABTOL(6, NCS) = YLOWR
|
||||
TIMEINTV( NCS) = CHEMINTV
|
||||
ABST2( NCS) = 1. / (CHEMINTV * CHEMINTV)
|
||||
HMAXUSE( NCS) = HMAXDAYR
|
||||
HMAXUSE( NCSP) = HMAXNIT
|
||||
ENDIF
|
||||
C
|
||||
C URBAN CHEMISTRY
|
||||
C
|
||||
IF (NCSURBAN.GT.0) THEN
|
||||
NCS = NCSURBAN
|
||||
NCSP = NCS + ICS
|
||||
CHEMTYP( NCS) = 'URBAN'
|
||||
ERRMAX( NCS) = ERRMAXU
|
||||
ABTOL(1, NCS) = YHIU
|
||||
ABTOL(6, NCS) = YLOWU
|
||||
TIMEINTV(NCS) = CHEMINTV
|
||||
ABST2( NCS) = 1. / (CHEMINTV * CHEMINTV)
|
||||
HMAXUSE( NCS) = HMAXDAYU
|
||||
HMAXUSE(NCSP) = HMAXNIT
|
||||
ENDIF
|
||||
C
|
||||
C TROPOSPHERIC CHEMISTRY
|
||||
C
|
||||
IF (NCSTROP.GT.0) THEN
|
||||
NCS = NCSTROP
|
||||
NCSP = NCS + ICS
|
||||
CHEMTYP( NCS) = 'TROPOSPHERIC'
|
||||
ERRMAX( NCS) = ERRMAXR
|
||||
ABTOL(1, NCS) = YHIR
|
||||
ABTOL(6, NCS) = YLOWR
|
||||
TIMEINTV(NCS) = CHEMINTV
|
||||
ABST2( NCS) = 1.d0 / (CHEMINTV * CHEMINTV)
|
||||
HMAXUSE( NCS) = HMAXDAYR
|
||||
HMAXUSE(NCSP) = HMAXNIT
|
||||
ENDIF
|
||||
C
|
||||
C STRATOSPHERIC CHEMISTRY
|
||||
C
|
||||
IF (NCSSTRAT.GT.0) THEN
|
||||
NCS = NCSSTRAT
|
||||
NCSP = NCS + ICS
|
||||
CHEMTYP( NCS) = 'STRATOSPHERIC'
|
||||
ERRMAX( NCS) = ERRMAXS
|
||||
ABTOL(1, NCS) = YHIS
|
||||
ABTOL(6, NCS) = YLOWS
|
||||
TIMEINTV(NCS) = CHEMINTV
|
||||
ABST2( NCS) = 1.d0 / (CHEMINTV * CHEMINTV)
|
||||
HMAXUSE( NCS) = HMAXDAYS
|
||||
HMAXUSE(NCSP) = HMAXNIT
|
||||
ENDIF
|
||||
C
|
||||
C CALCULATE ALL POSSIBLE REMAINING ABSOLUTE ERROR TOLERANCES
|
||||
C
|
||||
DO 272 NCS = 1, NCSGAS
|
||||
ABHI = LOG10(ABTOL(1,NCS))
|
||||
ABLO = LOG10(ABTOL(6,NCS))
|
||||
C
|
||||
IF (ABHI.LT.ABLO) THEN
|
||||
WRITE(6,*)'READER: ABHI < ABLO - INCREASE UPPER BOUND OF',
|
||||
1 'ABSOLUTE ERROR TOLERANCE FOR NCS = ',NCS,
|
||||
2 ABTOL(1,NCS),ABTOL(6,NCS)
|
||||
CALL GEOS_CHEM_STOP
|
||||
ENDIF
|
||||
C
|
||||
DO 270 I = 2, 5
|
||||
ABTOL(I,NCS) = 10.d0**(ABLO + (ABHI - ABLO) *FLOAT(6-I) / 5.d0)
|
||||
270 CONTINUE
|
||||
272 CONTINUE
|
||||
C
|
||||
C *********************************************************************
|
||||
C
|
||||
NMREAC = 3
|
||||
NALLREAC = 4
|
||||
NMPROD = 14
|
||||
NPRODLO = NALLREAC + 1
|
||||
NPRODHI = NALLREAC + NMPROD
|
||||
IFDID = 0
|
||||
IFNEVER = 0
|
||||
IFNONE = 0
|
||||
NSFTOT = 0
|
||||
NPDTOT = 0
|
||||
NSTTOT = 0
|
||||
IFAILTOT = 0
|
||||
LFAILTOT = 0
|
||||
NFAILTOT = 0
|
||||
NOCC = 0
|
||||
SUMAVGE = 0.d0
|
||||
SUMAVHI = 0.d0
|
||||
SUMRMSE = 0.d0
|
||||
SUMRMHI = 0.d0
|
||||
TOTSTEP = 0.d0
|
||||
TOTIT = 0.d0
|
||||
TELAPS = 0.d0
|
||||
RMSERR = 0.d0
|
||||
C
|
||||
MB1 = 1
|
||||
MB2 = 2
|
||||
DO 660 I = 1, IMASBAL
|
||||
MBCOMP(I,MB1) = 0.d0
|
||||
MBCOMP(I,MB2) = 0.d0
|
||||
660 CONTINUE
|
||||
C
|
||||
DO 705 NCS = 1, ICS
|
||||
NAMENCS(0,NCS) = ' '
|
||||
NMOTH( NCS) = 0
|
||||
NTSPEC( NCS) = 0
|
||||
JPHOTRAT( NCS) = 0
|
||||
ISGAINR( NCS) = 0
|
||||
ISPORL( NCS) = 0
|
||||
NOGAINE( NCS) = 0
|
||||
NOUSE( NCS) = 0
|
||||
NSPEC( NCS) = 0
|
||||
NTRATES( NCS) = 0
|
||||
ISGAINE( NCS) = 0
|
||||
NSPCSOLV( NCS) = 0
|
||||
ISCHANG( NCS) = 0
|
||||
NRATES( NCS) = 0
|
||||
NM3BOD( NCS) = 0
|
||||
ITWOR( NCS) = 0
|
||||
ITHRR( NCS) = 0
|
||||
INOREP( NCS) = 0
|
||||
NRATCUR( NCS) = 0
|
||||
NSURFACE( NCS) = 0
|
||||
NPRESM( NCS) = 0
|
||||
NMAIR( NCS) = 0
|
||||
NMO2( NCS) = 0
|
||||
NMN2( NCS) = 0
|
||||
NNEQ( NCS) = 0
|
||||
NARR( NCS) = 0
|
||||
NABR( NCS) = 0
|
||||
NACR( NCS) = 0
|
||||
NABC( NCS) = 0
|
||||
NKSPECW( NCS) = 0
|
||||
NKSPECX( NCS) = 0
|
||||
NKSPECY( NCS) = 0
|
||||
NKSPECZ( NCS) = 0
|
||||
705 CONTINUE
|
||||
|
||||
! Zero out entire nkspecv array (bdf, 4/1/03)
|
||||
NKSPECV = 0d0
|
||||
C
|
||||
DO 710 NCS = 1, ICP
|
||||
NOLOSP( NCS) = 0
|
||||
NGNFRAC( NCS) = 0
|
||||
NOLOSRAT( NCS) = 0
|
||||
IARRAY( NCS) = 0
|
||||
NALLRAT( NCS) = 0
|
||||
KZTLO( NCS) = 0
|
||||
KZTHI( NCS) = 0
|
||||
IONER( NCS) = 0
|
||||
NPLLO( NCS) = 0
|
||||
NPLHI( NCS) = 0
|
||||
NFRLO( NCS) = 0
|
||||
NFRHI( NCS) = 0
|
||||
NPDLO( NCS) = 0
|
||||
NPDHI( NCS) = 0
|
||||
710 CONTINUE
|
||||
C
|
||||
DO 715 NCS = 1, ICS
|
||||
DO 714 I = 1, MAXGL
|
||||
FRACP( I,NCS) = 0
|
||||
IGNFRAC( I,NCS) = 0
|
||||
NKGNFRAC(I,NCS) = 0
|
||||
714 CONTINUE
|
||||
715 CONTINUE
|
||||
C
|
||||
DO 720 NCS = 1, ICS
|
||||
DO 719 I = 1, MAXGL2
|
||||
NREACOTH(I,NCS) = 0
|
||||
LGASBINO(I,NCS) = 0
|
||||
719 CONTINUE
|
||||
720 CONTINUE
|
||||
C
|
||||
DO 725 NCS = 1, ICS
|
||||
DO 724 I = 1, MAXGL3
|
||||
NKNLOSP( I,NCS) = 0
|
||||
LOSINACP(I,NCS) = 0
|
||||
NREACAIR(I,NCS) = 0
|
||||
NREAC3B( I,NCS) = 0
|
||||
NREACEQ( I,NCS) = 0
|
||||
NREQOTH( I,NCS) = 0
|
||||
NREACN2( I,NCS) = 0
|
||||
NREACO2( I,NCS) = 0
|
||||
NREACPM( I,NCS) = 0
|
||||
LGAS3BOD(I,NCS) = 0
|
||||
724 CONTINUE
|
||||
725 CONTINUE
|
||||
C
|
||||
DO 735 NCS = 1, ICS
|
||||
DO 734 I = 1, MXGSAER
|
||||
NAMENCS( I,NCS) = ' '
|
||||
FRACGAIN(I,NCS) = 0.d0
|
||||
QBKCHEM( I,NCS) = 0.d0
|
||||
NUMLOST( I,NCS) = 0
|
||||
NUMGFRT( I,NCS) = 0
|
||||
NUMGAINT(I,NCS) = 0
|
||||
NGAINE( I,NCS) = 0
|
||||
IGAINR( I,NCS) = 0
|
||||
IPORL( I,NCS) = 0
|
||||
IGAINE( I,NCS) = 0
|
||||
ISOLVSPC(I,NCS) = 0
|
||||
INEWOLD( I,NCS) = 0
|
||||
MAPPL( I,NCS) = 0
|
||||
734 CONTINUE
|
||||
735 CONTINUE
|
||||
C
|
||||
DO 740 NCS = 1, ICP
|
||||
DO 739 I = 1, MXGSAER
|
||||
NUMLOSS( I,NCS) = 0
|
||||
NUMGAIN( I,NCS) = 0
|
||||
NUMPORL( I,NCS) = 0
|
||||
739 CONTINUE
|
||||
740 CONTINUE
|
||||
C
|
||||
DO 745 NCS = 1, ICS
|
||||
DO 744 I = 1, NMTRATE
|
||||
I1 = NMTRATE + I
|
||||
ARR( I,NCS) = 0.d0
|
||||
BRR( I,NCS) = 0.d0
|
||||
FCV( I,NCS) = 0.d0
|
||||
FCTEMP1( I,NCS) = 0.d0
|
||||
FCTEMP2( I,NCS) = 0.d0
|
||||
NKARR( I,NCS) = 0
|
||||
NKABR( I,NCS) = 0
|
||||
NKACR( I,NCS) = 0
|
||||
NKABC( I,NCS) = 0
|
||||
IRORD( I,NCS) = 0
|
||||
IAPROD( I,NCS) = 0
|
||||
NOLOSRN( I,NCS) = 0
|
||||
NRUSE( I,NCS) = 0
|
||||
NRREP( I,NCS) = 0
|
||||
NPRODUC( I,NCS) = 0
|
||||
NCEQUAT( I,NCS) = 0
|
||||
NOLDFNEW(I,NCS) = 0
|
||||
NEWFOLD( I,NCS) = 0
|
||||
NEWFOLD(I1,NCS) = 0
|
||||
NKONER( I,NCS) = 0
|
||||
NKTWOR( I,NCS) = 0
|
||||
NKTHRR( I,NCS) = 0
|
||||
KCRR( I,NCS) = 0
|
||||
JPHOTNK( I,NCS) = 0
|
||||
744 CONTINUE
|
||||
745 CONTINUE
|
||||
C
|
||||
DO 755 NCS = 1, ICS
|
||||
DO 754 J = 1, IPHOT
|
||||
NKPHOTRAT(J,NCS) = 0
|
||||
NPPHOTRAT(J,NCS) = 0
|
||||
NKNPHOTRT(J,NCS) = 0
|
||||
754 CONTINUE
|
||||
755 CONTINUE
|
||||
C
|
||||
DO 765 NCS = 1, ICP
|
||||
DO 764 I = 1, MXGSAER
|
||||
JARRDIAG(I,NCS) = 0
|
||||
JLOZ1( I,NCS) = 0
|
||||
JHIZ1( I,NCS) = 0
|
||||
IJTLO( I,NCS) = 0
|
||||
IJTHI( I,NCS) = 0
|
||||
IMZTOT( I,NCS) = 0
|
||||
764 CONTINUE
|
||||
765 CONTINUE
|
||||
|
||||
DO 770 NCS = 1, ICS
|
||||
DO 769 NK = 1, NMTRATE
|
||||
DO 768 I = 1, NMRPROD
|
||||
IRM( I,NK,NCS) = 0
|
||||
IRM2( I,NK,NCS) = 0
|
||||
FKOEF(I,NK,NCS) = 0.d0
|
||||
FK2( I,NK,NCS) = 0.d0
|
||||
768 CONTINUE
|
||||
769 CONTINUE
|
||||
770 CONTINUE
|
||||
C
|
||||
DO 775 NCS = 1, ICS
|
||||
DO 774 J = 1, MAXGL
|
||||
DO 773 I = 1, MXGSAER
|
||||
JPORL(I,J,NCS) = 0
|
||||
773 CONTINUE
|
||||
774 CONTINUE
|
||||
775 CONTINUE
|
||||
|
||||
! Set NCS=NCSURBAN here since we have defined our tropospheric
|
||||
! chemistry mechanism in the urban slot of SMVGEAR II
|
||||
NCS = NCSURBAN
|
||||
C
|
||||
C *********************************************************************
|
||||
C ********************** END OF SUBROUTINE READER *********************
|
||||
C *********************************************************************
|
||||
C
|
||||
100 FORMAT(A72)
|
||||
110 FORMAT(32X,'SMVGEAR II')
|
||||
115 FORMAT(//,35X,'***** MAIN SWITCHES',
|
||||
1 ' *****',/)
|
||||
C
|
||||
RETURN
|
||||
END SUBROUTINE READER
|
||||
Reference in New Issue
Block a user