72 lines
2.8 KiB
Fortran
72 lines
2.8 KiB
Fortran
! $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
|