Add files via upload

code/fjfunc.f

@@ -0,0 +1,71 @@
+! $Id: fjfunc.f,v 1.1 2009/06/09 21:51:53 daven Exp $
+      REAL*8 FUNCTION FJFUNC( I, J, L, NREAC, BRCH, NAME )
+!
+!*****************************************************************************
+!  Subroutine FJFUNC supplies J-values to SMVGEAR solver.
+!  (ppm, 4/98, bmy, 9/99, 10/15/02)
+!
+!  Arguments as input:
+!  ===========================================================================
+!  (1-3) I, J, L : Latitude, Longitude, Altitude indices of CTM grid box
+!  (4  ) NREAC   : SMVGEAR photo reaction number (read from "chem.dat")
+!  (5  ) BRCH    : SMVGEAR branch index (computed from "chem.dat")
+!  (6  ) NAME    : SMVGEAR species name (read from "chem.dat")
+!
+!  NOTES:
+!  (1  ) "cmn_fj.h" also includes "CMN_SIZE" and "define.h".
+!  (2  ) J-values are stored in array "ZPJ" from "cmn_fj.h".
+!  (3  ) Now references ERROR_STOP from "error_mod.f".  Updated comments,
+!         and made some cosmetic changes. (bmy, 10/15/02)
+!*****************************************************************************
+!
+      ! References to F90 modules
+      USE ERROR_MOD, ONLY : ERROR_STOP
+
+      IMPLICIT NONE
+
+#     include "cmn_fj.h"
+
+      ! Arguments
+      INTEGER,           INTENT(IN) :: I, J, L, NREAC, BRCH
+      CHARACTER (LEN=4), INTENT(IN) :: NAME
+
+      ! Local variables
+      INTEGER                       :: N
+
+      !=================================================================
+      ! FJFUNC begins here!
+      !
+      ! If your compiler has subscript-range checking (-C or
+      ! -check_bounds) then it is recommended to use this option to
+      ! test for the validity of (I,J,L), since repeated IF statements
+      ! are computationally expensive.
+      !
+      ! If your compiler does not have subscript-range checking, then
+      ! uncomment the following lines to do a manual test for the
+      ! validity of (I,J,L).
+      !=================================================================
+      !IF ( I > IPAR .OR. J > JPAR .OR. L > JPNL ) THEN
+      !   STOP 'invalid grid-box # in call to fjfunc - check fjfunc.f'
+      !ENDIF
+
+      !=================================================================
+      ! RINDEX converts the J-value index as read from "chem.dat" to
+      ! the J-value index as read from "ratj.d". (bmy, 10/5/98)
+      !
+      ! Make sure that we have taken the proper reaction!
+      !=================================================================
+      N = RINDEX(NREAC)
+
+      IF ( N > JPPJ ) THEN
+         WRITE(6,*) 'RXN for ',name,', branch ',brch,' not found!'
+         CALL ERROR_STOP( 'Check FJFUNC.F', 'fjfunc.f' )
+      ENDIF
+
+      !=================================================================
+      ! Return the appropriate J-value as the value of the function
+      !=================================================================
+      FJFUNC = ZPJ(L,N,I,J)
+
+      ! Return to calling program
+      END FUNCTION FJFUNC