! $Id: readchem.f,v 1.1 2009/06/09 21:51:53 daven Exp $ SUBROUTINE READCHEM ! !****************************************************************************** ! Subroutine READCHEM reads species 2names, chemical rxns, and photolysis ! reactions from the "globchem.dat" chemistry mechanism file for SMVGEAR II. ! (M. Jacobson 1997; bdf, bmy, 5/9/03, 8/9/06) ! ! NOTES: ! (1 ) Added space in FORMAT strings for more products. Also now references ! MAXDEP from "drydep_mod.f". Now also writes species and reactions ! to the "smv2.log" output file as unit #93. Now call GEOS_CHEM_STOP ! to deallocate all arrays and stop the run safely. Add NNADDG and ! NKSPECG for DMS+OH+O2 rxn. Now also force double precision with ! the "D" exponent. Now call SETPL before JSPARSE so that the prod/loss ! families will be computed correctly. (bmy, 5/9/03) ! (2 ) Now initialize ICH4 -- the location of CH4 in the CSPEC array. Now ! define lookup table ITS_NOT_A_ND65_FAMILY, which is used to exclude ! ND65 prod/loss families from modifying the SMVGEAR II convergence ! criteria. (bnd, bmy, 7/9/03) ! (3 ) Now declare ININT as a local variable instead of being declared w/in ! "comode.h". Remove reference to IPORD. (bmy, 7/16/03) ! (4 ) Now flag the N2O5 hydrolysis rxn for later use. (mje, bmy, 8/7/03) ! (5 ) Now references SETJFAM & SETPL from "diag_pl_mod.f" (bmy, 7/20/04) ! (6 ) Now look up ILISOPOH, the index of ISOP lost to OH (dkh, bmy, 6/1/06) ! (7 ) Increase FORMAT 510 so that it has space for 14 products (bmy, 8/9/06) ! (8 ) Now flag the HO2 heterogeneous uptake rxn for later use ! (jaegle, 02/26/09) ! (9 ) Added identifier to mark branching rxns for HOC2H4O (tmf, 1/7/09) ! HOC2H4O ------> HO2 + 2CH2O : marked as 'F' in P column ! HOC2H4O --O2--> HO2 + GLYC : marked as 'H' in P column ! ! The same branching rxns are also implemented in EP photolysis ! HOC2H4O ------> HO2 + 2CH2O : marked as 'I' in P column ! HOC2H4O --O2--> HO2 + GLYC : marked as 'J' in P column !****************************************************************************** ! ! References to F90 modules USE DRYDEP_MOD, ONLY : MAXDEP USE ERROR_MOD, ONLY : GEOS_CHEM_STOP USE DIAG_PL_MOD, ONLY : SETJFAM, SETPL IMPLICIT NONE # include "CMN_SIZE" ! Size parameters # include "comode.h" ! SMVGEAR II arrays C C ********************************************************************* C ************ WRITTEN BY MARK JACOBSON (1990-4) ************ C *** (650) 723-6836 *** C ********************************************************************* C C RRRRRR EEEEEEE A DDDDDD CCCCCCC H H EEEEEEE M M C R R E A A D D C H H E M M M M C RRRRRR EEEE A A D D C HHHHHHH EEEEEEE M M M C R R E AAAAAAA D D C H H E M M C R R EEEEEEE A A DDDDDD CCCCCCC H H EEEEEEE M M C C ********************************************************************* C * THIS IS THE SETUP ROUTINE FOR GAS-PHASE CHEMISTRY. IT READS * C * SPECIES NAMES, CHEMICAL REACTIONS, AND PHOTOPROCESSES FROM AN * C * INPUT DATA SET. IT THEN PLACES ALL NECESSARY INFORMATION INTO * C * ARRAYS AND PRINTS OUT THE INPUT INFORMATION. * C * * C * HOW TO CALL SUBROUTINE: * C * ---------------------- * C * CALL READCHEM.F FROM MAIN.F * C * * C ********************************************************************* C C ********************************************************************* C * SOME PARAMETER DEFINITIONS * C ********************************************************************* C C DEFPRAT = DEFAULT PHOTORATE (SEC-1) C IGAS = DIMENSION OF MAXIMUM NUMBER OF GAS SPECIES, ACTIVE + INACTIVE. C IPHOT = MAXIMUM NUMBER OF RADIATIVELY ACTIVE SPECIES C IPORD = ORDINAL # OF PHOTOPROCESS (USED TO IDENTIFY REACTION) C IRORD = ORDINAL # OF KINET. REACT. (USED TO IDENTIFY REACTION) C JMBCOMP = SPECIES NUMBER FOR EACH SPECIES IN A MASS BAL. GROUP C MBCOMP = COUNTS THE MASS BALANCE SPECIES IN EACH M.B. GROUP (I.E. C SULFUR IS A M.B. GROUP. C NACTIVE = NUMBER OF ACTIVE SPECIES READ IN -- (A) IN COLUMN ONE C OF INPUT DATA SET, CONVERTED TO NSPEC LATER C NALLREAC = TOTAL NUMBER OF REACTANT POSITIONS IN A REACTION (BUT C NUMBER OF ACTIVE POSITIONS IN NMREAC) C NAMD = NAMES OF SPECIES WHICH MAY APPEAR IN REACTIONS BUT WHICH ARE C "DEAD" WITH RESPECT TO THE PHOTOCHEMISTRY AND THUS ARE NOT C PRINTED OUT. C NAMEGAS = CHARACTER ARRAY OF SPECIES NAMES. C NAMENCS = CHARACTER ARRAY OF SPECIES NAMES. C NCS = 1..NCSGAS FOR GAS CHEMISTRY C NGAS = NSPEC, THE NUMBER OF ACTIVE SPECIES C NINAC = NUMBER OF INACTIVE SPECIES READ -- (I) IN COLUMN ONE C NMAIR = # REACTIONS WHERE THE SPECIES IN THE THIRD POSITION C IS 'M' = 'O2 + N2' C NMASBAL = NUMBER OF MASS BALANCE GROUPS (E.G. S, N, C ARE GROUPS) C NMN2 = # REACTIONS WHERE SPECIES IN THE THIRD POSITION IS N2 C NMO2 = # REACTIONS WHERE SPECIES IN THE THIRD POSITION IS O2 C NM3BOD = # REACTIONS WHERE SPECIES IN THE THIRD POSITION C IS ANY OTHER SPECIES: IRM(3,NK) = -SPECIES NUMBER C NMPROD = MAXIMUM NUMBER OF ACTIVE PRODUCTS IN A REACTION (READER.F) C NMREAC = MAXIMUM NUMBER OF ACTIVE REACTANTS IN A REACTION C OF INPUT DATA SET. (DEFINED IN READER.F) C NNEQ = # THERMALLY DISSOCIATING EQUILIBRIUM REACTIONS. PREVIOUS C EQUATION MUST BE PRESSURE-DEPENDENT. C NPHOTALL = NUMBER OF ACTIVE GAS PHOTOPROCESSES C NPRESM = # PRESSURE DEPENDENT 3-BODY REACTIONS C NPRODHI = HIGHEST PRODUCT POSITON IN A REACTION C NPRODLO = LOWEST PRODUCT POSITON IN A REACTION C NRATES = NUMBER OF ACTIVE REACTIONS (EXCLUDING PHOTPROCESSES) C NSDEAD = NUMBER OF DEAD SPECIES READ IN -- (D) IN COLUMN ONE OF C INPUT DATA SET. C NSPEC = TOTAL NUMBER OF ACTIVE SPECIES. C NTRATES = NUMBER OF ACTIVE KINETIC REACTIONS PLUS PHOTOPROCESSES C NTSPEC = ACTUAL NUMBER OF ACTIVE + INACTIVE (BUT NOT DEAD) SPECIES. C QBKGAS = DEFAULT BACKGROUND CONCENTRATION (VOL MIXING RATIO) C RINP = CHARACTER ARRAY FOR READING IN INFORMATION FROM DATA SETS. C WTMB = MASS BALANCE WEIGHT FOR EACH M. B. SPECIES C XINP = CHARACTER ARRAY FOR READING IN INFORMATION FROM DATA SETS. C C ********************************************************************* C * SET INITIAL VALUES AND READ INITIAL COMMENTS FROM INPUT DATA SET * C ********************************************************************* C INTEGER NINAC,NACTIVE,NSDEAD,NOTHGS,IDOPHOT,I,NMBGAS,NM,JGAS INTEGER MB,MBP,INACT1,JGAS1,J,IORD,NCOF,JORD,NDUM,NK,NAR,NK1 INTEGER JPR,JNUM,ITHIRDB,NM2,NR,NN,JGAS2,JGAS3,NA,N,NS2 REAL*8 C1,CSTRAT,CTROPL,CTROPS,CURBAN,QTHERMG ! ININT used to be defined w/in "comode.h", but it is only ever used ! w/in "readchem.f". Declare here as a local variable. (bmy, 7/16/03) INTEGER :: ININT(10) !================================================================= ! READCHEM begins here! !================================================================= NINAC = 0 NACTIVE = 0 NSDEAD = 0 NOTHGS = 0 NPHOTALL = 0 IDOPHOT = 0 C NAMEGAS(0) = ' ' C ! Initialize flag for N2O5 hydrolysis rxn (bmy, 8/7/03) NKN2O5 = 0 ! Initialize flag for HO2 hydrolysis rxn (jaegle, 02/26/09) NKHO2 = 0 DO 44 I = 1, NMDEAD NAMD(I) = ' ' 44 CONTINUE C DO 46 I = 1, IGAS NAMEGAS(I) = ' ' WTGAS( I) = 0.d0 QBKGAS( I) = 0.d0 46 CONTINUE C DO 47 I = 1, MXGSAER CPREV( I) = 0.d0 CMODEL(I) = 0.d0 47 CONTINUE C DO 48 I = 1, MAXGL4 NKSURF(I) = 0 NCOATG(I) = 0 48 CONTINUE C DO 49 I = 1, IPHOT DEFPRAT(I,:) = 0.d0 49 CONTINUE C READ(KGLC,21) HEADING !WRITE(6,21) HEADING 13 READ(KGLC,21) HEADING IF (HEADING.NE.'BEGIN') GOTO 13 21 FORMAT(A76) C C ********************************************************************* C READ IN MASS BALANCE GROUPS USED C ********************************************************************* C NMBGAS = 9 READ(KGLC,59) (RINP(I), I = 1, NMBGAS) READ(KGLC,61) (SINP(I), I = 1, NMBGAS) C DO 36 I = 1, NMBGAS MBTRACE(I) = 0 IF (SINP(I).EQ.'A') THEN DO 34 NM = 1, NMASBAL IF((NAMEMB(NM).EQ.'SULFUR ATOMS' .AND.RINP(I).EQ.'SUL').OR. 1 (NAMEMB(NM).EQ.'NITROGEN NO3' .AND.RINP(I).EQ.'NO3').OR. 2 (NAMEMB(NM).EQ.'NITROGEN NH4' .AND.RINP(I).EQ.'NH4').OR. 3 (NAMEMB(NM).EQ.'CARBON ATOMS' .AND.RINP(I).EQ.'CAR').OR. 4 (NAMEMB(NM).EQ.'CHLORINE ATOMS'.AND.RINP(I).EQ.'CHL').OR. 5 (NAMEMB(NM).EQ.'BROMINE ATOMS' .AND.RINP(I).EQ.'BRO').OR. 6 (NAMEMB(NM).EQ.'FLOURINE ATOMS'.AND.RINP(I).EQ.'FLO').OR. 7 (NAMEMB(NM).EQ.'HYDROGEN ATOMS'.AND.RINP(I).EQ.'HYD').OR. 8 (NAMEMB(NM).EQ.'OXYGEN ATOMS' .AND.RINP(I).EQ.'OXY'))THEN MBTRACE(I) = NM GOTO 36 ENDIF 34 CONTINUE WRITE(6,33) RINP(I) CALL GEOS_CHEM_STOP ENDIF C 36 CONTINUE C 59 FORMAT(20X,A3,8(1X,A3)) 61 FORMAT(21X,A1,8(3X,A1)) 33 FORMAT('READCHEM: MASS BALANCE GROUP ',A14,' NOT SET') C C ********************************************************************* C * READ IN THE SPECIES AND OTHER DATA FOR THIS RUN FROM INPUT DATA * C ********************************************************************* C C ITEMS IN THE FIRST READ STATEMENT C --------------------------------- C C A/I/D C D = SPECIES IS DEAD AND NOT USED C I = INACTIVE BUT USED (THESE SPECIES MUST ALSO BE INITIALIZED) C A = SPECIES USED WHEN IFURBAN, IFTROP, OR IFSTRAT > 0 C (URBAN, TROPSOSPHERIC AND STRATOSPHERIC SETS) C U = SPECIES USED WHEN IFURBAN > 0 C S = SPECIES USED WHEN IFSTRAT > 0 C T = SPECIES USED WHEN IFTROP > 0 C R = SPECIES USED WHEN IFURBAN OR IFTROP > 0 C H = SPECIES USED WHEN IFTROP OR IFSTRAT > 0 C SPEC = NAME OF THE SPECIES, C AB TELLS WHETHER SPECIES ABSORBS RADIATION (THE SPECIES C DOES NOT NECESSARILY PHOTOLYZE) C MW = ATOMIC MASS IN AMU; C IFSTRAT = 1: SOLVE STRATOSPHERIC CHEMISTRY C IFTROP = 1: SOLVE FREE TROPOSPHERIC CHEMISTRY C IFURBAN = 1: SOLVE URBAN CHEMISTRY C INITCONC = DEF'T BACKGROUND CONC. AT LOWEST LEVEL (VOL MIXING RATIO); C CSTRAT = DEFAULT VOL MIX RATIO (FRACTION) IN STRATOSPHERE (25 KM) C CTROPL = DEFAULT VOL MIX RATIO (FRACTION) IN FREE TROP OVER LAND (0 KM) C CTROPS = DEFAULT VOL MIX RATIO (FRACTION) IN FREE TROP OVER SEA (0 KM) C CURBAN = DEFAULT VOL MIX RATIO (FRACTION) IN URBAN REGIONS (0 KM) C C ********************************************************************* C ******************** READ IN SPECIES INFORMATION ******************** C ********************************************************************* C C FORMAT OF ITEMS IN THE SPECIES-LIST READ STATEMENT C C A/I/D SPEC AB MW CSTRAT CTROPL CTROPS CURBAN C A1,1X, A14,A2,1X,F6.0,E9.2, E9.2, E9.2 E9.2 C C S NO3 NH4 C CL BR F H O C 20X, I2,2X,I2,2X,I2,2X,I2,2X,I2,2X,I2,2X,I2,2X,I2,2X,I2 C ! Read 1st line of species list 10 READ(KGLC,11) (XINP(I), I=1,3),C1,CSTRAT,CTROPL,CTROPS,CURBAN 11 FORMAT(A1,1X,A14,A2,1X,0PF6.2,4(1PE10.3)) ! Test for "END" here (bmy, 4/7/03) IF (XINP(2).EQ.'END') GOTO 15 ! Read 2nd line of species list READ(KGLC,14) (ININT(I),I = 1, NMBGAS) 14 FORMAT(20X,I2,8(2X,I2)) C C ********************************************************************* C * COUNT ACTIVE, INACTIVE, AND DEAD SPECIES. ALSO, SET UP ARRAYS * C * FOR OTHER INFORMATION. * C ********************************************************************* IF (XINP(2).EQ.'END') GOTO 15 C IF (XINP(1).EQ.'U'.OR.XINP(1).EQ.'T'.OR.XINP(1).EQ.'S'.OR. 1 XINP(1).EQ.'R'.OR.XINP(1).EQ.'H') THEN IF ((XINP(1).EQ.'U'.AND.IFURBAN.EQ.0).OR. 1 (XINP(1).EQ.'T'.AND.IFTROP .EQ.0).OR. 2 (XINP(1).EQ.'S'.AND.IFSTRAT.EQ.0).OR. 3 (XINP(1).EQ.'R'.AND.IFURBAN.EQ.0.AND.IFTROP.EQ.0).OR. 4 (XINP(1).EQ.'H'.AND.IFSTRAT.EQ.0.AND.IFTROP.EQ.0)) THEN XINP(1) = 'D' ELSE XINP(1) = 'A' ENDIF ENDIF C IF (XINP(1).EQ.'D') THEN NSDEAD = NSDEAD + 1 NAMD(NSDEAD) = XINP(2) GOTO 10 ELSEIF (XINP(1).EQ.'I') THEN NINAC = NINAC + 1 JGAS = IGAS - NINAC + 1 ELSEIF (XINP(1).EQ.'A') THEN NACTIVE = NACTIVE + 1 JGAS = NACTIVE C DO 41 I = 1, NMBGAS MB = MBTRACE(I) IF (MB.GT.0.AND.ININT(I).GT.0) THEN MBCOMP(MB,MB1) = MBCOMP(MB,MB1) + 1 MBP = MBCOMP(MB,MB1) JMBCOMP(MB,MBP,MB1) = NACTIVE WTMB(MB,NACTIVE,MB1) = ININT(I) ENDIF 41 CONTINUE ELSE WRITE(6,19) XINP(2), XINP(1) CALL GEOS_CHEM_STOP ENDIF C NAMEGAS(JGAS) = XINP(2) WTGAS( JGAS) = C1 C IF (IFSTRAT.EQ.1.AND.IFTROP.EQ.0.AND.IFURBAN.EQ.0) THEN QBKGAS( JGAS) = CSTRAT ELSEIF (IFSTRAT.EQ.0.AND.IFTROP.EQ.1.AND.IFURBAN.EQ.0) THEN QBKGAS( JGAS) = CTROPL ELSEIF (IFSTRAT.EQ.0.AND.IFTROP.EQ.0.AND.IFURBAN.EQ.1) THEN QBKGAS( JGAS) = CURBAN ELSE QBKGAS( JGAS) = CTROPL ENDIF C GOTO 10 C C ********************************************************************* C * SET NSPEC AS NUMBER OF ACTIVE SPECIES - 1 SINCE JUST INCREASED * C * NACTIVE BEFORE THE 'END' STATEMENT. ALSO, CHECK SOME DIMENSIONS. * C ********************************************************************* C 15 CONTINUE NGAS = NACTIVE NTSPECGAS = NGAS + NINAC !================================================================= ! Chemical prod-loss diagnostic (bdf, bmy, 4/18/03) !================================================================= IF ( LFAMILY ) THEN ! Find species and rxns for ND65 diagnostic families CALL SETJFAM( NACTIVE, NINAC ) ! Reset quantities after SETJFAM NSPEC(NCS) = NACTIVE - 1 NGAS = NSPEC(NCS) NTSPECGAS = NGAS + NINAC NTSPEC(NCS) = NGAS + NINAC ENDIF C IF (NTSPECGAS.GT.IGAS .OR. NSDEAD.GT. NMDEAD) THEN WRITE(6,18) IGAS, NTSPECGAS, NMDEAD, NSDEAD CALL GEOS_CHEM_STOP ENDIF C 18 FORMAT('READCHEM: ONE OF THE DIMENSIONS BELOW IS TOO SMALL:',/, 1 'DIMENSION: IGAS = ',I3,' VARIABLE: NTSPECGS = ',I3,/, 2 'DIMENSION: NMDEAD = ',I3,' VARIABLE: NSDEAD = ',I3) C C ********************************************************************* C * RE-ARRANGE INACTIVE GAS ARRAYS SO THAT INFORMATION OF INACTIVE * C * SPECIES APPEARS IMMEDIATELY AFTER INFORMATION OF ACTIVE SPECIES * C ********************************************************************* C IF (NINAC.GT.0) THEN INACT1 = IGAS - NINAC DO 26 N = 1, NINAC JGAS = NGAS + N JGAS1 = INACT1 + N NAMEGAS(JGAS) = NAMEGAS(JGAS1) QBKGAS( JGAS) = QBKGAS( JGAS1) WTGAS( JGAS) = WTGAS( JGAS1) 26 CONTINUE END IF C C ********************************************************************* C * PRINT SPECIES INFORMATION IF IOSPEC = 1 + PRINT MASS BALANCE INFO * C ********************************************************************* C IF (IOSPEC.EQ.1) THEN ! Write species header WRITE( IO93, '(/,a)' ) REPEAT( '=', 79 ) WRITE( IO93, 23 ) WRITE( IO93, '(a,/)' ) REPEAT( '=', 79 ) WRITE( IO93, 22 ) ! Write species to "smv2.log" DO 25 N = 1, NGAS WRITE(IO93,24) N, NAMEGAS(N), WTGAS( N), QBKGAS(N) 25 CONTINUE IF (NINAC.GT.0) WRITE(IO93,28)(NAMEGAS(NGAS+N),N=1,NINAC) IF (NSDEAD.GT.0) WRITE(IO93,31)(NAMD(N),N=1,NSDEAD) END IF C WRITE(6,*) DO 77 I = 1, NMASBAL IF (MBCOMP(I,MB1).GT.0) THEN WRITE(6,98) NAMEMB(I) WRITE(6,99)(WTMB( I,JMBCOMP(I,J,MB1),MB1), 1 NAMEGAS(JMBCOMP(I,J,MB1)), J = 1, MBCOMP(I,MB1)) ENDIF 77 CONTINUE C 19 FORMAT('SPECIES ACTIVITY IS UNDEFINED ',A14,' TYPE = ',A2 ) 23 FORMAT('SPECIES FOR THIS RUN. PHYSICAL CONSTS AND BOUNDARY', 1 ' CONDITIONS ALSO GIVEN.') 22 FORMAT( 'NBR', 1X, 'NAME', 12X, 'MW', 1X, 'BKGAS(VMRAT)' ) 24 FORMAT(I3,1X, A14,F7.2,1PE9.2) 28 FORMAT(/'INACTIVE SPECIES FOR THIS RUN ARE:'//4(1X,A14)) 31 FORMAT(/'THE DEAD SPECIES FOR THIS RUN ARE:'//4(1X,A14)) 98 FORMAT('WEIGHTS AND SPECIES FOR MASS BALANCE EQUATION # ',A14) 99 FORMAT(4(0PF5.1,1X,A14)) C C ********************************************************************* C * SEARCH FOR SPECIFIC SPECIES NUMBERS USED IN OTHER SUBROUTINES * C ********************************************************************* C ! Initialize for safety's sake (bmy, 7/7/03) IOXYGEN = 0 IH2O = 0 ICH4 = 0 ILISOPOH =0 ! Locate positions of O2, H2O, CH4, LISOPOH in CSPEC array DO I = 1, NTSPECGAS SELECT CASE ( TRIM( NAMEGAS(I) ) ) CASE( 'O2' ) IOXYGEN = I CASE( 'H2O' ) IH2O = I CASE( 'CH4' ) ICH4 = I CASE( 'LISOPOH' ) ILISOPOH = I CASE DEFAULT ! Nothing END SELECT ENDDO C C ********************************************************************* C ***************** READ IN REACTION RATES *********************** C ********************************************************************* C C HERE, WE CAN HAVE 3 REACTANTS (EACH WITH COEFFICIENT OF 1) AND 12 C PRODUCTS [EACH WITH ANY REAL COEFFICIENT]. C FOR A 3-BODY M REACTION, PLACE AN M IN THE THIRD REACTANT POSITION C [NO [+] BEFORE IT] C FOR A 3-BODY OTHER SPECIES REACTION, PLACE THE SPECIES NAME IN THE THIRD C REACTANT POSITION [NO [+] BEFORE IT] C FOR A 3RD REACTANT, PLACE THE SPECIES NAME IN THE THIRD REACTANT POSITION C WITH A PLUS BEFORE IT. C FOR A REACTANT NOT INCLUDED IN THE REACTION RATE [I.E.02] PLACE THE C SPECIES NAME IN THE FOURTH REACTANT POSITION [NO [+] C BEFORE IT]. THE SPECIES MAY HAVE A COEFFICIENT PRECEDING IT. C A PRODUCT MAY EITHER BE LISTED TWICE [OR MORE TIMES] OR C HAVE A COEFFICIENT [I.E. 2 OR 3, 0.34] IMMEDIATELY BEFORE IT. C N COLUMN: NUMBER OF RATE COEFFICIENT LINES FOLLOWING TOP LINE C P COLUMN: C P = REACTION IS PRESSURE DEPENDENT 3-BODY REACTION. C THE FIRST COEFFICIENT IS A 3-BODY COEF. THE SECOND IS 2-BODY. C S = IDENTIFIES A ONE-BODY SURFACE REACTION C E = IDENTIFIES REVERSE EQUILIBRIUM REACTION C V = IDENTIFIES CH3SCH3 + OH --> CH3S(OH)CH3 C W = IDENTIFIES O(1D) + N2 OR O2 C X = IDENTIFIES OH + HNO3 C Y = IDENTIFIES OH + CO C Z = IDENTIFIES HO2 + HO2 C G = IDENTIFIES DMS + OH + O2 C K = IDENTIFIES WETDEP or HYDROLYSIS REACTIONS C C Fc COLUMN = VALUE OF Fc FOR THREE-BODY RATE REACTIONS (SEE REF 9, P.1145) C Fc(T) = Fc CALCULATED AS EXP(-T(K)/Fc(T)) C C REACTION RATES HAVE THE FORM K = A * (300 / T)**B * EXP(C / T) C C ********************************************************************* C * READ PRELIMINARY COMMENTS * C ********************************************************************* C C ----- REACTION RATE FORMAT ----- C C A/D ORD AR BR CR N P Fc FcT COM X +Y +Z IV =aA +bB +cC +dD +... C C A/D C D = REACTION IS DEAD. SKIP THIS REACTION. C A = REACTION ACTIVE AND INCLUDED IN ALL CHEMISTRY SETS C (URBAN, TROPSOSPHERIC AND STRATOSPHERIC SETS) C U = REACTION IN URBAN CHEMISTRY SET C S = REACTION IN STRATOSPHERIC CHEMISTRY SET C T = REACTION IN TROPOSPHERIC CHEMISTRY SET C R = REACTION IN TROPOSPHERIC AND URBAN CHEMISTRY SETS C H = REACTION IN TROPOSPHERIC AND STRATOSPHERIC CHEMISTRY SETS C ORD = ORDINAL NUMBER OF REACTION C AR,BR,CR = RATE COEFFICIENTS: K = AR * (300/T) * BR * EXP( CR / T) C AR = DEFAULT PHOTORATE (S-1) FOR PHOTOPROCESSES C NCOF = DESCRIBED IN 'N COLUMN' ABOVE C P = DESCRIBED IN 'P COLUMN' ABOVE C FCVT = CHARACTERIZES FALLOFF CURVE IN PRESSURE-DEPENDENT REACTION C FCT1T,2T = EXPONENTS GIVING TEMPERATURE DEPENDENCE OF FCVT C FCVT = EXP(-T/FCT1) OR C FCVT = EXP(-T/FCT1) + EXP(-FCT2/T) C COM = A9 AT THE END IS CURRENTLY FOR COMMENTS. C X,Y,Z = REACTANTS C Z = REACTANT OR 3RD BODY 'M' OR OTHER THIRD BODY C I = COEFFICIENT (INTEGER) FOR V C V = REACT NOT INCLUDED IN REACT. RATE, BUT WHICH IS LOST IN REACTION. C a,b,c,d. = COEFFICIENTS FOR PRODUCTS (1,2,3,0.45,1.32, ETC (>=0.)) C A,B,C,D.. = PRODUCTS C C ********************************************************************* C * READ REACTIONS * C ********************************************************************* C 102 READ(KGLC,21) HEADING IF (HEADING.NE.'BEGIN') GOTO 102 C 310 READ(KGLC,330) DINP,IORD,ARRT(1),BRRT(1),KCRRT(1),NCOF,SPECL(1), 1 FCVT(1),FCT1T(1),FCT2T(1),COMMENT IF (NCOF+1.GT.MXCOF) THEN WRITE(6,155) NCOF+1, MXCOF, IORD CALL GEOS_CHEM_STOP ENDIF C DO 350 I = 2, NCOF + 1 READ(KGLC,330) JST,JORD,ARRT(I),BRRT(I),KCRRT(I),NDUM,SPECL(I), 1 FCVT(I),FCT1T(I),FCT2T(I),COMMENT 350 CONTINUE C ! Now read 20 entries instead of 16 (bdf, bmy, 4/1/03) READ(KGLC,332) (RINP(I),PINP(I),XINP(I),I=1,20) C 155 FORMAT('READCHEM: NCOF + 1 > MXCOF IN GLOBCHEM.DAT',3I4) 330 FORMAT(A1,1X,I4,1X,ES8.2,1X,ES8.1,1X,I6,1X,I1,1X,A2,F6.2,1X, 1 2(F6.0,1X),A20) ! Increase format string to 14 products (bdf, 4/1/03) 332 FORMAT(4(A1,0PF5.3,A14)/4(A1,0PF5.3,A14)/ 1 4(A1,0PF5.3,A14)/4(A1,0PF5.3,A14)/4(A1,0PF5.3,A14)) C IF (DINP.NE.'A'.AND.DINP.NE.'U'.AND.DINP.NE.'T'.AND. 1 DINP.NE.'S'.AND.DINP.NE.'R'.AND.DINP.NE.'H') DINP = 'D' C IF ((DINP.EQ.'U'.AND.IFURBAN.EQ.0).OR. 1 (DINP.EQ.'T'.AND.IFTROP .EQ.0).OR. 2 (DINP.EQ.'S'.AND.IFSTRAT.EQ.0).OR. 3 (DINP.EQ.'R'.AND.IFURBAN.EQ.0.AND.IFTROP.EQ.0).OR. 4 (DINP.EQ.'H'.AND.IFSTRAT.EQ.0.AND.IFTROP.EQ.0)) DINP = 'D' C IF (XINP(1).EQ.'END KINETIC') THEN C DO 323 NCS = 1, NCSGAS NRATES(NCS) = NTRATES(NCS) 323 CONTINUE C IDOPHOT = 1 GOTO 102 ELSEIF (XINP(1).EQ.'END PHOTOLYSIS') THEN GOTO 660 ELSEIF (DINP.EQ.'D') THEN GOTO 310 ENDIF C C ********************************************************************* C * UPDATE REACTION NUMBER FOR REACTIONS THAT ARE USED * C ********************************************************************* C NRATCUR = CURRENT REACTION RATE NUMBER FOR A SET OF RATE COEFFICIENTS C NTRATES = CURRENT RATE COEFFICIENT NUMBER C NALLRAT = COUNTS THE NUMBER OF ACTUAL REACTIONS C SKIP URBAN ('A', 'U', OR 'R') REACTIONS IF NOT USED C SKIP TROPOSPHERIC ('A', 'T', 'R', OR 'H') REACTIONS IF NOT USED C SKIP STRATOSPHERIC ('A', 'S', OR 'H') REACTIONS IF NOT USED C DO 325 NCS = 1, NCSGAS C NOUSE(NCS) = 1 IF (NCS.EQ.NCSALL .AND.(DINP.EQ.'A'.OR.DINP.EQ.'U'.OR. 1 DINP.EQ.'R'.OR.DINP.EQ.'S'.OR.DINP.EQ.'T'.OR. 2 DINP.EQ.'H')) NOUSE(NCS) = 0 IF (NCS.EQ.NCSTRST .AND.(DINP.EQ.'A'.OR.DINP.EQ.'R'.OR. 1 DINP.EQ.'T'.OR.DINP.EQ.'S'.OR.DINP.EQ.'H')) 2 NOUSE(NCS) = 0 IF (NCS.EQ.NCSURBAN.AND.(DINP.EQ.'A'.OR.DINP.EQ.'U'.OR. 1 DINP.EQ.'R')) NOUSE(NCS) = 0 IF (NCS.EQ.NCSTROP .AND.(DINP.EQ.'A'.OR.DINP.EQ.'T'.OR. 1 DINP.EQ.'R'.OR.DINP.EQ.'H')) NOUSE(NCS) = 0 IF (NCS.EQ.NCSSTRAT.AND.(DINP.EQ.'A'.OR.DINP.EQ.'S'.OR. 1 DINP.EQ.'H')) NOUSE(NCS) = 0 C IF (NOUSE(NCS).EQ.0) THEN NK = NTRATES(NCS) + 1 NRATCUR(NCS) = NK NALLRAT(NCS) = NALLRAT(NCS) + 1 NAR = NALLRAT(NCS) NCEQUAT(NAR,NCS) = NK C DO 320 I = 1, NCOF + 1 NTRATES(NCS) = NTRATES( NCS) + 1 NK1 = NTRATES( NCS) IRORD( NK1,NCS) = IORD ARR( NK1,NCS) = ARRT(I) BRR( NK1,NCS) = BRRT(I) KCRR( NK1,NCS) = KCRRT(I) FCV( NK1,NCS) = FCVT( I) FCTEMP1(NK1,NCS) = FCT1T(I) FCTEMP2(NK1,NCS) = FCT2T(I) 320 CONTINUE ENDIF 325 CONTINUE C ********************************************************************* C SET UP A DEFAULT PHOTORATE (SEC-1), STORE ORDINAL NUMBER C ********************************************************************* C IF (IDOPHOT.EQ.1) THEN NPHOTALL = NPHOTALL + 1 ! record photalysis numbers for harvard-geos code (bdf, 4/18/03) NPHOT = NPHOTALL !DEFPRAT(NPHOTALL) = ARRT(1) DO 640 NCS = 1, NCSGAS IF (NOUSE(NCS).EQ.0) THEN NK = NRATCUR(NCS) DEFPRAT(NK,NCS) = ARRT(1) JPHOTRAT(NCS) = JPHOTRAT(NCS) + 1 JPR = JPHOTRAT(NCS) NKPHOTRAT(JPR,NCS) = NK NPPHOTRAT(JPR,NCS) = NPHOTALL JPHOTNK( NK, NCS) = JPR ENDIF 640 CONTINUE ENDIF C C ********************************************************************* C * CHECK WHETHER EACH SPECIES SPOT IN INPUT REACTION SET IS ACTIVE, * C * INACTIVE, BLANK, DEAD, OR 'M'. STOP IF THE SPECIES IS NONE * C * JNUM = -J = NON 'M' THIRD BODY IN PRESSURE-DEPENDENT REACTION. * C ********************************************************************* C DO 360 I = 1, NPRODHI IF (XINP(I).NE.' ') THEN C IF (I.LE.NMREAC.AND.PINP(I).NE.0.) THEN WRITE(6,450) IORD CALL GEOS_CHEM_STOP ENDIF C JNUM = 0 IF (I.EQ.NMREAC.AND.RINP(3).EQ.' ') THEN IF (XINP(I).EQ.'M' ) JNUM = -9999 IF (XINP(I).EQ.'O2') JNUM = -9998 IF (XINP(I).EQ.'N2') JNUM = -9997 IF (JNUM.LT.0) GOTO 380 ENDIF DO 370 J = 1, NTSPECGAS IF(XINP(I).EQ.NAMEGAS(J)) THEN IF (I.EQ.NMREAC.AND.RINP(3).EQ.' ') THEN JNUM = -J ELSE JNUM = J ENDIF GOTO 380 ENDIF 370 CONTINUE C IF (I.GT.NMREAC) THEN DO 390 J = 1, NSDEAD IF (XINP(I).EQ.NAMD(J)) GOTO 360 390 CONTINUE ENDIF C WRITE(6,400) IORD, XINP(I) CALL GEOS_CHEM_STOP C 380 DO 410 NCS = 1, NCSGAS IF (NOUSE(NCS).EQ.0) THEN NK = NRATCUR(NCS) IRM(I,NK,NCS) = JNUM NPRODUC(NK,NCS) = I IF (PINP(I).EQ.0.) THEN FKOEF(I,NK,NCS) = 1.0d0 ELSE FKOEF(I,NK,NCS) = PINP(I) ENDIF ENDIF 410 CONTINUE C IF (IDOPHOT.EQ.1) NAMEPHOT(I,NPHOTALL) = XINP(I) ENDIF 360 CONTINUE C DO 415 NCS = 1, NCSGAS IF (NOUSE(NCS).EQ.0) THEN NK = NRATCUR(NCS) IF (IRM(1,NK,NCS).EQ.0.OR.(IRM(3,NK,NCS).GT.0.AND. 1 IRM(2,NK,NCS).EQ.0)) THEN WRITE(6,430) IORD CALL GEOS_CHEM_STOP ENDIF ENDIF 415 CONTINUE C C ********************************************************************* C * PLACE SPECIAL-RATE INFORMATION INTO ARRAYS * C ********************************************************************* C C NMAIR = # REACTIONS WHERE THE SPECIES IN THE THIRD POSITION C IS 'M' = 'O2 + N2': IRM(3,NK) = -9999 C NMO2 = # REACTIONS WHERE THE SPECIES IN THE THIRD POSITION C IS O2: IRM(3,NK) = -9998 C NMN2 = # REACTIONS WHERE THE SPECIES IN THE THIRD POSITION C IS N2: IRM(3,NK) = -9997 C NM3BOD = # REACTIONS WHERE THE SPECIES IN THE THIRD POSITION C IS ANY OTHER SPECIES: IRM(3,NK) = -SPECIES NUMBER C NNEQ = # THERMALLY DISSOCIATING EQUILIBRIUM REACTIONS. PREVIOUS C EQUATION MUST BE PRESSURE-DEPENDENT. (SPECIAL = 'E') C THUS: REQUIRES 3 REACTIONS TOTAL (2 FOR PRESS. DEP, 1 EQ.) C NPRESM = # PRESSURE DEPENDENT 3-BODY REACTIONS (SPECIAL = 'P') C ! bdf smv2 count number of emission and drydep reactions. Used in calcrate ! to put emissions into the chemistry, and drydep out of chemistry. DO NCS=1,NCSGAS IF (NOUSE(NCS) .EQ. 0 ) THEN NK = NRATCUR(NCS) IF (XINP(1).EQ.'EMISSION') THEN NEMIS(NCS) = NEMIS(NCS) + 1 IF (NEMIS(NCS) .GT. MAXGL3) THEN WRITE(*,*) 'ERROR NEMIS Greater then MAXGL3', x ' NEMIS(NCS) = ',NEMIS(NCS), 'MAXGL3 = ',MAXGL3 WRITE( 6, '(a)' ) 'STOP 124' CALL GEOS_CHEM_STOP ENDIF NKEMIS(NEMIS(NCS),NCS) = NK ENDIF ENDIF C C NDRYDEP = number of dry deposition reactions read in C NKDRY = reaction numbers of dry deposition reactions IF (NOUSE(NCS) .EQ. 0) THEN NK = NRATCUR(NCS) IF (XINP(NPRODLO).EQ.'DRYDEP') THEN NDRYDEP(NCS) = NDRYDEP(NCS) + 1 IF (NDRYDEP(NCS) .GT. MAXDEP) THEN WRITE(*,*) 'ERROR NDRYDEP Greater then MAXDEP', x ' NDRYDEP(NCS)=',NDRYDEP(NCS),'MAXDEP=',MAXDEP WRITE( 6, '(a)' ) 'STOP 125' CALL GEOS_CHEM_STOP ENDIF NKDRY(NDRYDEP(NCS),NCS) = NK ENDIF ENDIF ! bdf smv2 use Q to flag O3 photolysis, code is not confused by 'A''s IF (NOUSE(NCS) .EQ. 0) THEN NK = NRATCUR(NCS) IF (SPECL(1).EQ.'Q') NKO3PHOT(NCS)=NK !Flag O3 photolysis IF (SPECL(1).EQ.'T') NKHNO4(NCS) =NK !Flag HNO4 photolysis (gcc) IF (SPECL(1).EQ.'I') NKHOROI(NCS) = NK !Flag CH2O-producing branch in EP photolysis IF (SPECL(1).EQ.'J') NKHOROJ(NCS) = NK !Flag GLYC-producing branch in EP photolysis ENDIF ENDDO IF (IDOPHOT.EQ.0) THEN IF ((SPECL(1).EQ.'V'.AND.NCOF.NE.1).OR. 1 (SPECL(1).EQ.'W'.AND.NCOF.NE.1).OR. 2 (SPECL(1).EQ.'X'.AND.NCOF.NE.2).OR. 3 (SPECL(1).EQ.'Y'.AND.NCOF.NE.0).OR. 4 (SPECL(1).EQ.'Z'.AND.NCOF.NE.1).OR. 5 (SPECL(1).EQ.'P'.AND.NCOF.NE.1).OR. 6 (SPECL(1).EQ.'E'.AND.NCOF.NE.0).OR. 7 (SPECL(1).EQ.'S'.AND.NCOF.NE.0)) THEN WRITE(6,440) IORD, SPECL(1), NCOF CALL GEOS_CHEM_STOP ENDIF C DO 420 NCS = 1, NCSGAS IF (NOUSE(NCS).EQ.0) THEN NK = NRATCUR(NCS) C ITHIRDB = IRM(3,NK,NCS) C IF (ITHIRDB.EQ.-9999) THEN NMAIR(NCS) = NMAIR(NCS) + 1 NM2 = NMAIR(NCS) NREACAIR(NM2,NCS) = NK ELSEIF (ITHIRDB.EQ.-9998) THEN NMO2(NCS) = NMO2(NCS) + 1 NM2 = NMO2(NCS) NREACO2(NM2,NCS) = NK ELSEIF (ITHIRDB.EQ.-9997) THEN NMN2(NCS) = NMN2(NCS) + 1 NM2 = NMN2(NCS) NREACN2(NM2,NCS) = NK ELSEIF (ITHIRDB.LT.0) THEN NM3BOD(NCS) = NM3BOD(NCS) + 1 NM2 = NM3BOD(NCS) NREAC3B(NM2,NCS) = NK LGAS3BOD(NM2,NCS) = -ITHIRDB ENDIF C IF (SPECL(1).EQ.'P') THEN NPRESM(NCS) = NPRESM(NCS) + 1 NR = NPRESM(NCS) NREACPM(NR,NCS) = NK ELSEIF (SPECL(1).EQ.'E') THEN NNEQ(NCS) = NNEQ(NCS) + 1 NN = NNEQ(NCS) NREACEQ(NN,NCS) = NK C C EQUILIBRIUM REACTIONS USE THE PREVIOUS REACTION AS PART OF THE C RATE CALCULATION (SEE CALCRATE.F). THE PREVIOUS REACTION MAY BE C PRESSURE DEPENDENT. C NREQOTH(NN,NCS) = NCEQUAT(NALLRAT(NCS)-1,NCS) ENDIF C C NKSPECV = SPECIAL REACTION CH3SCH3 + OH = CH3S(OH)CH3 (SPECL = 'V') C NKSPECW = SPECIAL REACTION O(1D) + O2,N2 (SPECL = 'W') C NKSPECX = SPECIAL REACTION OH + HNO3 (SPECL = 'X') C NKSPECY = SPECIAL REACTION OH + CO (SPECL = 'Y') C NKSPECZ = SPECIAL REACTION HO2 + HO2 (SPECL = 'Z') C ! bdf smv2 'V' reaction has a special rate. ! More than one reaction of this type IF (SPECL(1).EQ.'V') THEN NNADDV(NCS) = NNADDV(NCS)+1 NKSPECV( NNADDV(NCS),NCS ) = NK ENDIF ! Added for DMS+OH+O2 rxn (bdf, bmy, 4/18/03) IF (SPECL(1).EQ.'G') THEN NNADDG(NCS) = NNADDG(NCS)+1 NKSPECG( NNADDG(NCS),NCS ) = NK ENDIF ! add flag for wet dep reaction (bdf, bmy, 4/18/03) IF (SPECL(1).EQ.'K') THEN NNADDK(NCS) = NNADDK(NCS) + 1 NKSPECK( NNADDK(NCS),NCS) = NK ! Also denote N2O5 hydrolysis rxn (mje, bmy, 8/7/03) IF ( XINP(1) == 'N2O5' ) THEN NKN2O5 = NK ENDIF ! Same for HO2 hydrolysis rxn (jaegle, 02/26/09) IF ( XINP(1) == 'HO2' ) THEN NKHO2 = NK ENDIF ENDIF C IF (SPECL(1).EQ.'HR') THEN !modification of the rate for HO2+RO2 NNRO2HO2(NCS) = NNRO2HO2(NCS) + 1 NKSPECRO2HO2( NNRO2HO2(NCS),NCS) = NK ENDIF IF (SPECL(1).EQ.'D') THEN NNADDD(NCS) = NNADDD(NCS) + 1 NKSPECD( NNADDD(NCS),NCS) = NK ENDIF C IF (SPECL(1).EQ.'A') THEN NNADDA(NCS) = NNADDA(NCS) + 1 NKSPECA( NNADDA(NCS),NCS) = NK ENDIF C IF (SPECL(1).EQ.'B') THEN NNADDB(NCS) = NNADDB(NCS) + 1 NKSPECB( NNADDB(NCS),NCS) = NK ENDIF C IF (SPECL(1).EQ.'C') THEN NNADDC(NCS) = NNADDC(NCS) + 1 NKSPECC( NNADDC(NCS),NCS) = NK ENDIF ! F: HOC2H4O ------> HO2 + 2CH2O IF (SPECL(1).EQ.'F') THEN NNADDF(NCS) = NNADDF(NCS) + 1 NKSPECF( NNADDF(NCS),NCS) = NK ENDIF ! H: HOC2H4O --O2--> HO2 + GLYC IF (SPECL(1).EQ.'H') THEN NNADDH(NCS) = NNADDH(NCS) + 1 NKSPECH( NNADDH(NCS),NCS) = NK ENDIF IF (SPECL(1).EQ.'W') THEN NKSPECW(NCS) = NK ENDIF IF (SPECL(1).EQ.'X') THEN NKSPECX(NCS) = NK ENDIF IF (SPECL(1).EQ.'Y') THEN NKSPECY(NCS) = NK ENDIF IF (SPECL(1).EQ.'Z') THEN NKSPECZ(NCS) = NK ENDIF C C ********************************************************************* C * SURFACE REACTIONS * C ********************************************************************* C ARR(INIT) = REACTION PROBABILITY C ARR(FINAL) = REACTION PROBABILITY * QTHERMG C QTHERMG * SQRT(T) = (1/4) * THERMAL VELOCITY OF GAS (CM S-1) C IF (SPECL(1).EQ.'S') THEN NSURFACE(NCS) = NSURFACE(NCS) + 1 NS2 = NSURFACE(NCS) JGAS1 = IRM(1,NK,NCS) JGAS2 = IRM(2,NK,NCS) JGAS3 = IRM(3,NK,NCS) QTHERMG = 0.25d0*SQRT(EIGHTDPI*RSTARG/WTGAS(JGAS1)) ARR(NK,NCS) = ARR(NK,NCS) * QTHERMG NKSURF(NS2) = NK NCOATG(NS2) = JGAS2 C IF (JGAS3.NE.0) THEN WRITE(6,470) NK CALL GEOS_CHEM_STOP ENDIF ENDIF C C ********************************************************************* C * SET ARRAYS FOR CALCULATING REACTION RATES EFFICIENTLY * C ********************************************************************* C NARR = NUMBER OF REACTIONS OF THE FORM K = A C NABR = NUMBER OF REACTIONS OF THE FORM K = A * (300 / T)**B C NACR = NUMBER OF REACTIONS OF THE FORM K = A * EXP(C / T) C NABC = NUMBER OF REACTIONS OF THE FORM K = A * (300 / T)**B * EXP(C / T) C NKARR, NKBRR, NKACR, NKABC = REACTION RATE NUMBERS OF EACH C NARR, NABR, NACR, NABC REACTION C NK1 = NK - 1 DO 425 I = 1, NCOF + 1 NK1 = NK1 + 1 IF (KCRR(NK1,NCS).EQ.0) THEN IF (BRR(NK1,NCS).EQ.0.) THEN NARR(NCS) = NARR(NCS) + 1 NA = NARR(NCS) NKARR(NA,NCS) = NK1 ELSE NABR(NCS) = NABR(NCS) + 1 NA = NABR(NCS) NKABR(NA,NCS) = NK1 ENDIF ELSE IF (BRR(NK1,NCS).EQ.0.) THEN NACR(NCS) = NACR(NCS) + 1 NA = NACR(NCS) NKACR(NA,NCS) = NK1 ELSE NABC(NCS) = NABC(NCS) + 1 NA = NABC(NCS) NKABC(NA,NCS) = NK1 ENDIF ENDIF 425 CONTINUE C ENDIF C ENDIF NOUSE(NCS).EQ.0 C 420 CONTINUE ENDIF C ENDIF IDOPHOT.EQ.0 C GOTO 310 C 400 FORMAT('INVALID REACT',I4,' W UNRECOGNIZABLE OR DEAD SPEC ',A14, 1 'ALL REACTANTS MUST BE ACTIVE/INACTIVE. PRODS CAN BE DEAD') 430 FORMAT('READCHEM:REACT ',I3,' 1ST SPOT EMPTY OR 3RD SPOT FILLED ', 1 ' BUT 2ND EMPTY') 440 FORMAT('READCHEM: REACT ',I3,'OR BEFORE: SPECIAL REACTION WITH ', 1 'DELIMETER ',A2,' HAD INCORRECT # OF REACTIONS ',I5) 450 FORMAT('READCHEM: ORD# REACT ',I3,' CANT HAVE COEFF > 1') 470 FORMAT('READCHEM: SURFACE REACTION ',I5,'HAS THREE REACTANTS ') 510 FORMAT(I3,1X,ES7.1,1X,ES7.1,I6,1X,0PF3.2,1X, 1 A6,2(A1,A6),14(A1,0PF3.1,A6)) 520 FORMAT( 'KINETIC REACTIONS FOR ', A,' CHEMISTRY',/, 1 'RATE CONSTANTS HAVE FORM K = A * (300/T)**B * EXP(C/T).') 521 FORMAT( 'NMBR A B C Fv REACTION' ) 525 FORMAT( 'PHOTOPROCESS REACTIONS FOR ', A,' CHEMISTRY' ) 526 FORMAT( 'NMBR DEFP (S-1) REACTION' ) C C ********************************************************************* C * PRINT OUT REACTION INFORMATION * C ********************************************************************* C 660 IF (IOREAC.EQ.1) THEN DO 502 NCS = 1, NCSGAS ! Write reaction header WRITE( IO93, '(/,a)' ) REPEAT( '=', 79 ) WRITE( IO93, 520 ) TRIM( CHEMTYP(NCS) ) WRITE( IO93, '(a,/)' ) REPEAT( '=', 79 ) WRITE( IO93, 521 ) DO 500 NK = 1, NTRATES(NCS) ! Write photo rxn header IF ( NK .EQ. NRATES(NCS)+1 ) THEN WRITE( IO93, '(/,a)' ) REPEAT( '=', 79 ) WRITE( IO93, 525 ) TRIM( CHEMTYP(NCS) ) WRITE( IO93, '(a,/)' ) REPEAT( '=', 79 ) WRITE( IO93, 526 ) ENDIF DO 490 I = 1, NPRODHI RINP(I) = '+' PINP(I) = FKOEF(I,NK,NCS) JGAS = IRM(I,NK,NCS) IF (JGAS.GE.0) XINP(I) = NAMEGAS(JGAS) IF (JGAS.EQ.-9999) XINP(I) = 'M' IF (JGAS.EQ.-9998) XINP(I) = 'O2' IF (JGAS.EQ.-9997) XINP(I) = 'N2' IF (JGAS.LT.0.AND.JGAS.GT.-NTSPECGAS) XINP(I) = NAMEGAS(-JGAS) 490 CONTINUE C RINP(5) = '=' WRITE(IO93,510) NK,ARR(NK,NCS),BRR(NK,NCS),KCRR(NK,NCS), 1 FCV(NK,NCS),XINP(1),'+',XINP(2), 2 '+',XINP(3),(RINP(I),PINP(I),XINP(I), 3 I = 5,NPRODUC(NK,NCS)) 500 CONTINUE 502 CONTINUE ENDIF C C ********************************************************************* C *********************** CHECK SOME DIMENSIONS ********************* C ********************************************************************* C DO 670 NCS = 1, NCSGAS IF (NTRATES(NCS) .GT. NMTRATE .OR. NPHOTALL .GT. IPHOT .OR. 1 NTSPECGAS .GT. IGAS .OR. NSDEAD .GT. NMDEAD .OR. 2 NPRODHI .GT. NMRPROD .OR. 3 NMAIR(NCS) .GT. MAXGL3 .OR. NMO2(NCS) .GT. MAXGL3 .OR. 4 NMN2(NCS) .GT. MAXGL2 .OR. NPRESM(NCS).GT. MAXGL2 .OR. 5 NSURFACE(NCS).GT. MAXGL4 .OR. NM3BOD(NCS).GT. MAXGL3) THEN C WRITE(6,680) 1 NMTRATE,NTRATES(NCS), IPHOT , NPHOTALL, IGAS ,NTSPECGAS, 2 NMDEAD ,NSDEAD, NMRPROD, NPRODHI, 3 MAXGL3 ,NMAIR(NCS), MAXGL3 , NMO2(NCS), MAXGL2,NMN2(NCS), 4 MAXGL2 ,NPRESM(NCS), MAXGL4 , NSURFACE(NCS),MAXGL3,NM3BOD(NCS) CALL GEOS_CHEM_STOP ENDIF 670 CONTINUE C 680 FORMAT('ONE OF THE DIMENSIONS BELOW IS TOO SMALL:',/, 1 'DIMENSION: NMTRATE = ',I4,' VARIABLE: NTRATES = ',I4/ 2 'DIMENSION: IPHOT = ',I4,' VARIABLE: NPHOTALL = ',I4/ 3 'DIMENSION: IGAS = ',I4,' VARIABLE: NTSPECGS = ',I4/ 4 'DIMENSION: NMDEAD = ',I4,' VARIABLE: NSDEAD = ',I4/ 6 'DIMENSION: NMRPROD = ',I4,' VARIABLE: NPRODHI = ',I4/ 7 'DIMENSION: MAXGL3 = ',I4,' VARIABLE: NMAIR = ',I4/ 8 'DIMENSION: MAXGL3 = ',I4,' VARIABLE: NMO2 = ',I4/ 9 'DIMENSION: MAXGL2 = ',I4,' VARIABLE: NMN2 = ',I4/ 1 'DIMENSION: MAXGL2 = ',I4,' VARIABLE: NPRESM = ',I4/ 2 'DIMENSION: MAXGL4 = ',I4,' VARIABLE: NSURFACE = ',I4/ 3 'DIMENSION: MAXGL3 = ',I4,' VARIABLE: NM3BOD = ',I4) C C ********************************************************************* C ************************** SET KEY PARAMETERS *********************** C ********************************************************************* C DO 702 NCS = 1, NCSGAS NSPEC(NCS) = NGAS NTSPEC(NCS) = NTSPECGAS C DO 700 JGAS = 1, NTSPECGAS NAMENCS(JGAS,NCS) = NAMEGAS(JGAS) QBKCHEM(JGAS,NCS) = QBKGAS( JGAS) 700 CONTINUE 702 CONTINUE !---smv2-s ! Update (gcc) C bdf smv2, put this in here for now. C ********************************************************************* C **************** READ INFO FOR AEROSOL REACTIONS **************** C ********************************************************************* C astkcf -- sticking coefficient (no unit), order of 0.1 C xgdfcf -- gas phase diffusion coefficient (cm2/s), order of 0.1 C iarsfa -- fortran unit number for reading sulfate abundance file C mwarsl -- aerosol molecular wright (g/mol) [H2SO4=98] C ruarsl -- density of aerosol (g/cc) C RH100 -- deliquescence point, relative humidity below which we C have no wet aerosols C OPEN(7,FILE='chemga.dat',FORM='FORMATTED',STATUS='OLD') READ(7,*) READ(7,610) ASTKCF READ(7,*) READ(7,610) READ(7,*) READ(7,620) MWARSL READ(7,610) RUARSL READ(7,630) RH100 READ(7,620) IARSFA CLOSE(7) 610 FORMAT(E10.3) 620 FORMAT(I10) 630 FORMAT(F10.2) C C ********************************************************************* C ***** CALL JSPARSE TO SET ARRAYS FOR SOLVING CHEMICAL EQUATIONS ***** C ********************************************************************* C ! Call SETPL to setup ND65 prod/loss diagnostic ! SETPL must be called before JSPARSE (ljm, bmy, 5/9/03) IF ( LFAMILY ) CALL SETPL ! IFSOLVE = 1 means we are calling the chemistry solver IF ( IFSOLVE .EQ. 1 ) THEN ! Loop over chemistry regimes (for now NCSGAS=NCSURBAN=1) DO NCS = 1, NCSGAS ! Set up sparse matrix stuff CALL JSPARSE !=========================================================== ! Determine which species are ND65 families and which are ! not. Do this once (after JSPARSE) & store in the lookup ! table ITS_NOT_A_ND65_FAMILY. (bmy, 7/9/03) !=========================================================== ! Loop over all species DO J = 1, ISCHANG(NCS) ! Initialize lookup table ITS_NOT_A_ND65_FAMILY(J) = .TRUE. ! Test if species J is a ND65 prodloss family ! MAPPL is the reordered species index after JSPARSE DO N = 1, NFAMILIES IF ( J == MAPPL(IFAM(N),NCS) ) THEN ITS_NOT_A_ND65_FAMILY(J) = .FALSE. EXIT ENDIF ENDDO ENDDO ENDDO ELSE ! If we are not calling the chemistry solver, then ! set number of active gas photoprocesses to zero NPHOTALL = 0 ENDIF C C ********************************************************************* C ******************* END OF SUBROUTINE READCHEM ****************** C ********************************************************************* C RETURN END SUBROUTINE READCHEM