Add files via upload

code/update.f

@@ -0,0 +1,105 @@
+! $Id: update.f,v 1.1 2009/06/09 21:51:50 daven Exp $
+      SUBROUTINE UPDATE
+!
+!******************************************************************************
+!  Subroutine UPDATE updates rxn rates for each timestep for SMVGEAR II.
+!  (M. Jacobson, 1997, bdf, bmy, 4/18/03)
+!
+!  NOTES:
+!  (1 )
+!******************************************************************************
+!
+      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 ***                        (650) 723-6836                         ***
+C *********************************************************************
+C
+C        U     U  PPPPPPP  DDDDDD      A    TTTTTTT  EEEEEEE
+C        U     U  P     P  D     D    A A      T     E
+C        U     U  PPPPPPP  D     D   A   A     T     EEEEEEE
+C        U     U  P        D     D  AAAAAAA    T     E
+C        UUUUUUU  P        DDDDDD  A       A   T     EEEEEEE
+C
+C *********************************************************************
+C * THIS SUBROUTINE UPDATES PHOTORATES AND ARB EMISSIONS RATES FOR    *
+C * EACH TIME-STEP. PHOTORATES ARE INCLUDED IN FIRST AND PARTIAL      *
+C * DERIVATIVE EQUATIONS WHILE EMISSIONS RATES ARE INCLUDED IN FIRST  *
+C * DERIVATE EQUATIONS ONLY. SINCE THE EMISSIONS RATES ARE CONSTANT   *
+C * FOR A GIVEN TIME STEP AND LOCATION (ALTHOUGH THEY CHANGE EACH     *
+C * TIME STEP AND LOCATION, THEY ARE PUT INTO THE FIRST DERIVATIVE    *
+C * TERM OF SUBFUN.F ONLY (NOT INTO PARTIAL DERIVATIVE TERMS. EVERY   *
+C * INTEGRATION TIME-STEP, EMISSIONS ARE RECALCULATED.                *
+C *********************************************************************
+C
+C *********************************************************************
+C * UPDATE PHOTO-RATES AND OTHER PARMETERS BECAUSE THE TIME CHANGED.  *
+C * NOTE THAT A TIME CHANGE COULD CORRESPOND TO EITHER A SUCCESSFUL   *
+C * OR FAILED STEP                                                    *
+C *********************************************************************
+C RRATE    = PRATE1 + XELAPS * (PRATE - PRATE1)
+C XELAPS   = ELAPSED TIME DURING INTERVAL
+C IFPRAT   = 1: USE SCALED PHOTORATES FROM photrate.dat (ITESTGEAR.EQ.0)
+C          = 0: USE PHOTORATES FROM globchem.dat (ITESTGEAR > 0)
+C
+C *********************************************************************
+C **************          UPDATE PHOTORATES             ***************
+C ****************** INTERPOLATE BETWEEN TWO VALUES *******************
+C *********************************************************************
+C
+      ! Local variables
+      INTEGER J,NKN,KLOOP,I,NK,NH,ISPC1,ISPC2,ISPC3
+
+      REAL*8 TOFDAY,HOURANG,SINFUNC
+C
+C *********************************************************************
+C *      SET RATES WHERE PHOTOREACTION HAS NO ACTIVE LOSS TERM        *
+C *********************************************************************
+C JOLD = MAPPL(JOLD) FOR INACTIVE SPECIES
+C
+      DO 80 I            = 1, NOLOSP(NCSP)
+         NK                = NKNLOSP(I,NCS)
+         NKN               = NEWFOLD(NK,NCS)
+         NH                = NKN + NALLR
+         DO 79 KLOOP       = 1, KTLOOP
+            TRATE(KLOOP,NKN) =  RRATE(KLOOP,NKN)
+            TRATE(KLOOP,NH)  = -RRATE(KLOOP,NKN)
+ 79      CONTINUE
+ 80   CONTINUE
+C
+C *********************************************************************
+C *              PRINT OUT CHEMICAL RATES AND STOP                    *
+C *********************************************************************
+C
+      IF (IPRATES.EQ.1) THEN
+      if ( jlooplo == 744 ) then
+       DO 90 I           = 1, NALLRAT(NCS)
+        NK               = NCEQUAT(I,NCS)
+        NKN              = NEWFOLD(NK,NCS)
+        ISPC1            = IRM(1,NK,NCS)
+        ISPC2            = IRM(2,NK,NCS)
+        ISPC3            = IRM(3,NK,NCS)
+        IF (ISPC3.LT.0)          ISPC3 = 0
+        IF (ISPC1.GT.NSPEC(NCS)) ISPC1 = 0
+        IF (ISPC2.GT.NSPEC(NCS)) ISPC2 = 0
+        IF (ISPC3.GT.NSPEC(NCS)) ISPC3 = 0
+        WRITE(6,95)I,NK,NKN,NAMENCS(ISPC1,NCS), NAMENCS(ISPC2,NCS),
+     1             NAMENCS(ISPC3,NCS), RRATE(1,NKN)
+ 90    CONTINUE
+       STOP
+       endif
+      ENDIF
+ 95   FORMAT(I3,1X,I3,1X,I3,1X,3A15,1X,1PE13.6)
+C
+C *********************************************************************
+C ******************** END OF SUBROUTINE UPDATE.F *********************
+C *********************************************************************
+C
+      RETURN
+      END SUBROUTINE UPDATE
+