! $Id: pbl_mix_mod.f,v 1.4 2010/03/09 15:03:47 daven Exp $ MODULE PBL_MIX_MOD ! !****************************************************************************** ! Module PBL_MIX_MOD contains routines and variables used to compute the ! planetary boundary layer (PBL) height and to mix tracers underneath the ! PBL top. (bmy, 2/11/05, 8/4/06) ! ! Module Variables: ! ============================================================================ ! (1 ) IMIX (INTEGER) : Array for integer # of levels under PBL top ! (2 ) FPBL (REAL*8 ) : Array for frac # of levels under PBL top ! (3 ) F_OF_PBL (REAL*8 ) : Array for frac of box (I,J,L) w/in PBL ! (4 ) F_UNDER_TOP (REAL*8 ) : Array for frac of box (I,J,L) under PBL top ! (5 ) PBL_TOP_hPa (REAL*8 ) : Array for PBL top [hPa] ! (6 ) PBL_TOP_L (REAL*8 ) : Array for PBL top [model levels] ! (7 ) PBL_TOP_m (REAL*8 ) : Array for PBL top [m] ! (7 ) PBL_THICK (REAL*8 ) : Array for PBL thickness [hPa] ! ! Module Routines: ! ============================================================================ ! (1 ) DO_PBL_MIX : Driver routine for PBL mixing ! (2 ) GET_FRAC_OF_PBL : Returns fraction of grid box w/in PBL ! (3 ) GET_FRAC_UNDER_PBLTOP : Returns fraction of grid box under PBL top ! (4 ) GET_PBL_MAX_L : Returns model level at highest part of PBL ! (5 ) GET_PBL_TOP_hPa : Returns PBL top value in [hPa] ! (6 ) GET_PBL_TOP_L : Returns PBL top value in [model layers] ! (7 ) GET_PBL_THICK : Returns PBL thickness in [hPa] ! (8 ) GET_IMIX : Returns IMIX (adj_group, dkh, 07/08/09) ! (9 ) GET_FPBL : Returns FPBL (adj_group, dkh, 07/08/09) ! (10) INIT_PBL_MIX : Allocates and zeroes all module arrays ! (11) CLEANUP_PBL_MIX : Deallocates all module arrays ! ! GEOS-CHEM modules referenced by "input_mod.f" ! ============================================================================ ! (1 ) dao_mod.f : Module w/ arrays for DAO met fields ! (2 ) diag_mod.f : Module w/ GEOS-CHEM diagnostic arrays ! (3 ) error_mod.f : Module w/ I/O error and NaN check routines ! (4 ) grid_mod.f : Module w/ horizontal grid information ! (5 ) logical_mod.f : Module w/ GEOS-CHEM logical switches ! (6 ) pressure_mod.f : Module w/ routines to compute P(I,J,L) ! (7 ) time_mod.f : Module w/ routines for computing time & date ! (8 ) tracer_mod.f : Module w/ GEOS-CHEM tracer array STT etc. ! ! NOTES: ! (1 ) Now modified for GCAP and GEOS-5 met fields (bmy, 5/24/05) ! (2 ) Remove reference to "CMN" and XTRA2. (bmy, 8/30/05) ! (3 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06) !****************************************************************************** ! IMPLICIT NONE !================================================================= ! MODULE PRIVATE DECLARATIONS -- keep certain internal variables ! and routines from being seen outside "pbl_mix_mod.f" !================================================================= ! Make everything PRIVATE ... PRIVATE ! ... except these routines PUBLIC :: CLEANUP_PBL_MIX PUBLIC :: DO_PBL_MIX PUBLIC :: GET_FRAC_OF_PBL PUBLIC :: GET_FRAC_UNDER_PBLTOP PUBLIC :: GET_PBL_MAX_L PUBLIC :: GET_PBL_TOP_hPa PUBLIC :: GET_PBL_TOP_L PUBLIC :: GET_PBL_TOP_m PUBLIC :: GET_PBL_THICK ! adj_group (dkh, 07/08/09) PUBLIC :: GET_IMIX PUBLIC :: GET_FPBL PUBLIC :: COMPUTE_PBL_HEIGHT !================================================================= ! MODULE VARIABLES !================================================================= ! Scalars INTEGER :: PBL_MAX_L ! Arrays INTEGER, ALLOCATABLE :: IMIX(:,:) REAL*8, ALLOCATABLE :: FPBL(:,:) REAL*8, ALLOCATABLE :: F_OF_PBL(:,:,:) REAL*8, ALLOCATABLE :: F_UNDER_TOP(:,:,:) REAL*8, ALLOCATABLE :: PBL_TOP_hPa(:,:) REAL*8, ALLOCATABLE :: PBL_TOP_L(:,:) REAL*8, ALLOCATABLE :: PBL_TOP_m(:,:) REAL*8, ALLOCATABLE :: PBL_THICK(:,:) REAL*8, ALLOCATABLE :: XTRA2(:,:) !================================================================= ! MODULE ROUTINES -- follow below the "CONTAINS" statement !================================================================= CONTAINS !------------------------------------------------------------------------------ SUBROUTINE DO_PBL_MIX( DO_TURBDAY ) ! !****************************************************************************** ! Subroutine DO_PBL_MIX is the driver routine for planetary boundary layer ! mixing. The PBL layer height and related quantities are always computed. ! Complete mixing of tracers underneath the PBL top is toggled by the ! DO_TURBDAY switch. (bmy, 2/11/05) ! ! Arguments as Input: ! ============================================================================ ! (1 ) DO_TURBDAY (LOGICAL) : Switch which turns on PBL mixing of tracers ! ! NOTES: !****************************************************************************** ! ! References to F90 modules USE LOGICAL_MOD, ONLY : LTURB USE TRACER_MOD, ONLY : N_TRACERS, STT, TCVV USE TIME_MOD, ONLY : GET_NHMS,GET_NYMD, GET_TAU USE TRACER_MOD, ONLY : FP, IM # include "CMN_SIZE" ! Size parameters ! Arguments LOGICAL, INTENT(IN) :: DO_TURBDAY ! Local variables LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: NYMD, NHMS, I, J REAL*8 :: TAU !================================================================= ! DO_PBL_MIX begins here! !================================================================= NHMS = GET_NHMS() NYMD = GET_NYMD() TAU = GET_TAU() ! First-time initialization IF ( FIRST ) THEN CALL INIT_PBL_MIX FIRST = .FALSE. ENDIF ! Compute PBL height and related quantities CALL COMPUTE_PBL_HEIGHT ! Do complete mixing of tracers in the PBL (if necessary) IF ( DO_TURBDAY ) CALL TURBDAY( N_TRACERS, STT, TCVV ) ! Return to calling program END SUBROUTINE DO_PBL_MIX !------------------------------------------------------------------------------ SUBROUTINE COMPUTE_PBL_HEIGHT ! !****************************************************************************** ! Subroutine COMPUTE_PBL_HEIGHT computes the PBL height and other related ! quantities. (bmy, 2/15/05, 8/4/06) ! ! NOTES: ! (1 ) Now modified for GEOS-5 and GCAP met fields (swu, bmy, 5/25/05) ! (2 ) Remove reference to "CMN" and XTRA2 -- they're obsolete. Also do not ! force BLTOP, BLTHIK to minimum values for GEOS-STRAT met fields. ! (bmy, 8/30/05) ! (3 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06) !****************************************************************************** ! ! References to F90 modules USE DAO_MOD, ONLY : BXHEIGHT, PBL USE ERROR_MOD, ONLY : ERROR_STOP USE PRESSURE_MOD, ONLY : GET_PEDGE # include "CMN_SIZE" ! Size parameters # include "CMN_GCTM" ! Scale height ! Local variables INTEGER :: I, J, L, LTOP REAL*8 :: BLTOP, BLTHIK, DELP REAL*8 :: P(0:LLPAR) !================================================================= ! COMPUTE_PBL_HEIGHT begins here! !================================================================= !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L, P, BLTOP, BLTHIK, LTOP, DELP ) DO J = 1, JJPAR DO I = 1, IIPAR !---------------------------------------------- ! Define pressure edges: ! P(L-1) = P at bottom edge of box (I,J,L) ! P(L ) = P at top edge of box (I,J,L) !---------------------------------------------- ! Pressure at level edges [hPa] DO L = 0, LLPAR P(L) = GET_PEDGE(I,J,L+1) ENDDO #if defined( GEOS_3 ) !---------------------------------------------- ! GEOS-3: Find PBL top and thickness [hPa] !---------------------------------------------- ! BLTOP = pressure at PBL top ! PBL is in [hPa], so subtract it from surface pressure [hPa] BLTOP = P(0) - PBL(I,J) ! BLTHIK is PBL thickness [hPa] BLTHIK = MAX( PBL(I,J), 1d0 ) ! If the PBL depth is very small (or zero), then assume ! a PBL depth of 2 mb. This will prevent NaN's from ! propagating throughout the code. (bmy, 3/7/01) IF ( PBL(I,J) < 1d-5 ) BLTOP = P(0) - 2d0 #else !---------------------------------------------- ! GEOS-4, GEOS-5, GCAP: ! Find PBL top and thickness [hPa] !---------------------------------------------- ! BLTOP = pressure at PBL top [hPa] ! Use barometric law since PBL is in [m] BLTOP = P(0) * EXP( -PBL(I,J) / SCALE_HEIGHT ) ! BLTHIK is PBL thickness [hPa] BLTHIK = P(0) - BLTOP #endif !---------------------------------------------- ! Find model level where BLTOP occurs !---------------------------------------------- LTOP = 0 ! Loop over levels DO L = 1, LLPAR ! Exit when we get to the PBL top level IF ( BLTOP > P(L) ) THEN LTOP = L EXIT ENDIF ENDDO !---------------------------------------------- ! Define various related quantities !---------------------------------------------- ! IMIX(I,J) is the level where the PBL top occurs at (I,J) ! IMIX(I,J)-1 is the number of whole levels below the PBL top IMIX(I,J) = LTOP ! Fraction of the IMIXth level underneath the PBL top FPBL(I,J) = 1d0 - ( BLTOP - P(LTOP) ) / & ( P(LTOP-1) - P(LTOP) ) ! PBL top [model layers] PBL_TOP_L(I,J) = FLOAT( IMIX(I,J) - 1 ) + FPBL(I,J) ! PBL top [hPa] PBL_TOP_hPa(I,J) = BLTOP ! Zero PBL top [m] -- compute below PBL_TOP_m(I,J) = 0d0 ! PBL thickness [hPa] PBL_THICK(I,J) = BLTHIK !============================================================== ! Loop up to the maximum tropopause level !============================================================== DO L = 1, LLTROP ! Thickness of grid box (I,J,L) [hPa] DELP = P(L-1) - P(L) IF ( L < IMIX(I,J) ) THEN !-------------------------------------------- ! (I,J,L) lies completely below the PBL top !-------------------------------------------- ! Fraction of grid box (I,J,L) w/in the PBL F_OF_PBL(I,J,L) = DELP / BLTHIK ! Fraction of grid box (I,J,L) underneath PBL top F_UNDER_TOP(I,J,L) = 1d0 ! PBL height [m] PBL_TOP_m(I,J) = PBL_TOP_m(I,J) + BXHEIGHT(I,J,L) ELSE IF ( L == IMIX(I,J) ) THEN !-------------------------------------------- ! (I,J,L) straddles the PBL top !-------------------------------------------- ! Fraction of grid box (I,J,L) w/in the PBL F_OF_PBL(I,J,L) = ( P(L-1) - BLTOP ) / BLTHIK ! Fraction of grid box (I,J,L) underneath PBL top F_UNDER_TOP(I,J,L) = FPBL(I,J) ! PBL height [m] PBL_TOP_m(I,J) = PBL_TOP_m(I,J) + & ( BXHEIGHT(I,J,L) * FPBL(I,J) ) ELSE !-------------------------------------------- ! (I,J,L) lies completely above the PBL top !-------------------------------------------- ! Fraction of grid box (I,J,L) w/in the PBL F_OF_PBL(I,J,L) = 0d0 ! Fraction of grid box (I,J,L) underneath PBL top F_UNDER_TOP(I,J,L) = 0d0 ENDIF !### Debug ! IF ( I==23 .and. J==34 .and. L < 6 ) THEN ! PRINT*, '###--------------------------------------' ! PRINT*, '### COMPUTE_PBL_HEIGHT' ! PRINT*, '### I, J, L : ', I, J, L ! PRINT*, '### P(L-1) : ', P(L-1) ! PRINT*, '### P(L) : ', P(L) ! PRINT*, '### PBL(I,J) : ', PBL(I,J) ! PRINT*, '### F_OF_PBL : ', F_OF_PBL(I,J,L) ! PRINT*, '### F_UNDER_TOP : ', F_UNDER_TOP(I,J,L) ! PRINT*, '### IMIX : ', IMIX(I,J) ! PRINT*, '### FPBL : ', FPBL(I,J) ! PRINT*, '### PBL_TOP_hPa : ', PBL_TOP_hPa(I,J) ! PRINT*, '### PBL_TOP_L : ', PBL_TOP_L(I,J) ! PRINT*, '### DELP : ', DELP ! PRINT*, '### BLTHIK : ', BLTHIK ! PRINT*, '### BLTOP : ', BLTOP ! PRINT*, '### BXHEIGHT : ', BXHEIGHT(I,J,L) ! PRINT*, '### PBL_TOP_m : ', PBL_TOP_m(I,J) ! PRINT*, '### other way m : ', ! & P(0) * EXP( -PBL_TOP_hPa(I,J) / SCALE_HEIGHT ) ! ENDIF ENDDO ! Error check IF ( ABS( SUM( F_OF_PBL(I,J,:) ) - 1.d0 ) > 1.d-3 ) THEN PRINT*, 'bad sum at: ', I, J CALL ERROR_STOP( 'Error in computing F_OF_PBL!', & 'COMPUTE_PBL_HEIGHT ("pbl_mix_mod.f")' ) ENDIF ENDDO ENDDO !$OMP END PARALLEL DO ! Model level where PBL top occurs PBL_MAX_L = MAXVAL( IMIX ) ! Return to calling program END SUBROUTINE COMPUTE_PBL_HEIGHT !------------------------------------------------------------------------------ SUBROUTINE TURBDAY( NTRC, TC, TCVV ) ! !****************************************************************************** ! Subroutine TURBDAY executes the GEOS-CTM dry convection / boundary layer ! mixing algorithm. Original subroutine by Dale Allen, Univ of MD. ! (bmy, bey, 1/30/98, 2/15/05) ! ! Arguments as Input: ! =========================================================================== ! (1 ) NTRC : Number of tracers used in computation [1 to NNPAR] ! (2 ) TC : Tracer concentration [ v / v ] ! (3 ) TCVV : MW air (g/mol) / MW tracer (g/mol) [ unitless ] ! ! Arguments as output: ! ========================================================================== ! (2 ) TC : Modified Tracer concentration [ v / v ] ! ! NOTES: ! (1 ) TURBDAY is written in Fixed-Form Fortran 90. Also use F90 ! syntax for declarations (bmy, 4/1/99). ! (2 ) New tracer concentrations are returned in TC. ! (3 ) PS(I,J) is ACTUAL surface pressure and not Psurface - PTOP ! (4 ) Change in tracer in kg is now stored in DTC(I,J,L,N). This makes ! it easier to compute diagnostic quantities. The new mixing ratio ! is computed as TC(I,J,L,N) = TC(I,J,L,N) + DTC(I,J,L,N) / AD(I,J,L). ! (5 ) XTRA2(*,*,5) is the height of the PBL in # of layers. So if the ! PBL top is located in the middle of the 3rd sigma layer at (I,J) ! the value of XTRA2(I,J,5) would be 2.5. The XTRA2 variable is ! used by the HCTM drydep subroutines...it really is a historical ! holdover. ! (6 ) Restore the following NDxx diagnostics: (a) ND63 : Mass balance ! (CNVUPP) (b) ND15 : Mass change due to mixing in the boundary layer ! (7 ) Now pass TCVV and NCONV for the mass flux diagnostics. Also ! updated comments and cleaned up a few things. (bey, bmy, 11/10/99) ! (8 ) Remove PTOP and XNUMOL from the arg list. PTOP is now a parameter ! in "CMN_SIZE". XNUMOL is no longer used in TURBDAY. (bmy, 2/10/00) ! (9 ) Also removed obsolete ND63 diagnostics and updated comments. ! (bmy, 4/12/00) ! (10) Now use NTRC instead of NNPAR to dimension variables TC, TCVV, DTC, ! and DTCSUM (bmy, 10/17/00). ! (11) Removed obsolete code from 10/17/00 (bmy, 12/21/00) ! (12) If the PBL depth is very small (or zero), then assume a PBL depth ! of 2 mb -- this prevents NaN's from propagating throughout the ! code. Also updated comments & made cosmetic changes. (bmy, 3/9/01) ! (13) DTCSUM was declared twice but wasn't used. Elminate declarations ! to DTCSUM. (bmy, 7/16/01) ! (14) XTRA2(IREF,JREF,5) is now XTRA2(I,J). Also updated comments. ! Also remove IREF, JREF and some debug output. (bmy, 9/25/01) ! (15) Removed obsolete commented out code from 9/01 (bmy, 10/24/01) ! (16) Now takes in P=PS-PTOP instead of PS. Redimension SIGE to ! (1:LLPAR+1). ! (17) Renamed PS to PZ so as not to conflict w/ the existing P variable. ! Now pass P-PTOP thru PZ, in order to ensure that P and AD are ! consistent w/ each other. Added parallel DO-loops. Updated comments, ! cosmetic changes. Now print a header to stdout on the first call, ! to confirm that TURBDAY has been called. (bmy, 4/11/02) ! (18) Now use GET_PEDGE from "pressure_mod.f" to compute the pressure ! at the bottom edge of grid box (I,J,L). Deleted obsolete code from ! 4/02. Removed PZ, SIGE from the argument list, since we now compute ! pressure from GET_PEDGE. (dsa, bdf, bmy, 8/22/02) ! (19) Now reference AD, PBL from "dao_mod.f". Now removed DXYP from the ! arg list, use GET_AREA_M2 from "grid_mod.f" instead. Now removed ! NCONV, ALPHA_d, ALPHA_n from the arg list. Now no longer reference ! SUNCOS. Now set A(:,:)=1 day & nite; we assume full mixing all the ! time regardless of SUNCOS. Updated comments, cosmetic changes. ! (bmy, 2/11/03) ! (20) Now can handle PBL field in meters for GEOS-4/fvDAS. Also the ! atmospheric scale height from CMN_GCTM. (bmy, 6/23/03) ! (21) Now bundled into "pbl_mix_mod.f". Broke off the part which computes ! PBL height and related quantities into COMPUTE_PBL_HEIGHT. ! (bmy, 2/15/05) !****************************************************************************** ! ! References to F90 modules USE DAO_MOD, ONLY : AD USE DIAG_MOD, ONLY : TURBFLUP USE GRID_MOD, ONLY : GET_AREA_M2 USE TIME_MOD, ONLY : GET_TS_CONV ! dkh debug USE LOGICAL_ADJ_MOD, ONLY : LPRINTFD USE ADJ_ARRAYS_MOD, ONLY : IFD, JFD # include "CMN_SIZE" ! Size parameters # include "CMN_DIAG" ! ND15 ! Arguments INTEGER, INTENT(IN) :: NTRC REAL*8, INTENT(INOUT) :: TC(IIPAR,JJPAR,LLPAR,NTRC) REAL*8, INTENT(IN) :: TCVV(NTRC) ! Local variables LOGICAL, SAVE :: FIRST = .TRUE. INTEGER :: I, J, L, LTOP, N REAL*8 :: AA, CC, CC_AA, AREA_M2, DTCONV REAL*8 :: A(IIPAR,JJPAR) REAL*8 :: DTC(IIPAR,JJPAR,LLPAR,NTRC) !================================================================= ! TURBDAY begins here! !================================================================= ! First-time initialization IF ( FIRST ) THEN ! Echo info WRITE( 6, '(a)' ) REPEAT( '=', 79 ) WRITE( 6, '(a)' ) 'T U R B D A Y -- by Dale Allen, U. Md.' WRITE( 6, '(a)' ) 'Modified for GEOS-CHEM by Bob Yantosca' WRITE( 6, '(a)' ) 'Last Modification Date: 2/4/03' WRITE( 6, '(a)' ) REPEAT( '=', 79 ) ! Reset first time flag FIRST = .FALSE. ENDIF !================================================================= ! Do the boundary layer mixing !================================================================= ! Convection timestep [s] DTCONV = GET_TS_CONV() * 60d0 ! Loop over Lat/Long grid boxes (I,J) !$OMP PARALLEL DO !$OMP+DEFAULT( SHARED ) !$OMP+PRIVATE( I, J, L, N, AA, CC, CC_AA ) DO J = 1, JJPAR DO I = 1, IIPAR ! We assume full mixing in the boundary layer, so the A ! coefficients are 1 everywhere, day & night (bmy, 2/11/03) A(I,J) = 1d0 ! Calculate air mass within PBL at grid box (I,J,L) AA = 0.d0 DO L = 1, IMIX(I,J)-1 AA = AA + AD(I,J,L) ENDDO L = IMIX(I,J) AA = AA + AD(I,J,L) * FPBL(I,J) ! dkh debug !IF ( LPRINTFD .AND. I == IFD .AND. J == JFD ) THEN ! WRITE(6,*) ' AA fwd = ', AA !ENDIF ! Loop over tracers DO N = 1, NTRC ! dkh debug !IF ( LPRINTFD .AND. I == IFD .AND. J == JFD ) THEN ! WRITE(6,*) ' FPBL fwd = ', FPBL(I,J) ! WRITE(6,*) ' IMIX fwd = ', IMIX(I,J) !ENDIF !=========================================================== ! Calculate tracer mass within PBL at grid box (I,J,L) !=========================================================== ! Sum mass from (I,J,L) below the PBL top CC = 0.d0 DO L = 1, IMIX(I,J)-1 CC = CC + AD(I,J,L) * TC(I,J,L,N) ENDDO ! Then also sum mass from (I,J,L) which straddle the PBL top L = IMIX(I,J) CC = CC + AD(I,J,L) * TC(I,J,L,N) * FPBL(I,J) ! CC/AA is the mean mixing ratio of tracer at ! (I,J) from L=1 to L=LTOP CC_AA = CC / AA !======================================================== ! TC(I,J,L,N) new = TC(I,J,L,N) old + ! ( DTC(I,J,L,N) / AD(I,J,L) ) ! ! where ! ! DTC(I,J,L,N) = [ alpha * (mean MR below PBL) * ! Airmass at (I,J,L) ] - ! [ alpha * TC(I,J,L,N) old * ! Airmass at (I,J,L) ] ! ! DTC is thus the change in mass (kg) due to BL mixing, ! so DTC/AD is the change in (V/V) mixing ratio units. !======================================================== ! For grid boxes (I,J,L) which lie below the PBL top DO L = 1, IMIX(I,J)-1 DTC(I,J,L,N) = ( A(I,J) * CC_AA * AD(I,J,L) - & A(I,J) * TC(I,J,L,N) * AD(I,J,L) ) TC(I,J,L,N) = TC(I,J,L,N) + DTC(I,J,L,N)/AD(I,J,L) ENDDO ! For grid boxes (I,J,L) which straddle the PBL top L = IMIX(I,J) DTC(I,J,L,N) = & ( A(I,J) * FPBL(I,J) * CC_AA * AD(I,J,L) - & A(I,J) * FPBL(I,J) * TC(I,J,L,N) * AD(I,J,L) ) TC(I,J,L,N) = TC(I,J,L,N) + DTC(I,J,L,N)/AD(I,J,L) !======================================================= ! ND15 Diagnostic: ! mass change due to mixing in the boundary layer !======================================================= IF ( ND15 > 0 ) THEN DO L = 1, IMIX(I,J) TURBFLUP(I,J,L,N) = TURBFLUP(I,J,L,N) + & DTC(I,J,L,N) / ( TCVV(N) * DTCONV ) ENDDO ENDIF ENDDO ENDDO ENDDO !$OMP END PARALLEL DO !----------------------------------------------------------------------------- ! Original code...leave here for reference (bmy, 11/10/99) ! TC(I,J,L,N) = ! & ( A(I,J) * AIRMAS(I,J,L) * CC/AA + ! & (1-A(I,J)) * TC(I,J,L,N) * AIRMAS(I,J,L)) / ! & AIRMAS(I,J,L) ! ! TC(I,J,L,N) = ! & ( A(I,J) * FPBL(I,J) * ! & AIRMAS(I,J,L) * CC/AA + ! & ( 1 - A(I,J) * FPBL(I,J) ) * ! & TC(I,J,L,N) * AIRMAS(I,J,L) ) / AIRMAS(I,J,L) !----------------------------------------------------------------------------- ! Return to calling program END SUBROUTINE TURBDAY !------------------------------------------------------------------------------ FUNCTION GET_FRAC_OF_PBL( I, J, L ) RESULT( FRAC ) ! !****************************************************************************** ! Function GET_FRAC_OF_PBL returns the fraction of grid box (I,J,L) that ! lies within the planetary boundary layer (bmy, 2/15/05) ! ! 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: !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments INTEGER, INTENT(IN) :: I, J, L ! Return value REAL*8 :: FRAC !================================================================= ! GET_FRAC_OF_PBL begins here! !================================================================= IF ( L <= LLTROP ) THEN FRAC = F_OF_PBL(I,J,L) ELSE FRAC = 0d0 ENDIF ! Return to calling program END FUNCTION GET_FRAC_OF_PBL !------------------------------------------------------------------------------ FUNCTION GET_FRAC_UNDER_PBLTOP( I, J, L ) RESULT( FRAC ) ! !****************************************************************************** ! Function GET_FRAC_UNDER_PBLTOP returns the fraction of grid box (I,J,L) ! that lies underneath the planetary boundary layer top. ! ! 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: !****************************************************************************** ! # include "CMN_SIZE" ! Size parameters ! Arguments INTEGER, INTENT(IN) :: I, J, L ! Return value REAL*8 :: FRAC !================================================================= ! GET_FRAC_UNDER_PBLTOP begins here! !================================================================= IF ( L <= LLTROP ) THEN FRAC = F_UNDER_TOP(I,J,L) ELSE FRAC = 0d0 ENDIF ! Return to calling program END FUNCTION GET_FRAC_UNDER_PBLTOP !------------------------------------------------------------------------------ FUNCTION GET_PBL_MAX_L() RESULT( TOP ) ! !****************************************************************************** ! Function GET_PBL_MAX_L returns the model level at the highest part of ! the planetary boundary layer. (bmy, 2/15/05). ! ! NOTES: !****************************************************************************** ! ! Return value INTEGER :: TOP !================================================================= ! GET_PBL_MAX_L begins here! !================================================================= TOP = PBL_MAX_L ! Return to calling program END FUNCTION GET_PBL_MAX_L !------------------------------------------------------------------------------ FUNCTION GET_PBL_TOP_hPa( I, J ) RESULT( TOP ) ! !****************************************************************************** ! Function GET_PBL_TOP_hPa returns the planetary boundary layer top [hPa] ! at a given GEOS-CHEM surface location (I,J). ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: I, J ! Return value REAL*8 :: TOP !================================================================= ! GET_PBL_TOP_hPa begins here! !================================================================= TOP = PBL_TOP_hPa(I,J) ! Return to calling program END FUNCTION GET_PBL_TOP_hPa !------------------------------------------------------------------------------ FUNCTION GET_PBL_TOP_L( I, J ) RESULT( TOP ) ! !****************************************************************************** ! Function GET_PBL_TOP_L returns the planetary boundary layer top ! [model levels] at a given GEOS-CHEM surface location (I,J). ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: I, J ! Return value REAL*8 :: TOP !================================================================= ! GET_PBL_TOP_L begins here! !================================================================= TOP = PBL_TOP_L(I,J) ! Return to calling program END FUNCTION GET_PBL_TOP_L !------------------------------------------------------------------------------ FUNCTION GET_PBL_TOP_m( I, J ) RESULT( TOP ) ! !****************************************************************************** ! Function GET_PBL_TOP_m returns the planetary boundary layer top [m] ! at a given GEOS-CHEM surface location (I,J). ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: I, J ! Return value REAL*8 :: TOP !================================================================= ! GET_PBL_TOP_m begins here! !================================================================= TOP = PBL_TOP_m(I,J) ! Return to calling program END FUNCTION GET_PBL_TOP_m !------------------------------------------------------------------------------ FUNCTION GET_PBL_THICK( I, J ) RESULT( THICK ) ! !****************************************************************************** ! Function GET_PBL_TOP_L returns the planetary boundary layer top ! [model levels] at a given GEOS-CHEM surface location (I,J). ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: I, J ! Return value REAL*8 :: THICK !================================================================= ! GET_PBL_THICK begins here! !================================================================= THICK = PBL_THICK(I,J) ! Return to calling program END FUNCTION GET_PBL_THICK !------------------------------------------------------------------------------ FUNCTION GET_IMIX( I, J ) RESULT( IM ) ! !****************************************************************************** ! Function GET_IMIX returns IMIX (adj_group, dkh, 07/08/09) ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: I, J ! Return value INTEGER :: IM !================================================================= ! GET_IMIX begins here! !================================================================= IM = IMIX(I,J) ! Return to calling program END FUNCTION GET_IMIX !------------------------------------------------------------------------------ FUNCTION GET_FPBL( I, J ) RESULT( F ) ! !****************************************************************************** ! Function GET_FPBL returns FPBL (adj_group, dkh, 07/08/09) ! ! Arguments as Input: ! ============================================================================ ! (1 ) I (INTEGER) : GEOS-CHEM longitude index ! (2 ) J (INTEGER) : GEOS-CHEM latitude index ! ! NOTES: !****************************************************************************** ! ! Arguments INTEGER, INTENT(IN) :: I, J ! Return value REAL*8 :: F !================================================================= ! GET_FPBL begins here! !================================================================= F = FPBL(I,J) ! Return to calling program END FUNCTION GET_FPBL !------------------------------------------------------------------------------ SUBROUTINE INIT_PBL_MIX ! !****************************************************************************** ! Subroutine INIT_PBL_MIX allocates and zeroes module arrays (bmy, 2/10/05) ! ! NOTES: !****************************************************************************** ! ! References to F90 modules USE ERROR_MOD, ONLY : ALLOC_ERR # include "CMN_SIZE" ! Local variables INTEGER :: AS !================================================================= ! INIT_PBL_MIX begins here! !================================================================= ! Scalars PBL_MAX_L = 0 ! Arrays ALLOCATE( IMIX( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'IMIX' ) IMIX = 0 ALLOCATE( FPBL( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'FPBL' ) FPBL = 0d0 ALLOCATE( F_OF_PBL( IIPAR, JJPAR, LLTROP ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'F_OF_PBL' ) F_OF_PBL = 0d0 ALLOCATE( F_UNDER_TOP( IIPAR, JJPAR, LLTROP ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'F_UNDER_TOP' ) F_UNDER_TOP = 0d0 ALLOCATE( PBL_TOP_hPa( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'PBL_TOP_hPa' ) PBL_TOP_hPa = 0d0 ALLOCATE( PBL_TOP_L( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'PBL_TOP_L' ) PBL_TOP_L = 0d0 ALLOCATE( PBL_TOP_m( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'PBL_TOP_m' ) PBL_TOP_m = 0d0 ALLOCATE( PBL_THICK( IIPAR, JJPAR ), STAT=AS ) IF ( AS /= 0 ) CALL ALLOC_ERR( 'PBL_THICK' ) PBL_THICK = 0d0 ! Return to calling program END SUBROUTINE INIT_PBL_MIX !------------------------------------------------------------------------------ SUBROUTINE CLEANUP_PBL_MIX ! !****************************************************************************** ! Subroutine INIT_PBL_MIX allocates and zeroes module arrays (bmy, 2/10/05) ! ! NOTES: !****************************************************************************** ! !================================================================= ! CLEANUP_PBL_MIX begins here! !================================================================= IF ( ALLOCATED( IMIX ) ) DEALLOCATE( IMIX ) IF ( ALLOCATED( FPBL ) ) DEALLOCATE( FPBL ) IF ( ALLOCATED( F_OF_PBL ) ) DEALLOCATE( F_OF_PBL ) IF ( ALLOCATED( F_UNDER_TOP ) ) DEALLOCATE( F_UNDER_TOP ) IF ( ALLOCATED( PBL_TOP_hPa ) ) DEALLOCATE( PBL_TOP_hPa ) IF ( ALLOCATED( PBL_TOP_L ) ) DEALLOCATE( PBL_TOP_L ) IF ( ALLOCATED( PBL_TOP_m ) ) DEALLOCATE( PBL_TOP_m ) IF ( ALLOCATED( PBL_THICK ) ) DEALLOCATE( PBL_THICK ) ! Return to calling program END SUBROUTINE CLEANUP_PBL_MIX !------------------------------------------------------------------------------ ! End of module END MODULE PBL_MIX_MOD