! $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