! $Id: tropopause_mod.f,v 1.3 2009/06/18 21:29:43 daven Exp $ MODULE TROPOPAUSE_MOD ! !****************************************************************************** ! Module TROPOPAUSE_MOD contains routines and variables for reading and ! returning the value of the annual mean tropopause. (bmy, 8/15/05, 11/14/08) ! ! Module Variables: ! ============================================================================ ! (1 ) LMIN (INTEGER) : Minimum extent of annual mean tropopause ! (2 ) LMAX (INTEGER) : Maximum extent of annual mean tropopause ! (3 ) LPAUSE (INTEGER) : Array for annual mean tropopause ! (4 ) IFLX (INTEGER) : Array for tropopause flags for ND27 (OBSOLETE) ! ! Module Routines: ! ============================================================================ ! (1 ) READ_TROPOPAUSE : Reads annual mean tropopause from disk ! (2 ) GET_MIN_TPAUSE_LEVEL : Returns min extent of ann mean tropopause ! (3 ) GET_MAX_TPAUSE_LEVEL : Returns max extent of ann mean tropopause ! (4 ) GET_TPAUSE_LEVEL : Returns tropopause level at box (I,J) ! (5 ) ITS_IN_THE_TROP : Returns TRUE if box (I,J,L) is in troposphere ! (6 ) ITS_IN_THE_STRAT : Returns TRUE if box (I,J,L) is in stratosphere ! (7 ) INIT_TROPOPAUSE : Allocates and zeroes all module arrays ! (8 ) CLEANUP_TROPOPAUSE : Deallocates all module arrays ! (9 ) COPY_FULL_TROP : for variable tropopause ! (10) SAVE_FULL_TROP : for variable tropopause ! (11) CHECK_VAR_TROP : check value of LLTROP and set LMAX and LMIN ! ! GEOS-CHEM modules referenced by tropopause_mod.f ! ============================================================================ ! (1 ) bpch2_mod.f : Module w/ routines for binary punch file I/O ! (2 ) comode_mod.f : Module w/ common for ODE ! (3 ) dao_mod.f : Module w/ input fields ! (3 ) directory_mod.f : Module w/ GEOS-CHEM met field and data dirs ! (4 ) error_mod.f : Module w/ NaN, other error check routines ! (6 ) pressure_mod.f : Module w/ routines to get pressure ! (7 ) time_mod.f : Module w/ time routines ! (8 ) transfer_mod.f : Module w/ routines to cast & resize arrays ! ! NOTES: ! (1 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05) ! (2 ) Simplify counting of tropospheric boxes (bmy, 11/1/05) ! (3 ) Added case of variable tropopause. ! The definition of the tropopause boxes is different in the two cases. ! They are part of the troposphere in the case of a variable ! troposphere. LMAX, LMIN are the min and max extent of the troposphere ! in that case. (bdf, phs, 1/19/07) ! (4 ) Bug fix: set NCS=NCSURBAN for safety's sake (bmy, 4/25/07) ! (5 ) Updated comments (bmy, 9/18/07) ! (6 ) Bug fix: make ITS_IN_THE_STRAT more robust. (phs, 11/14/08) !****************************************************************************** ! IMPLICIT NONE !================================================================= ! MODULE PRIVATE DECLARATIONS -- keep certain internal variables ! and routines from being seen outside "tropopause_mod.f" !================================================================= ! Make everything PRIVATE ... PRIVATE ! ... except these routines PUBLIC :: CLEANUP_TROPOPAUSE PUBLIC :: CHECK_VAR_TROP PUBLIC :: COPY_FULL_TROP PUBLIC :: GET_MIN_TPAUSE_LEVEL PUBLIC :: GET_MAX_TPAUSE_LEVEL PUBLIC :: GET_TPAUSE_LEVEL PUBLIC :: ITS_IN_THE_TROP PUBLIC :: ITS_IN_THE_STRAT PUBLIC :: READ_TROPOPAUSE PUBLIC :: SAVE_FULL_TROP !================================================================= ! MODULE VARIABLES !================================================================= ! Scalars INTEGER :: LMIN, LMAX ! Arrays INTEGER, ALLOCATABLE :: TROPOPAUSE(:,:) INTEGER, ALLOCATABLE :: IFLX(:,:) !================================================================= ! MODULE ROUTINES -- follow below the "CONTAINS" statement !================================================================= CONTAINS !------------------------------------------------------------------------------ SUBROUTINE COPY_FULL_TROP ! !****************************************************************************** ! Subroutine COPY_FULL_TROP takes the saved full troposphere and copies ! chemical species into the current troposphere that will be used in SMVGEAR ! for this timestep. (phs, bmy, 9/14/06, 4/25/07) ! ! ROUTINE NEEDED BECAUSE WITH VARIABLE TROPOPAUSE ! JLOOP WILL NOT ALWAYS REFER TO THE SAME (I,J,L) BOX ! ! NOTES: ! (1 ) Very similar to a get_properties of an object. Should probably ! be in COMODE_MOD.F, and called GET_SPECIES_CONCENTRATION (phs) ! (2 ) Bug fix: set NCS=NCSURBAN for safety's sake (bmy, 4/25/07) !****************************************************************************** ! ! References to F90 modules USE COMODE_MOD, ONLY : CSPEC, CSPEC_FULL USE COMODE_MOD, ONLY : IXSAVE, IYSAVE, IZSAVE IMPLICIT NONE # include "CMN_SIZE" # include "comode.h" ! Local variables INTEGER :: JGAS, JLOOP, IX, IY, IZ INTEGER :: LOCATION(4) !================================================================= ! COPY_FULL_TROP begins here! !================================================================= ! Reset NCS to NCSURBAN for safety's sake (bmy, 4/25/07) NCS = NCSURBAN !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( JGAS, JLOOP, IX, IY, IZ ) ! Loop over species DO JGAS = 1, NTSPEC(NCS) ! Loop over 1-D grid boxes DO JLOOP = 1, NTLOOP ! 3-D array indices IX = IXSAVE(JLOOP) IY = IYSAVE(JLOOP) IZ = IZSAVE(JLOOP) ! Copy from 3-D array CSPEC(JLOOP,JGAS) = CSPEC_FULL(IX,IY,IZ,JGAS) ENDDO ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE COPY_FULL_TROP !------------------------------------------------------------------------------ SUBROUTINE SAVE_FULL_TROP ! !****************************************************************************** ! Subroutine SAVE_FULL_TROP takes the current troposphere and copies chemical ! species into the full troposphere that will be used in SMVGEAR for this ! timestep. (phs, bmy, 9/14/06) ! ! ROUTINE NEEDED BECAUSE WITH VARIABLE TROPOPAUSE ! JLOOP WILL NOT ALWAYS REFER TO THE SAME (I,J,L) BOX ! ! NOTES: ! (1 ) Very similar to a set_properties of an object. Should probably ! be in COMODE_MOD.F, and called SAVE_SPECIES_CONCENTRATION (phs) ! (2 ) Bug fix: set NCS=NCSURBAN for safety's sake! (bmy, 4/25/07) !****************************************************************************** ! ! References to F90 modules USE COMODE_MOD, ONLY : CSPEC, CSPEC_FULL USE COMODE_MOD, ONLY : IXSAVE, IYSAVE, IZSAVE IMPLICIT NONE # include "CMN_SIZE" # include "comode.h" ! Local variables INTEGER :: JGAS, JLOOP, IX, IY, IZ !================================================================= ! SAVE_FULL_TROP begins here! !================================================================= ! Reset NCS to NCSURBAN for safety's sake (bmy, 4/25/07) NCS = NCSURBAN !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( JGAS, JLOOP, IX, IY, IZ ) ! Loop over species DO JGAS = 1, NTSPEC(NCS) ! Loop over 1-D grid boxes DO JLOOP = 1, NTLOOP ! 3-D array indices IX = IXSAVE(JLOOP) IY = IYSAVE(JLOOP) IZ = IZSAVE(JLOOP) ! Save in 3-D array CSPEC_FULL(IX,IY,IZ,JGAS) = CSPEC(JLOOP,JGAS) ENDDO ENDDO !$OMP END PARALLEL DO ! Return to calling program END SUBROUTINE SAVE_FULL_TROP !------------------------------------------------------------------------------ SUBROUTINE CHECK_VAR_TROP ! !****************************************************************************** ! Subroutine CHECK_VAR_TROP checks that the entire variable troposphere is ! included in the 1..LLTROP range, and set the LMIN and LMAX to current ! min and max tropopause. (phs, 8/24/06, 1/19/07) ! ! NOTES: ! (1 ) LLTROP is set at the first level entirely above 20 km (phs, 9/29/06) ! (2 ) Fix LPAUSE for CH4 chemistry (phs, 1/19/07) !****************************************************************************** ! ! Reference to F90 modules USE DAO_MOD, ONLY : TROPP USE ERROR_MOD, ONLY : GEOS_CHEM_STOP # include "CMN_SIZE" ! Size parameters # include "CMN" ! LPAUSE, for backwards compatibility ! Local Variables INTEGER :: I, J REAL*8 :: TPAUSE_LEV(IIPAR,JJPAR) !================================================================= ! CHECK_VAR_TROP begins here! !================================================================= ! set LMIN and LMAX to current min and max tropopause DO J = 1, JJPAR DO I = 1, IIPAR TPAUSE_LEV(I,J) = GET_TPAUSE_LEVEL(I,J) ENDDO ENDDO LMIN = MINVAL( TPAUSE_LEV ) LMAX = MAXVAL( TPAUSE_LEV ) !### For backwards compatibility during transition (still needed??) !### LPAUSE is still used by CH4 chemistry and ND27 (phs, 1/19/07) LPAUSE = TPAUSE_LEV - 1 ! check to be sure LLTROP is large enough. IF ( LLTROP < LMAX ) THEN WRITE( 6, '(a)' ) 'CHECK_VAR_TROP: LLTROP is set too low!' WRITE( 6, 10 ) LMAX, LLTROP 10 FORMAT( 'MAX TROPOSPHERE LEVEL = ', i3, ' and LLTROP = ', i3 ) WRITE( 6, '(a)' ) 'STOP in TROPOPAUSE_MOD.F!!!' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CALL GEOS_CHEM_STOP ENDIF ! Return to calling program END SUBROUTINE CHECK_VAR_TROP !------------------------------------------------------------------------------ SUBROUTINE READ_TROPOPAUSE ! !****************************************************************************** ! Subroutine READ_TROPOPAUSE reads in the annual mean tropopause. ! (qli, bmy, 12/13/99, 11/1/05) ! ! NOTES: ! (1 ) Call READ_BPCH2 to read in the annual mean tropopause data ! which is stored in binary punch file format. (bmy, 12/13/99) ! (2 ) Now also read integer flags for ND27 diagnostic -- these determine ! how to sum fluxes from boxes adjacent to the annual mean tropoause. ! (qli, bmy, 1/7/00) ! (3 ) Cosmetic changes (bmy, 3/17/00) ! (4 ) Reference F90 module "bpch2_mod" which contains routine "read_bpch2" ! for reading data from binary punch files (bmy, 6/28/00) ! (5 ) Call TRANSFER_2D from "transfer_mod.f" to cast data from REAL*4 to ! INTEGER and also to resize to (IIPAR,JJPAR). ARRAY needs to be of ! size (IGLOB,JGLOB). Also updated comments and made cosmetic changes. ! Removed obsolete variables.(bmy, 9/26/01) ! (6 ) Removed obsolete code from 9/01 (bmy, 10/26/01) ! (7 ) Now read annual mean tropopause files from the ann_mean_trop_200202/ ! subdirectory of DATA_DIR (bmy, 1/24/02) ! (8 ) Eliminated obsolete code from 1/02 (bmy, 2/27/02) ! (9 ) Now write file name to stdout (bmy, 4/3/02) ! (10) Now reference GEOS_CHEM_STOP from "error_mod.f", which frees all ! allocated memory before stopping the run. (bmy, 10/15/02) ! (11) Now call READ_BPCH2 with QUIET=.TRUE. to suppress printing of extra ! info to stdout. Also updated FORMAT strings. (bmy, 3/14/03) ! (12) Now references DATA_DIR from "directory_mod.f" (bmy, 7/20/04) ! (13) Now bundled into "tropopause_mod.f' (bmy, 2/10/05) ! (14) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05) ! (15) Simplify counting of # of tropospheric boxes (bmy, 11/1/05) !****************************************************************************** ! ! References to F90 modules USE BPCH2_MOD, ONLY : GET_NAME_EXT, GET_RES_EXT USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2 USE DIRECTORY_MOD, ONLY : DATA_DIR USE ERROR_MOD, ONLY : GEOS_CHEM_STOP USE TRANSFER_MOD, ONLY : TRANSFER_2D # include "CMN_SIZE" ! Size parameters # include "CMN" ! LPAUSE, for backwards compatibility ! Local Variables LOGICAL, SAVE :: FIRST=.TRUE. INTEGER :: I, J, COUNT REAL*4 :: ARRAY(IGLOB,JGLOB,1) CHARACTER(LEN=255) :: FILENAME !================================================================= ! READ_TROPOPAUSE begins here! ! ! Read the annual mean tropopause from disk (binary punch file ! format). Transfer data into an array of size (IIPAR,JJPAR). !================================================================= ! Allocate arrays IF ( FIRST ) THEN CALL INIT_TROPOPAUSE FIRST = .FALSE. ENDIF ! Create filename FILENAME = TRIM( DATA_DIR ) // & 'ann_mean_trop_200202/ann_mean_trop.' // & GET_NAME_EXT() // '.' // GET_RES_EXT() ! Write file name to stdout WRITE( 6, 110 ) TRIM( FILENAME ) 110 FORMAT( ' - READ_TROPOPAUSE: Reading ', a ) ! Annual mean tropopause is tracer #1 CALL READ_BPCH2( FILENAME, 'TR-PAUSE', 1, & 0d0, IGLOB, JGLOB, & 1, ARRAY, QUIET=.TRUE. ) ! Copy from REAL*4 to INTEGER and resize to (IIPAR,JJPAR) CALL TRANSFER_2D( ARRAY(:,:,1), TROPOPAUSE ) !### For backwards compatibility during transition LPAUSE = TROPOPAUSE !----------------------------------------------------------------------------- ! Prior to 2/10/05: ! For now don't read in IFLUX (bmy, 1/2 ! ! Integer flags for ND27 diagnostic is tracer #4 ! CALL READ_BPCH2( FILENAME, 'TR-PAUSE', 4, 0d0, ! & IGLOB, JGLOB, 1, ARRAY, QUIET=.TRUE. ) ! ! ! Copy from REAL*4 to INTEGER and resize to (IIPAR,JJPAR) ! CALL TRANSFER_2D( ARRAY(:,:,1), IFLX ) !----------------------------------------------------------------------------- !================================================================= ! L < TROPOPAUSE(I,J) are tropospheric boxes ! L >= TROPOPAUSE(I,J) are stratospheric boxes ! ! LMIN = level where minimum extent of the TROPOPAUSE occurs ! LMAX = level where maximum extent of the TROPOPAUSE occurs ! ! LMIN-1 = level where minimum extent of the TROPOSPHERE occurs ! LMAX-1 = level where maximum extent of the TROPOSPHERE occurs ! ! Write LMAX-1 and LMIN-1 to the standard output. ! ! Also make sure that LMAX-1 does not exceed LLTROP, since LLTROP ! is used to dimension the chemistry arrays in "comode.h". !================================================================= LMIN = MINVAL( TROPOPAUSE ) LMAX = MAXVAL( TROPOPAUSE ) WRITE( 6, 120 ) LMIN-1 120 FORMAT( ' - READ_TROPOPAUSE: Minimum tropospheric extent,', & ' L=1 to L=', i3 ) WRITE( 6, 130 ) LMAX-1 130 FORMAT( ' - READ_TROPOPAUSE: Maximum tropospheric extent,', & ' L=1 to L=', i3 ) IF ( LMAX-1 > LLTROP ) THEN WRITE( 6, '(a)' ) 'READ_TROPOPAUSE: LLTROP is set too low!' WRITE( 6, 131 ) LMAX-1, LLTROP 131 FORMAT( 'LMAX = ', i3, ' LLTROP = ', i3 ) WRITE( 6, '(a)' ) 'STOP in READ_TROPOPAUSE.F!!!' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CALL GEOS_CHEM_STOP ENDIF !================================================================= ! Write the number of tropopsheric and stratospheric boxes. ! Recall that tropospheric boxes extend up to TROPOPAUSE - 1. !================================================================= COUNT = SUM( TROPOPAUSE - 1 ) WRITE( 6, 140 ) COUNT 140 FORMAT( ' - READ_TROPOPAUSE: # of tropopsheric boxes: ', i8 ) WRITE( 6, 150 ) ( IIPAR * JJPAR * LLPAR ) - COUNT 150 FORMAT( ' - READ_TROPOPAUSE: # of stratospheric boxes: ', i8 ) ! Return to calling program END SUBROUTINE READ_TROPOPAUSE !------------------------------------------------------------------------------ FUNCTION GET_MAX_TPAUSE_LEVEL() RESULT( L_MAX ) ! !****************************************************************************** ! Function GET_MAX_TPAUSE_LEVEL returns GEOS-CHEM level at the highest extent ! of the annual mean tropopause. (bmy, 2/10/05) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: L_MAX !================================================================= ! GET_MAX_TPAUSE_LEVEL begins here! !================================================================= L_MAX = LMAX ! Return to calling program END FUNCTION GET_MAX_TPAUSE_LEVEL !------------------------------------------------------------------------------ FUNCTION GET_MIN_TPAUSE_LEVEL() RESULT( L_MIN ) ! !****************************************************************************** ! Function GET_MIN_TPAUSE_LEVEL returns GEOS-CHEM level at the lowest extent ! of the annual mean tropopause. (bmy, 2/10/05) ! ! NOTES: !****************************************************************************** ! ! Function value INTEGER :: L_MIN !================================================================= ! GET_MIN_TPAUSE_LEVEL begins here! !================================================================= L_MIN = LMIN ! Return to calling program END FUNCTION GET_MIN_TPAUSE_LEVEL !------------------------------------------------------------------------------ FUNCTION GET_TPAUSE_LEVEL( I, J ) RESULT( L_TP ) ! !****************************************************************************** ! Function GET_TPAUSE_LEVEL returns the model level L_TP which contains the ! GEOS_CHEM annual mean tropopause at grid box (I,J). Note that L_TP is ! considered to be in the stratosphere. Levels L_TP-1 and below are ! considered to be purely tropospheric levels. (bmy, 8/22/05) ! ! NOTES: ! (1 ) If logical LVARTROP is true (i.e., case of a variable tropopause), ! the tropopause box (i.e., the tropopause level) is the highest purely ! tropospheric box. !****************************************************************************** ! USE DAO_MOD, ONLY : TROPP, PSC2 USE LOGICAL_MOD, ONLY : LVARTROP USE ERROR_MOD, ONLY : GEOS_CHEM_STOP USE PRESSURE_MOD, ONLY : GET_PEDGE # include "CMN_SIZE" ! Size parameters ! Arguments INTEGER, INTENT(IN) :: I, J ! Local variables INTEGER :: L_TP, L REAL*8 :: PRESS_BEDGE !================================================================= ! GET_TPAUSE_LEVEL begins here! !================================================================= IF ( LVARTROP ) THEN L = 1 DO !check to find the current tropopause PRESS_BEDGE = GET_PEDGE(I,J,L) IF ( TROPP(I,J) .GE. PRESS_BEDGE ) THEN L_TP = L-1 ! get_pedge gets edge for BOTTOM of box EXIT ENDIF L = L+1 ! THIS TEST IS DUBIOUS since GET_PEDGE will not be defined ! if L > LLPAR ! IF (L .GT. 1000000) THEN ! replaced by (phs): IF ( L .GT. LLPAR ) THEN WRITE( 6, '(a)' ) 'GET_TPAUSE_LEVEL: CANNOT ' // & 'FIND T-PAUSE !' WRITE( 6, 160 ) L 160 FORMAT( 'L reaches ', i3 ) WRITE( 6, '(a)' ) 'STOP in GET_TPAUSE_LEVEL' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) CALL GEOS_CHEM_STOP ENDIF ENDDO ELSE L_TP = TROPOPAUSE(I,J) ENDIF ! DEBUG: ! write(6,*) i,j, 'value of tropopause pressure', tropp(i,j) ! write(6,*) 'surface pressure', psc2(i,j) ! Return to calling program END FUNCTION GET_TPAUSE_LEVEL !------------------------------------------------------------------------------ FUNCTION ITS_IN_THE_TROP( I, J, L ) RESULT ( IS_TROP ) ! !****************************************************************************** ! Function ITS_IN_THE_TROP returns TRUE if grid box (I,J,L) lies within ! the troposphere, or FALSE otherwise. (phs, bmy, 2/10/05, 9/14/06) ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! (3 ) L (INTEGER) : GEOS-CHEM level index ! ! NOTES: ! (1 ) Modified for variable tropopause (phs, 9/14/06) !****************************************************************************** ! ! References to F90 modules USE DAO_MOD, ONLY : TROPP, PSC2 USE LOGICAL_MOD, ONLY : LVARTROP USE PRESSURE_MOD, ONLY : GET_PEDGE ! Arguments INTEGER, INTENT(IN) :: I, J, L ! Local variables REAL*8 :: PRESS_BEDGE ! Return value LOGICAL :: IS_TROP !================================================================= ! ITS_IN_THE_TROP begins here !================================================================= IF ( LVARTROP ) THEN ! Get bottom pressure edge PRESS_BEDGE = GET_PEDGE(I,J,L) ! Check against actual tropopause pressure IS_TROP = ( PRESS_BEDGE > TROPP(I,J) ) ELSE ! Check against annual mean tropopause IS_TROP = ( L < TROPOPAUSE(I,J) ) ENDIF ! Return to calling program END FUNCTION ITS_IN_THE_TROP !------------------------------------------------------------------------------ FUNCTION ITS_IN_THE_STRAT( I, J, L ) RESULT( IS_STRAT ) ! !****************************************************************************** ! Function ITS_IN_THE_STRAT returns TRUE if grid box (I,J,L) lies within ! the stratosphere, or FALSE otherwise. (phs, bmy, 2/10/05, 11/14/08) ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! (3 ) L (INTEGER) : GEOS-CHEM level index ! ! NOTES: ! (1 ) Modified for variable tropopause (phs, 9/14/06) ! (2 ) Now return the opposite value of ITS_IN_THE_TROP. This should help ! to avoid numerical issues. (phs, 11/14/08) !****************************************************************************** ! ! References to F90 modules USE DAO_MOD, ONLY : TROPP, PSC2 USE LOGICAL_MOD, ONLY : LVARTROP USE PRESSURE_MOD, ONLY : GET_PEDGE ! Arguments INTEGER, INTENT(IN) :: I, J, L ! Local variables REAL*8 :: PRESS_BEDGE ! Return value LOGICAL :: IS_STRAT !================================================================= ! ITS_IN_THE_STRAT begins here !================================================================= ! Make the algorithm more robust by making ITS_IN_THE_STRAT be the ! exact opposite of function ITS_IN_THE_TROP. This should avoid ! numerical issues. (phs, 11/14/08) IS_STRAT = ( .not. ITS_IN_THE_TROP( I, J, L ) ) ! Return to calling program END FUNCTION ITS_IN_THE_STRAT !------------------------------------------------------------------------------ SUBROUTINE INIT_TROPOPAUSE ! !****************************************************************************** ! Subroutine INIT_TROPOPAUSE allocates & zeroes module arrays. (bmy, 2/10/05) ! ! NOTES: !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : ALLOC_ERR # include "CMN_SIZE" INTEGER :: AS !================================================================= ! INIT_TROPOPAUSE !================================================================= ALLOCATE( TROPOPAUSE( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'TROPOPAUSE' ) TROPOPAUSE = 0 ! For now don't allocate IFLX !ALLOCATE( IFLX( IIPAR, JJPAR ), STAT=AS ) !IF ( AS /= 0 ) CALL ALLOC_ERR( 'IFLX' ) !IFLX = 0 ! Return to calling program END SUBROUTINE INIT_TROPOPAUSE !------------------------------------------------------------------------------ SUBROUTINE CLEANUP_TROPOPAUSE ! !****************************************************************************** ! Subroutine CLEANUP_TROPOPAUSE deallocates module arrays (bmy, 2/10/05) ! ! NOTES: !****************************************************************************** ! !================================================================= ! CLEANUP_TROPOPAUSE begins here! !================================================================= IF ( ALLOCATED( TROPOPAUSE ) ) DEALLOCATE( TROPOPAUSE ) IF ( ALLOCATED( IFLX ) ) DEALLOCATE( IFLX ) ! Return to calling program END SUBROUTINE CLEANUP_TROPOPAUSE !------------------------------------------------------------------------------ ! End of module END MODULE TROPOPAUSE_MOD