866 lines
35 KiB
Fortran
866 lines
35 KiB
Fortran
! $Id: jsparse.f,v 1.1 2009/06/09 21:51:53 daven Exp $
|
|
SUBROUTINE JSPARSE
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine JSPARSE sets up the sparse-matrix arrays for SMVGEAR II.
|
|
! (M. Jacobson 1993; bdf, bmy, 4/18/03)
|
|
!
|
|
! NOTES:
|
|
! (1 ) For GEOS-CHEM we had to remove T3 from "comode.h" and to declare it
|
|
! allocatable in "comode_mod.f". This allows us to only allocate it
|
|
! if we are doing a fullchem run. Write list of repeat reactants to
|
|
! and change in moles to "smv2.log". Now call GEOS_CHEM_STOP to
|
|
! deallocate all arrays and stop the run safely. Now force double
|
|
! precision with "D" exponents. (bmy, 4/18/03)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE COMODE_MOD, ONLY : T3
|
|
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "comode.h" ! SMVGEAR II arrays
|
|
C
|
|
C *********************************************************************
|
|
C ************ WRITTEN BY MARK JACOBSON (1993) ************
|
|
C *** (C) COPYRIGHT, 1993 BY MARK Z. JACOBSON ***
|
|
C *** U.S. COPYRIGHT OFFICE REGISTRATION NO. TXu 670-279 ***
|
|
C *** (650) 723-6836 ***
|
|
C *********************************************************************
|
|
C
|
|
C JJ SSSSSSS PPPPPPP A RRRRRRR SSSSSSS EEEEEEE
|
|
C J S P P A A R R S E
|
|
C J SSSSSSS PPPPPPP A A RRRRRRR SSSSSSS EEEEEEE
|
|
C J J S P AAAAAAA R R S E
|
|
C JJJJJJJ SSSSSSS P A A R R SSSSSSS EEEEEEE
|
|
C
|
|
C *********************************************************************
|
|
C * THIS ROUTINE SETS UP SPARSE-MATRIX AND OTHER ARRAYS FOR SMVGEAR *
|
|
C * (SPARSE-MATRIX VECTORIZED GEAR-CODE. IT SETS ARRAYS FOR GAS- *
|
|
C * -PHASE, AQUEOUS-PHASE, AND ANY OTHER TYPE OF CHEMISTRY. IT ALSO *
|
|
C * SETS ARRAYS FOR BOTH DAY AND NIGHT CHEMISTRY OF EACH TYPE. *
|
|
C * *
|
|
C * HOW TO CALL SUBROUTINE: *
|
|
C * ---------------------- *
|
|
C * CALL JSPARSE.F FROM READCHEM.F WITH *
|
|
C * NCS = 1..NCSGAS FOR GAS CHEMISTRY *
|
|
C *********************************************************************
|
|
C
|
|
C *********************************************************************
|
|
C ******* SETS UP ARRAYS FOR GAS- AND AQUEOUS-PHASE CHEMISTRY ********
|
|
C * INCLUDES ARRAYS FOR CALCULATING FIRST DERIVATIVES, PARTIAL DERIV- *
|
|
C * ATIVES, MATRIX DECOMPOSTION, AND MATRIX BACK-SUBSTITUTION. FIRST, *
|
|
C * JSPARSE RE-ORDERS THE ORDINARY DIFFERENTIAL EQUATIONS TO MAXIMIZE *
|
|
C * THE NUMBER OF ZEROS IN THE MATRIX OF PARTIAL DERIVATIVES. IT *
|
|
C * LATER SETS ARRAYS TO ELIMINATE ALL CALCULATIONS INVOLVING A ZERO. *
|
|
C *********************************************************************
|
|
*
|
|
C NTSPEC = TOTAL NUMBER OF ACTIVE + INACTIVE SPECIES.
|
|
C NSPEC = TOTAL NUMBER OF ACTIVE SPECIES.
|
|
C NMREAC = 3 = MAXIMUM NUMBER OF ACTIVE REACTANTS IN A REACTION
|
|
C NALLREAC = 4 = TOTAL REACTANT POSITIONS IN A REACTION
|
|
C NMPROD = 5 = MAXIMUN NUMBER OF ACTIVE PRODUCTS IN A REACTION
|
|
C NPRODLO = NALLREAC + 1 = LOWEST PRODUCT POSITION NUMBER.
|
|
C NPRODHI = NALLREAC + NMPROD = HIGHEST PRODUCT POSITION NUMBER.
|
|
C
|
|
C *********************************************************************
|
|
C * DETERMINE HOW MANY PARTIAL DERIV TERMS ARE NEEDED FOR EACH SPECIES*
|
|
C *********************************************************************
|
|
C IFREPRO = 1 THEN SPECIES IS LOST AND REPRODUCED IN REACTION NK
|
|
C IRM = SPECIES # OF EACH REACT OR PRODUCT IN EACH NK REACTION
|
|
C ISAPORL = COUNTS PARTIAL DERIVATIVE TERMS FOR EACH SPECIES
|
|
C FKOEF = 1, 2, FRACTION, OR MORE = # OF A GIVEN REACTANT OR PRODUCTS
|
|
C E.G. REACTION A + B --> 2C + 0.34D + D
|
|
C VALUE OF FKOEF 1 1 2 0.34 1
|
|
C NCS = 1..NCSGAS FOR GAS CHEMISTRY
|
|
C NCSP = NCS FOR DAYTIME GAS CHEM
|
|
C = NCS +ICS FOR NIGHTTIME GAS CHEM
|
|
C NK = REACTION # OF EACH REACTION
|
|
C NRATES = NUMBER OF KINETIC (NON-PHOTO) RATE COEFFICIENTS
|
|
C NTRATES = NUMBER OF KINETIC PLUS PHOTO RATE COEFFICIENTS
|
|
C NALLRAT = NUMBER OF KINETIC PLUS PHOTO REACTION RATES
|
|
C
|
|
|
|
INTEGER NREPT,I,J,NAR,NK,K,IREACT,L,IPO,NOCHANG,JOLD,JNEW
|
|
INTEGER MINVALU,IMINOLD,IMINNEW,INEW,IOLD,NKLAST,IAL,IRE
|
|
INTEGER NMO,NOL,ISDIFF,IB,JSPCL,ISPC1,ISPC2,ISPC3,IAP,IPROD
|
|
INTEGER IPR,LFRAC,NGN,KPRODS,KDIF,NPL,IC,NK1,NTWO,ICB,ICD
|
|
INTEGER NKN,IGR,ISP,NSP,NGR,NGTSUM,NLTSUM,NGSUM,NLSUM,NGFSUM
|
|
INTEGER N,JGAS,NA,IHIREAC,JAL,JRE,JPR
|
|
INTEGER KNUMPORL,NCCOUNT,NREMAIN,NFIVE,NFOUR,NTHREE,NONE,MC
|
|
INTEGER IR,JR,IAR,JP,JSPC
|
|
|
|
REAL*8 RFRAC,ALFRAC,DIFF,TNUMGNA,TNUMGN
|
|
REAL*8 TNUMLS,SUMGN,TSUMGNA,TNUMLSA
|
|
|
|
INTEGER, SAVE :: NPLTOT,NPLFUN,NFRCOUN,NPDCOUN
|
|
|
|
NCSP = NCS + ICS
|
|
NREPT = 0
|
|
C
|
|
DO 30 I = 1, MXGSAER
|
|
ISAPORL( I) = 0
|
|
30 CONTINUE
|
|
C
|
|
DO 33 I = 1, MAXGL
|
|
NEWNK(I) = 0
|
|
33 CONTINUE
|
|
C
|
|
DO 42 I = 1, MXGSAER
|
|
DO 41 J = 1, MXGSAER
|
|
ISPARDER(I,J) = 0
|
|
41 CONTINUE
|
|
42 CONTINUE
|
|
C
|
|
DO 100 NAR = 1, NALLRAT(NCS)
|
|
NK = NCEQUAT(NAR,NCS)
|
|
IF (NK.LE.NRATES(NCS)) NALLRAT(NCSP) = NAR
|
|
DO 60 K = 1, NMREAC
|
|
IREACT = IRM(K,NK,NCS)
|
|
IF (IREACT.GT.0.AND.IREACT.LE.NSPEC(NCS)) THEN
|
|
DO 50 L = 1, NPRODHI
|
|
IPO = IRM(L,NK,NCS)
|
|
IF ((L.LE.NMREAC.OR.L.GE.NPRODLO).AND.IPO.GT.0.AND.
|
|
1 IPO.LE.NSPEC(NCS)) ISPARDER(IPO,IREACT) = 1
|
|
50 CONTINUE
|
|
ENDIF
|
|
60 CONTINUE
|
|
100 CONTINUE
|
|
C CONTINUE NAR = 1, NALLRAT
|
|
C
|
|
DO 72 IREACT = 1, NTSPEC(NCS)
|
|
DO 70 IPO = 1, NTSPEC(NCS)
|
|
IF (ISPARDER(IPO,IREACT).EQ.1) ISAPORL(IPO)=ISAPORL(IPO)+1
|
|
70 CONTINUE
|
|
72 CONTINUE
|
|
C
|
|
C *********************************************************************
|
|
C * RE-ARRAGE SPECIES ARRAY SO THAT ALL SPECIES WITH AT LEAST ONE *
|
|
C * PARTIAL DERIVATIVE TERM APPEAR FIRST, AND THOSE WITH ZERO *
|
|
C * APPEAR LAST. *
|
|
C *********************************************************************
|
|
C ISCHANG = NUMBER OF ORIGINAL NSPEC SPECIES WITH AT LEAST ONE PD TERM.
|
|
C INEWOLD = ORIGINAL SPECIES NUMBER OF EACH NEW JNEW SPECIES
|
|
C MAPPL = NEW SPECIES NUMBER FOR CHEMISTRY OF EACH ORIGINAL JOLD SPECIES
|
|
C
|
|
NOCHANG = NSPEC(NCS)
|
|
DO 110 JOLD = 1, NTSPEC(NCS)
|
|
IF (JOLD.GT.NSPEC(NCS)) THEN
|
|
MAPPL(JOLD,NCS) = JOLD
|
|
INEWOLD(JOLD,NCS) = JOLD
|
|
ELSEIF (ISAPORL(JOLD).GT.0) THEN
|
|
ISCHANG(NCS) = ISCHANG(NCS) + 1
|
|
JNEW = ISCHANG(NCS)
|
|
INEWOLD(JNEW,NCS) = JOLD
|
|
MAPPL(JOLD,NCS) = JNEW
|
|
ELSE
|
|
INEWOLD(NOCHANG,NCS) = JOLD
|
|
MAPPL(JOLD,NCS) = NOCHANG
|
|
NOCHANG = NOCHANG - 1
|
|
ENDIF
|
|
110 CONTINUE
|
|
C
|
|
C *********************************************************************
|
|
C * RE-ARRAGE SPECIES IN ISCHANG ARRAY SO THAT SPECIES WITH THE *
|
|
C * FEWEST PARTIAL DERIVATIVE TERMS COMBINED ARE PLACED FIRST, *
|
|
C * AND THOSE WITH THE MOST APPEAR LAST. HOWEVER, SPECIES WITH ZERO *
|
|
C * PARTIAL DERIVATIVE TERMS STILL APPEAR AFTER ALL ISCHANG SPECIES *
|
|
C *********************************************************************
|
|
C
|
|
DO 117 JNEW = 1, ISCHANG(NCS)
|
|
JOLD = INEWOLD(JNEW,NCS)
|
|
MINVALU = ISAPORL(JOLD)
|
|
IMINOLD = JOLD
|
|
IMINNEW = JNEW
|
|
DO 115 INEW = JNEW+1, ISCHANG(NCS)
|
|
IOLD = INEWOLD(INEW,NCS)
|
|
IF (ISAPORL(IOLD).LT.MINVALU) THEN
|
|
MINVALU = ISAPORL(IOLD)
|
|
IMINOLD = IOLD
|
|
IMINNEW = INEW
|
|
ENDIF
|
|
115 CONTINUE
|
|
INEWOLD(IMINNEW,NCS) = JOLD
|
|
INEWOLD(JNEW,NCS) = IMINOLD
|
|
MAPPL(JOLD,NCS) = IMINNEW
|
|
MAPPL(IMINOLD,NCS) = JNEW
|
|
117 CONTINUE
|
|
C
|
|
C *********************************************************************
|
|
C * COUNT GROSS AND NET LOSS *
|
|
C *********************************************************************
|
|
C IONER = NUMBER OF REACTIONS WITH ONE ACTIVE REACTANT
|
|
C ITWOR = NUMBER OF REACTIONS WITH TWO ACTIVE REACTANTS
|
|
C ITHRR = NUMBER OF REACTIONS WITH THREE ACTIVE REACTANTS
|
|
C NKONER = REACTION NUMBER OF EACH IONER REACTION
|
|
C NKTWOR = REACTION NUMBER OF EACH ITWOR REACTION
|
|
C NKTHRR = REACTION NUMBER OF EACH ITHRR REACTION
|
|
C NUMLOST = EVERY OCCURENCE OF A LOSS (ACTIVE & INACTIVE SPEC)
|
|
C NUMLOSS = EVERY NET OCCURENCE OF A LOSS WHERE THE SPECIES IS NOT
|
|
C REPRODUCED IN THE SAME REACTION. (ACTIVE & INACTIVE SPECIES)
|
|
C JLOSS = REACTION NUMBER OF EACH NET LOSS OCCURRENCE
|
|
C IRM2 = IDENTIFIES EACH NEW ACTIVE SPECIES NUMBER IN EACH REACTION
|
|
C NUMKIAL = NUMBER OF REACTIONS WITH EITHER 1, 2, OR 3 ACTIVE REACTANTS
|
|
C NKSDT = REACTION NUMBER OF EACH NUMKIAL REACTION
|
|
C NRUSE = 1,2,3 IF REACTION HAS 1, 2, OR 3 ACTIVE REACTANTS, RESPECTIVELY.
|
|
C NRREP = 0 FOR EACH OF TWO REACTIONS WHERE THE REACTANTS ARE IDENTICAL.
|
|
C IF MORE THAN TWO REACTIONS HAVE THE SAME REACTANTS, NRREP = 0
|
|
C FOR THE FIRST TWO REACTIONS ONLY.
|
|
C = 1,2,3 IF REACTION HAS 1, 2, OR 3 REACTANTS, RESPECTIVELY.
|
|
C NMOTH = # OF OCCURRENCES WHERE INACTIVE SPEC APPEARS IN RATE EQUATION
|
|
C EXCLUDES THIRD BODIES IN ARRAY NM3BOD (E.G., O2, N2, M, WHEN
|
|
C THESE SPECIES DO NOT LOSE CONCENTRATION IN THE REACTION)
|
|
C NREACOTH = REACTION NUMBER OF EACH NMOTH OCCURRENCE
|
|
C LGASBINO = OLD SPECIES NUMBER OF EACH INACTIVE SPECIES
|
|
C
|
|
NOLOSP(NCSP) = 0
|
|
NKLAST = 0
|
|
C
|
|
DO 230 NAR = 1, NALLRAT(NCS)
|
|
NK = NCEQUAT(NAR,NCS)
|
|
C
|
|
C *********************************************************************
|
|
C *** DETERMINE OCCURRENCES OF INACTIVE SPECIES IN RATE EQUATIONS ***
|
|
C * SET ARRAY TO IDENTIFY ACTIVE LOSS SPECIES *
|
|
C *********************************************************************
|
|
C
|
|
IAL = 0
|
|
C
|
|
DO 157 JSPC = 1, MXGSAER
|
|
APORL(JSPC) = 0.d0
|
|
157 CONTINUE
|
|
C
|
|
DO 158 J = 1, NMREAC
|
|
IREACT = IRM(J,NK,NCS)
|
|
IF (IREACT.GT.0) THEN
|
|
IRE = MAPPL(IREACT,NCS)
|
|
C
|
|
APORL(IRE) = APORL(IRE) - 1.d0
|
|
NUMLOST(IRE,NCS) = NUMLOST(IRE,NCS) + 1
|
|
C
|
|
IF (IRE.LE.NSPEC(NCS)) THEN
|
|
C
|
|
IAL = IAL + 1
|
|
IRM2(IAL,NK,NCS) = IRE
|
|
C
|
|
ELSEIF (IRE.GT.NSPEC(NCS)) THEN
|
|
C
|
|
IF (NK.LE.NRATES(NCS)) THEN
|
|
NMOTH(NCS) = NMOTH(NCS) + 1
|
|
NMO = NMOTH(NCS)
|
|
NREACOTH(NMO,NCS) = NK
|
|
LGASBINO(NMO,NCS) = IREACT
|
|
ELSE
|
|
NOLOSP(NCS) = NOLOSP(NCS) + 1
|
|
NOL = NOLOSP(NCS)
|
|
NKNLOSP(NOL,NCS) = NK
|
|
LOSINACP(NOL,NCS) = IREACT
|
|
ENDIF
|
|
C
|
|
ENDIF
|
|
ENDIF
|
|
C
|
|
158 CONTINUE
|
|
C
|
|
C *********************************************************************
|
|
C * SET ARRAYS TO IDENTIFY REACTIONS WITH AT LEAST ONE ACTIVE LOSS *
|
|
C *********************************************************************
|
|
C
|
|
IF (IAL.GT.0) THEN
|
|
NRUSE(NK,NCS) = IAL
|
|
NRREP(NK,NCS) = IAL
|
|
C
|
|
IF (IAL.EQ.1) THEN
|
|
IONER(NCS) = IONER(NCS) + 1
|
|
NKONER(IONER(NCS),NCS) = NK
|
|
ELSEIF (IAL.EQ.2) THEN
|
|
ITWOR(NCS) = ITWOR(NCS) + 1
|
|
NKTWOR(ITWOR(NCS),NCS) = NK
|
|
ELSEIF (IAL.EQ.3) THEN
|
|
ITHRR(NCS) = ITHRR(NCS) + 1
|
|
NKTHRR(ITHRR(NCS),NCS) = NK
|
|
ENDIF
|
|
C
|
|
C *********************************************************************
|
|
C * COMPARE TWO CONSECUTIVE REACTIONS. IF THE SPECIES (BUT NOT RATES) *
|
|
C * ARE THE SAME, THEN SAVE MULTIPLICATIONS IN SUBFUN.F *
|
|
C *********************************************************************
|
|
C
|
|
IF (NKLAST.GT.0) THEN
|
|
IF (NRUSE(NKLAST,NCS).EQ.IAL) THEN
|
|
ISDIFF = 0
|
|
DO 150 IB = 1, IAL
|
|
JSPCL = IRM2(IB,NKLAST,NCS)
|
|
JSPC = IRM2(IB,NK ,NCS)
|
|
IF (JSPCL.NE.JSPC) ISDIFF = 1
|
|
150 CONTINUE
|
|
IF (ISDIFF.EQ.0.AND.NRREP(NKLAST,NCS).NE.0) THEN
|
|
NRREP(NK,NCS) = 0
|
|
NRREP(NKLAST,NCS) = 0
|
|
NREPT = NREPT + 1
|
|
ISPC1 = IRM2(1,NK,NCS)
|
|
ISPC2 = IRM2(2,NK,NCS)
|
|
ISPC3 = IRM2(3,NK,NCS)
|
|
IF (ISPC1.GT.0) ISPC1 = INEWOLD(ISPC1,NCS)
|
|
IF (ISPC2.GT.0) ISPC2 = INEWOLD(ISPC2,NCS)
|
|
IF (ISPC3.GT.0) ISPC3 = INEWOLD(ISPC3,NCS)
|
|
WRITE(IO93,155) NREPT, NK,NAMENCS(ISPC1,NCS),
|
|
1 NAMENCS(ISPC2,NCS), NAMENCS(ISPC3,NCS)
|
|
155 FORMAT('REPEAT REACTANTS: ',I5,I5,3(1X,A14))
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
C
|
|
C *********************************************************************
|
|
C * DETERMINE THE NUMBER OF REACTIONS WITH ZERO ACTIVE LOSS TERMS *
|
|
C *********************************************************************
|
|
C NOLOSRAT = NUMBER OF ACTIVE REACTIONS WITH NO LOSS TERMS
|
|
C NOLOSRN = REACTION NUMBER OF EACH REACTION WITH NO LOSS TERMS
|
|
C
|
|
|
|
ELSEIF (IAL.EQ.0) THEN
|
|
NOLOSRAT(NCS) = NOLOSRAT(NCS) + 1
|
|
NOL = NOLOSRAT(NCS)
|
|
NOLOSRN(NOL,NCS) = NK
|
|
ENDIF
|
|
C ENDIF IAL.GT.0
|
|
C
|
|
C *********************************************************************
|
|
C * COUNT GROSS AND NET PRODUCTION AND SET A PARTIAL DERIVATIVE ARRAY *
|
|
C *********************************************************************
|
|
C NUMGAINT = EVERY OCCURENCE OF A PRODUCTION (ACTIVE & INACTIVE SPEC)
|
|
C NUMGAIN = EVERY NET OCCURENCE OF A PRODUCTION WHERE THE SPECIES IS
|
|
C NOT LOST IN THE SAME REACTION. (ACTIVE & INACTIVE SPEC)
|
|
C IAPROD = NUMBER OF ACTIVE PRODUCTS IN EACH NK REACTION. USED
|
|
C TO CALCULATE PARTIAL DERIVATIVES IN PDERIV.F.
|
|
C IRM2 = NEW SPECIES # OF EACH ACTIVE PRODUCT IN EACH NK REACTION
|
|
C
|
|
IAP = NPRODLO - 1
|
|
DO 210 K = NPRODLO, NPRODHI
|
|
IPROD = IRM(K,NK,NCS)
|
|
IF (IPROD.GT.0) THEN
|
|
IPR = MAPPL(IPROD,NCS)
|
|
RFRAC = FKOEF(K,NK,NCS)
|
|
LFRAC = INT(RFRAC + SMAL1)
|
|
ALFRAC = FLOAT(LFRAC)
|
|
DIFF = ABS(RFRAC-ALFRAC)
|
|
C
|
|
C ******************** PRODUCTION TERM IS A FRACTION ******************
|
|
C
|
|
IF (DIFF.GT.SMAL1) THEN
|
|
IF (IPR.LE.NSPEC(NCS)) THEN
|
|
NGNFRAC(NCS) = NGNFRAC(NCS) + 1
|
|
NGN = NGNFRAC(NCS)
|
|
IGNFRAC( NGN,NCS) = IPR
|
|
NKGNFRAC(NGN,NCS) = NK
|
|
FRACP( NGN,NCS) = RFRAC
|
|
ENDIF
|
|
KPRODS = 1
|
|
NUMGFRT( IPR,NCS) = NUMGFRT( IPR,NCS) + 1
|
|
FRACGAIN(IPR,NCS) = FRACGAIN(IPR,NCS) + RFRAC
|
|
C
|
|
C ******************* PRODUCTION TERM IS NON-FRACTION *****************
|
|
C
|
|
ELSE
|
|
APORL(IPR) = APORL(IPR) + RFRAC
|
|
KPRODS = LFRAC
|
|
NUMGAINT(IPR,NCS) = NUMGAINT(IPR,NCS) + LFRAC
|
|
FKOEF(K,NK,NCS) = 1.d0
|
|
ENDIF
|
|
C
|
|
C ******************* IDENTIFY ALL PRODUCTION TERMS *******************
|
|
C
|
|
IF (IPR.LE.NSPEC(NCS)) THEN
|
|
DO 170 L = 1, KPRODS
|
|
IAP = IAP + 1
|
|
IAPROD(NK,NCS) = IAP
|
|
IRM2(IAP,NK,NCS) = IPR
|
|
FK2( IAP,NK,NCS) = FKOEF(K,NK,NCS)
|
|
170 CONTINUE
|
|
ENDIF
|
|
C
|
|
ENDIF
|
|
C
|
|
210 CONTINUE
|
|
C
|
|
C *********************************************************************
|
|
C * FIND NET PROD AND LOSS TERMS FOR ALL BUT FRACTIONATED PRODUCTS *
|
|
C *********************************************************************
|
|
C
|
|
DO 220 JSPC = 1, NTSPEC(NCS)
|
|
IF (ABS(APORL(JSPC)).LT.SMAL1) THEN
|
|
KDIF = 0
|
|
C
|
|
ELSEIF (APORL(JSPC).GT.0.) THEN
|
|
KDIF = INT(APORL(JSPC) + 0.00001)
|
|
DO 190 L = 1, KDIF
|
|
NUMGAIN(JSPC,NCS) = NUMGAIN(JSPC,NCS) + 1
|
|
NUMPORL(JSPC,NCS) = NUMPORL(JSPC,NCS) + 1
|
|
NPL = NUMPORL(JSPC,NCS)
|
|
JPORL(JSPC,NPL,NCS) = NK + NTRATES(NCS)
|
|
190 CONTINUE
|
|
ELSE
|
|
KDIF = -INT(APORL(JSPC) - 0.00001)
|
|
DO 140 L = 1, KDIF
|
|
NUMLOSS(JSPC,NCS) = NUMLOSS(JSPC,NCS) + 1
|
|
NUMPORL(JSPC,NCS) = NUMPORL(JSPC,NCS) + 1
|
|
NPL = NUMPORL(JSPC,NCS)
|
|
JPORL(JSPC,NPL,NCS) = NK
|
|
140 CONTINUE
|
|
ENDIF
|
|
C
|
|
IF (NK.LE.NRATES(NCS)) THEN
|
|
NUMLOSS(JSPC,NCSP) = NUMLOSS(JSPC,NCS)
|
|
NUMGAIN(JSPC,NCSP) = NUMGAIN(JSPC,NCS)
|
|
NUMPORL(JSPC,NCSP) = NUMPORL(JSPC,NCS)
|
|
ENDIF
|
|
C
|
|
220 CONTINUE
|
|
C
|
|
IF (NK.LE.NRATES(NCS)) THEN
|
|
NOLOSRAT(NCSP) = NOLOSRAT(NCS)
|
|
NGNFRAC( NCSP) = NGNFRAC( NCS)
|
|
IONER( NCSP) = IONER( NCS)
|
|
ENDIF
|
|
C
|
|
NKLAST = NK
|
|
C
|
|
230 CONTINUE
|
|
C CONTINUE N = 1, NTRATES
|
|
C
|
|
C *********************************************************************
|
|
C * SET ARRAY FOR REORDERING RATES FROM 3..2..1..0 BODY REACTIONS *
|
|
C *********************************************************************
|
|
C INOREP = LAST REORDERED REACTION NUMBER PRIOR TO SETS OF TWO
|
|
C REACTIONS WITH TWO REACTANTS
|
|
C NOLDFNEW = OLD REACTION RATE # CORRESP. TO EACH REORDERED REACTION
|
|
C NEWFOLD = NEW REACTION RATE # CORRESP. TO EACH ORIGINAL RATE NUMBER
|
|
C
|
|
IC = 0
|
|
DO 235 I = 1, ITHRR(NCS)
|
|
IC = IC + 1
|
|
NK = NKTHRR(I,NCS)
|
|
NK1 = NK + NTRATES(NCS)
|
|
NOLDFNEW(IC, NCS) = NK
|
|
NEWFOLD( NK, NCS) = IC
|
|
NEWFOLD( NK1,NCS) = IC + NALLRAT(NCS)
|
|
235 CONTINUE
|
|
C
|
|
NTWO = ITHRR(NCS) + ITWOR(NCS)
|
|
ICB = NTWO + 1
|
|
DO 237 I = 1, ITWOR(NCS)
|
|
NK = NKTWOR(I,NCS)
|
|
NK1 = NK + NTRATES(NCS)
|
|
IF (NRREP(NK,NCS).GT.0) THEN
|
|
IC = IC + 1
|
|
ICD = IC
|
|
ELSE
|
|
ICB = ICB - 1
|
|
ICD = ICB
|
|
ENDIF
|
|
NOLDFNEW(ICD, NCS) = NK
|
|
NEWFOLD( NK, NCS) = ICD
|
|
NEWFOLD( NK1, NCS) = ICD + NALLRAT(NCS)
|
|
237 CONTINUE
|
|
C
|
|
INOREP(NCS) = IC
|
|
IC = NTWO
|
|
DO 239 I = 1, IONER(NCS)
|
|
IC = IC + 1
|
|
NK = NKONER(I,NCS)
|
|
NK1 = NK + NTRATES(NCS)
|
|
NOLDFNEW(IC, NCS) = NK
|
|
NEWFOLD( NK, NCS) = IC
|
|
NEWFOLD( NK1,NCS) = IC + NALLRAT(NCS)
|
|
239 CONTINUE
|
|
C
|
|
DO 241 I = 1, NOLOSRAT(NCS)
|
|
IC = IC + 1
|
|
NK = NOLOSRN(I,NCS)
|
|
NK1 = NK + NTRATES(NCS)
|
|
NOLDFNEW(IC, NCS) = NK
|
|
NEWFOLD( NK, NCS) = IC
|
|
NEWFOLD( NK1,NCS) = IC + NALLRAT(NCS)
|
|
241 CONTINUE
|
|
C
|
|
IF (IC.NE.NALLRAT(NCS)) THEN
|
|
WRITE(6,245) IC, NALLRAT(NCS)
|
|
CALL GEOS_CHEM_STOP
|
|
ENDIF
|
|
C
|
|
C *********************************************************************
|
|
C SET A SLIGHTLY MORE EFFICIENT PHOTO ARRAY
|
|
C *********************************************************************
|
|
C
|
|
DO 243 J = 1, JPHOTRAT(NCS)
|
|
NK = NKPHOTRAT(J,NCS)
|
|
NKN = NEWFOLD(NK,NCS)
|
|
NKNPHOTRT(J,NCS) = NKN
|
|
243 CONTINUE
|
|
C
|
|
245 FORMAT('JSPARSE: IC NE NALLRAT =',2(I5))
|
|
C
|
|
C *********************************************************************
|
|
C ****** DETERMINE NUMBER OF SPECIES WITH GROSS/NET LOSSES/GAINS ******
|
|
C *********************************************************************
|
|
C NSPCSOLV = # OF ACTIVE SPECIES WITH AT LEAST ONE GROSS LOSS
|
|
C ISOLVSPC = SPECIES NUMBER OF EACH NSPCSOLV SPECIES
|
|
C ISGAINR = # OF ACTIVE SPECIES WITH AT LEAST ONE NET CHEM GAIN
|
|
C IGAINR = SPECIES NUMBER OF EACH ISGAINR SPECIES
|
|
C ISGAINE = # OF ACTIVE SPECIES WITH AT LEAST 1 NET CHEM GAIN
|
|
C IGAINR = SPECIES NUMBER OF EACH ISGAINR SPECIES
|
|
C NOGAINE = # OF ACTIVE SPECIES WITH ZERO NET CHEM OR GAINS
|
|
C NGAINE = SPECIES NUMBER OF EACH NOGAINE SPECIES
|
|
C ISPORL = # OF ACTIVE SPECIES WITH AT LEAST ONE NET PRODUCTION
|
|
C OR LOSS TERM FOR SMVGEAR.
|
|
C IPORL = SPECIES NUMBER OF EACH ISPORL SPECIES
|
|
C
|
|
DO 300 JOLD = 1, NSPEC(NCS)
|
|
JNEW = MAPPL(JOLD,NCS)
|
|
C
|
|
IF (NUMGAIN(JNEW,NCS).GT.0) THEN
|
|
ISGAINR(NCS) = ISGAINR(NCS) + 1
|
|
IGR = ISGAINR(NCS)
|
|
IGAINR(IGR,NCS) = JNEW
|
|
ENDIF
|
|
C
|
|
IF (NUMPORL(JNEW,NCS).GT.0) THEN
|
|
ISPORL(NCS) = ISPORL(NCS) + 1
|
|
ISP = ISPORL(NCS)
|
|
IPORL(ISP,NCS) = JNEW
|
|
ENDIF
|
|
C
|
|
IF (NUMLOST(JNEW,NCS).GT.0) THEN
|
|
NSPCSOLV(NCS) = NSPCSOLV(NCS) + 1
|
|
NSP = NSPCSOLV(NCS)
|
|
ISOLVSPC(NSP,NCS) = JNEW
|
|
ENDIF
|
|
C
|
|
IF (NUMGAIN(JNEW,NCS).GT.0.OR.FRACGAIN(JNEW,NCS).GT.0) THEN
|
|
ISGAINE(NCS) = ISGAINE(NCS) + 1
|
|
IGR = ISGAINE(NCS)
|
|
IGAINE(IGR,NCS) = JNEW
|
|
ELSEIF (NUMLOSS(JNEW,NCS).GT.0) THEN
|
|
NOGAINE(NCS) = NOGAINE(NCS) + 1
|
|
NGR = NOGAINE(NCS)
|
|
NGAINE(NGR,NCS) = JNEW
|
|
ENDIF
|
|
C
|
|
300 CONTINUE
|
|
C
|
|
C *********************************************************************
|
|
C ******** CHECK DIMENSIONS RESULTING FROM GAINS AND LOSSES *********
|
|
C *********************************************************************
|
|
C
|
|
NGTSUM = 0
|
|
NLTSUM = 0
|
|
NGSUM = 0
|
|
NLSUM = 0
|
|
NGFSUM = 0
|
|
DO 260 K = 1, NTSPEC(NCS)
|
|
J = INEWOLD(K,NCS)
|
|
NGTSUM = NGTSUM + NUMGAINT(K,NCS)
|
|
NLTSUM = NLTSUM + NUMLOST( K,NCS)
|
|
NGSUM = NGSUM + NUMGAIN( K,NCS)
|
|
NLSUM = NLSUM + NUMLOSS( K,NCS)
|
|
NGFSUM = NGFSUM + NUMGFRT( K,NCS)
|
|
IF (NUMGAINT(K,NCS) .GT. MAXGL .OR.
|
|
1 NUMLOST( K,NCS) .GT. MAXGL) THEN
|
|
WRITE(6,280) NAMENCS(J,NCS), NUMGAINT(K,NCS), NUMLOST(K,NCS)
|
|
CALL GEOS_CHEM_STOP
|
|
ENDIF
|
|
260 CONTINUE
|
|
C
|
|
IF (IOREAC.EQ.1) THEN
|
|
WRITE(IO93,*)
|
|
WRITE(IO93,240)
|
|
DO 270 K = 1, NTSPEC(NCS)
|
|
J = INEWOLD(K,NCS)
|
|
WRITE(IO93,250)NAMENCS( J,NCS),NUMGAINT(K,NCS),NUMGAIN( K,NCS),
|
|
1 NUMLOST( K,NCS),NUMLOSS( K,NCS),NUMGAINT(K,NCS)
|
|
2 -NUMLOST( K,NCS)-NUMGAIN( K,NCS)+NUMLOSS( K,NCS),
|
|
3 FRACGAIN(K,NCS),NUMGFRT( K,NCS)
|
|
270 CONTINUE
|
|
WRITE(IO93,250) 'OVERALL ',NGTSUM, NGSUM, NLTSUM, NLSUM,
|
|
1 NGTSUM - NLTSUM - NGSUM + NLSUM, 0., NGFSUM
|
|
ENDIF
|
|
C
|
|
IF (NMOTH( NCS).GT.MAXGL2.OR.NOLOSP(NCS).GT.MAXGL3.OR.
|
|
1 NGNFRAC(NCS).GT.MAXGL) THEN
|
|
WRITE(6,275) MAXGL2, NMOTH( NCS), MAXGL3, NOLOSP(NCS),
|
|
1 MAXGL, NGNFRAC(NCS)
|
|
CALL GEOS_CHEM_STOP
|
|
ENDIF
|
|
C
|
|
C *********************************************************************
|
|
C * CHECK WHETHER CHEMICAL SYSTEM IS ATOM-CONSERVATIVE *
|
|
C *********************************************************************
|
|
C JMBCOMP = SPECIES NUMBER FOR EACH SPECIES IN A MASS BAL. GROUP
|
|
C MBCOMP = COUNTS THE NUMBER OF MASS BALANCE SPECIES IN EACH M.B GROUP
|
|
C NMASBAL = NUMBER OF MASS BALANCE GROUPS (E.G. S, N, C ARE GROUPS)
|
|
C WTMB(1) = NUMBER OF ATOMS OF A GIVEN MASS BALANCE SPECIES PER MOLECULE
|
|
C
|
|
WRITE(IO93,360) CHEMTYP(NCS)
|
|
C
|
|
IF (NCS.LE.NCSGAS) THEN
|
|
C
|
|
C ---------------------------- GAS-PHASE --------------------------
|
|
C
|
|
DO 385 N = 1, NMASBAL
|
|
IF (MBCOMP(N,MB1).GT.0) THEN
|
|
TNUMGN = 0
|
|
TNUMLS = 0
|
|
WRITE(IO93,325) NAMEMB(N)
|
|
DO 380 J = 1, MBCOMP(N,MB1)
|
|
JGAS = JMBCOMP(N,J,MB1)
|
|
JNEW = MAPPL(JGAS,NCS)
|
|
SUMGN = NUMGAIN(JNEW,NCS) + FRACGAIN(JNEW,NCS)
|
|
TNUMGNA = SUMGN * WTMB(N,JGAS,MB1)
|
|
TNUMLSA = NUMLOSS(JNEW,NCS) * WTMB(N,JGAS,MB1)
|
|
TNUMGN = TNUMGN + TNUMGNA
|
|
TNUMLS = TNUMLS + TNUMLSA
|
|
WRITE(IO93,320) NAMEGAS(JGAS), TNUMGNA, TNUMLSA, 0
|
|
380 CONTINUE
|
|
WRITE(IO93,370) TNUMGN, TNUMLS, TNUMGN - TNUMLS
|
|
ENDIF
|
|
385 CONTINUE
|
|
ENDIF
|
|
C
|
|
WRITE(IO93,375) NALLRAT(NCSP), NALLRAT(NCS) - NALLRAT(NCSP),
|
|
1 NALLRAT(NCS)
|
|
C
|
|
360 FORMAT(/'CHANGE IN MOLES DUE TO ',A14,' CHEMISTRY')
|
|
325 FORMAT('MASS BALANCE GROUP = ',A14)
|
|
320 FORMAT('GAINS/LOSSES FOR ',A14,' = ',2(F8.3),I5)
|
|
370 FORMAT('TOTAL GAINS - LOSSES = ',3(F8.3))
|
|
375 FORMAT(/'# KINETIC REACTIONS: ',I5,' PHOTORATES: ',I5,
|
|
1 ' TOTAL: ',I5)
|
|
240 FORMAT('SPEC NUMGT NUMG NUMLT NUML NGT-NLT-',
|
|
1 'NG+NL FRACGN NUMGFT')
|
|
250 FORMAT(A14,4(2X,I4),7X,I4,3X,F8.3,I5)
|
|
280 FORMAT('GEARSET: SPEC ',A6,' DIMENS EXCEEDED. EITHER NUMGAINT ',
|
|
1 'NUMLOSS,NUMGAIN, OR NUMLOST > MAXGL ',
|
|
2 4(I3,1X))
|
|
275 FORMAT('JSPARSE: ONE OF THE DIMENSIONS BELOW IS TOO SMALL:',/,
|
|
1 'DIMENSION: MAXGL2 = ',I4,' VARIABLE: NMOTH = ',I4/
|
|
2 'DIMENSION: MAXGL3 = ',I4,' VARIABLE: NOLOSP = ',I4/
|
|
3 'DIMENSION: MAXGL = ',I4,' VARIABLE: NGNFRAC = ',I4)
|
|
C
|
|
C *********************************************************************
|
|
C *********************************************************************
|
|
C ** SET ARRAYS TO TAKE ADVANTAGE OF SPARSE MATRICES **
|
|
C *********************************************************************
|
|
C *********************************************************************
|
|
C
|
|
C IFSUN = 1 THEN DAY-CHEMISTRY; = 2 THEN NIGHT CHEMISTRY
|
|
C NCSP = NCS FOR DAYTIME TROP-GAS, STRAT-GAS CHEM
|
|
C NCSP = NCS + ICP FOR NIGHTTIME TROP-GAS, STRAT-GAS CHEM
|
|
C
|
|
C LZERO = 1 IF AN ARRAY SPOT IS FILLED WITH A NON-ZERO VALUE. LZERO
|
|
C IS UPDATED AS WE SIMULATE THE ORDER OF CALCULATIONS DURING
|
|
C A PRACTICE L-U DECOMPOSITION
|
|
C MXGSAER = LARGER OF IGAS, IAERTY
|
|
C
|
|
C
|
|
IF (IFNONE.EQ.0) THEN
|
|
IFNONE = 1
|
|
NPLFUN = 0
|
|
NFRCOUN = 0
|
|
NPDCOUN = 0
|
|
NPLTOT = 0
|
|
ENDIF
|
|
C
|
|
DO 700 IFSUN = 1, 2
|
|
NCSP = (IFSUN - 1) * ICS + NCS
|
|
C
|
|
DO 517 I = 1, MXGSAER
|
|
DO 515 J = 1, MXGSAER
|
|
LZERO(J,I) = 0
|
|
515 CONTINUE
|
|
LZERO(I,I) = 1
|
|
517 CONTINUE
|
|
C
|
|
DO 504 NA = 1, NALLRAT(NCSP)
|
|
NK = NCEQUAT(NA,NCS)
|
|
IHIREAC = NRUSE( NK,NCS)
|
|
DO 502 IAL = 1, IHIREAC
|
|
IRE = IRM2(IAL,NK,NCS)
|
|
DO 490 JAL = 1, IHIREAC
|
|
JRE = IRM2(JAL,NK,NCS)
|
|
LZERO(JRE,IRE) = 1
|
|
490 CONTINUE
|
|
DO 500 IAP = NPRODLO, IAPROD(NK,NCS)
|
|
JPR = IRM2(IAP,NK,NCS)
|
|
LZERO(JPR,IRE) = 1
|
|
500 CONTINUE
|
|
502 CONTINUE
|
|
504 CONTINUE
|
|
C
|
|
C *********************************************************************
|
|
C * SET DECOMPOSITION AND BACK-SUBSTITUTION SPARSE-MATRIX ARRAYS *
|
|
C *********************************************************************
|
|
C
|
|
CALL KSPARSE
|
|
|
|
C
|
|
C *********************************************************************
|
|
C * SET ARRAYS TO IMPROVE EFFICIENCY OF FIRST-DERIVATIVE CALCS *
|
|
C *********************************************************************
|
|
C *********************************************************************
|
|
C ** SET ARRAYS FOR KINETIC AND PHOTO PRODUCTION AND LOSS RATES **
|
|
C *********************************************************************
|
|
C
|
|
NPLLO(NCSP) = NPLTOT + 1
|
|
DO 670 I = 1, ISPORL(NCS)
|
|
JSPC = IPORL(I,NCS)
|
|
KNUMPORL = NUMPORL(JSPC,NCSP)
|
|
NCCOUNT = 0
|
|
NPLTOT = NPLTOT + 1
|
|
NREMAIN = KNUMPORL
|
|
NFIVE = (NREMAIN + 0.0001) / 5
|
|
NREMAIN = NREMAIN - NFIVE * 5
|
|
NFOUR = (NREMAIN + 0.0001) / 4
|
|
NREMAIN = NREMAIN - NFOUR * 4
|
|
NTHREE = (NREMAIN + 0.0001) / 3
|
|
NREMAIN = NREMAIN - NTHREE * 3
|
|
NTWO = (NREMAIN + 0.0001) / 2
|
|
NREMAIN = NREMAIN - NTWO * 2
|
|
NONE = (NREMAIN + 0.0001)
|
|
NREMAIN = NREMAIN - NONE
|
|
C
|
|
JSPNPL(NPLTOT) = JSPC
|
|
NPL5( NPLTOT) = NPLFUN + 1
|
|
NPH5( NPLTOT) = NPLFUN + NFIVE
|
|
NPL4( NPLTOT) = NPH5(NPLTOT) + 1
|
|
NPH4( NPLTOT) = NPH5(NPLTOT) + NFOUR
|
|
NPL3( NPLTOT) = NPH4(NPLTOT) + 1
|
|
NPH3( NPLTOT) = NPH4(NPLTOT) + NTHREE
|
|
NPL2( NPLTOT) = NPH3(NPLTOT) + 1
|
|
NPH2( NPLTOT) = NPH3(NPLTOT) + NTWO
|
|
NPL1( NPLTOT) = NPH2(NPLTOT) + 1
|
|
NPH1( NPLTOT) = NPH2(NPLTOT) + NONE
|
|
NPLFUN = NPH1(NPLTOT)
|
|
C
|
|
DO 649 N = 1, KNUMPORL
|
|
NK = JPORL(JSPC,N,NCS)
|
|
NEWNK(N) = NEWFOLD(NK,NCS)
|
|
649 CONTINUE
|
|
C
|
|
DO 651 MC = NPL5(NPLTOT), NPH5(NPLTOT)
|
|
LOSSRA(MC) = NEWNK(NCCOUNT+1)
|
|
LOSSRB(MC) = NEWNK(NCCOUNT+2)
|
|
LOSSRC(MC) = NEWNK(NCCOUNT+3)
|
|
LOSSRD(MC) = NEWNK(NCCOUNT+4)
|
|
LOSSRE(MC) = NEWNK(NCCOUNT+5)
|
|
NCCOUNT = NCCOUNT + 5
|
|
651 CONTINUE
|
|
C
|
|
DO 652 MC = NPL4(NPLTOT), NPH4(NPLTOT)
|
|
LOSSRA(MC) = NEWNK(NCCOUNT+1)
|
|
LOSSRB(MC) = NEWNK(NCCOUNT+2)
|
|
LOSSRC(MC) = NEWNK(NCCOUNT+3)
|
|
LOSSRD(MC) = NEWNK(NCCOUNT+4)
|
|
NCCOUNT = NCCOUNT + 4
|
|
652 CONTINUE
|
|
C
|
|
DO 653 MC = NPL3(NPLTOT), NPH3(NPLTOT)
|
|
LOSSRA(MC) = NEWNK(NCCOUNT+1)
|
|
LOSSRB(MC) = NEWNK(NCCOUNT+2)
|
|
LOSSRC(MC) = NEWNK(NCCOUNT+3)
|
|
NCCOUNT = NCCOUNT + 3
|
|
653 CONTINUE
|
|
C
|
|
DO 654 MC = NPL2(NPLTOT), NPH2(NPLTOT)
|
|
LOSSRA(MC) = NEWNK(NCCOUNT+1)
|
|
LOSSRB(MC) = NEWNK(NCCOUNT+2)
|
|
NCCOUNT = NCCOUNT + 2
|
|
654 CONTINUE
|
|
C
|
|
DO 656 MC = NPL1(NPLTOT), NPH1(NPLTOT)
|
|
LOSSRA(MC) = NEWNK(NCCOUNT+1)
|
|
NCCOUNT = NCCOUNT + 1
|
|
656 CONTINUE
|
|
C
|
|
670 CONTINUE
|
|
NPLHI(NCSP) = NPLTOT
|
|
C
|
|
C *********************************************************************
|
|
C * SET ARRAY FOR FRACTIONATED PRODUCTS *
|
|
C *********************************************************************
|
|
C
|
|
NFRLO(NCSP) = NFRCOUN + 1
|
|
DO 695 I = 1, NGNFRAC(NCSP)
|
|
JSPC = IGNFRAC(I,NCS)
|
|
NFRCOUN = NFRCOUN + 1
|
|
JSPCNFR(NFRCOUN) = JSPC
|
|
NK = NKGNFRAC(I,NCS)
|
|
NKNFR( NFRCOUN) = NEWFOLD(NK,NCS)
|
|
FRACNFR(NFRCOUN) = FRACP(I,NCS)
|
|
695 CONTINUE
|
|
NFRHI(NCSP) = NFRCOUN
|
|
C
|
|
C *********************************************************************
|
|
C * SET ARRAYS TO IMPROVE EFFICIENCY OF PARTIAL DERIVATIVE CALCS *
|
|
C *********************************************************************
|
|
C
|
|
NPDLO(NCSP) = NPDCOUN + 1
|
|
C
|
|
DO 974 NA = 1, NALLRAT(NCSP)
|
|
NK = NCEQUAT(NA,NCS)
|
|
IHIREAC = NRUSE( NK,NCS)
|
|
C
|
|
DO 972 IAL = 1, IHIREAC
|
|
IR = IRM2(IAL,NK,NCS)
|
|
DO 960 JAL = 1, IHIREAC
|
|
JR = IRM2(JAL,NK,NCS)
|
|
IAR = JARRAYPT(JR,IR)
|
|
NPDCOUN = NPDCOUN + 1
|
|
NKPDTERM(NPDCOUN) = NEWFOLD(NK,NCS)
|
|
IPOSPD( NPDCOUN) = IAR
|
|
IIALPD( NPDCOUN) = IAL
|
|
FRACPL( NPDCOUN) = -1.
|
|
960 CONTINUE
|
|
C
|
|
DO 970 IAP = NPRODLO, IAPROD(NK,NCS)
|
|
JP = IRM2(IAP,NK,NCS)
|
|
IAR = JARRAYPT(JP,IR)
|
|
NPDCOUN = NPDCOUN + 1
|
|
NKPDTERM(NPDCOUN) = NEWFOLD(NK,NCS)
|
|
IPOSPD( NPDCOUN) = IAR
|
|
IIALPD( NPDCOUN) = IAL
|
|
FRACPL( NPDCOUN) = FK2(IAP,NK,NCS)
|
|
970 CONTINUE
|
|
972 CONTINUE
|
|
974 CONTINUE
|
|
C
|
|
NPDHI(NCSP) = NPDCOUN
|
|
C
|
|
C *********************************************************************
|
|
C ** CHECK DIMENSIONS AND PRINT OUT ARRAY SAVINGS **
|
|
C *********************************************************************
|
|
C
|
|
IF (NPLTOT .GT. MXCOUNT4 .OR. NPLFUN .GT. MXCOUNT4 .OR.
|
|
3 NFRCOUN .GT. MXCOUNT4 .OR. NPDCOUN .GT. MXCOUNT2) THEN
|
|
WRITE(6,645) MXCOUNT4, NPLTOT, MXCOUNT4, NPLFUN,
|
|
2 MXCOUNT4, NFRCOUN, MXCOUNT2, NPDCOUN
|
|
CALL GEOS_CHEM_STOP
|
|
ENDIF
|
|
C
|
|
700 CONTINUE
|
|
C CONTINUE IFSUN = 1, 2
|
|
C
|
|
645 FORMAT('ONE OF THE DIMENSIONS BELOW IS TOO SMALL:',/,
|
|
1 'DIMENSION: MXCOUNT4 = ',I5,' VARIABLE: NPLTOT = ',I5,/,
|
|
2 'DIMENSION: MXCOUNT4 = ',I5,' VARIABLE: NPLFUN = ',I5,/,
|
|
3 'DIMENSION: MXCOUNT4 = ',I5,' VARIABLE: NFRCOUN = ',I5,/,
|
|
4 'DIMENSION: MXCOUNT2 = ',I5,' VARIABLE: NPDCOUN = ',I5)
|
|
C
|
|
C *********************************************************************
|
|
C ********************** END OF SUBROUTINE JSPARSE ********************
|
|
C *********************************************************************
|
|
C
|
|
RETURN
|
|
END SUBROUTINE JSPARSE
|