Add files via upload
This commit is contained in:
Xuesong (Steve)
272
code/subfun.f
Normal file
272
code/subfun.f
Normal file
@ -0,0 +1,272 @@
|
||||
! $Id: subfun.f,v 1.1 2009/06/09 21:51:54 daven Exp $
|
||||
SUBROUTINE SUBFUN
|
||||
!
|
||||
!******************************************************************************
|
||||
! Subroutine SUBFUN evaluates the first derivative of each ODE for SMVGEAR II.
|
||||
! (M. Jacobson, 1997; bdf, bmy, 4/1/03)
|
||||
!
|
||||
! NOTES:
|
||||
! (1 ) Now force double-precision with the "D" exponent (bmy, 4/18/03)
|
||||
!******************************************************************************
|
||||
!
|
||||
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 SSSSSSS U U BBBBBBB FFFFFFF U U N N
|
||||
C S U U B B F U U NN N
|
||||
C SSSSSSS U U BBBBBBB FFF U U N N N
|
||||
C S U U B B F U U N NN
|
||||
C SSSSSSS UUUUUUU BBBBBBB F UUUUUUU N N
|
||||
C
|
||||
C *********************************************************************
|
||||
C * THIS SUBROUTINE EVALUATES THE FIRST DERIVATIVE OF EACH ORDINARY *
|
||||
C * DIFFERENTIAL EQUATION (ODE) *
|
||||
C * *
|
||||
C * HOW TO CALL SUBROUTINE: *
|
||||
C * ---------------------- *
|
||||
C * CALL SUBFUN.F FROM SMVGEAR.F WITH *
|
||||
C * NCS = 1..NCSGAS FOR GAS CHEMISTRY *
|
||||
C * NCSP = NCS FOR DAYTIME GAS CHEM *
|
||||
C * NCSP = NCS +ICS FOR NIGHTTIME GAS CHEM *
|
||||
C *********************************************************************
|
||||
C
|
||||
C EXAMPLE
|
||||
C -------
|
||||
C
|
||||
C SPECIES: A, B, C
|
||||
C CONCENTRATIONS: [A], [B], [C]
|
||||
C
|
||||
C REACTIONS: 1) A --> B J
|
||||
C 2) A + B --> C K1
|
||||
C 3 A + B + C --> D K2
|
||||
C
|
||||
C FIRST d[A] / dt = -J[A] - K1[A][B] - K2[A][B][C]
|
||||
C DERIVATIVES: d[B] / dt = +J[A] - K1[A][B] - K2[A][B][C]
|
||||
C d[C] / dt = + K1[A][B] - K2[A][B][C]
|
||||
C d[D] / dt = + K2[A][B][C]
|
||||
C
|
||||
C *********************************************************************
|
||||
C
|
||||
C CONCMULT = PRODUCT OF CONCENTRATIONS IN A RATE. IF TWO
|
||||
C CONSECUTIVE REACTIONS HAVE THE SAME SPECIES REACTING
|
||||
C (EG A + B --> C AND A + B --> D + E) THEN USE THE
|
||||
C SAME VALUE OF CONCMULT FOR BOTH REACTIONS.
|
||||
C CNEW = INIT (AND FINAL) SPECIES CONC (# CM-3-AIR OR MOLES L-1-H2O)
|
||||
C GLOSS = FIRST DERIVATIVE = SUM OF PROD. MINUS LOSS RATES FOR A SPECIES
|
||||
C IRMA,B,C = LOCATES REORDERED ACTIVE SPECIES NUMBERS
|
||||
C ISCHAN = NUMBER OF ODES.
|
||||
C LOSSRA.. = REAORDERED REACTION RATE NUMBERS FOR EACH LOSS (AND PROD) TERM
|
||||
C KTLOOP = NUMBER OF GRID-CELLS IN A GRID-BLOCK
|
||||
C NSUBFUN = COUNTS THE NUMBER OF TIMES THIS ROUTINE IS CALLED
|
||||
C RRATE = FORWARD RATE COEFFICIENT
|
||||
C = S-1 FOR RATES WITH 1 REACTANT
|
||||
C = L-H2O MOLE-1 S-1 OR CM**3 #-1 S-1 FOR RATES WITH 2 REACTANTS
|
||||
C = L**2-H2O M-2 S-1 OR CM**6 #-2 S-1 FOR RATES WITH 3 REACTANTS
|
||||
C TRATE = REACTION RATE MOLES L-1 -H2O S-1 OR # CM-3 S-1
|
||||
C
|
||||
C *********************************************************************
|
||||
C * SET RATES OF REACTION *
|
||||
C *********************************************************************
|
||||
C
|
||||
C
|
||||
! Local variables
|
||||
INTEGER NKN,JA,JB,JC,NH,K,NK2,NH2,JSPC,NPL,NL5,NH5,NL4,NH4,NL3,NH3
|
||||
INTEGER NL2,NL1,NH1,NC,NK0,NK1,NK3,NK4,N
|
||||
INTEGER NK,I,JNEW,KLOOP
|
||||
REAL*8 CONCMULT,FRACN
|
||||
|
||||
NSUBFUN = NSUBFUN + 1
|
||||
NFDH1 = NFDH2 + IONER(NCSP)
|
||||
C
|
||||
C *********************************************************************
|
||||
C * FIRST DERIVATIVES FOR RATES WITH THREE ACTIVE LOSS TERMS *
|
||||
C *********************************************************************
|
||||
C
|
||||
|
||||
DO 102 NKN = 1, NFDH3
|
||||
JA = IRMA(NKN)
|
||||
JB = IRMB(NKN)
|
||||
JC = IRMC(NKN)
|
||||
NH = NKN + NALLR
|
||||
DO 100 K = 1, KTLOOP
|
||||
TRATE(K,NKN) = RRATE(K,NKN)*CNEW(K,JA)*CNEW(K,JB)*CNEW(K,JC)
|
||||
TRATE(K,NH) = -TRATE(K,NKN)
|
||||
100 CONTINUE
|
||||
102 CONTINUE
|
||||
|
||||
C
|
||||
C *********************************************************************
|
||||
C * FIRST DERIVATIVES FOR RATES WITH TWO ACTIVE LOSS TERMS *
|
||||
C *********************************************************************
|
||||
C
|
||||
|
||||
DO 152 NKN = NFDL2, NFDREP
|
||||
JA = IRMA(NKN)
|
||||
JB = IRMB(NKN)
|
||||
NH = NKN + NALLR
|
||||
DO 150 K = 1, KTLOOP
|
||||
TRATE(K,NKN) = RRATE(K,NKN) * CNEW(K,JA) * CNEW(K,JB)
|
||||
TRATE(K,NH) = -TRATE(K,NKN)
|
||||
150 CONTINUE
|
||||
152 CONTINUE
|
||||
|
||||
C
|
||||
C *********************************************************************
|
||||
C * FIRST DERIVATIVES FOR RATES WITH TWO ACTIVE LOSS TERMS AND *
|
||||
C * WHERE THE SUBSEQUENT REACTION HAS THE SAME REACTANTS BUT A *
|
||||
C * DIFFERENT RATE. *
|
||||
C *********************************************************************
|
||||
C
|
||||
DO 202 NKN = NFDREP1, NFDH2, 2
|
||||
JA = IRMA(NKN)
|
||||
JB = IRMB(NKN)
|
||||
NK2 = NKN + 1
|
||||
NH = NKN + NALLR
|
||||
NH2 = NK2 + NALLR
|
||||
DO 200 K = 1, KTLOOP
|
||||
CONCMULT = CNEW(K,JA) * CNEW(K,JB)
|
||||
TRATE(K,NKN) = RRATE(K,NKN) * CONCMULT
|
||||
TRATE(K,NK2) = RRATE(K,NK2) * CONCMULT
|
||||
TRATE(K,NH) = -TRATE(K,NKN)
|
||||
TRATE(K,NH2) = -TRATE(K,NK2)
|
||||
200 CONTINUE
|
||||
202 CONTINUE
|
||||
|
||||
C
|
||||
C *********************************************************************
|
||||
C * FIRST DERIVATIVES FOR RATES WITH ONE ACTIVE LOSS TERM *
|
||||
C *********************************************************************
|
||||
C
|
||||
DO 252 NKN = NFDL1, NFDH1
|
||||
JA = IRMA(NKN)
|
||||
NH = NKN + NALLR
|
||||
DO 250 K = 1, KTLOOP
|
||||
TRATE(K,NKN) = RRATE(K,NKN) * CNEW(K,JA)
|
||||
TRATE(K,NH) = -TRATE(K,NKN)
|
||||
250 CONTINUE
|
||||
252 CONTINUE
|
||||
|
||||
C
|
||||
C *********************************************************************
|
||||
C * INITIALIZE FIRST DERIVATIVE = 0 *
|
||||
C *********************************************************************
|
||||
C
|
||||
|
||||
DO 302 JSPC = 1, ISCHAN
|
||||
DO 300 K = 1, KTLOOP
|
||||
GLOSS(K,JSPC) = 0.d0
|
||||
300 CONTINUE
|
||||
302 CONTINUE
|
||||
|
||||
C
|
||||
C *********************************************************************
|
||||
C * SUM NET (NOT REPRODUCED) KINETIC AND PHOTO GAINS AND LOSSES FOR *
|
||||
C * EACH SPECIES. *
|
||||
C *********************************************************************
|
||||
C SUM 1,2,3,4, OR 5 TERMS AT A TIME TO IMPROVE VECTORIZATION.
|
||||
C
|
||||
DO 554 NPL = NPLLO(NCSP), NPLHI(NCSP)
|
||||
JSPC = JSPNPL(NPL)
|
||||
NL5 = NPL5( NPL)
|
||||
NH5 = NPH5( NPL)
|
||||
NL4 = NPL4( NPL)
|
||||
NH4 = NPH4( NPL)
|
||||
NL3 = NPL3( NPL)
|
||||
NH3 = NPH3( NPL)
|
||||
NL2 = NPL2( NPL)
|
||||
NH2 = NPH2( NPL)
|
||||
NL1 = NPL1( NPL)
|
||||
NH1 = NPH1( NPL)
|
||||
C
|
||||
C *********************** SUM 5 TERMS AT A TIME *********************
|
||||
C
|
||||
DO 352 NC = NL5, NH5
|
||||
NK0 = LOSSRA(NC)
|
||||
NK1 = LOSSRB(NC)
|
||||
NK2 = LOSSRC(NC)
|
||||
NK3 = LOSSRD(NC)
|
||||
NK4 = LOSSRE(NC)
|
||||
DO 350 K = 1, KTLOOP
|
||||
GLOSS(K,JSPC) = GLOSS(K,JSPC) - TRATE(K,NK0)
|
||||
1 - TRATE(K,NK1) - TRATE(K,NK2)
|
||||
2 - TRATE(K,NK3) - TRATE(K,NK4)
|
||||
350 CONTINUE
|
||||
352 CONTINUE
|
||||
|
||||
C
|
||||
C *********************** SUM 4 TERMS AT A TIME *********************
|
||||
C
|
||||
DO 402 NC = NL4, NH4
|
||||
NK0 = LOSSRA(NC)
|
||||
NK1 = LOSSRB(NC)
|
||||
NK2 = LOSSRC(NC)
|
||||
NK3 = LOSSRD(NC)
|
||||
DO 400 K = 1, KTLOOP
|
||||
GLOSS(K,JSPC) = GLOSS(K,JSPC) - TRATE(K,NK0)
|
||||
1 - TRATE(K,NK1) - TRATE(K,NK2)
|
||||
2 - TRATE(K,NK3)
|
||||
400 CONTINUE
|
||||
402 CONTINUE
|
||||
C
|
||||
C *********************** SUM 3 TERMS AT A TIME *********************
|
||||
C
|
||||
DO 452 NC = NL3, NH3
|
||||
NK0 = LOSSRA(NC)
|
||||
NK1 = LOSSRB(NC)
|
||||
NK2 = LOSSRC(NC)
|
||||
DO 450 K = 1, KTLOOP
|
||||
GLOSS(K,JSPC) = GLOSS(K,JSPC) - TRATE(K,NK0)
|
||||
1 - TRATE(K,NK1) - TRATE(K,NK2)
|
||||
450 CONTINUE
|
||||
452 CONTINUE
|
||||
C
|
||||
C *********************** SUM 2 TERMS AT A TIME *********************
|
||||
C
|
||||
DO 502 NC = NL2, NH2
|
||||
NK0 = LOSSRA(NC)
|
||||
NK1 = LOSSRB(NC)
|
||||
DO 500 K = 1, KTLOOP
|
||||
GLOSS(K,JSPC) = GLOSS(K,JSPC) - TRATE(K,NK0)
|
||||
1 - TRATE(K,NK1)
|
||||
500 CONTINUE
|
||||
502 CONTINUE
|
||||
C
|
||||
C *********************** SUM 1 TERM AT A TIME **********************
|
||||
C
|
||||
DO 552 NC = NL1, NH1
|
||||
NK0 = LOSSRA(NC)
|
||||
DO 550 K = 1, KTLOOP
|
||||
GLOSS(K,JSPC) = GLOSS(K,JSPC) - TRATE(K,NK0)
|
||||
550 CONTINUE
|
||||
552 CONTINUE
|
||||
554 CONTINUE
|
||||
C
|
||||
C *********************************************************************
|
||||
C * SUM PRODUCTION TERM FOR REACTIONS WHERE PRODUCTS FRACTIONATED *
|
||||
C *********************************************************************
|
||||
C
|
||||
DO 802 N = NFRLO(NCSP), NFRHI(NCSP)
|
||||
JSPC = JSPCNFR(N)
|
||||
NKN = NKNFR( N)
|
||||
FRACN = FRACNFR(N)
|
||||
DO 800 K = 1, KTLOOP
|
||||
GLOSS(K,JSPC) = GLOSS(K,JSPC) + FRACN * TRATE(K,NKN)
|
||||
800 CONTINUE
|
||||
802 CONTINUE
|
||||
|
||||
C
|
||||
C *********************************************************************
|
||||
C ********************** END OF SUBROUTINE SUBFUN *******************
|
||||
C *********************************************************************
|
||||
C
|
||||
RETURN
|
||||
END SUBROUTINE SUBFUN
|
||||
Reference in New Issue
Block a user