diff --git a/src/Applications/GEOSctm_App/CTM_GridComp.rc.tmpl b/src/Applications/GEOSctm_App/CTM_GridComp.rc.tmpl index aeb9029..2d0bdfe 100644 --- a/src/Applications/GEOSctm_App/CTM_GridComp.rc.tmpl +++ b/src/Applications/GEOSctm_App/CTM_GridComp.rc.tmpl @@ -1,4 +1,14 @@ +#----------------------------- +# Do you want to do Advection? +#----------------------------- +do_ctmAdvection: T + +#-------------------------------------------------- +# Read courant numbers and mass fluxes for AdvCore? +#-------------------------------------------------- +read_advCoreFields: F + #--------------------------- # Setting for Passive Tracer #--------------------------- diff --git a/src/Applications/GEOSctm_App/FPIT_ExtData.rc.tmpl b/src/Applications/GEOSctm_App/FPIT_ExtData.rc.tmpl index 4c0265c..93d0f07 100755 --- a/src/Applications/GEOSctm_App/FPIT_ExtData.rc.tmpl +++ b/src/Applications/GEOSctm_App/FPIT_ExtData.rc.tmpl @@ -1,3 +1,5 @@ +Ext_AllowExtrap: .TRUE. + PrimaryExports%% # ---------|-------------|-------|--------|----------------------|--------|--------|-------------|----------| # Import | | | Regrid | Refresh | OffSet | Scale | Variable On | File | diff --git a/src/Applications/GEOSctm_App/FP_ExtData.rc.tmpl b/src/Applications/GEOSctm_App/FP_ExtData.rc.tmpl index 4c60a86..4ad8b76 100755 --- a/src/Applications/GEOSctm_App/FP_ExtData.rc.tmpl +++ b/src/Applications/GEOSctm_App/FP_ExtData.rc.tmpl @@ -1,3 +1,5 @@ +Ext_AllowExtrap: .TRUE. + PrimaryExports%% # ---------|-------------|-------|--------|----------------------|--------|--------|-------------|----------| # Import | | | Regrid | Refresh | OffSet | Scale | Variable On | File | diff --git a/src/Applications/GEOSctm_App/MERRA1_ExtData.rc.tmpl b/src/Applications/GEOSctm_App/MERRA1_ExtData.rc.tmpl index 1fc84b1..7a8213c 100755 --- a/src/Applications/GEOSctm_App/MERRA1_ExtData.rc.tmpl +++ b/src/Applications/GEOSctm_App/MERRA1_ExtData.rc.tmpl @@ -1,3 +1,5 @@ +Ext_AllowExtrap: .TRUE. + PrimaryExports%% # ---------|-------------|-------|--------|----------------------|--------|--------|-------------|----------| # Import | | | Regrid | Refresh | OffSet | Scale | Variable On | File | diff --git a/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl b/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl index 20840cb..4ad3fcd 100755 --- a/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl +++ b/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl @@ -1,3 +1,5 @@ +Ext_AllowExtrap: .TRUE. + PrimaryExports%% # ---------|-------------|-------|--------|----------------------|--------|--------|-------------|----------| # Import | | | Regrid | Refresh | OffSet | Scale | Variable On | File | @@ -117,6 +119,11 @@ DQLDT 'kg/kg/s' N N 0 0.0 1.0 #---------------- #AdvCore Specific #---------------- +PS0 'Pa' N N 0 0.0 1.0 PS /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_aer_Nv.%y4%m2%d2.nc4 +PS1 'Pa' N N 0;@nhmsDT 0.0 1.0 PS /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_aer_Nv.%y4%m2%d2.nc4 +DELP0 'Pa' N N 0 0.0 1.0 DELP /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_aer_Nv.%y4%m2%d2.nc4 +DELP1 'Pa' N N 0;@nhmsDT 0.0 1.0 DELP /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_aer_Nv.%y4%m2%d2.nc4 + PLE0 'Pa' N N 0 0.0 1.0 PLE /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_nav_Ne.%y4%m2%d2.nc4 PLE1 'Pa' N N 0;@nhmsDT 0.0 1.0 PLE /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_nav_Ne.%y4%m2%d2.nc4 UC0;VC0 'm s-1' N N 0 0.0 1.0 U;V /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_asm_Nv.%y4%m2%d2.nc4 diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt index 8a2293e..2e8bb94 100644 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt +++ b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt @@ -2,17 +2,12 @@ if (Convection_MODE MATCHES stub) set (SRCS - CTM_ConvectionStubCompMod.F90 - GenericConvectionMethod_mod.F90 - GmiConvectionMethod_mod.F90 convectiveTransport_mod.F90 CTM_rasCalculationsMod.F90 ) else () set (SRCS CTM_ConvectionGridCompMod.F90 - GenericConvectionMethod_mod.F90 - GmiConvectionMethod_mod.F90 convectiveTransport_mod.F90 CTM_rasCalculationsMod.F90 ) diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 index d542108..37f4800 100644 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 +++ b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 @@ -13,14 +13,17 @@ MODULE CTM_ConvectionGridCompMod ! !USES: ! USE ESMF - USE MAPL - USE GmiConvectionMethod_mod ! GMI Convection component - USE GenericConvectionMethod_mod ! Generic Convection component + USE MAPL_Mod + !USE GmiConvectionMethod_mod ! GMI Convection component + USE convectiveTransport_mod USE m_chars, ONLY : uppercase - use CTM_rasCalculationsMod, only : INIT_RASPARAMS, DO_RAS, RASPARAM_Type USE Chem_UtilMod, only : pmaxmin + use GmiArrayBundlePointer_mod + USE GmiESMFrcFileReading_mod IMPLICIT NONE + + INTEGER, PARAMETER :: DBL = KIND(0.00D+00) PRIVATE ! ! !PUBLIC MEMBER FUNCTIONS: @@ -38,21 +41,30 @@ MODULE CTM_ConvectionGridCompMod ! !EOP !------------------------------------------------------------------------- - TYPE Convection_State + TYPE T_Convection_State PRIVATE - TYPE(gmiConvection_GridComp), POINTER :: gmiCONV => null() - TYPE(genConvection_GridComp), POINTER :: genCONV => null() - END TYPE Convection_State + logical :: det_ent = .FALSE. ! flag for doing detrainment then entrainment + logical :: do_downdraft = .FALSE. ! flag for doing downdrafts + integer :: convecType = 1 ! 1: Generic Convection (only convective transport) + ! 2: GMI convection + integer :: numSpecies + logical, pointer :: isFixedConcentration(:) => null() + END TYPE T_Convection_State TYPE Convection_WRAP - TYPE (Convection_State), pointer :: PTR => null() + TYPE (T_Convection_State), pointer :: PTR => null() END TYPE Convection_WRAP - integer :: convecType ! 1: Generic Convection (only convective transport) - ! 2: GMI convection + integer :: i1=1, i2, ig=0, im ! dist grid indices + integer :: j1=1, j2, jg=0, jm ! dist grid indices + integer :: km ! dist grid indices + integer :: k1=1, k2, ivert, ilong - TYPE(RASPARAM_Type) :: RASPARAMS - logical :: enable_rasCalculations = .FALSE. + REAL, PARAMETER :: mwtAir = 28.9 + REAL, PARAMETER :: rStar = 8.314E+03 + REAL, PARAMETER :: Pa2hPa = 0.01 + REAL, PARAMETER :: ToGrPerKg = 1000.00 + REAL, PARAMETER :: secPerDay = 86400.00 !------------------------------------------------------------------------- CONTAINS @@ -85,7 +97,7 @@ SUBROUTINE SetServices ( GC, RC ) character(len=ESMF_MAXSTR) :: rcfilen = 'CTM_GridComp.rc' type (ESMF_Config) :: CF - type (Convection_State), pointer:: state ! internal, that is + type (T_Convection_State), pointer:: state ! internal, that is type (Convection_wrap) :: wrap type (ESMF_Config) :: convConfigFile @@ -136,9 +148,30 @@ SUBROUTINE SetServices ( GC, RC ) call ESMF_ConfigLoadFile(convConfigFile, TRIM(rcfilen), rc=STATUS ) VERIFY_(STATUS) - call ESMF_ConfigGetAttribute(convConfigFile, enable_rasCalculations, & - Default = .FALSE., & - Label = "enable_rasCalculations:", __RC__ ) + call ESMF_ConfigGetAttribute(convConfigFile, state%det_ent, & + Label = "det_ent:", & + default=.FALSE., __RC__ ) + + call ESMF_ConfigGetAttribute(convConfigFile, state%do_downdraft, & + Label = "do_downdraft:", & + default=.FALSE., __RC__ ) + ! ------------------------------ + ! convecType + ! 1: Generic Convection (only convective transport) + ! 2: GMI convection + !------ ------------------------ + + call ESMF_ConfigGetAttribute(convConfigFile, state%convecType, & + label = "convecType:",& + default = 1, __RC__ ) + VERIFY_(STATUS) + + IF ( MAPL_AM_I_ROOT() ) THEN + PRINT*," -----> det_ent = ", state%det_ent + PRINT*," -----> do_downdraft = ", state%do_downdraft + PRINT*," -----> convecType = ", state%convecType + PRINT *,"Done Reading the Convection Resource File" + END IF ! ========================== IMPORT STATE ========================= @@ -149,14 +182,6 @@ SUBROUTINE SetServices ( GC, RC ) DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, __RC__ ) - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'Q', & - LONG_NAME = 'specific_humidity', & - UNITS = 'kg kg-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__ ) - - call MAPL_AddImportSpec(GC, & SHORT_NAME = 'PLE', & LONG_NAME = 'air_pressure', & @@ -185,13 +210,6 @@ SUBROUTINE SetServices ( GC, RC ) DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'LWI', & - LONG_NAME = 'land-ocean-ice_mask', & - UNITS = '1', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__ ) - call MAPL_AddImportSpec(GC, & SHORT_NAME = 'AREA', & LONG_NAME = 'agrid_cell_area', & @@ -199,6 +217,20 @@ SUBROUTINE SetServices ( GC, RC ) DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__ ) + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CNV_MFC', & + LONG_NAME = 'cumulative_mass_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationEdge, __RC__ ) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CNV_MFD', & + LONG_NAME = 'detraining_mass_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + call MAPL_AddImportSpec(GC, & SHORT_NAME = 'ConvTR', & LONG_NAME = 'convected_quantities', & @@ -208,62 +240,6 @@ SUBROUTINE SetServices ( GC, RC ) DATATYPE = MAPL_BundleItem, & RESTART = MAPL_RestartOptional, __RC__ ) - IF (enable_rasCalculations) THEN - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'FRLAND', & - LONG_NAME = 'fraction_of_land', & - UNITS = '1', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__ ) - - call MAPL_AddImportSpec ( gc, & - SHORT_NAME = 'KH', & - LONG_NAME = 'scalar_diffusivity', & - UNITS = 'm+2 s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, __RC__ ) - - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'TS', & - LONG_NAME = 'surface temperature', & - UNITS = 'K', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__ ) - ELSE - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'CNV_MFC', & - LONG_NAME = 'cumulative_mass_flux', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, __RC__ ) - - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'CNV_MFD', & - LONG_NAME = 'detraining_mass_flux', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__ ) - END IF - -! ========================== EXPORT STATE ========================= - - IF (enable_rasCalculations) THEN - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'CNV_MFC', & - LONG_NAME = 'cumulative_mass_flux', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, __RC__ ) - - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'CNV_MFD', & - LONG_NAME = 'detraining_mass_flux', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__ ) - ENDIF - - !#include "convTendency_ExportSpec.h" @@ -313,7 +289,6 @@ SUBROUTINE Initialize_ ( gc, impConv, expConv, clock, rc ) !------------------------------------------------------------------------- !BOC character(len=ESMF_MAXSTR) :: IAm = 'Initialize_' - character(len=ESMF_MAXSTR) :: rcfilen = 'CTM_GridComp.rc' character(len=ESMF_MAXSTR) :: COMP_NAME type(ESMF_Config) :: CF @@ -322,17 +297,19 @@ SUBROUTINE Initialize_ ( gc, impConv, expConv, clock, rc ) type(ESMF_State) :: internal type(MAPL_VarSpec), pointer :: InternalSpec(:) type (ESMF_Config) :: convConfigFile + type (T_Convection_State), pointer:: conv_state ! internal, that is + type (Convection_wrap) :: wrap integer :: STATUS integer :: nymd, nhms ! time of day real :: cdt ! chemistry timestep (secs) - integer :: i1=1, i2, ig=0, im ! dist grid indices - integer :: j1=1, j2, jg=0, jm ! dist grid indices - integer :: km ! dist grid indices integer :: dims(3), k, l, n - - type(gmiConvection_GridComp), pointer :: gmiCONV ! Grid Component - type(genConvection_GridComp), pointer :: genCONV ! Grid Component + type (ESMF_Field) :: FIELD + type (ESMF_Array) :: ARRAY + type (ESMF_FieldBundle) :: ConvTR + REAL, POINTER, DIMENSION(:,:,:) :: S + character(len=ESMF_MAXSTR) :: field_name + integer :: ic rc = 0 @@ -355,27 +332,17 @@ SUBROUTINE Initialize_ ( gc, impConv, expConv, clock, rc ) call MAPL_TimerOn(ggSTATE,"TOTAL") call MAPL_TimerOn(ggSTATE,"INITIALIZE") - convConfigFile = ESMF_ConfigCreate(rc=STATUS ) - VERIFY_(STATUS) - - call ESMF_ConfigLoadFile(convConfigFile, TRIM(rcfilen), rc=STATUS ) - VERIFY_(STATUS) - - ! ------------------------------ - ! convecType - ! 1: Generic Convection (only convective transport) - ! 2: GMI convection - !------ ------------------------ + ! Get my private state from the component + !---------------------------------------- - call ESMF_ConfigGetAttribute(convConfigFile, convecType, & - label = "convecType:",& - default = 1, rc=STATUS ) + call ESMF_UserCompGetInternalState(gc, 'Convection_state', WRAP, STATUS) VERIFY_(STATUS) + conv_state => WRAP%PTR ! Get parameters from gc and clock ! -------------------------------- - call extract_ ( gc, clock, genCONV, gmiCONV, nymd, nhms, cdt, STATUS ) + call extract_ ( gc, clock, nymd, nhms, cdt, STATUS ) VERIFY_(STATUS) call ESMF_GridCompGet ( GC, GRID=esmfGrid, rc=STATUS) @@ -393,42 +360,43 @@ SUBROUTINE Initialize_ ( gc, impConv, expConv, clock, rc ) ! Local sizes of three dimensions !-------------------------------- - i2 = dims(1) - j2 = dims(2) - km = dims(3) - - ! Call initialize - ! --------------- - if (convecType == 1) then - genCONV%i1 = i1 - genCONV%i2 = i2 - genCONV%im = im - genCONV%j1 = j1 - genCONV%j2 = j2 - genCONV%jm = jm - genCONV%km = km - - call initializeGenericConvection ( genCONV, impConv, expConv, nymd, nhms, & - esmfGrid, cdt, STATUS ) + i2 = dims(1) + j2 = dims(2) + km = dims(3) + k2 = km + ivert = km + ilong = i2-i1+1 + + ! Get the bundles containing the quantities to be diffused, + !---------------------------------------------------------- + + call ESMF_StateGet(impConv, 'ConvTR' , ConvTR, RC=STATUS) + VERIFY_(STATUS) + + call ESMF_FieldBundleGet(ConvTR, fieldCOUNT=conv_state%numSpecies, RC=STATUS) + VERIFY_(STATUS) + + allocate(conv_state%isFixedConcentration(conv_state%numSpecies), STAT=STATUS) + VERIFY_(STATUS) + conv_state%isFixedConcentration(:) = .FALSE. + + DO ic = 1, conv_state%numSpecies + ! Get field and name from tracer bundle + !-------------------------------------- + call ESMF_FieldBundleGet(ConvTR, ic, FIELD, RC=STATUS) VERIFY_(STATUS) - elseif (convecType == 2) then - gmiCONV%i1 = i1 - gmiCONV%i2 = i2 - gmiCONV%im = im - gmiCONV%j1 = j1 - gmiCONV%j2 = j2 - gmiCONV%jm = jm - gmiCONV%km = km - - call initializeGmiConvection ( gmiCONV, impConv, expConv, nymd, nhms, & - esmfGrid, cdt, STATUS ) + + call ESMF_FieldGet(FIELD, name=field_name, RC=STATUS) VERIFY_(STATUS) - end if - IF (enable_rasCalculations) THEN - IF (MAPL_AM_I_ROOT()) PRINT*, TRIM(Iam)//': Doing RAS Calculations' - CALL INIT_RASPARAMS(RASPARAMS) - ENDIF + !Identify fixed species such as O2, N2, ad. + !------------------------------------------ + if (TRIM(field_name) == 'ACET' .OR. TRIM(field_name) == 'N2' .OR. & + TRIM(field_name) == 'O2' .OR. TRIM(field_name) == 'NUMDENS') THEN + conv_state%isFixedConcentration(ic) = .TRUE. + end if + + END DO call MAPL_TimerOff(ggSTATE,"INITIALIZE") call MAPL_TimerOff(ggSTATE,"TOTAL") @@ -480,8 +448,6 @@ SUBROUTINE Run_ ( gc, impConv, expConv, clock, rc ) integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME - type(gmiConvection_GridComp), pointer :: gmiCONV ! Grid Component - type(genConvection_GridComp), pointer :: genCONV ! Grid Component integer :: nymd, nhms ! time real :: cdt ! chemistry timestep (secs) integer :: i, iOX, iT2M, k, m, n @@ -490,10 +456,41 @@ SUBROUTINE Run_ ( gc, impConv, expConv, clock, rc ) type(ESMF_Grid) :: esmfGrid type(ESMF_Time) :: TIME type (MAPL_MetaComp), pointer :: ggState - - !REAL :: qmin, qmax - !real, pointer, dimension(:,:,:) :: CNV_MFC => null() - !real, pointer, dimension(:,:,:) :: CNV_MFD => null() + type (T_Convection_State), pointer :: conv_state + type (Convection_wrap) :: WRAP + + REAL, POINTER, DIMENSION(:,:) :: zpbl + REAL, POINTER, DIMENSION(:,:,:) :: ple, zle, totalMass + REAL, POINTER, DIMENSION(:,:,:) :: CNV_MFC, CNV_MFD, T + REAL, POINTER, DIMENSION(:,:) :: gridBoxArea + + integer :: ic, kR, ik, is + REAL, ALLOCATABLE :: pl(:,:,:) + + REAL(KIND=DBL), ALLOCATABLE :: cellArea(:,:) + REAL(KIND=DBL), ALLOCATABLE :: pbl(:,:) + REAL(KIND=DBL), ALLOCATABLE :: mass(:,:,:) + REAL(KIND=DBL), ALLOCATABLE :: press3c(:,:,:) + REAL(KIND=DBL), ALLOCATABLE :: press3e(:,:,:) + REAL(KIND=DBL), ALLOCATABLE :: gridBoxHeight(:,:,:) + REAL(KIND=DBL), ALLOCATABLE :: cmf(:,:,:) + REAL(KIND=DBL), allocatable :: dtrain (:, :, :) + REAL(KIND=DBL), allocatable :: eu (:, :, :) + REAL(KIND=DBL), allocatable :: ed (:, :, :) + REAL(KIND=DBL), allocatable :: md (:, :, :) + REAL(KIND=DBL), allocatable :: kel (:, :, :) + REAL(KIND=DBL) :: tdt + + type (ESMF_Field) :: FIELD + type (ESMF_Array) :: ARRAY + type (ESMF_FieldBundle) :: ConvTR + REAL, POINTER, DIMENSION(:,:,:) :: S + + type (t_GmiArrayBundle), pointer :: concentration(:) + character(len=ESMF_MAXSTR) :: NAME, speciesName +!EOP +!------------------------------------------------------------------------- +!BOC ! Get my name and set-up traceback handle ! --------------------------------------- @@ -501,35 +498,145 @@ SUBROUTINE Run_ ( gc, impConv, expConv, clock, rc ) VERIFY_(STATUS) Iam = TRIM(COMP_NAME)//"::Run" + ! Get my internal MAPL_Generic state + !----------------------------------- + call MAPL_GetObjectFromGC ( GC, ggState, __RC__ ) + + call MAPL_TimerOn(ggState,"TOTAL") + call MAPL_TimerOn(ggState,"RUN") + + ! Get my private state from the component + !---------------------------------------- + call ESMF_UserCompGetInternalState(gc, 'Convection_state', WRAP, STATUS) + VERIFY_(STATUS) + + conv_state => WRAP%PTR ! Get ESMF parameters from gc and clock ! ----------------------------------------- - call extract_ ( gc, clock, genCONV, gmiCONV, nymd, nhms, & - cdt, rc=status ) + call extract_ ( gc, clock, nymd, nhms, cdt, rc=status ) VERIFY_(STATUS) - IF (enable_rasCalculations) THEN - CALL runRAS(impConv, expConv, esmfGrid, cdt) +! Run +! --- + !--------------------- + ! Convective Transport + !--------------------- - !call MAPL_GetPointer ( expConv, CNV_MFC, 'CNV_MFC', __RC__ ) - !call MAPL_GetPointer ( expConv, CNV_MFD, 'CNV_MFD', __RC__ ) + ! Get the bundles containing the quantities to be diffused, + !---------------------------------------------------------- - !CALL pmaxmin('CNV_MFC-:',CNV_MFC, qmin, qmax, size(CNV_MFD,1)*size(CNV_MFD,2), size(CNV_MFD,3)+1, 1. ) - !CALL pmaxmin('CNV_MFD-:',CNV_MFD, qmin, qmax, size(CNV_MFD,1)*size(CNV_MFD,2), size(CNV_MFD,3), 1. ) + call ESMF_StateGet(impConv, 'ConvTR' , ConvTR, RC=STATUS) + VERIFY_(STATUS) - ENDIF + ! Get the tracers from the ESMF Bundle + !------------------------------------- + ALLOCATE(concentration(conv_state%numSpecies), STAT=STATUS) + VERIFY_(STATUS) -! Run -! --- - if (convecType == 1) then - CALL runGenericConvection ( genCONV, impConv, expConv, nymd, nhms, & - cdt, enable_rasCalculations, STATUS ) + DO ic = 1, conv_state%numSpecies + ! Get field and name from tracer bundle + !-------------------------------------- + call ESMF_FieldBundleGet(ConvTR, ic, FIELD, RC=STATUS) + VERIFY_(STATUS) + + call ESMF_FieldGet(FIELD, name=NAME, RC=STATUS) + VERIFY_(STATUS) + + ! Get pointer to the quantity + !---------------------------- + call ESMFL_BundleGetPointerToData(ConvTR, NAME, S, RC=STATUS) + VERIFY_(STATUS) + + ! The quantity must exist; others are optional. + !---------------------------------------------- + ASSERT_(associated(S )) + + ALLOCATE(concentration(ic)%pArray3d(i1:i2,j1:j2,km), STAT=STATUS) + VERIFY_(STATUS) + + concentration(ic)%pArray3d(:,:,km:1:-1) = S(:,:,:) + END DO + + ! Satisfy the imports + !-------------------- + CALL MAPL_GetPointer(impConv, T, 'T', __RC__) + CALL MAPL_GetPointer(impConv, zpbl, 'ZPBL', __RC__) + CALL MAPL_GetPointer(impConv, ple, 'PLE', __RC__) + CALL MAPL_GetPointer(impConv, totalMass, 'MASS', __RC__) + CALL MAPL_GetPointer(impConv, zle, 'ZLE', __RC__) + CALL MAPL_GetPointer(impConv, CNV_MFD, 'CNV_MFD', __RC__) + CALL MAPL_GetPointer(impConv, CNV_MFC, 'CNV_MFC', __RC__) + CALL MAPL_GetPointer(impConv, gridBoxArea, 'AREA', __RC__) + + allocate(cellArea(i1:i2,j1:j2), STAT=STATUS); VERIFY_(STATUS) + allocate(pbl(i1:i2,j1:j2), STAT=STATUS); VERIFY_(STATUS) + allocate(press3c(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + allocate(press3e(i1:i2,j1:j2,k1-1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(pl(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(mass(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + allocate(gridBoxHeight(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(cmf(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(dtrain(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(eu(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(ed(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(md(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(kel(i1:i2,j1:j2,k1:k2), STAT=STATUS); VERIFY_(STATUS) + + cellArea(:,:) = gridBoxArea(:,:) + pbl (:,:) = zpbl(:,:) + kel (:,:,k1:k2) = T (:,:,km:1:-1) + cmf (:,:,k1:k2) = CNV_MFC (:,:,km-1:0:-1) + dtrain (:,:,k1:k2) = CNV_MFD (:,:,km:1:-1) + mass (:,:,k1:k2) = totalMass(:,:,km:1:-1) + pl (:,:,k1:k2) = (ple(:,:,0:km-1)+ple(:,:,1:km))*0.50 + + press3c(i1:i2,j1:j2,:) = pl (:,:,km:1:-1)*Pa2hPa + press3e(i1:i2,j1:j2,k1-1:k2) = ple(:,:,km:0:-1)*Pa2hPa + + ! This formulation was suggested by Steve Steentod (25Nov2014) + DO ik=1,km + kR = km-ik+1 + eu(:,:,kR) = CNV_MFC(:,:,ik-1) - CNV_MFC(:,:,ik) + dtrain(:,:,kR) + END DO + + ed = 0.0 + md = 0.0 + + DO ik=1,km + kR = km-ik+1 + gridBoxHeight(:,:,kR) = zle(:,:,ik-1)-zle(:,:,ik) ! m + END DO + + tdt = cdt + + call doConvectiveTransport (conv_state%det_ent, conv_state%do_downdraft, pbl, cmf, & + dtrain, eu, ed, md, gridBoxHeight, mass, kel, press3e, & + concentration, conv_state%isFixedConcentration, cellArea, tdt, & + i1, i2, j1, j2, k1, k2, ilong, ivert, conv_state%numSpecies) + + deallocate(pbl ) + deallocate(dtrain, cmf, kel, eu, ed, md) + deallocate(press3e, press3c, mass, gridBoxHeight, pl) + + ! Pass back the tracers to the ESMF Bundle + !------------------------------------------ + DO ic = 1, conv_state%numSpecies + call ESMF_FieldBundleGet(ConvTR, ic, FIELD, RC=STATUS) VERIFY_(STATUS) - elseif (convecType == 2) then - CALL runGmiConvection ( gmiCONV, impConv, expConv, nymd, nhms, & - cdt, enable_rasCalculations, STATUS ) + + call ESMF_FieldGet(FIELD, name=NAME, RC=STATUS) + VERIFY_(STATUS) + + call ESMFL_BundleGetPointerToData(ConvTR, NAME, S, RC=STATUS) VERIFY_(STATUS) - end if + + ! Do not forget to re-order the vertical levels + S(:,:,:) = concentration(ic)%pArray3d(:,:,km:1:-1) + END DO + + CALL CleanArrayPointer(concentration, STATUS) + VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) @@ -575,13 +682,9 @@ SUBROUTINE Finalize_ ( gc, impConv, expConv, clock, rc ) integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME - type(gmiConvection_GridComp), pointer :: gmiCONV ! Grid Component - type(genConvection_GridComp), pointer :: genCONV ! Grid Component integer :: nymd, nhms ! time real :: cdt ! chemistry timestep (secs) - type(Convection_state), pointer :: state - ! Get my name and set-up traceback handle ! --------------------------------------- call ESMF_GridCompGet( GC, NAME=COMP_NAME, RC=STATUS ) @@ -590,192 +693,28 @@ SUBROUTINE Finalize_ ( gc, impConv, expConv, clock, rc ) ! Get ESMF parameters from gc and clock ! ------------------------------------- - call extract_ ( gc, clock, genCONV, gmiCONV, nymd, nhms, cdt, STATUS, & - state = state ) + call extract_ ( gc, clock, nymd, nhms, cdt, STATUS ) VERIFY_(STATUS) -! Call ESMF version -! ----------------- - if (convecType == 1) then - call finalizeGenericConvection ( genCONV ) - elseif (convecType == 2) then - call finalizeGmiConvection ( gmiCONV ) - end if - ! Finalize MAPL Generic. Atanas says, "Do not deallocate foreign objects." ! ------------------------------------------------------------------------- call MAPL_GenericFinalize ( gc, impConv, expConv, clock, RC=STATUS ) VERIFY_(STATUS) -! Destroy Legacy state -! -------------------- - if (convecType == 1) then - deallocate ( state%genCONV, stat = STATUS ) - VERIFY_(STATUS) - elseif (convecType == 2) then - deallocate ( state%gmiCONV, stat = STATUS ) - VERIFY_(STATUS) - end if - RETURN_(ESMF_SUCCESS) END SUBROUTINE Finalize_ !EOC !------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: runRAS -! -! !INTERFACE: -! - subroutine runRAS(impConv, expConv, esmfGrid, cdt) -! -! !USES: - !USE Chem_UtilMod, only : pmaxmin - use, intrinsic :: iso_fortran_env, only: REAL64 - - implicit NONE -! -! !INPUT PARAMETERS: - real, intent(in ) :: cdt -! -! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Grid), intent(inout) :: esmfGrid - type(ESMF_State), intent(inout) :: impConv ! Import State - type(ESMF_State), intent(inout) :: expConv ! Export State -!EOP -!------------------------------------------------------------------------- -!BOC - - character(len=ESMF_MAXSTR) :: IAm = 'runRAS' - integer :: RC, STATUS, IM, JM, LM - real, pointer, dimension(:,:) :: FRLAND => null() - real, POINTER, dimension(:,:) :: PBLH => null() - real, pointer, dimension(:,:) :: TS => null() - real, pointer, dimension(:,:,:) :: CNV_MFC => null() - real, pointer, dimension(:,:,:) :: CNV_MFD => null() - real, pointer, dimension(:,:,:) :: T => null() - real, pointer, dimension(:,:,:) :: TH => null() - real, pointer, dimension(:,:,:) :: KH => null() - real, pointer, dimension(:,:,:) :: Q => null() - real, pointer, dimension(:,:,:) :: PLE => null() - - real, pointer, dimension(:) :: PREF => null() - real, pointer, dimension(:,:,:) :: CNV_MFCras => null() - real, pointer, dimension(:,:,:) :: CNV_MFDras => null() - - real(REAL64), pointer, dimension(:,:) :: LATS => null() - real(REAL64), pointer, dimension(:,:) :: LONS => null() - real(REAL64), allocatable :: AK(:) - real(REAL64), allocatable :: BK(:) - !REAL :: qmin, qmax - - call MAPL_GetPointer ( impConv, Q, 'Q', __RC__ ) - call MAPL_GetPointer ( impConv, T, 'T', __RC__ ) - call MAPL_GetPointer ( impConv, KH, 'KH', __RC__ ) - call MAPL_GetPointer ( impConv, TS, 'TS', __RC__ ) - call MAPL_GetPointer ( impConv, PLE, 'PLE', __RC__ ) - call MAPL_GetPointer ( impConv, PBLH, 'ZPBL', __RC__ ) - call MAPL_GetPointer ( impConv, FRLAND, 'FRLAND', __RC__ ) - - IM = SIZE(T, 1) - JM = SIZE(T, 2) - LM = SIZE(T, 3) - - ! Get the AK and BK - allocate(AK(LM+1),stat=status) - VERIFY_(STATUS) - allocate(BK(LM+1),stat=status) - VERIFY_(STATUS) - - call ESMF_AttributeGet(esmfGrid,name="GridAK",valuelist=AK,rc=status) - VERIFY_(STATUS) - call ESMF_AttributeGet(esmfGrid,name="GridBK",valuelist=BK,rc=status) - VERIFY_(STATUS) - - ! Get the LATS and LONS - call ESMF_GridGetCoord(esmfGrid, coordDim=2, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=LATS, rc=status) - VERIFY_(status) - - call ESMF_GridGetCoord(esmfGrid, coordDim=1, localDE=0, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=LONS, rc=status) - - !----------------------------------------- - ! Compute the reference air pressure in Pa - ! AK in Pa - ! MAPL_P00 = 100000 Pa - !----------------------------------------- - ALLOCATE(PREF(LM+1)) - PREF = AK + BK * MAPL_P00 - - ALLOCATE(TH (IM,JM,1:LM)) - ALLOCATE(CNV_MFDras(IM,JM,1:LM)) - ALLOCATE(CNV_MFCras(IM,JM,0:LM)) - - ! Compute the potential temperature - TH(:,:,:) = T(:,:,:)/ & - ((0.5*(PLE(:,:,0:LM-1) + PLE(:,:,1:LM ) ))/100000.)**(MAPL_RGAS/MAPL_CP) - -! IF ( MAPL_am_I_root() ) THEN -! PRINT*, "DT: ", cdt -! PRINT* -! PRINT*, "AK: ", AK -! PRINT* -! PRINT*, "BK: ", BK -! PRINT* -! PRINT*, "PREF: ", PREF -! PRINT* -! END IF -! -! CALL pmaxmin('LONS :',REAL(LONS), qmin, qmax, IM*JM, 1, 1. ) -! CALL pmaxmin('LATS :',REAL(LATS), qmin, qmax, IM*JM, 1, 1. ) -! CALL pmaxmin('KH :', KH, qmin, qmax, IM*JM, LM+1, 1. ) -! CALL pmaxmin('TH :', TH, qmin, qmax, IM*JM, LM , 1. ) -! CALL pmaxmin('TS :', TS, qmin, qmax, IM*JM, 1, 1. ) -! CALL pmaxmin('Q :', Q, qmin, qmax, IM*JM, LM , 1. ) -! CALL pmaxmin('FRLAND:', FRLAND, qmin, qmax, IM*JM, 1, 1. ) -! CALL pmaxmin('PLE :', PLE, qmin, qmax, IM*JM, LM+1, 1. ) -! CALL pmaxmin('PBLH :', PBLH, qmin, qmax, IM*JM, 1, 1. ) -! - ! Do the RAS calculations to obtain the values of CNV_MFD and CNV_MFC - CALL DO_RAS(RASPARAMS, PREF, TH, PLE, KH, PBLH, Q, & - FRLAND, TS, CNV_MFDras, CNV_MFCras, & - REAL(LATS), REAL(LONS), cdt, IM, JM, LM) - - !CALL pmaxmin('CNV_MFC :',CNV_MFCras, qmin, qmax, IM*JM, LM+1, 1. ) - !CALL pmaxmin('CNV_MFD :',CNV_MFDras, qmin, qmax, IM*JM, LM, 1. ) - - ! Populate the export state - call MAPL_GetPointer ( expConv, CNV_MFC, 'CNV_MFC', ALLOC=.TRUE., __RC__ ) - call MAPL_GetPointer ( expConv, CNV_MFD, 'CNV_MFD', ALLOC=.TRUE., __RC__ ) - - CNV_MFC(:,:,:) = CNV_MFCras(:,:,:) - CNV_MFD(:,:,:) = CNV_MFDras(:,:,:) - - DEALLOCATE(PREF) - DEALLOCATE(CNV_MFDras, CNV_MFCras) - DEALLOCATE(TH) - deallocate(AK, BK) - end subroutine runRAS -!EOC -!------------------------------------------------------------------------- - SUBROUTINE extract_ ( gc, clock, genCONV, gmiCONV, nymd, nhms, cdt, & - rc, state ) + SUBROUTINE extract_ ( gc, clock, nymd, nhms, cdt, rc ) type(ESMF_GridComp), intent(inout) :: gc type(ESMF_Clock), intent(in) :: clock - type(gmiConvection_GridComp), pointer :: gmiCONV - type(genConvection_GridComp), pointer :: genCONV integer, intent(out) :: nymd, nhms real, intent(out) :: cdt integer, intent(out) :: rc - type(Convection_state), pointer, optional :: state - - type(Convection_state), pointer :: myState + type(T_Convection_state), pointer :: myState ! ErrLog Variables ! ---------------- @@ -785,7 +724,6 @@ SUBROUTINE extract_ ( gc, clock, genCONV, gmiCONV, nymd, nhms, cdt, & type(ESMF_Time) :: TIME type(ESMF_Config) :: CF - type(Convection_Wrap) :: wrap integer :: IYR, IMM, IDD, IHR, IMN, ISC @@ -795,35 +733,6 @@ SUBROUTINE extract_ ( gc, clock, genCONV, gmiCONV, nymd, nhms, cdt, & VERIFY_(STATUS) Iam = trim(COMP_NAME) // 'extract_' - rc = 0 - -! Get my internal state -! --------------------- - call ESMF_UserCompGetInternalState(gc, 'Convection_state', WRAP, STATUS) - VERIFY_(STATUS) - myState => wrap%ptr - if ( present(state) ) then - state => wrap%ptr - end if - -! This is likely to be allocated during initialize only -! ----------------------------------------------------- - if (convecType == 1) then - if ( .not. associated(myState%genCONV) ) then - allocate ( myState%genCONV, stat=STATUS ) - VERIFY_(STATUS) - end if - - genCONV => myState%genCONV - elseif (convecType == 2) then - if ( .not. associated(myState%gmiCONV) ) then - allocate ( myState%gmiCONV, stat=STATUS ) - VERIFY_(STATUS) - end if - - gmiCONV => myState%gmiCONV - end if - ! Get the configuration ! --------------------- call ESMF_GridCompGet ( GC, CONFIG = CF, RC=STATUS ) @@ -834,11 +743,6 @@ SUBROUTINE extract_ ( gc, clock, genCONV, gmiCONV, nymd, nhms, cdt, & call ESMF_ConfigGetAttribute ( CF, cdt, LABEL="RUN_DT:", RC=STATUS ) VERIFY_(STATUS) -! Disable Option for Modified cdt (Chemistry does not operate with modified refresh intervals) -! -------------------------------------------------------------------------------------------- -! call ESMF_ConfigGetAttribute ( CF, cdt, LABEL="CHEMISTRY_DT:", DEFAULT=cdt, RC=STATUS ) -! VERIFY_(STATUS) - ! Extract nymd, nhms, day of year from clock ! ------------------------------------------ call ESMF_ClockGet(CLOCK,currTIME=TIME,rc=STATUS) diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionStubCompMod.F90 b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionStubCompMod.F90 deleted file mode 100644 index 4ef6a4d..0000000 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionStubCompMod.F90 +++ /dev/null @@ -1,63 +0,0 @@ -!------------------------------------------------------------------------- -! NASA/GSFC, Global Modeling and Assimilation Office, Code 910.1 ! -!------------------------------------------------------------------------- -!BOP -! -! !MODULE: CTM_ConvectionGridCompMod - The Convection Grid Component -! -! !INTERFACE: -! - Module CTM_ConvectionGridCompMod -! -! !USES: -! - - use ESMF - - implicit none - private -! -! !PUBLIC MEMBER FUNCTIONS: - - public SetServices -! -! !DESCRIPTION: -! -! This is a stub for the {\tt Convection} gridded component. -! -!EOP -!------------------------------------------------------------------------- - -CONTAINS - - -!------------------------------------------------------------------------- -! NASA/GSFC, Global Modeling and Assimilation Office, Code 910.1 ! -!------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: SetServices --- Sets IRF services for Convection Grid Component -! -! !INTERFACE: - - subroutine SetServices ( GC, RC ) - -! !ARGUMENTS: - - type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component - integer, optional :: RC ! return code - -! !DESCRIPTION: Sets Initialize, Run and Finalize services. -! -! !REVISION HISTORY: -! -! 28Jan2013 Kouatchou First crack. -! -!EOP -!------------------------------------------------------------------------- - - if ( present(rc) ) rc = 0 - - end subroutine SetServices - -end Module CTM_ConvectionGridCompMod diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_rasCalculationsMod.F90 b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_rasCalculationsMod.F90 index a47a057..96ccfe4 100644 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_rasCalculationsMod.F90 +++ b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_rasCalculationsMod.F90 @@ -11,7 +11,7 @@ MODULE CTM_rasCalculationsMod ! !USES: ! use ESMF - use MAPL + use MAPL_Mod use GEOS_Mod use GEOS_UtilsMod diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/GmiConvectionMethod_mod.F90 b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/GmiConvectionMethod_mod.F90 index 4649349..e61e770 100644 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/GmiConvectionMethod_mod.F90 +++ b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/GmiConvectionMethod_mod.F90 @@ -13,7 +13,7 @@ module GmiConvectionMethod_mod ! ! !USES: use ESMF - use MAPL + use MAPL_Mod USE Chem_UtilMod use GmiArrayBundlePointer_mod USE GmiESMFrcFileReading_mod @@ -164,39 +164,31 @@ subroutine initializeGmiConvection (self, impConv, expConv, nymd, nhms, & !------ ------------------------ call ESMF_ConfigGetAttribute(convConfigFile, self%convec_opt, & - & label = "convec_opt:",& - & default = 0, rc=STATUS ) - VERIFY_(STATUS) + label = "convec_opt:",& + default = 0, __RC__ ) - call ESMF_ConfigGetAttribute(convConfigFile, value=self%det_ent, & - label="det_ent:", default=.false., rc=STATUS) - VERIFY_(STATUS) + call ESMF_ConfigGetAttribute(convConfigFile, self%det_ent, & + label = "det_ent:", default=.false., __RC__ ) - call ESMF_ConfigGetAttribute(convConfigFile, value=self%do_downdraft, & - label="do_downdraft:", default=.false., rc=STATUS) - VERIFY_(STATUS) + call ESMF_ConfigGetAttribute(convConfigFile, self%do_downdraft, & + label = "do_downdraft:", default=.false., __RC__ ) - call ESMF_ConfigGetAttribute(convConfigFile, value=self%do_old_ncar, & - label="do_old_ncar:", default=.false., rc=STATUS) - VERIFY_(STATUS) + call ESMF_ConfigGetAttribute(convConfigFile, self%do_old_ncar, & + label = "do_old_ncar:", default=.false., __RC__ ) call ESMF_ConfigGetAttribute(convConfigFile, self%met_opt, & - & label = "met_opt:",& - & default = 0, rc=STATUS ) - VERIFY_(STATUS) + label = "met_opt:",& + default = 0, __RC__ ) call ESMF_ConfigGetAttribute(convConfigFile, self%chem_opt, & - & label = "chem_opt:",& - & default = 0, rc=STATUS ) - VERIFY_(STATUS) + label = "chem_opt:",& + default = 0, __RC__ ) - call ESMF_ConfigGetAttribute(convConfigFile, value=self%do_wetdep, & - label="do_wetdep:", default=.false., rc=STATUS) - VERIFY_(STATUS) + call ESMF_ConfigGetAttribute(convConfigFile, self%do_wetdep, & + label = "do_wetdep:", default=.false., __RC__ ) - call ESMF_ConfigGetAttribute(convConfigFile, value=self%do_drydep, & - label="do_drydep:", default=.false., rc=STATUS) - VERIFY_(STATUS) + call ESMF_ConfigGetAttribute(convConfigFile, self%do_drydep, & + label = "do_drydep:", default=.false., __RC__ ) IF ( MAPL_AM_I_ROOT() ) THEN PRINT*," -----> det_ent = ", self%det_ent diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/convectiveTransport_mod.F90 b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/convectiveTransport_mod.F90 index 643540b..aca5fa5 100644 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/convectiveTransport_mod.F90 +++ b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/convectiveTransport_mod.F90 @@ -9,10 +9,12 @@ ! module convectiveTransport_mod + USE GmiArrayBundlePointer_mod + implicit none private - public :: convectiveTransport + public :: doConvectiveTransport ! ! !DESCRIPTION: ! Module for the convective transport. @@ -20,6 +22,176 @@ module convectiveTransport_mod !EOP !----------------------------------------------------------------------------- CONTAINS +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: doConvectiveTransport +! +! !INTERFACE: +! + subroutine doConvectiveTransport (det_ent, do_downdraft, pbl, cldmas, & + dtrn, eu, ed, md, grid_height, mass, kel, press3e, & + concentration, isFixedConcentration, mcor, tdt, & + i1, i2, j1, j2, k1, k2, ilong, ivert, num_species) +! +! !INPUT PARAMETER: + integer, intent(in) :: i1, i2, j1, j2, k1, k2 + integer, intent(in) :: ilong, ivert, num_species + logical, intent(in) :: isFixedConcentration(:) + logical, intent(in) :: det_ent ! flag for doing detrainment then entrainment + logical, intent(in) :: do_downdraft ! flag for doing downdrafts + real*8 , intent(in) :: tdt ! model time step (s) + real*8 , intent(in) :: mcor (i1:i2, j1:j2) ! area of each grid box (m^2) + real*8 , intent(in) :: pbl (i1:i2,j1:j2) ! planetary boundary layer thickness (m) + real*8 , intent(in) :: cldmas (i1:i2,j1:j2,k1:k2) ! convective mass flux in updraft (kg/m^2/s) + real*8 , intent(in) :: dtrn (i1:i2,j1:j2,k1:k2) ! detrainment rate (DAO:kg/m^2*s, NCAR:s^-1) + real*8 , intent(in) :: eu (i1:i2,j1:j2,k1:k2) ! ntrainment into convective updraft (s^-1) + real*8 , intent(in) :: ed (i1:i2,j1:j2,k1:k2) ! entrainment into convective downdraft (s^-1) + real*8 , intent(in) :: md (i1:i2,j1:j2,k1:k2) ! convective mass flux in downdraft (kg/m^2/s) + real*8 , intent(in) :: grid_height(i1:i2,j1:j2,k1:k2) ! grid box height (m) + real*8 , intent(in) :: mass (i1:i2,j1:j2,k1:k2) ! mass of air in each grid box (kg) + real*8 , intent(in) :: kel (i1:i2,j1:j2,k1:k2) ! temperature (degK) + real*8 , intent(in) :: press3e (i1:i2,j1:j2,k1-1:k2) ! atmospheric pressure at the edge of each grid box (mb) +! +! !INPUT/OUTPUT PARAMETERS: + ! species concentration, known at zone centers (mixing ratio) + type (t_GmiArrayBundle), intent(inOut) :: concentration(num_species) +! +! !DEFINED PARAMETERS: + real*8, parameter :: MBSTH = 1.0d-15 ! threshold below which we treat + ! mass fluxes as zero (mb/s) + real*8, parameter :: GMI_G = 9.81d0 ! mean surface gravity accel. (m/s^2) + real*8, parameter :: PASPMB = 100.00d0 ! pascals per millibar +! +! !DESCRIPTION: +! This is the interface routine to Convective Transport. +! It formats the gem variables to satisfy the Convective Transport routine. +! +!EOP +!------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: + character (len=75) :: err_msg + integer :: iku + integer :: il, ij, ik, ic + integer :: il2g ! gathered index to operate over + integer :: itdt_conv + integer :: num_conv_steps + real*8 :: rnum_conv_steps + real*8 :: tdt_conv + real*8 :: xmbsth + integer :: ideep(ilong) ! gathering array + integer :: pbli (ilong) ! index of pbl height + real*8 :: updraft_velocity(i1:i2) ! velocity in convective updraft + ! (m/s) + real*8 :: dpi(ilong, k1:k2) ! delta pressure between interfaces + real*8 :: dui(ilong, k1:k2) ! mass detraining from updraft + real*8 :: eui(ilong, k1:k2) ! mass entraining into updraft + real*8 :: mui(ilong, k1:k2) ! mass flux up + real*8 :: mdi(ilong, k1:k2) ! mass flux down + real*8 :: fracis(i1:i2, k1:k2, num_species) ! insoluble fraction of tracer + real*8 :: qq (i1:i2, k1:k2, num_species) ! tracer array including moisture + + ideep(:) = 0 + pbli (:) = 0 + + dpi(:,:) = 0.0d0 + dui(:,:) = 0.0d0 + eui(:,:) = 0.0d0 + mui(:,:) = 0.0d0 + mdi(:,:) = 0.0d0 + + fracis(:,:,:) = 0.0d0 + + xmbsth = MBSTH + + updraft_velocity(:) = 0.0d0 + + ! ----------------------------------------------------------- + ! Calculate any needed sub-cycling of the convection operator + ! by comparing the mass flux over the full time step to the + ! mass within the grid box. + ! ----------------------------------------------------------- + + num_conv_steps = Maxval (tdt * cldmas(:,:,:) * Spread (mcor(:,:), 3, k2-k1+1) / & + mass(:,:,:)) + 1.0d0 + + rnum_conv_steps = num_conv_steps + tdt_conv = tdt / rnum_conv_steps + + IJLOOP: do ij = j1, j2 + il2g = 0 + + ILLOOP: do il = i1, i2 + ! ---------------------------------------------------- + ! Verify that there is convection in the current cell. + ! ---------------------------------------------------- + if (Maxval (cldmas(il,ij,:)) >= 0.0d0) then + il2g = il2g + 1 + ideep(il2g) = il + + dpi(il2g,:) = (press3e(il,ij,k2-1:k1-1:-1) - & + press3e(il,ij,k2:k1:-1)) * PASPMB + + mui(il2g,:) = cldmas(il,ij,k2:k1:-1) * GMI_G + + eui(il2g,k1+1:k2-1) = Max (0.0d0, cldmas(il,ij,k2-1:k1+1:-1) - & + cldmas(il,ij,k2-2:k1 :-1) + & + dtrn (il,ij,k2-1:k1+1:-1)) + + eui(il2g,:) = eui(il2g,:) * GMI_G + + if (det_ent) dui(il2g,:) = dtrn(il,ij,k2:k1:-1) * GMI_G + end if + end do ILLOOP + + IL2GIF: if (il2g /= 0) then + fracis(:,:,:) = 1.0d0 + + ! ---------------------------------------------------------------- + ! Find the index of the top of the planetary boundary layer (pbl). + ! Convection will assume well mixed tracers below that level. + ! ---------------------------------------------------------------- + do il = 1, il2g + pbli(il) = 0 + + IKLOOP: do ik = k1, k2 + if (pbl(ideep(il),ij) < Sum (grid_height(ideep(il),ij,k1:ik))) then + pbli(il) = ik + exit IKLOOP + end if + end do IKLOOP + + if (pbli(il) == 0) then + err_msg = 'Could not find pbl in doConvectiveTransport.' + PRINT*, err_msg + stop + end if + + pbli(il) = k2 - pbli(il) + end do + + ITDTCLOOP: do itdt_conv = 1, num_conv_steps + do ic = 1, num_species + qq(:,k2:k1:-1,ic) = concentration(ic)%pArray3D(:,ij,k1:k2) + end do + + call convectiveTransport (il2g, tdt_conv, xmbsth, ideep, & + pbli, dui, eui, mui, mdi, dpi, fracis, qq, & + isFixedConcentration, i1, i2, k1, k2, ilong, num_species) + + do ic = 1, num_species + concentration(ic)%pArray3D(:,ij,k1:k2) = qq(:,k2:k1:-1,ic) + end do + end do ITDTCLOOP + end if IL2GIF + end do IJLOOP + + return + + end subroutine doConvectiveTransport +!EOC !----------------------------------------------------------------------------- !BOP ! diff --git a/src/Components/GEOSctm_GridComp/GEOS_ctmEnvGridComp.F90 b/src/Components/GEOSctm_GridComp/GEOS_ctmEnvGridComp.F90 index d05c203..d0643cc 100644 --- a/src/Components/GEOSctm_GridComp/GEOS_ctmEnvGridComp.F90 +++ b/src/Components/GEOSctm_GridComp/GEOS_ctmEnvGridComp.F90 @@ -16,7 +16,8 @@ module GEOS_ctmEnvGridComp use FV_StateMod, only : calcCourantNumberMassFlux => fv_computeMassFluxes use fv_arrays_mod , only: FVPRC use m_set_eta, only : set_eta - use GEOS_FV3_UtilitiesMod, only: a2d2c + use GEOS_FV3_UtilitiesMod, only: A2D2c + use CTM_rasCalculationsMod, only: INIT_RASPARAMS, DO_RAS, RASPARAM_Type implicit none private @@ -33,32 +34,37 @@ module GEOS_ctmEnvGridComp ! ! !DESCRIPTION: ! This GC is used to derive variables needed by the CTM GC children. + + !Derived types for the internal state + type T_CTMenv_STATE + private + logical :: enable_pTracers = .FALSE. ! do idealized Passive Tracers? + logical :: output_forcingData = .FALSE. ! Export variables to HISTORY? + logical :: read_advCoreFields = .FALSE. ! read courant numbers and mass fluxes? + logical :: enable_rasCalculations = .FALSE. ! do RAS calculations? + logical :: do_ctmAdvection = .TRUE. ! do Advection? + TYPE(RASPARAM_Type) :: RASPARAMS + character(len=ESMF_MAXSTR) :: metType ! MERRA2 or MERRA1 or FPIT or FP + end type T_CTMenv_STATE + + type CTMenv_WRAP + type (T_CTMenv_STATE), pointer :: PTR + end type CTMenv_WRAP ! ! !AUTHORS: ! Jules.Kouatchou-1@nasa.gov ! !EOP !------------------------------------------------------------------------- - integer, parameter :: r8 = 8 - integer, parameter :: r4 = 4 - - INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND(6,30) - INTEGER, PARAMETER :: dp = SELECTED_REAL_KIND(14,300) - INTEGER, PARAMETER :: qp = SELECTED_REAL_KIND(18,400) + integer, parameter :: r8 = SELECTED_REAL_KIND(14,300) + integer, parameter :: r4 = SELECTED_REAL_KIND(6,30) real(r8), parameter :: RADIUS = MAPL_RADIUS real(r8), parameter :: PI = MAPL_PI_R8 - real(r8), parameter :: D0_0 = 0.0_r8 - real(r8), parameter :: D0_5 = 0.5_r8 - real(r8), parameter :: D1_0 = 1.0_r8 real(r8), parameter :: GPKG = 1000.0d0 real(r8), parameter :: MWTAIR = 28.96d0 real(r8), parameter :: SecondsPerMinute = 60.0d0 - logical :: enable_pTracers = .FALSE. - logical :: output_forcingData = .FALSE. - character(len=ESMF_MAXSTR) :: metType ! MERRA2 or MERRA1 or FPIT or FP - !------------------------------------------------------------------------- CONTAINS !------------------------------------------------------------------------- @@ -87,45 +93,67 @@ subroutine SetServices ( GC, RC ) ! ! !LOCAL VARIABLES: integer :: STATUS - integer :: I type (ESMF_Config) :: CF type (ESMF_Config) :: configFile character(len=ESMF_MAXSTR) :: COMP_NAME CHARACTER(LEN=ESMF_MAXSTR) :: rcfilen = 'CTM_GridComp.rc' character(len=ESMF_MAXSTR) :: IAm = 'SetServices' + type (T_CTMenv_STATE), pointer :: state + type (CTMenv_WRAP) :: wrap ! Get my name and set-up traceback handle ! --------------------------------------- - call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, __RC__ ) Iam = trim(COMP_NAME) // TRIM(Iam) + ! Wrap internal state for storing in GC; rename legacyState + ! ------------------------------------- + allocate ( state, stat=STATUS ) + VERIFY_(STATUS) + wrap%ptr => state + ! Register services for this component ! ------------------------------------ call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, __RC__ ) call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run, __RC__ ) - configFile = ESMF_ConfigCreate(rc=STATUS ) - VERIFY_(STATUS) + ! Save pointer to the wrapped internal state in the GC + !----------------------------------------------------- - call ESMF_ConfigLoadFile(configFile, TRIM(rcfilen), rc=STATUS ) + call ESMF_UserCompSetInternalState ( GC, 'CTMenv', wrap, STATUS ) VERIFY_(STATUS) - call ESMF_ConfigGetAttribute(configFile, enable_pTracers, & + configFile = ESMF_ConfigCreate(__RC__) + + call ESMF_ConfigLoadFile(configFile, TRIM(rcfilen), __RC__ ) + + call ESMF_ConfigGetAttribute(configFile, state%enable_pTracers, & Default = .FALSE., & Label = "ENABLE_pTracers:", __RC__ ) - call ESMF_ConfigGetAttribute(configFile, output_forcingData, & + call ESMF_ConfigGetAttribute(configFile, state%read_advCoreFields, & + Default = .FALSE., & + Label = "read_advCoreFields:", __RC__ ) + + call ESMF_ConfigGetAttribute(configFile, state%output_forcingData, & Default = .FALSE., & Label = "output_forcingData:", __RC__ ) + call ESMF_ConfigGetAttribute(configFile, state%enable_rasCalculations, & + Default = .FALSE., & + Label = "enable_rasCalculations:", __RC__ ) + + call ESMF_ConfigGetAttribute(configFile, state%do_ctmAdvection, & + Default = .TRUE., & + Label = "do_ctmAdvection:", __RC__ ) + ! Type of meteological fields (MERRA2 or MERRA1 or FPIT or FP) - call ESMF_ConfigGetAttribute(configFile, metType, & + call ESMF_ConfigGetAttribute(configFile, state%metType, & Default = 'MERRA2', & Label = "metType:", __RC__ ) - IF ((TRIM(metType) == "F515_516") .OR. & - (TRIM(metType) == "F5131")) metType = "FP" + IF ((TRIM(state%metType) == "F515_516") .OR. & + (TRIM(state%metType) == "F5131")) state%metType = "FP" ! !IMPORT STATE: !------------------------------------------ @@ -143,24 +171,51 @@ subroutine SetServices ( GC, RC ) LONG_NAME = 'agrid_cell_area', & UNITS = 'm+2', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, RC=STATUS) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__) - call MAPL_AddImportSpec ( gc, & - SHORT_NAME = 'PLE0', & - LONG_NAME = 'pressure_at_layer_edges_before_advection', & - UNITS = 'Pa', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + IF (state%read_advCoreFields) THEN + call MAPL_AddImportSpec ( gc, & + SHORT_NAME = 'MFX', & + LONG_NAME = 'pressure_weighted_eastward_mass_flux', & + UNITS = 'Pa m+2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) - call MAPL_AddImportSpec ( gc, & - SHORT_NAME = 'PLE1', & - LONG_NAME = 'pressure_at_layer_edges_after_advection', & - UNITS = 'Pa', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_AddImportSpec ( gc, & + SHORT_NAME = 'MFY', & + LONG_NAME = 'pressure_weighted_northward_mass_flux', & + UNITS = 'Pa m+2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddImportSpec ( gc, & + SHORT_NAME = 'CX', & + LONG_NAME = 'eastward_accumulated_courant_number', & + UNITS = '', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddImportSpec ( gc, & + SHORT_NAME = 'CY', & + LONG_NAME = 'northward_accumulated_courant_number', & + UNITS = '', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + ENDIF + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'PS0', & + LONG_NAME = 'surface_pressure_before_advection', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'PS1', & + LONG_NAME = 'surface_pressure_after_advection', & + UNITS = 'Pa', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'UC0', & @@ -169,8 +224,7 @@ subroutine SetServices ( GC, RC ) STAGGERING = MAPL_CGrid, & ROTATION = MAPL_RotateCube, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'UC1', & @@ -179,8 +233,7 @@ subroutine SetServices ( GC, RC ) STAGGERING = MAPL_CGrid, & ROTATION = MAPL_RotateCube, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'VC0', & @@ -189,8 +242,7 @@ subroutine SetServices ( GC, RC ) STAGGERING = MAPL_CGrid, & ROTATION = MAPL_RotateCube, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'VC1', & @@ -199,168 +251,182 @@ subroutine SetServices ( GC, RC ) STAGGERING = MAPL_CGrid, & ROTATION = MAPL_RotateCube, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'T', & LONG_NAME = 'air_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'TS', & LONG_NAME = 'surface temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__ ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'FROCEAN', & LONG_NAME = 'areal_ocean_fraction', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__ ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'Q', & LONG_NAME = 'specific_humidity', & UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'FRLAKE', & LONG_NAME = 'fraction_of_lake', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__ ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'FRACI', & LONG_NAME = 'ice_covered_fraction_of_tile', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, RC=STATUS ) - VERIFY_(STATUS) - - IF ( (TRIM(metType) == 'MERRA2') .OR. & - (TRIM(metType) == 'FPIT') .OR. & - (TRIM(metType) == 'FP') ) THEN - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'ZLE', & - LONG_NAME = 'geopotential_height', & - UNITS = 'm', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__ ) + + IF ( (TRIM(state%metType) == 'MERRA2') .OR. & + (TRIM(state%metType) == 'FPIT') .OR. & + (TRIM(state%metType) == 'FP') ) THEN + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'ZLE', & + LONG_NAME = 'geopotential_height', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationEdge, __RC__ ) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'RH2', & + LONG_NAME = 'relative_humidity_after_moist', & + UNITS = '1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) END IF ! Only doing the Imports if we are not doing Idealized Passive Tracer !---------------------------------------------------------- - IF (.NOT. enable_pTracers) THEN + IF (.NOT. state%enable_pTracers) THEN + IF (state%enable_rasCalculations) THEN + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'ZPBL', & + LONG_NAME = 'planetary_boundary_layer_height', & + UNITS = 'm', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__ ) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'FRLAND', & + LONG_NAME = 'fraction_of_land', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__ ) + + call MAPL_AddImportSpec ( gc, & + SHORT_NAME = 'KH', & + LONG_NAME = 'scalar_diffusivity', & + UNITS = 'm+2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationEdge, __RC__ ) + ELSE + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CNV_MFC', & + LONG_NAME = 'cumulative_mass_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationEdge, __RC__ ) + + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'CNV_MFD', & + LONG_NAME = 'detraining_mass_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + END IF + call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'QL', & - LONG_NAME = 'mass_fraction_of_cloud_liquid_water', & - UNITS = 'kg kg-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__) + SHORT_NAME = 'QL', & + LONG_NAME = 'mass_fraction_of_cloud_liquid_water', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__) call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'QI', & - LONG_NAME = 'mass_fraction_of_cloud_ice_water', & - UNITS = 'kg kg-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__) + SHORT_NAME = 'QI', & + LONG_NAME = 'mass_fraction_of_cloud_ice_water', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__) call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'PRECCON', & - LONG_NAME = 'convective_precipitation', & - UNITS = 'km m-2 s-1', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__) + SHORT_NAME = 'PRECCON', & + LONG_NAME = 'convective_precipitation', & + UNITS = 'km m-2 s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'PRECANV', & - LONG_NAME = 'anvil_precipitation', & - UNITS = 'km m-2 s-1', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__) + SHORT_NAME = 'PRECANV', & + LONG_NAME = 'anvil_precipitation', & + UNITS = 'km m-2 s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'PRECLSC', & - LONG_NAME = 'nonanvil_large_scale_precipitation', & - UNITS = 'km m-2 s-1', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__) + SHORT_NAME = 'PRECLSC', & + LONG_NAME = 'nonanvil_large_scale_precipitation', & + UNITS = 'km m-2 s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'QLTOT', & LONG_NAME = 'mass_fraction_of_cloud_liquid_water', & UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'QITOT', & LONG_NAME = 'mass_fraction_of_cloud_ice_water', & UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'QLTOT1', & LONG_NAME = 'mass_fraction_of_cloud_liquid_water_before',& UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'QITOT1', & LONG_NAME = 'mass_fraction_of_cloud_ice_water_before', & UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'CNV_MFC', & - LONG_NAME = 'cumulative_mass_flux', & - UNITS = 'kg m-2 s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddImportSpec(GC, & SHORT_NAME ='CN_PRCP', & LONG_NAME ='convective_precipitation', & UNITS ='kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__ ) !--------------------------------------------------------- ! Variables to import if output_forcingData is set to TRUE !--------------------------------------------------------- - IF (output_forcingData) THEN - call MAPL_AddImportSpec(GC, & - SHORT_NAME = 'SGH', & - LONG_NAME = 'isotropic_stdv_GWD_topography', & - UNITS = 'm', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__) - + IF (state%output_forcingData) THEN call MAPL_AddImportSpec(GC, & SHORT_NAME = 'PHIS', & LONG_NAME = 'surface_geopotential_height', & @@ -375,12 +441,12 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__) - call MAPL_AddImportSpec ( gc, & - SHORT_NAME = 'DELP', & - LONG_NAME = 'pressure_thickness', & + call MAPL_AddImportSpec(GC, & + SHORT_NAME = 'TROPP', & + LONG_NAME = 'tropopause_pressure_based_on_blended_estimate', & UNITS = 'Pa', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__ ) + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__) ENDIF ! output_forcingData END IF @@ -395,8 +461,7 @@ subroutine SetServices ( GC, RC ) UNITS = '', & PRECISION = ESMF_KIND_R8, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'CYr8', & @@ -404,8 +469,7 @@ subroutine SetServices ( GC, RC ) UNITS = '', & PRECISION = ESMF_KIND_R8, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'MFXr8', & @@ -413,8 +477,7 @@ subroutine SetServices ( GC, RC ) UNITS = 'Pa m+2 s-1', & PRECISION = ESMF_KIND_R8, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'MFYr8', & @@ -422,8 +485,7 @@ subroutine SetServices ( GC, RC ) UNITS = 'Pa m+2 s-1', & PRECISION = ESMF_KIND_R8, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PLE1r8', & @@ -431,8 +493,7 @@ subroutine SetServices ( GC, RC ) UNITS = 'Pa', & PRECISION = ESMF_KIND_R8, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationEdge, __RC__ ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PLE0r8', & @@ -440,131 +501,140 @@ subroutine SetServices ( GC, RC ) UNITS = 'Pa', & PRECISION = ESMF_KIND_R8, & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationEdge, __RC__ ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PLE', & LONG_NAME = 'pressure_at_layer_edges', & UNITS = 'Pa', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationEdge, __RC__ ) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'TH', & LONG_NAME = 'potential_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__ ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'AIRDENS', & LONG_NAME = 'air_density', & UNITS = 'kg m-3', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationCenter, __RC__) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWI', & LONG_NAME = 'land-ocean-ice_mask', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__ ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'MASS', & LONG_NAME = 'total_mass', & UNITS = 'kg', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS) - VERIFY_(STATUS) - - IF ( TRIM(metType) == 'MERRA1' ) THEN - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'RH2', & - LONG_NAME = 'relative_humidity_after_moist', & - UNITS = '1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, & - RC=STATUS ) - VERIFY_(STATUS) - END IF + VLOCATION = MAPL_VLocationCenter, __RC__) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ZLE', & LONG_NAME = 'geopotential_height', & UNITS = 'm', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationEdge, __RC__ ) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'RH2', & + LONG_NAME = 'relative_humidity_after_moist', & + UNITS = '1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) ! Exports if not doing Passive Tracer experiment !----------------------------------------------- - IF (.NOT. enable_pTracers) THEN + IF (.NOT. state%enable_pTracers) THEN call MAPL_AddExportSpec(GC, & - SHORT_NAME= 'ITY', & - LONG_NAME = 'vegetation_type', & - UNITS = '1', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, RC=STATUS ) - VERIFY_(STATUS) + SHORT_NAME = 'CNV_MFC', & + LONG_NAME = 'cumulative_mass_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationEdge, __RC__ ) call MAPL_AddExportSpec(GC, & - SHORT_NAME='BYNCY', & - LONG_NAME ='buoyancy_of surface_parcel', & - UNITS ='m s-2', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'CNV_QC', & - LONG_NAME = 'grid_mean_convective_condensate', & - UNITS = 'kg kg-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'QCTOT', & - LONG_NAME = 'mass_fraction_of_total_cloud_water', & - UNITS = 'kg kg-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, RC=STATUS ) - VERIFY_(STATUS) - - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'LFR', & - LONG_NAME = 'lightning_flash_rate', & - UNITS = 'km-2 s-1', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) + SHORT_NAME = 'CNV_MFD', & + LONG_NAME = 'detraining_mass_flux', & + UNITS = 'kg m-2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'U', & + LONG_NAME = 'eastward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'V', & + LONG_NAME = 'northward_wind', & + UNITS = 'm s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + call MAPL_AddExportSpec(GC, & + SHORT_NAME= 'ITY', & + LONG_NAME = 'vegetation_type', & + UNITS = '1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__ ) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME='BYNCY', & + LONG_NAME ='buoyancy_of surface_parcel', & + UNITS ='m s-2', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'CNV_QC', & + LONG_NAME = 'grid_mean_convective_condensate', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'QCTOT', & + LONG_NAME = 'mass_fraction_of_total_cloud_water', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec(GC, & + SHORT_NAME = 'LFR', & + LONG_NAME = 'lightning_flash_rate', & + UNITS = 'km-2 s-1', & + DIMS = MAPL_DimsHorzOnly, & + VLOCATION = MAPL_VLocationNone, __RC__ ) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'QLCN', & - LONG_NAME = 'mass_fraction_of_convective_cloud_liquid_water', & - UNITS = 'kg kg-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__) + SHORT_NAME = 'QLCN', & + LONG_NAME = 'mass_fraction_of_convective_cloud_liquid_water', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'QICN', & - LONG_NAME = 'mass_fraction_of_convective_cloud_ice_water', & - UNITS = 'kg kg-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__) + SHORT_NAME = 'QICN', & + LONG_NAME = 'mass_fraction_of_convective_cloud_ice_water', & + UNITS = 'kg kg-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__) !--------------------------------------------------------- ! Variables to export if output_forcingData is set to TRUE !--------------------------------------------------------- - IF (output_forcingData) THEN + IF (state%output_forcingData) THEN call MAPL_AddExportSpec(GC, & SHORT_NAME = 'PS', & LONG_NAME = 'surface_pressure', & @@ -573,16 +643,16 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'SGH', & - LONG_NAME = 'isotropic_stdv_GWD_topography', & - UNITS = 'm', & + SHORT_NAME = 'PHIS_input', & + LONG_NAME = 'surface_geopotential_height', & + UNITS = 'm2 s-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'PHIS', & - LONG_NAME = 'surface_geopotential_height', & - UNITS = 'm2 s-2', & + SHORT_NAME = 'TROPP', & + LONG_NAME = 'tropopause_pressure_based_on_blended_estimate', & + UNITS = 'Pa', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__) @@ -600,20 +670,6 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__) - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'U', & - LONG_NAME = 'eastward_wind', & - UNITS = 'm s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__ ) - - call MAPL_AddExportSpec ( gc, & - SHORT_NAME = 'V', & - LONG_NAME = 'northward_wind', & - UNITS = 'm s-1', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__ ) - call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'DELP', & LONG_NAME = 'pressure_thickness', & @@ -644,18 +700,45 @@ subroutine SetServices ( GC, RC ) ENDIF ! output_forcingData END IF + IF ( (.NOT. state%read_advCoreFields) .AND. state%output_forcingData) THEN + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'MFX', & + LONG_NAME = 'pressure_weighted_eastward_mass_flux', & + UNITS = 'Pa m+2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'MFY', & + LONG_NAME = 'pressure_weighted_northward_mass_flux', & + UNITS = 'Pa m+2 s-1', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'CX', & + LONG_NAME = 'eastward_accumulated_courant_number', & + UNITS = '', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + + call MAPL_AddExportSpec ( gc, & + SHORT_NAME = 'CY', & + LONG_NAME = 'northward_accumulated_courant_number', & + UNITS = '', & + DIMS = MAPL_DimsHorzVert, & + VLOCATION = MAPL_VLocationCenter, __RC__ ) + END IF + ! Set the Profiling timers !------------------------- - call MAPL_TimerAdd(GC, name="INITIALIZE" ,RC=STATUS) - VERIFY_(STATUS) - call MAPL_TimerAdd(GC, name="RUN" ,RC=STATUS) - VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="INITIALIZE" , __RC__ ) + call MAPL_TimerAdd(GC, name="RUN" , __RC__ ) ! Create children's gridded components and invoke their SetServices ! ----------------------------------------------------------------- - call MAPL_GenericSetServices ( GC, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GenericSetServices ( GC, __RC__ ) RETURN_(ESMF_SUCCESS) @@ -692,42 +775,56 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: COMP_NAME type(ESMF_Grid) :: esmfGrid type (ESMF_VM) :: VM - integer :: im, jm, km type(MAPL_MetaComp), pointer :: ggState ! GEOS Generic State type (ESMF_Config) :: CF - integer :: dims(3) + type (T_CTMenv_STATE), pointer :: CTMenv_STATE + type (CTMenv_WRAP) :: WRAP +! +!EOP +!------------------------------------------------------------------------------ +!BOC ! Get my name and set-up traceback handle ! --------------------------------------- - call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, VM=VM, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, VM=VM, __RC__ ) Iam = TRIM(COMP_NAME)//"::Initialize" ! Initialize GEOS Generic ! ------------------------ - call MAPL_GenericInitialize ( gc, IMPORT, EXPORT, clock, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GenericInitialize ( gc, IMPORT, EXPORT, clock, __RC__ ) ! Get my internal MAPL_Generic state ! ----------------------------------- - call MAPL_GetObjectFromGC ( GC, ggState, RC=STATUS) - VERIFY_(STATUS) + call MAPL_GetObjectFromGC ( GC, ggState, __RC__) call MAPL_TimerOn(ggSTATE,"TOTAL") call MAPL_TimerOn(ggSTATE,"INITIALIZE") - ! Get the grid related information - !--------------------------------- - call ESMF_GridCompGet ( GC, GRID=esmfGrid, rc=STATUS) + ! Get my private state from the component + !---------------------------------------- + call ESMF_UserCompGetInternalState(gc, 'CTMenv', WRAP, STATUS) VERIFY_(STATUS) - call MAPL_GridGet ( esmfGrid, globalCellCountPerDim=dims, RC=STATUS) - VERIFY_(STATUS) + CTMenv_STATE => WRAP%PTR + + IF (MAPL_AM_I_ROOT()) THEN + PRINT* + PRINT*, '<---------------------------------------------->' + PRINT*, TRIM(Iam)//' enable_pTracers: ', CTMenv_STATE%enable_pTracers + PRINT*, TRIM(Iam)//' do_ctmAdvection: ', CTMenv_STATE%do_ctmAdvection + PRINT*, TRIM(Iam)//' output_forcingData: ', CTMenv_STATE%output_forcingData + PRINT*, TRIM(Iam)//' read_advCoreFields: ', CTMenv_STATE%read_advCoreFields + PRINT*, TRIM(Iam)//' enable_rasCalculations: ', CTMenv_STATE%enable_rasCalculations + PRINT*, '<---------------------------------------------->' + PRINT* + END IF + + IF (CTMenv_STATE%enable_rasCalculations) THEN + IF (MAPL_AM_I_ROOT()) & + PRINT*, TRIM(Iam)//': Doing RAS Calculations' + CALL INIT_RASPARAMS(CTMenv_STATE%RASPARAMS) + ENDIF - im = dims(1) - jm = dims(2) - km = dims(3) - call MAPL_TimerOff(ggSTATE,"INITIALIZE") call MAPL_TimerOff(ggSTATE,"TOTAL") @@ -766,11 +863,11 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: COMP_NAME type (MAPL_MetaComp), pointer :: ggState type (ESMF_Grid) :: esmfGrid + type (T_CTMenv_STATE), pointer :: CTMenv_STATE + type (CTMenv_wrap) :: WRAP ! Imports !-------- - real, pointer, dimension(:,:,:) :: PLE1 => null() - real, pointer, dimension(:,:,:) :: PLE0 => null() real, pointer, dimension(:,:,:) :: UC0 => null() real, pointer, dimension(:,:,:) :: UC1 => null() real, pointer, dimension(:,:,:) :: VC0 => null() @@ -783,16 +880,15 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:,:) :: QITOT1 => null() real, pointer, dimension(:,:,:) :: QLTOT1 => null() real, pointer, dimension(:,:) :: cellArea => null() + real, pointer, dimension(:,:) :: PS0 => null() + real, pointer, dimension(:,:) :: PS1 => null() real, pointer, dimension(:,:) :: TS => null() real, pointer, dimension(:,:) :: FROCEAN => null() real, pointer, dimension(:,:) :: CN_PRCP => null() real, pointer, dimension(:,:,:) :: CNV_MFC => null() real, pointer, dimension(:,:) :: FRLAKE => null() - real, pointer, dimension(:,:,:) :: PFLCU => null() - !real, pointer, dimension(:,:,:) :: PFICU => null() - !real, pointer, dimension(:,:,:) :: PFLLSAN => null() - !real, pointer, dimension(:,:,:) :: PFILSAN => null() + !real, pointer, dimension(:,:,:) :: PFLCU => null() ! Exports !-------- @@ -807,35 +903,30 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) real(r8), pointer, dimension(:,:,:) :: MFXr8 => null() real(r8), pointer, dimension(:,:,:) :: MFYr8 => null() + real(r4), pointer, dimension(:,:,:) :: CXr4 => null() + real(r4), pointer, dimension(:,:,:) :: CYr4 => null() + real(r4), pointer, dimension(:,:,:) :: MFXr4 => null() + real(r4), pointer, dimension(:,:,:) :: MFYr4 => null() + real(r8), pointer, dimension(:,:,:) :: UCr8 => null() real(r8), pointer, dimension(:,:,:) :: VCr8 => null() real(r8), pointer, dimension(:,:,:) :: PLEr8 => null() - real, pointer, dimension(:,:,:) :: U => null() - real, pointer, dimension(:,:,:) :: V => null() + !real, pointer, dimension(:,:,:) :: U => null() + !real, pointer, dimension(:,:,:) :: V => null() real, pointer, dimension(:,:,:) :: QCTOT => null() real, pointer, dimension(:,:,:) :: CNV_QC => null() real, pointer, dimension(:,:) :: FRACI => null() real, pointer, dimension(:,:) :: LFR => null() - real, pointer, dimension(:,:) :: flashRate => null() + real, pointer, dimension(:,:,:) :: RH2imp => null() real, pointer, dimension(:,:,:) :: RH2 => null() - real, pointer, dimension(:,:,:) :: PKAPPA => null() - real, pointer, dimension(:,:) :: CNV_TOPP => null() - real, pointer, dimension(:,:) :: CAPE => null() real, pointer, dimension(:,:) :: LWI => null() real, pointer, dimension(:,:) :: ITY => null() - !real, pointer, dimension(:,:,:) :: DQDT => null() - !real, pointer, dimension(:,:,:) :: DQRL => null() - real, pointer, dimension(:,:,:) :: BYNCY => null() - real, pointer, dimension(:,:,:) :: totflux => null() + !real, pointer, dimension(:,:,:) :: totflux => null() real, pointer, dimension(:,:,:) :: expZLE => null() - !real, pointer, dimension(:,:,:) :: DQRC => null() - !real, pointer, dimension(:,:,:) :: DQIDT => null() - !real, pointer, dimension(:,:,:) :: DQLDT => null() - real, pointer, dimension(:,:,:) :: QI => null() real, pointer, dimension(:,:,:) :: QL => null() real, pointer, dimension(:,:,:) :: QICN => null() @@ -843,31 +934,32 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: PRECCON => null() real, pointer, dimension(:,:) :: PRECANV => null() real, pointer, dimension(:,:) :: PRECLSC => null() - real, pointer, dimension(:,:) :: TPREC => null() - real, pointer, dimension(:,:) :: tempFrac => null() - - real, pointer, dimension(:,:) :: PSimp => null() - real, pointer, dimension(:,:) :: PSexp => null() - real, pointer, dimension(:,:) :: TSimp => null() - real, pointer, dimension(:,:) :: TSexp => null() - real, pointer, dimension(:,:) :: SLPimp => null() - real, pointer, dimension(:,:) :: SLPexp => null() - real, pointer, dimension(:,:) :: SGHimp => null() - real, pointer, dimension(:,:) :: SGHexp => null() - real, pointer, dimension(:,:) :: PHISimp => null() - real, pointer, dimension(:,:) :: PHISexp => null() - real, pointer, dimension(:,:,:) :: Q_imp => null() - real, pointer, dimension(:,:,:) :: Q_exp => null() + !real, pointer, dimension(:,:) :: TPREC => null() + real, pointer, dimension(:,:,:) :: Uexp => null() real, pointer, dimension(:,:,:) :: Vexp => null() real, pointer, dimension(:,:,:) :: QITOTexp => null() real, pointer, dimension(:,:,:) :: QLTOTexp => null() - real, pointer, dimension(:,:,:) :: DELPimp => null() - real, pointer, dimension(:,:,:) :: DELPexp => null() - integer :: km, k, is, ie, js, je, lm, ik, nc + real, pointer, dimension(:,:,:) ::CNV_MFCexp => null() + real, pointer, dimension(:,:,:) ::CNV_MFDexp => null() + real, pointer, dimension(:,:,:) :: CNV_MFD => null() + real, pointer, dimension(:,:,:) :: KH => null() + real, pointer, dimension(:,:) :: FRLAND => null() + real, POINTER, dimension(:,:) :: PBLH => null() + real, pointer, dimension(:) :: PREF => null() + real, pointer, dimension(:,:,:) ::CNV_MFCras => null() + real, pointer, dimension(:,:,:) ::CNV_MFDras => null() + real(r8), pointer, dimension(:,:) :: LATS => null() + real(r8), pointer, dimension(:,:) :: LONS => null() + + real(r8), allocatable :: AK(:) + real(r8), allocatable :: BK(:) + + integer :: IM, JM, LM + integer :: k, is, ie, js, je, nc integer :: ndt, isd, ied, jsd, jed, i, j, l - real(FVPRC) :: DT + real(r8) :: DT ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- @@ -882,6 +974,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_TimerOn(ggState,"TOTAL") call MAPL_TimerOn(ggState,"RUN") + ! Get my private state from the component + !---------------------------------------- + call ESMF_UserCompGetInternalState(gc, 'CTMenv', WRAP, STATUS) + VERIFY_(STATUS) + + CTMenv_STATE => WRAP%PTR + ! Get the time-step ! ----------------------- call MAPL_GetResource( ggState, ndt, 'RUN_DT:', default=0, __RC__ ) @@ -890,154 +989,149 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !----------------------------- ! Required Imports and Exports !----------------------------- - call MAPL_GetPointer ( IMPORT, PLE0, 'PLE0', __RC__ ) - call MAPL_GetPointer ( IMPORT, PLE1, 'PLE1', __RC__ ) + call MAPL_GetPointer ( IMPORT, PS0, 'PS0', __RC__ ) + call MAPL_GetPointer ( IMPORT, PS1, 'PS1', __RC__ ) call MAPL_GetPointer ( IMPORT, UC0, 'UC0', __RC__ ) call MAPL_GetPointer ( IMPORT, UC1, 'UC1', __RC__ ) call MAPL_GetPointer ( IMPORT, VC0, 'VC0', __RC__ ) call MAPL_GetPointer ( IMPORT, VC1, 'VC1', __RC__ ) call MAPL_GetPointer ( IMPORT, cellArea, 'AREA', __RC__ ) - call MAPL_GetPointer ( EXPORT, PLE, 'PLE', __RC__ ) - PLE = PLE0 - call MAPL_GetPointer ( EXPORT, PLE0r8, 'PLE0r8', __RC__ ) - PLE0r8 = PLE0 - call MAPL_GetPointer ( EXPORT, PLE1r8, 'PLE1r8', __RC__ ) - PLE1r8 = PLE1 - call MAPL_GetPointer ( EXPORT, MFXr8, 'MFXr8', __RC__ ) - call MAPL_GetPointer ( EXPORT, MFYr8, 'MFYr8', __RC__ ) - call MAPL_GetPointer ( EXPORT, CXr8, 'CXr8', __RC__ ) - call MAPL_GetPointer ( EXPORT, CYr8, 'CYr8', __RC__ ) - - is = lbound(PLE,1); ie = ubound(PLE,1) - js = lbound(PLE,2); je = ubound(PLE,2) - LM = size (PLE,3) - 1 + is = lbound(UC0,1); ie = ubound(UC0,1) + js = lbound(UC0,2); je = ubound(UC0,2) + IM = ie-is+1 + JM = je-js+1 + LM = size (UC0,3) nc = (ie-is+1)*(je-js+1) + ! Compute the 3D pressure using surface pressure + IF ( ASSOCIATED(PS0) .AND. ASSOCIATED(PS1) ) THEN + call MAPL_GetPointer ( EXPORT, PLE, 'PLE', __RC__ ) + call MAPL_GetPointer ( EXPORT, PLE0r8, 'PLE0r8', __RC__ ) + call MAPL_GetPointer ( EXPORT, PLE1r8, 'PLE1r8', __RC__ ) + + allocate(AK(LM+1),stat=rc) + VERIFY_(rc) + allocate(BK(LM+1),stat=rc) + VERIFY_(rc) + + call ESMF_AttributeGet(esmfGrid, name="GridAK", valuelist=AK, __RC__) + call ESMF_AttributeGet(esmfGrid, name="GridBK", valuelist=BK, __RC__) + + call computeEdgePressure(PLE0r8, PS0, AK, BK, LM) + call computeEdgePressure(PLE1r8, PS1, AK, BK, LM) + + !DEALLOCATE(AK, BK) ! will be deallocated later + + IF (ASSOCIATED(PLE)) PLE = PLE0r8 + ENDIF + !-------------------------------------------- ! courant numbers and mass fluxes for AdvCore !-------------------------------------------- - ALLOCATE( UCr8(is:ie,js:je,lm), STAT=STATUS); VERIFY_(STATUS) - ALLOCATE( VCr8(is:ie,js:je,lm), STAT=STATUS); VERIFY_(STATUS) - ALLOCATE(PLEr8(is:ie,js:je,lm+1), STAT=STATUS); VERIFY_(STATUS) - - call A2D2C(uc1,vc1,lm,.true.) - call A2D2c(uc0,vc0,lm,.true.) - UCr8 = 0.50d0*(UC1 + UC0) - VCr8 = 0.50d0*(VC1 + VC0) - PLEr8 = 0.50d0*(PLE1 + PLE0) - - call calcCourantNumberMassFlux(UCr8, VCr8, PLEr8, & - MFXr8, MFYr8, CXr8, CYr8, DT) - - DEALLOCATE(UCr8, VCr8, PLEr8) + + IF (CTMenv_STATE%do_ctmAdvection) THEN + call MAPL_GetPointer ( EXPORT, MFXr8, 'MFXr8', __RC__ ) + call MAPL_GetPointer ( EXPORT, MFYr8, 'MFYr8', __RC__ ) + call MAPL_GetPointer ( EXPORT, CXr8, 'CXr8', __RC__ ) + call MAPL_GetPointer ( EXPORT, CYr8, 'CYr8', __RC__ ) + + IF (CTMenv_STATE%read_advCoreFields) THEN + ! Get the courant numbers and mass fluxes from files + call MAPL_GetPointer ( IMPORT, MFXr4, 'MFX', __RC__ ) + call MAPL_GetPointer ( IMPORT, MFYr4, 'MFY', __RC__ ) + call MAPL_GetPointer ( IMPORT, CXr4, 'CX', __RC__ ) + call MAPL_GetPointer ( IMPORT, CYr4, 'CY', __RC__ ) + + MFXr8 = MFXr4 + MFYr8 = MFYr4 + CXr8 = CXr4 + CYr8 = CYr4 + ELSE + ! Compute the courant numbers and mass fluxes + ALLOCATE( UCr8(is:ie,js:je,lm), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE( VCr8(is:ie,js:je,lm), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE(PLEr8(is:ie,js:je,lm+1), STAT=STATUS); VERIFY_(STATUS) + + !KNJR08Oct2021 call A2D2C(UC1, VC1, LM, .TRUE.) + !KNJR08Oct2021 call A2D2c(UC0, VC0, LM, .TRUE.) + UCr8 = 0.50d0*(UC1 + UC0) + VCr8 = 0.50d0*(VC1 + VC0) + PLEr8 = 0.50d0*(PLE1r8 + PLE0r8) + + call calcCourantNumberMassFlux(UCr8, VCr8, PLEr8, & + MFXr8, MFYr8, CXr8, CYr8, DT) + + DEALLOCATE(UCr8, VCr8, PLEr8) + ENDIF + ENDIF !----------- ! Derive LWI !----------- - call MAPL_GetPointer ( IMPORT, FROCEAN, 'FROCEAN', __RC__ ) - call MAPL_GetPointer ( IMPORT, FRACI, 'FRACI', __RC__ ) - call MAPL_GetPointer ( IMPORT, FRLAKE, 'FRLAKE', __RC__ ) - call MAPL_GetPointer ( IMPORT, Q, 'Q', __RC__ ) - call MAPL_GetPointer ( IMPORT, TS, 'TS', __RC__ ) - - call MAPL_GetPointer ( EXPORT, LWI, 'LWI', ALLOC=.TRUE., __RC__ ) - call computeLWI (LWI, TS, FRLAKE, FROCEAN, FRACI) + call derive_LWI() !-------------------------------------- ! Derive the Potential Temperature (TH) !-------------------------------------- - call MAPL_GetPointer ( IMPORT, T, 'T', ALLOC=.TRUE., __RC__ ) - call MAPL_GetPointer ( EXPORT, TH, 'TH', ALLOC=.TRUE., __RC__ ) - - ALLOCATE( PKAPPA(is:ie,js:je,LM), STAT=STATUS); VERIFY_(STATUS) - - PKAPPA(:,:,:) = ((0.5*(PLE(:,:,0:LM-1) + PLE(:,:,1:LM ) ))/100000.)**(MAPL_RGAS/MAPL_CP) - TH(:,:,:) = T(:,:,:)/PKAPPA(:,:,:) - - DEALLOCATE(PKAPPA) + call derive_TH() !----------------------------------- - ! Derive ZLE and RH2 is using MERRA1 + ! Derive ZLE and RH2 if using MERRA1 !----------------------------------- - IF ( (TRIM(metType) == 'MERRA2') .OR. & - (TRIM(metType) == 'FPIT') .OR. & - (TRIM(metType) == 'FP') ) THEN + IF ( (TRIM(CTMenv_STATE%metType) == 'MERRA2') .OR. & + (TRIM(CTMenv_STATE%metType) == 'FPIT') .OR. & + (TRIM(CTMenv_STATE%metType) == 'FP') ) THEN call MAPL_GetPointer ( IMPORT, ZLE, 'ZLE', __RC__ ) call MAPL_GetPointer ( EXPORT, expZLE, 'ZLE', ALLOC=.TRUE., __RC__ ) - expZLE = ZLE + IF (ASSOCIATED(expZLE) .AND. ASSOCIATED(ZLE)) expZLE = ZLE - ELSEIF ( TRIM(metType) == 'MERRA1') THEN + call MAPL_GetPointer ( IMPORT, RH2imp, 'RH2', __RC__ ) + call MAPL_GetPointer ( EXPORT, RH2, 'RH2', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(RH2imp) .AND. ASSOCIATED(RH2)) RH2 = RH2imp + ELSEIF ( TRIM(CTMenv_STATE%metType) == 'MERRA1') THEN !--------------------------------- ! RH2 and ZLE if using MERRA1 data !--------------------------------- - call MAPL_GetPointer ( EXPORT, RH2, 'RH2', ALLOC=.TRUE., __RC__ ) - call MAPL_GetPointer ( EXPORT, ZLE, 'ZLE', ALLOC=.TRUE., __RC__ ) + call MAPL_GetPointer ( EXPORT, RH2, 'RH2', __RC__ ) + call MAPL_GetPointer ( EXPORT, ZLE, 'ZLE', __RC__ ) - call compute_ZLE_RH2 (ZLE, RH2, TH, Q, PLE, ie-is+1, je-js+1, LM) + IF (ASSOCIATED(RH2) .AND. ASSOCIATED(ZLE)) THEN + call compute_ZLE_RH2 (ZLE, RH2, TH, Q, PLE, ie-is+1, je-js+1, LM) + END IF END IF ! --------------------------------------- ! Derive Air Density and Atmospheric Mass ! --------------------------------------- - call MAPL_GetPointer ( EXPORT, AIRDENS, 'AIRDENS', ALLOC=.TRUE., __RC__ ) - call MAPL_GetPointer ( EXPORT, MASS, 'MASS', ALLOC=.TRUE., __RC__ ) + call derive_AIRDENS_MASS() - ! Compute air density - call airdens_ ( AIRDENS, PLE, TH, Q, ie-is+1, je-js+1, LM) + IF (.NOT. CTMenv_STATE%enable_pTracers) THEN - ! Compute the total mass - DO k = 1, LM - MASS(:,:,k) = AIRDENS(:,:,k)*cellArea(:,:)*(ZLE(:,:,k-1)-ZLE(:,:,k)) - END DO + IF (ASSOCIATED(UC0)) THEN + call MAPL_GetPointer ( EXPORT, Uexp, 'U', ALLOC=.TRUE., __RC__ ) + Uexp = UC0 + ENDIF + + IF (ASSOCIATED(VC0)) THEN + call MAPL_GetPointer ( EXPORT, Vexp, 'V', ALLOC=.TRUE., __RC__ ) + Vexp = VC0 + ENDIF - IF (.NOT. enable_pTracers) THEN !--------------------- ! Derive QICN and QLCN !--------------------- - call MAPL_GetPointer ( IMPORT, PRECCON, 'PRECCON', __RC__ ) - call MAPL_GetPointer ( IMPORT, PRECANV, 'PRECANV', __RC__ ) - call MAPL_GetPointer ( IMPORT, PRECLSC, 'PRECLSC', __RC__ ) - call MAPL_GetPointer ( IMPORT, QI, 'QI', __RC__ ) - call MAPL_GetPointer ( IMPORT, QL, 'QL', __RC__ ) - call MAPL_GetPointer ( EXPORT, QICN, 'QICN', ALLOC=.TRUE., __RC__ ) - call MAPL_GetPointer ( EXPORT, QLCN, 'QLCN', ALLOC=.TRUE., __RC__ ) - - isd = lbound(QLCN,1); ied = ubound(QLCN,1) - jsd = lbound(QLCN,2); jed = ubound(QLCN,2) - - ALLOCATE( tempFrac(isd:ied,jsd:jed), STAT=STATUS); VERIFY_(STATUS) - ALLOCATE( TPREC(isd:ied,jsd:jed), STAT=STATUS); VERIFY_(STATUS) - - call computeTotalPrecip(TPREC, PRECANV, PRECCON, PRECLSC) - - tempFrac(:,:) = 0.0 - WHERE (TPREC(:,:) .NE. 0.0) - tempFrac(:,:) = PRECANV(:,:) /TPREC(:,:) - END WHERE - - DO k=1,LM - QICN(:,:,k) = QI(:,:,k)*tempFrac(:,:) - QLCN(:,:,k) = QL(:,:,k)*tempFrac(:,:) - ENDDO - DEALLOCATE(tempFrac, TPREC) + call derive_QICN_QLCN() !------------------------------------------- ! Mass Fraction of Total Cloud Water (QCTOT) - ! Grid Mean Convective Condensate (CNV_QC) !------------------------------------------- - call MAPL_GetPointer ( IMPORT, QITOT, 'QITOT', __RC__ ) - call MAPL_GetPointer ( IMPORT, QLTOT, 'QLTOT', __RC__ ) - call MAPL_GetPointer ( EXPORT, QCTOT, 'QCTOT', ALLOC=.TRUE., __RC__ ) - QCTOT(:,:,:) = QLTOT(:,:,:) + QITOT(:,:,:) + call derive_QCTOT() - call MAPL_GetPointer ( IMPORT, QITOT1, 'QITOT1', __RC__ ) - call MAPL_GetPointer ( IMPORT, QLTOT1, 'QLTOT1', __RC__ ) - call MAPL_GetPointer ( EXPORT, CNV_QC, 'CNV_QC', ALLOC=.TRUE., __RC__ ) - CNV_QC(:,:,:) = QCTOT(:,:,:) - ( QLTOT1(:,:,:) + QITOT1(:,:,:) ) - - WHERE ( CNV_QC(:,:,:) < 0.0 ) CNV_QC(:,:,:) = 0.0 - CNV_QC(:,:,:) = CNV_QC(:,:,:) *(DT/(30.0*SecondsPerMinute)) + !------------------------------------------- + ! Grid Mean Convective Condensate (CNV_QC) + !------------------------------------------- + call derive_CNV_QC() !---------------- ! Vegetation Type @@ -1045,77 +1139,31 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GetPointer ( EXPORT, ITY, 'ITY', ALLOC=.TRUE., __RC__ ) ITY = 1.0 + !----------------------- + ! Convective Mass Fluxes + !----------------------- + call derive_convective_mass_fluxes() + !------------------------------------------------ ! Flash Rate (LFR) for Lighting Parameterization + ! Buoyancy !------------------------------------------------ - call MAPL_GetPointer ( IMPORT, CNV_MFC, 'CNV_MFC', __RC__ ) - call MAPL_GetPointer ( IMPORT, CN_PRCP, 'CN_PRCP', __RC__ ) - call MAPL_GetPointer ( EXPORT, LFR, 'LFR', ALLOC=.TRUE., __RC__ ) - call MAPL_GetPointer ( EXPORT, BYNCY, 'BYNCY', ALLOC=.TRUE., __RC__ ) - - ! Determine the pressure at convective cloud top - ALLOCATE( CNV_TOPP(is:ie,js:je), STAT=STATUS); VERIFY_(STATUS) - CNV_TOPP(:,:) = MAPL_UNDEF - do j=js, je - do i=is, ie - do l=1,lm - if (CNV_MFC(i,j,l)/=0.0) then - CNV_TOPP(i,j) = PLE(i,j,l) - exit - endif - enddo - enddo - enddo - - ALLOCATE( CAPE(is:ie,js:je), STAT=STATUS); VERIFY_(STATUS) - call computeCAPE (TH, Q, PLE, CAPE, BYNCY, ie-is+1, je-js+1, LM) - - ALLOCATE( flashRate(is:ie,js:je), STAT=STATUS); VERIFY_(STATUS) - - call computeFlashRate (ggState, nc, LM, TS, CNV_TOPP, FROCEAN, & - CN_PRCP, CAPE, CNV_MFC, TH, PLE, ZLE, flashRate, RC=STATUS) - VERIFY_(STATUS) - - LFR(:,:) = flashRate(:,:) - - DEALLOCATE(CNV_TOPP, CAPE, flashRate) + call derive_LFR_BYNCY() !---------------------------------------------- ! If you choose to output specific forcing data !---------------------------------------------- - IF (output_forcingData) THEN - call MAPL_GetPointer ( IMPORT, PSimp, 'PS', __RC__ ) - call MAPL_GetPointer ( EXPORT, PSexp, 'PS', __RC__ ) - PSexp = PSimp - call MAPL_GetPointer ( IMPORT, SLPimp, 'SLP', __RC__ ) - call MAPL_GetPointer ( EXPORT, SLPexp, 'SLP', __RC__ ) - SLPexp = SLPimp - call MAPL_GetPointer ( IMPORT, SGHimp, 'SGH', __RC__ ) - call MAPL_GetPointer ( EXPORT, SGHexp, 'SGH', __RC__ ) - SGHexp = SGHimp - call MAPL_GetPointer ( IMPORT, PHISimp, 'PHIS', __RC__ ) - call MAPL_GetPointer ( EXPORT, PHISexp, 'PHIS', __RC__ ) - PHISexp = PHISimp - call MAPL_GetPointer ( IMPORT, DELPimp, 'DELP', __RC__ ) - call MAPL_GetPointer ( EXPORT, DELPexp, 'DELP', __RC__ ) - DELPexp = DELPimp - - call MAPL_GetPointer ( EXPORT, QITOTexp, 'QITOT', __RC__ ) - QITOTexp = QITOT - call MAPL_GetPointer ( EXPORT, QLTOTexp, 'QLTOT', __RC__ ) - QLTOTexp = QLTOT - call MAPL_GetPointer ( EXPORT, Uexp, 'U', __RC__ ) - Uexp = UC0 - call MAPL_GetPointer ( EXPORT, Vexp, 'V', __RC__ ) - Vexp = VC0 - call MAPL_GetPointer ( EXPORT, Q_exp, 'Q', __RC__ ) - Q_exp = Q - call MAPL_GetPointer ( EXPORT, TSexp, 'TS', __RC__ ) - TSexp = TS + IF (CTMenv_STATE%output_forcingData) THEN + call export_to_HISTORY() END IF END IF ! .NOT. enable_pTracers + + IF ((.NOT. CTMenv_STATE%read_advCoreFields) .AND. CTMenv_STATE%output_forcingData) THEN + call export_advCoreFields() + END IF + call MAPL_TimerOff(ggState,"RUN") call MAPL_TimerOff(ggState,"TOTAL") @@ -1123,9 +1171,359 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! -------- RETURN_(ESMF_SUCCESS) + !---------------------- + ! - Intenal Subroutines + !---------------------- + CONTAINS + ! + !------------------------------------------------------- + ! + subroutine derive_LWI() + call MAPL_GetPointer ( IMPORT, FROCEAN, 'FROCEAN', __RC__ ) + call MAPL_GetPointer ( IMPORT, FRACI, 'FRACI', __RC__ ) + call MAPL_GetPointer ( IMPORT, FRLAKE, 'FRLAKE', __RC__ ) + call MAPL_GetPointer ( IMPORT, Q, 'Q', __RC__ ) + call MAPL_GetPointer ( IMPORT, TS, 'TS', __RC__ ) + + IF ( ASSOCIATED(FROCEAN) .AND. ASSOCIATED(FRACI) .AND. & + ASSOCIATED(FRLAKE) .AND. ASSOCIATED(TS) .AND. & + ASSOCIATED(Q) ) THEN + call MAPL_GetPointer ( EXPORT, LWI, 'LWI', ALLOC=.TRUE., __RC__ ) + call computeLWI (LWI, TS, FRLAKE, FROCEAN, FRACI) + ENDIF + end subroutine derive_LWI + ! + !------------------------------------------------------- + ! + subroutine derive_TH() + real, pointer, dimension(:,:,:) :: PKAPPA => null() + call MAPL_GetPointer ( IMPORT, T, 'T', __RC__ ) + IF ( ASSOCIATED(T) .AND. ASSOCIATED(PLE) ) THEN + call MAPL_GetPointer ( EXPORT, TH, 'TH', ALLOC=.TRUE., __RC__ ) + + ALLOCATE( PKAPPA(is:ie,js:je,LM), STAT=STATUS); VERIFY_(STATUS) + + PKAPPA(:,:,:) = ((0.5*(PLE(:,:,0:LM-1) + PLE(:,:,1:LM ) ))/100000.)**(MAPL_RGAS/MAPL_CP) + TH(:,:,:) = T(:,:,:)/PKAPPA(:,:,:) + + DEALLOCATE(PKAPPA) + ENDIF + end subroutine derive_TH + ! + !------------------------------------------------------- + ! + subroutine derive_AIRDENS_MASS() + + IF ( ASSOCIATED(PLE) .AND. ASSOCIATED(TH) .AND. ASSOCIATED(Q) .AND. & + ASSOCIATED(ZLE) ) THEN + call MAPL_GetPointer ( EXPORT, AIRDENS, 'AIRDENS', ALLOC=.TRUE., __RC__ ) + call MAPL_GetPointer ( EXPORT, MASS, 'MASS', ALLOC=.TRUE., __RC__ ) + + ! Compute air density + call airdens_ ( AIRDENS, PLE, TH, Q, ie-is+1, je-js+1, LM) + + ! Compute the total mass + DO k = 1, LM + MASS(:,:,k) = AIRDENS(:,:,k)*cellArea(:,:)*(ZLE(:,:,k-1)-ZLE(:,:,k)) + END DO + ENDIF + end subroutine derive_AIRDENS_MASS + ! + !------------------------------------------------------- + ! + subroutine derive_LFR_BYNCY() + ! Imports: CNV_MFC, CN_PRCP + ! Exports: LFR, BYNCY + real, pointer, dimension(:,:,:) :: BYNCY => null() + real, pointer, dimension(:,:) :: CNV_TOPP => null() + real, pointer, dimension(:,:) :: CAPE => null() + real, pointer, dimension(:,:) :: flashRate => null() + + call MAPL_GetPointer ( IMPORT, CNV_MFC, 'CNV_MFC', __RC__ ) + call MAPL_GetPointer ( IMPORT, CN_PRCP, 'CN_PRCP', __RC__ ) + + IF (ASSOCIATED(CNV_MFC) .AND. ASSOCIATED(CN_PRCP)) THEN + call MAPL_GetPointer ( EXPORT, LFR, 'LFR', ALLOC=.TRUE., __RC__ ) + call MAPL_GetPointer ( EXPORT, BYNCY, 'BYNCY', ALLOC=.TRUE., __RC__ ) + + ! Determine the pressure at convective cloud top + ALLOCATE( CNV_TOPP(is:ie,js:je), STAT=STATUS); VERIFY_(STATUS) + CNV_TOPP(:,:) = MAPL_UNDEF + do j=js, je + do i=is, ie + do l=1,lm + if (CNV_MFC(i,j,l)/=0.0) then + CNV_TOPP(i,j) = PLE(i,j,l) + exit + endif + enddo + enddo + enddo + + ALLOCATE( CAPE(is:ie,js:je), STAT=STATUS); VERIFY_(STATUS) + call computeCAPE (TH, Q, PLE, CAPE, BYNCY, ie-is+1, je-js+1, LM) + + ALLOCATE( flashRate(is:ie,js:je), STAT=STATUS); VERIFY_(STATUS) + + call computeFlashRate (ggState, nc, LM, TS, CNV_TOPP, FROCEAN, & + CN_PRCP, CAPE, CNV_MFC, TH, PLE, ZLE, flashRate, RC=STATUS) + VERIFY_(STATUS) + + LFR(:,:) = flashRate(:,:) + + DEALLOCATE(CNV_TOPP, CAPE, flashRate) + ENDIF + end subroutine derive_LFR_BYNCY + ! + !------------------------------------------------------- + ! + subroutine derive_convective_mass_fluxes() + ! Imports: + ! Exports: CNV_MFC, CNV_MFD + IF (CTMenv_STATE%enable_rasCalculations) THEN + + ! Get the LATS and LONS + call ESMF_GridGetCoord(esmfGrid, coordDim=2, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=LATS, rc=status) + VERIFY_(status) + + call ESMF_GridGetCoord(esmfGrid, coordDim=1, localDE=0, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=LONS, rc=status) + + !----------------------------------------- + ! Compute the reference air pressure in Pa + ! AK in Pa + ! MAPL_P00 = 100000 Pa + !----------------------------------------- + ALLOCATE(PREF(LM+1)) + PREF = AK + BK * MAPL_P00 + + ALLOCATE(CNV_MFDras(IM,JM,1:LM)) + ALLOCATE(CNV_MFCras(IM,JM,0:LM)) + + call MAPL_GetPointer ( IMPORT, KH, 'KH', __RC__ ) + call MAPL_GetPointer ( IMPORT, PBLH, 'ZPBL', __RC__ ) + call MAPL_GetPointer ( IMPORT, FRLAND, 'FRLAND', __RC__ ) + + IF ( ASSOCIATED(KH) .AND. ASSOCIATED(PBLH) .AND. & + ASSOCIATED(FRLAND) ) THEN + CALL DO_RAS(CTMenv_STATE%RASPARAMS, PREF, TH, PLE, KH, PBLH, Q, & + FRLAND, TS, CNV_MFDras, CNV_MFCras, & + REAL(LATS), REAL(LONS), REAL(DT), IM, JM, LM) + + call MAPL_GetPointer ( EXPORT, CNV_MFC, 'CNV_MFC', __RC__ ) + call MAPL_GetPointer ( EXPORT, CNV_MFD, 'CNV_MFD', __RC__ ) + + CNV_MFC(:,:,:) = CNV_MFCras(:,:,:) + CNV_MFD(:,:,:) = CNV_MFDras(:,:,:) + ENDIF + DEALLOCATE(PREF) + DEALLOCATE(CNV_MFDras, CNV_MFCras) + deallocate(AK, BK) + ELSE + call MAPL_GetPointer ( IMPORT, CNV_MFC, 'CNV_MFC', __RC__ ) + IF (ASSOCIATED(CNV_MFC)) THEN + call MAPL_GetPointer ( EXPORT, CNV_MFCexp, 'CNV_MFC', __RC__ ) + CNV_MFCexp(:,:,:) = CNV_MFC(:,:,:) + ENDIF + + call MAPL_GetPointer ( IMPORT, CNV_MFD, 'CNV_MFD', __RC__ ) + IF (ASSOCIATED(CNV_MFD)) THEN + call MAPL_GetPointer ( EXPORT, CNV_MFDexp, 'CNV_MFD', __RC__ ) + CNV_MFDexp(:,:,:) = CNV_MFD(:,:,:) + ENDIF + ENDIF + end subroutine derive_convective_mass_fluxes + ! + !------------------------------------------------------- + ! + subroutine derive_QCTOT() + ! Imports: QITOT, QLTOT + ! Exports: QCTOT + call MAPL_GetPointer ( IMPORT, QITOT, 'QITOT', __RC__ ) + call MAPL_GetPointer ( IMPORT, QLTOT, 'QLTOT', __RC__ ) + + IF (ASSOCIATED(QITOT) .AND. ASSOCIATED(QLTOT) ) THEN + call MAPL_GetPointer ( EXPORT, QCTOT, 'QCTOT', ALLOC=.TRUE., __RC__ ) + QCTOT(:,:,:) = QLTOT(:,:,:) + QITOT(:,:,:) + ENDIF + end subroutine derive_QCTOT + ! + !------------------------------------------------------- + ! + subroutine derive_CNV_QC() + ! Expected: QCTOT derived in derive_QCTOT + ! Imports: QITOT1, QLTOT1 + ! Exports: CNV_QC + call MAPL_GetPointer ( IMPORT, QITOT1, 'QITOT1', __RC__ ) + call MAPL_GetPointer ( IMPORT, QLTOT1, 'QLTOT1', __RC__ ) + IF (ASSOCIATED(QITOT) .AND. ASSOCIATED(QLTOT1) .AND. ASSOCIATED(QITOT1) ) THEN + call MAPL_GetPointer ( EXPORT, CNV_QC, 'CNV_QC', ALLOC=.TRUE., __RC__ ) + CNV_QC(:,:,:) = QCTOT(:,:,:) - ( QLTOT1(:,:,:) + QITOT1(:,:,:) ) + + WHERE ( CNV_QC(:,:,:) < 0.0 ) CNV_QC(:,:,:) = 0.0 + CNV_QC(:,:,:) = CNV_QC(:,:,:) *(DT/(30.0*SecondsPerMinute)) + ENDIF + end subroutine derive_CNV_QC + ! + !------------------------------------------------------- + ! + subroutine derive_QICN_QLCN() + + real, pointer, dimension(:,:) :: TPREC => null() + real, pointer, dimension(:,:) :: tempFrac => null() + + call MAPL_GetPointer ( IMPORT, PRECCON, 'PRECCON', __RC__ ) + call MAPL_GetPointer ( IMPORT, PRECANV, 'PRECANV', __RC__ ) + call MAPL_GetPointer ( IMPORT, PRECLSC, 'PRECLSC', __RC__ ) + call MAPL_GetPointer ( IMPORT, QI, 'QI', __RC__ ) + call MAPL_GetPointer ( IMPORT, QL, 'QL', __RC__ ) + + IF (ASSOCIATED(QI) .AND. ASSOCIATED(QL)) THEN + call MAPL_GetPointer ( EXPORT, QICN, 'QICN', __RC__ ) + call MAPL_GetPointer ( EXPORT, QLCN, 'QLCN', __RC__ ) + + isd = lbound(QLCN,1); ied = ubound(QLCN,1) + jsd = lbound(QLCN,2); jed = ubound(QLCN,2) + + ALLOCATE( tempFrac(isd:ied,jsd:jed), STAT=STATUS); VERIFY_(STATUS) + ALLOCATE( TPREC(isd:ied,jsd:jed), STAT=STATUS); VERIFY_(STATUS) + + call computeTotalPrecip(TPREC, PRECANV, PRECCON, PRECLSC) + + tempFrac(:,:) = 0.0 + WHERE (TPREC(:,:) .NE. 0.0) + tempFrac(:,:) = PRECANV(:,:) /TPREC(:,:) + END WHERE + + DO k=1,LM + QICN(:,:,k) = QI(:,:,k)*tempFrac(:,:) + QLCN(:,:,k) = QL(:,:,k)*tempFrac(:,:) + ENDDO + DEALLOCATE(tempFrac, TPREC) + ENDIF + + end subroutine derive_QICN_QLCN + ! + !------------------------------------------------------- + ! + subroutine export_to_HISTORY() + + real, pointer, dimension(:,:) :: SLPimp => null() + real, pointer, dimension(:,:) :: SLPexp => null() + real, pointer, dimension(:,:) :: TSexp => null() + real, pointer, dimension(:,:) :: PSexp => null() + real, pointer, dimension(:,:) :: TROPPimp => null() + real, pointer, dimension(:,:) :: TROPPexp => null() + real, pointer, dimension(:,:) :: PHISimp => null() + real, pointer, dimension(:,:) :: PHISexp => null() + real, pointer, dimension(:,:,:) :: Qexp => null() + real, pointer, dimension(:,:,:) :: DELPexp => null() + ! We check the IMPORTS, because they are not initialized for Ideal Tracers + + call MAPL_GetPointer ( EXPORT, PSexp, 'PS', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(PS0).AND.ASSOCIATED(PSexp)) PSexp = PS0 + + call MAPL_GetPointer ( IMPORT, SLPimp, 'SLP', __RC__ ) + call MAPL_GetPointer ( EXPORT, SLPexp, 'SLP', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(SLPimp).AND.ASSOCIATED(SLPexp)) SLPexp = SLPimp + + call MAPL_GetPointer ( IMPORT, PHISimp, 'PHIS', __RC__ ) + call MAPL_GetPointer ( EXPORT, PHISexp, 'PHIS_input', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(PHISimp).AND.ASSOCIATED(PHISexp)) PHISexp = PHISimp + + call MAPL_GetPointer ( IMPORT, TROPPimp, 'TROPP', __RC__ ) + call MAPL_GetPointer ( EXPORT, TROPPexp, 'TROPP', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(TROPPimp).AND.ASSOCIATED(TROPPexp)) TROPPexp = TROPPimp + + call MAPL_GetPointer ( EXPORT, DELPexp, 'DELP', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(PLE).AND.ASSOCIATED(DELPexp)) call compute_DELP(DELPexp, PLE) + + call MAPL_GetPointer ( EXPORT, QITOTexp, 'QITOT', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(QITOT).AND.ASSOCIATED(QITOTexp)) QITOTexp = QITOT + + call MAPL_GetPointer ( EXPORT, QLTOTexp, 'QLTOT', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(QLTOT).AND.ASSOCIATED(QLTOTexp)) QLTOTexp = QLTOT + + call MAPL_GetPointer ( EXPORT, Qexp, 'Q', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(Q).AND.ASSOCIATED(Qexp)) Qexp = Q + + call MAPL_GetPointer ( EXPORT, TSexp, 'TS', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(TS).AND.ASSOCIATED(TSexp)) TSexp = TS + end subroutine export_to_HISTORY + ! + !------------------------------------------------------- + ! + subroutine export_advCoreFields() + call MAPL_GetPointer ( EXPORT, MFXr4, 'MFX', __RC__ ) + IF (ASSOCIATED(MFXr8).AND.ASSOCIATED(MFXr4)) MFXr4 = MFXr8 + + call MAPL_GetPointer ( EXPORT, MFYr4, 'MFY', __RC__ ) + IF (ASSOCIATED(MFYr8).AND.ASSOCIATED(MFYr4)) MFYr4 = MFYr8 + + call MAPL_GetPointer ( EXPORT, CXr4, 'CX', __RC__ ) + IF (ASSOCIATED(CXr8).AND.ASSOCIATED(CXr4)) CXr4 = CXr8 + + call MAPL_GetPointer ( EXPORT, CYr4, 'CY', __RC__ ) + IF (ASSOCIATED(CYr8).AND.ASSOCIATED(CYr4)) CYr4 = CYr8 + end subroutine export_advCoreFields + end subroutine Run !EOC !------------------------------------------------------------------------------ +!BOP + subroutine compute_DELP(DELP, PLE) +! +! !INPUT PARAMETERS: + REAL(r4), intent(in) :: PLE(:,:,:) ! Edge pressure (Pa) +! +! !OUTPUT PARAMETERS: + REAL(r4), intent(out) :: DELP(:,:,:) ! Pressure thickness (Pa) +!EOP +!------------------------------------------------------------------------------ +!BOC + INTEGER :: L, KM + + KM = SIZE(DELP, 3) + + DO L = 1, KM + DELP(:,:,L) = PLE(:,:,L+1) - PLE(:,:,L) + END DO + + RETURN + + end subroutine compute_DELP +!EOC +!------------------------------------------------------------------------------ +!BOP + subroutine compute_PLE(PLE, PS, DELP) +! +! !INPUT PARAMETERS: + REAL(r4), intent(in) :: PS(:,:) ! Surface pressure (Pa) + REAL(r4), intent(in) :: DELP(:,:,:) ! Pressure thickness (Pa) +! +! !OUTPUT PARAMETERS: + REAL(r8), intent(out) :: PLE(:,:,:) ! Edge pressure (Pa) +!EOP +!------------------------------------------------------------------------------ +!BOC + INTEGER :: L, KM + + KM = SIZE(DELP, 3) + + PLE(:,:,KM+1) = PS(:,:) + + DO L = KM, 1, -1 + PLE(:,:,L) = PLE(:,:,L+1) - DELP(:,:,L) + END DO + + RETURN + + end subroutine compute_PLE +!EOC +!------------------------------------------------------------------------------ !BOP subroutine computeEdgePressure(PLE, PS, AK, BK, km) ! @@ -1135,13 +1533,13 @@ subroutine computeEdgePressure(PLE, PS, AK, BK, km) REAL(r8), intent(in) :: ak(km+1), bk(km+1) ! ! !OUTPUT PARAMETERS: - REAL(r4), intent(out) :: PLE(:,:,:) ! Edge pressure (Pa) + REAL(r8), intent(out) :: PLE(:,:,:) ! Edge pressure (Pa) !EOP !------------------------------------------------------------------------------ !BOC INTEGER :: L - - DO L = 1, km + + DO L = 1, km+1 PLE(:,:,L) = ak(L) + bk(L)*PS(:,:) END DO @@ -1312,7 +1710,7 @@ function compAreaWeightedAverage_2d (var2D, vm, cellArea) result(wAverage) logical, save :: first = .true. real(r8) , save :: sumArea real(r8) :: sumWeight - integer :: ik, im, jm, STATUS, RC + integer :: im, jm, STATUS, RC real(r8), pointer :: weightVals(:,:) real(r8) :: sumWeight_loc, sumArea_loc character(len=ESMF_MAXSTR) :: IAm = 'compAreaWeightedAverage_2d' @@ -1536,63 +1934,42 @@ subroutine computeFlashRate (STATE, nc, lm, TS, CCTP, FROCEAN, CN_PRCP, & ! Coefficients of the predictors, marine locations ! ------------------------------------------------ - CALL MAPL_GetResource(STATE,a0m,'MARINE_A0:',DEFAULT= 0.0139868,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a1m,'MARINE_A1:',DEFAULT= 0.0358764,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a2m,'MARINE_A2:',DEFAULT=-0.0610214,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a3m,'MARINE_A3:',DEFAULT=-0.0102320,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a4m,'MARINE_A4:',DEFAULT= 0.0031352,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a5m,'MARINE_A5:',DEFAULT= 0.0346241,RC=STATUS) - VERIFY_(STATUS) + CALL MAPL_GetResource(STATE,a0m,'MARINE_A0:',DEFAULT= 0.0139868, __RC__) + CALL MAPL_GetResource(STATE,a1m,'MARINE_A1:',DEFAULT= 0.0358764, __RC__) + CALL MAPL_GetResource(STATE,a2m,'MARINE_A2:',DEFAULT=-0.0610214, __RC__) + CALL MAPL_GetResource(STATE,a3m,'MARINE_A3:',DEFAULT=-0.0102320, __RC__) + CALL MAPL_GetResource(STATE,a4m,'MARINE_A4:',DEFAULT= 0.0031352, __RC__) + CALL MAPL_GetResource(STATE,a5m,'MARINE_A5:',DEFAULT= 0.0346241, __RC__) ! Coefficients of the predictors, continental locations ! ----------------------------------------------------- - CALL MAPL_GetResource(STATE,a0c,'CONTINENT_A0:',DEFAULT=-0.0183172,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a1c,'CONTINENT_A1:',DEFAULT=-0.0562338,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a2c,'CONTINENT_A2:',DEFAULT= 0.1862740,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a3c,'CONTINENT_A3:',DEFAULT=-0.0023363,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a4c,'CONTINENT_A4:',DEFAULT=-0.0013838,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,a5c,'CONTINENT_A5:',DEFAULT= 0.0114759,RC=STATUS) - VERIFY_(STATUS) + CALL MAPL_GetResource(STATE,a0c,'CONTINENT_A0:',DEFAULT=-0.0183172, __RC__) + CALL MAPL_GetResource(STATE,a1c,'CONTINENT_A1:',DEFAULT=-0.0562338, __RC__) + CALL MAPL_GetResource(STATE,a2c,'CONTINENT_A2:',DEFAULT= 0.1862740, __RC__) + CALL MAPL_GetResource(STATE,a3c,'CONTINENT_A3:',DEFAULT=-0.0023363, __RC__) + CALL MAPL_GetResource(STATE,a4c,'CONTINENT_A4:',DEFAULT=-0.0013838, __RC__) + CALL MAPL_GetResource(STATE,a5c,'CONTINENT_A5:',DEFAULT= 0.0114759, __RC__) ! Divisors for nondimensionalization of the predictors ! ---------------------------------------------------- - CALL MAPL_GetResource(STATE,x1Divisor,'X1_DIVISOR:',DEFAULT=4.36,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,x2Divisor,'X2_DIVISOR:',DEFAULT=9.27,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,x3Divisor,'X3_DIVISOR:',DEFAULT=34.4,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,x4Divisor,'X4_DIVISOR:',DEFAULT=21.4,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,x5Divisor,'X5_DIVISOR:',DEFAULT=14600.,RC=STATUS) - VERIFY_(STATUS) + CALL MAPL_GetResource(STATE,x1Divisor,'X1_DIVISOR:',DEFAULT=4.36, __RC__) + CALL MAPL_GetResource(STATE,x2Divisor,'X2_DIVISOR:',DEFAULT=9.27, __RC__) + CALL MAPL_GetResource(STATE,x3Divisor,'X3_DIVISOR:',DEFAULT=34.4, __RC__) + CALL MAPL_GetResource(STATE,x4Divisor,'X4_DIVISOR:',DEFAULT=21.4, __RC__) + CALL MAPL_GetResource(STATE,x5Divisor,'X5_DIVISOR:',DEFAULT=14600., __RC__) ! Exponent for the surface temperature deviation predictor ! -------------------------------------------------------- - CALL MAPL_GetResource(STATE,x5Power,'X5_EXPONENT:',DEFAULT=3.00,RC=STATUS) - VERIFY_(STATUS) + CALL MAPL_GetResource(STATE,x5Power,'X5_EXPONENT:',DEFAULT=3.00, __RC__) ! Threshold temperatures ! ---------------------- - CALL MAPL_GetResource(STATE,sfcTLimit,'SFC_T_LIMIT:',DEFAULT=273.0,RC=STATUS) - VERIFY_(STATUS) - CALL MAPL_GetResource(STATE,airTLimit,'AIR_T_LIMIT:',DEFAULT=263.0,RC=STATUS) - VERIFY_(STATUS) + CALL MAPL_GetResource(STATE,sfcTLimit,'SFC_T_LIMIT:',DEFAULT=273.0, __RC__) + CALL MAPL_GetResource(STATE,airTLimit,'AIR_T_LIMIT:',DEFAULT=263.0, __RC__) ! Cloud-top pressure limiter ! -------------------------- - CALL MAPL_GetResource(STATE,hPaCldTop,'CLOUD_TOP_LIMIT:',DEFAULT=500.,RC=STATUS) - VERIFY_(STATUS) + CALL MAPL_GetResource(STATE,hPaCldTop,'CLOUD_TOP_LIMIT:',DEFAULT=500., __RC__) ! Layer depths [m] ! ---------------- @@ -1796,7 +2173,7 @@ subroutine computeCAPE (TH, Q, PLE, CAPE, BUOY, IM, JM, LM) real, dimension(IM,JM,0:LM) :: CNV_PLE real, dimension(IM,JM,0:LM) :: PKE real, dimension(IM,JM ) :: HC - logical, dimension(IM,JM ) :: UNSTABLE + !logical, dimension(IM,JM ) :: UNSTABLE CNV_PLE = PLE*.01 PLO = 0.5*(CNV_PLE(:,:,0:LM-1) + CNV_PLE(:,:,1:LM ) ) diff --git a/src/Components/GEOSctm_GridComp/GEOS_ctmGridCompMod.F90 b/src/Components/GEOSctm_GridComp/GEOS_ctmGridCompMod.F90 index 0cf72b7..6fe57ca 100644 --- a/src/Components/GEOSctm_GridComp/GEOS_ctmGridCompMod.F90 +++ b/src/Components/GEOSctm_GridComp/GEOS_ctmGridCompMod.F90 @@ -42,7 +42,7 @@ module GEOS_ctmGridCompMod ! ! \paragraph{Runnng the Code:} ! -! The code acn be run in two main configurations: +! The code can be run in two main configurations: ! \begin{enumerate} ! \item \textbf{Passive Tracer Run:} This experiment is done to verify how well ! AdvCore transports the tracers. We want to find out if the advection @@ -88,18 +88,26 @@ module GEOS_ctmGridCompMod ! !EOP !------------------------------------------------------------------------------ - integer :: CHEM = -1 - integer :: CONV = -1 - integer :: DIFF = -1 - integer :: ADV3 = -1 - integer :: ECTM = -1 - integer :: PTRA = -1 - - logical :: enable_pTracers = .FALSE. - logical :: do_ctmAdvection = .FALSE. - logical :: do_ctmConvection = .FALSE. - logical :: do_ctmDiffusion = .FALSE. - character(len=ESMF_MAXSTR) :: metType ! MERRA2 or MERRA1 or FPIT or FP + !Derived types for the internal state + type T_CTM_STATE + private + integer :: CHEM = -1 + integer :: CONV = -1 + integer :: DIFF = -1 + integer :: ADV3 = -1 + integer :: ECTM = -1 + integer :: PTRA = -1 + logical :: do_ctmConvection = .FALSE. ! do Convection? + logical :: do_ctmDiffusion = .FALSE. ! do Diffusion? + logical :: do_ctmAdvection = .TRUE. ! do Advection? + logical :: enable_pTracers = .FALSE. ! do idealized Passive Tracers? + character(len=ESMF_MAXSTR) :: metType ! MERRA2 or MERRA1 or FPIT or FP + end type T_CTM_STATE + + type CTM_WRAP + type (T_CTM_STATE), pointer :: PTR + end type CTM_WRAP + !------------------------------------------------------------------------------ contains !------------------------------------------------------------------------------ @@ -135,65 +143,79 @@ subroutine SetServices ( GC, RC ) character(len=ESMF_MAXSTR) :: COMP_NAME CHARACTER(LEN=ESMF_MAXSTR) :: rcfilen = 'CTM_GridComp.rc' character(len=ESMF_MAXSTR) :: IAm = 'SetServices' + type (T_CTM_STATE), pointer :: state + type (CTM_WRAP) :: wrap ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'SetServices' - call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, RC=STATUS ) + call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, __RC__ ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // "::" // Iam + ! Wrap internal state for storing in GC; rename legacyState + ! ------------------------------------- + allocate ( state, stat=STATUS ) + VERIFY_(STATUS) + wrap%ptr => state + ! Register services for this component ! ------------------------------------ - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, RC=STATUS ) - VERIFY_(STATUS) - call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run, RC=STATUS ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_INITIALIZE, Initialize, __RC__ ) + call MAPL_GridCompSetEntryPoint ( GC, ESMF_METHOD_RUN, Run, __RC__ ) + + ! Save pointer to the wrapped internal state in the GC + !----------------------------------------------------- + call ESMF_UserCompSetInternalState ( GC, 'CTM_GridComp', wrap, STATUS ) VERIFY_(STATUS) ! Choose children to birth and which children not to conceive ! ----------------------------------------------------------- - configFile = ESMF_ConfigCreate(rc=STATUS ) - VERIFY_(STATUS) + configFile = ESMF_ConfigCreate( __RC__ ) - call ESMF_ConfigLoadFile(configFile, TRIM(rcfilen), rc=STATUS ) - VERIFY_(STATUS) + call ESMF_ConfigLoadFile(configFile, TRIM(rcfilen), __RC__ ) - call ESMF_ConfigGetAttribute(configFile, enable_pTracers, & + call ESMF_ConfigGetAttribute(configFile, state%enable_pTracers, & Default = .FALSE., & Label = "ENABLE_pTracers:", __RC__ ) - call ESMF_ConfigGetAttribute(configFile, do_ctmConvection, & + call ESMF_ConfigGetAttribute(configFile, state%do_ctmConvection, & Default = .FALSE., & Label = "do_ctmConvection:", __RC__ ) - call ESMF_ConfigGetAttribute(configFile, do_ctmAdvection, & + call ESMF_ConfigGetAttribute(configFile, state%do_ctmAdvection, & Default = .TRUE., & Label = "do_ctmAdvection:", __RC__ ) - call ESMF_ConfigGetAttribute(configFile, do_ctmDiffusion, & + call ESMF_ConfigGetAttribute(configFile, state%do_ctmDiffusion, & Default = .FALSE., & Label = "do_ctmDiffusion:", __RC__ ) ! Type of meteological fields (MERRA2 or MERRA1 or FPIT or FP) - call ESMF_ConfigGetAttribute(configFile, metType, & + call ESMF_ConfigGetAttribute(configFile, state%metType, & Default = 'MERRA2', & Label = "metType:", __RC__ ) - IF ((TRIM(metType) == "F515_516") .OR. & - (TRIM(metType) == "F5131")) metType = "FP" + IF ((TRIM(state%metType) == "F515_516") .OR. & + (TRIM(state%metType) == "F5131")) state%metType = "FP" + + ! Turn Convection on for any Chemistry configuration + IF (.NOT. state%enable_pTracers) THEN + state%do_ctmConvection = .TRUE. + ENDIF IF ( MAPL_am_I_root() ) THEN PRINT* PRINT*, "---------------------------------------------------" PRINT*, "----- GEOS CTM Settings -----" PRINT*, "---------------------------------------------------" - PRINT*,' Doing Passive Tracer?: ', enable_pTracers - PRINT*,' Advection: ', do_ctmAdvection - PRINT*,' Convection: ', do_ctmConvection - PRINT*,' Diffusion: ', do_ctmDiffusion - PRINT*,' Meteological Fields: ', TRIM(metType) + PRINT*,' Doing Passive Tracer?: ', state%enable_pTracers + PRINT*,' Advection: ', state%do_ctmAdvection + PRINT*,' Convection: ', state%do_ctmConvection + PRINT*,' Diffusion: ', state%do_ctmDiffusion + PRINT*,' Meteological Fields: ', TRIM(state%metType) PRINT*, "---------------------------------------------------" PRINT* END IF @@ -202,130 +224,137 @@ subroutine SetServices ( GC, RC ) ! Create children`s gridded components and invoke their SetServices ! ----------------------------------------------------------------- - IF (enable_pTracers) THEN + IF (state%enable_pTracers) THEN ! Doing passive tracer experiment !-------------------------------- - ADV3 = MAPL_AddChild(GC, NAME='DYNAMICS', SS=AdvCSetServices, __RC__) - ECTM = MAPL_AddChild(GC, NAME='CTMenv', SS=EctmSetServices, __RC__) - PTRA = MAPL_AddChild(GC, NAME='PTRACERS', SS=pTraSetServices, __RC__) + state%ADV3 = MAPL_AddChild(GC, NAME='DYNAMICS', SS=AdvCSetServices, __RC__) + state%ECTM = MAPL_AddChild(GC, NAME='CTMenv', SS=EctmSetServices, __RC__) + state%PTRA = MAPL_AddChild(GC, NAME='PTRACERS', SS=pTraSetServices, __RC__) ! Are you doing Convection? - if (do_ctmConvection) then - CONV = MAPL_AddChild(GC, NAME='CONVECTION', SS=ConvSetServices, __RC__) + if (state%do_ctmConvection) then + state%CONV = MAPL_AddChild(GC, NAME='CONVECTION', SS=ConvSetServices, __RC__) end if ! Are you doing Diffusion? - if (do_ctmDiffusion) then - DIFF = MAPL_AddChild(GC, NAME='DIFFUSION', SS=DiffSetServices, __RC__) + if (state%do_ctmDiffusion) then + state%DIFF = MAPL_AddChild(GC, NAME='DIFFUSION', SS=DiffSetServices, __RC__ ) end if ELSE - ADV3 = MAPL_AddChild(GC, NAME='DYNAMICS', SS=AdvCSetServices, __RC__) - CHEM = MAPL_AddChild(GC, NAME='CHEMISTRY', SS=ChemSetServices, __RC__) - ECTM = MAPL_AddChild(GC, NAME='CTMenv', SS=EctmSetServices, __RC__) + state%ADV3 = MAPL_AddChild(GC, NAME='DYNAMICS', SS=AdvCSetServices, __RC__) + state%CHEM = MAPL_AddChild(GC, NAME='CHEMISTRY', SS=ChemSetServices, __RC__) + state%ECTM = MAPL_AddChild(GC, NAME='CTMenv', SS=EctmSetServices, __RC__) ! Are you doing Convection? - if (do_ctmConvection) then - CONV = MAPL_AddChild(GC, NAME='CONVECTION', SS=ConvSetServices, __RC__) + if (state%do_ctmConvection) then + state%CONV = MAPL_AddChild(GC, NAME='CONVECTION', SS=ConvSetServices, __RC__) end if ! Are you doing Diffusion? - if (do_ctmDiffusion) then - DIFF = MAPL_AddChild(GC, NAME='DIFFUSION', SS=DiffSetServices, __RC__) + if (state%do_ctmDiffusion) then + state%DIFF = MAPL_AddChild(GC, NAME='DIFFUSION', SS=DiffSetServices, __RC__) end if END IF - call MAPL_TimerAdd(GC, name="INITIALIZE" ,RC=STATUS) - VERIFY_(STATUS) - - call MAPL_TimerAdd(GC, name="RUN" ,RC=STATUS) - VERIFY_(STATUS) + call MAPL_TimerAdd(GC, name="INITIALIZE", __RC__) + call MAPL_TimerAdd(GC, name="RUN" , __RC__) ! ------------------------------- ! Connectivities between Children ! ------------------------------- CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AREA'/), & - DST_ID = ECTM, SRC_ID = ADV3, __RC__ ) + DST_ID = state%ECTM, SRC_ID = state%ADV3, __RC__ ) CALL MAPL_AddConnectivity ( GC, & SRC_NAME = (/ 'CXr8 ', 'CYr8 ', 'MFXr8 ', 'MFYr8 ', 'PLE0r8', 'PLE1r8' /), & DST_NAME = (/ 'CX ', 'CY ', 'MFX ', 'MFY ', 'PLE0 ', 'PLE1 ' /), & - DST_ID = ADV3, SRC_ID = ECTM, __RC__ ) + DST_ID = state%ADV3, SRC_ID = state%ECTM, __RC__ ) CALL MAPL_TerminateImport ( GC, & SHORT_NAME = (/'TRADV'/), & - CHILD = ADV3, __RC__ ) + CHILD = state%ADV3, __RC__ ) ! Doing Convection - IF (do_ctmConvection) THEN + IF (state%do_ctmConvection) THEN + CALL MAPL_AddConnectivity ( GC, & + SHORT_NAME = (/ 'CNV_MFC', 'CNV_MFD' /), & + DST_ID = state%CONV, SRC_ID = state%ECTM, __RC__ ) + CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AREA'/), & - DST_ID = CONV, SRC_ID = ADV3, __RC__ ) + DST_ID = state%CONV, SRC_ID = state%ADV3, __RC__ ) - IF ( (TRIM(metType) == 'MERRA2') .OR. & - (TRIM(metType) == 'FPIT') .OR. & - (TRIM(metType) == 'FP') ) THEN - CALL MAPL_AddConnectivity ( GC, & + IF ( (TRIM(state%metType) == 'MERRA2') .OR. & + (TRIM(state%metType) == 'FPIT') .OR. & + (TRIM(state%metType) == 'FP') ) THEN + CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'PLE ', 'MASS', 'LWI '/), & - DST_ID = CONV, SRC_ID = ECTM, __RC__ ) - ELSEIF ( TRIM(metType) == 'MERRA1') THEN + DST_ID = state%CONV, SRC_ID = state%ECTM, __RC__ ) + ELSEIF ( TRIM(state%metType) == 'MERRA1') THEN CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'PLE ', 'MASS', 'ZLE ', 'LWI '/), & - DST_ID = CONV, SRC_ID = ECTM, __RC__ ) + DST_ID = state%CONV, SRC_ID = state%ECTM, __RC__ ) END IF CALL MAPL_TerminateImport ( GC, & SHORT_NAME = (/'ConvTR'/), & - CHILD = CONV, __RC__ ) + CHILD = state%CONV, __RC__ ) END IF ! Doing Diffusion - IF (do_ctmDiffusion) THEN + IF (state%do_ctmDiffusion) THEN CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AREA'/), & - DST_ID = DIFF, SRC_ID = ADV3, __RC__ ) + DST_ID = state%DIFF, SRC_ID = state%ADV3, __RC__ ) - IF ( (TRIM(metType) == 'MERRA2') .OR. & - (TRIM(metType) == 'FPIT') .OR. & - (TRIM(metType) == 'FP') ) THEN + IF ( (TRIM(state%metType) == 'MERRA2') .OR. & + (TRIM(state%metType) == 'FPIT') .OR. & + (TRIM(state%metType) == 'FP') ) THEN CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'PLE ', 'MASS'/), & - DST_ID = DIFF, SRC_ID = ECTM, __RC__ ) - ELSEIF ( TRIM(metType) == 'MERRA1') THEN + DST_ID = state%DIFF, SRC_ID = state%ECTM, __RC__ ) + ELSEIF ( TRIM(state%metType) == 'MERRA1') THEN CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'PLE ', 'MASS', 'ZLE '/), & - DST_ID = DIFF, SRC_ID = ECTM, __RC__ ) + DST_ID = state%DIFF, SRC_ID = state%ECTM, __RC__ ) END IF CALL MAPL_TerminateImport ( GC, & SHORT_NAME = (/'DiffTR'/), & - CHILD = DIFF, __RC__ ) + CHILD = state%DIFF, __RC__ ) END IF - IF (enable_pTracers) THEN + IF (state%enable_pTracers) THEN CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AREA'/), & - DST_ID = PTRA, SRC_ID = ADV3, __RC__ ) + DST_ID = state%PTRA, SRC_ID = state%ADV3, __RC__ ) CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'PLE'/), & - DST_ID = PTRA, SRC_ID = ECTM, __RC__ ) + DST_ID = state%PTRA, SRC_ID = state%ECTM, __RC__ ) ELSE CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AREA'/), & - DST_ID = CHEM, SRC_ID = ADV3, __RC__ ) + DST_ID = state%CHEM, SRC_ID = state%ADV3, __RC__ ) + + IF (state%do_ctmConvection) THEN + CALL MAPL_AddConnectivity ( GC, & + SHORT_NAME = (/ 'CNV_MFC', 'CNV_MFD' /), & + DST_ID = state%CHEM, SRC_ID = state%ECTM, __RC__ ) + ENDIF ! This is done for MERRA1, MERRA2, FPIT, FP CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/ 'LFR ', 'QCTOT ', 'TH ', 'PLE ', & - 'LWI ', 'CNV_QC', & + 'LWI ', 'CNV_QC', 'U ', 'V ', & 'BYNCY ', 'ITY ', 'QICN ', 'QLCN ' /), & - DST_ID = CHEM, SRC_ID = ECTM, __RC__ ) + DST_ID = state%CHEM, SRC_ID = state%ECTM, __RC__ ) ! Additional Connectivity if using MERRA1 - IF ( TRIM(metType) == 'MERRA1') THEN + IF ( TRIM(state%metType) == 'MERRA1') THEN CALL MAPL_AddConnectivity ( GC, & SHORT_NAME = (/ 'ZLE ', 'RH2 ' /), & - DST_ID = CHEM, SRC_ID = ECTM, __RC__ ) + DST_ID = state%CHEM, SRC_ID = state%ECTM, __RC__ ) END IF END IF @@ -335,32 +364,25 @@ subroutine SetServices ( GC, RC ) SHORT_NAME = 'TRADVI', & LONG_NAME = 'advected_quantities_tendencies', & units = 'UNITS s-1', & - DATATYPE = MAPL_BundleItem, & - RC=STATUS ) - VERIFY_(STATUS) + DATATYPE = MAPL_BundleItem, __RC__ ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'MTRI', & LONG_NAME = 'moist_quantities_tendencies', & units = 'UNITS s-1', & - DATATYPE = MAPL_BundleItem, & - RC=STATUS ) - VERIFY_(STATUS) + DATATYPE = MAPL_BundleItem, __RC__ ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TRI', & LONG_NAME = 'turbulence_quantities_tendencies', & units = 'UNITS s-1', & - DATATYPE = MAPL_BundleItem, & - RC=STATUS ) - VERIFY_(STATUS) + DATATYPE = MAPL_BundleItem, __RC__ ) ! Create grid for this GC !------------------------ !call MAPL_GridCreate (GC, __RC__ ) - call MAPL_GenericSetServices ( GC, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GenericSetServices ( GC, __RC__ ) RETURN_(ESMF_SUCCESS) @@ -408,20 +430,22 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: NA character(len=ESMF_MAXSTR), pointer :: NAMES(:) character(len=ESMF_MAXSTR) :: myNAME + character(len=ESMF_MAXSTR) :: varName character(len=ESMF_MAXSTR) :: iNAME character(len=ESMF_MAXSTR) :: COMP_NAME character(len=ESMF_MAXSTR) :: IAm = "Initialize" real(REAL64), allocatable :: ak(:),bk(:) real(REAL64) :: ptop, pint - integer :: counts(3),lm,ls + integer :: counts(3),lm,ls, ib + type (T_CTM_STATE), pointer :: CTM_STATE + type (CTM_WRAP) :: WRAP ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- !call ESMF_GridCompGet ( GC, name=COMP_NAME, GRID=GRID, RC=STATUS ) - call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet ( GC, name=COMP_NAME, __RC__ ) Iam = trim(COMP_NAME) // "::" // TRIM(Iam) ! Create grid for this GC @@ -438,69 +462,70 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(bk(lm+1),stat=status) VERIFY_(STATUS) call set_eta(lm,ls,ptop,pint,ak,bk) - call ESMF_AttributeSet(grid,name='GridAK', itemCount=LM+1, & - valuelist=ak,rc=status) + call ESMF_AttributeSet(grid, name='GridAK', itemCount=LM+1, & + valuelist=ak, __RC__) VERIFY_(STATUS) - call ESMF_AttributeSet(grid,name='GridBK', itemCount=LM+1, & - valuelist=bk,rc=status) + call ESMF_AttributeSet(grid, name='GridBK', itemCount=LM+1, & + valuelist=bk, __RC__) VERIFY_(STATUS) deallocate(ak,bk) ! Get my MAPL_Generic state !-------------------------- - call MAPL_GetObjectFromGC ( GC, STATE, RC=STATUS) - VERIFY_(STATUS) + call MAPL_GetObjectFromGC ( GC, STATE, __RC__ ) ! Call Initialize for every Child !-------------------------------- - call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) - VERIFY_(STATUS) + call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, __RC__ ) call MAPL_TimerOn(STATE,"TOTAL") call MAPL_TimerOn(STATE,"INITIALIZE") + ! Get my private state from the component + !---------------------------------------- + call ESMF_UserCompGetInternalState(GC, 'CTM_GridComp', WRAP, STATUS ) + VERIFY_(STATUS) + + CTM_STATE => WRAP%PTR + #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": IMPORT State" ) - if ( MAPL_am_I_root() ) call ESMF_StatePrint ( IMPORT, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_StatePrint ( IMPORT, __RC__ ) call WRITE_PARALLEL ( trim(Iam)//": EXPORT State" ) - if ( MAPL_am_I_root() ) call ESMF_StatePrint ( EXPORT, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_StatePrint ( EXPORT, __RC__ ) #endif ! Get children and their im/ex states from my generic state. !---------------------------------------------------------- - call MAPL_Get ( STATE, GCS=GCS, GIM=GIM, GEX=GEX, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_Get ( STATE, GCS=GCS, GIM=GIM, GEX=GEX, __RC__ ) ! Extract the friendly tracers !----------------------------- - IF (enable_pTracers) THEN - if (do_ctmDiffusion) then + IF (CTM_STATE%enable_pTracers) THEN + if (CTM_STATE%do_ctmDiffusion) then !------------------ ! Diffusion Tracers !------------------ - call ESMF_StateGet (GIM(DIFF), 'DiffTR' , BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_StateGet (GIM(CTM_STATE%DIFF), 'DiffTR' , BUNDLE, __RC__ ) - call MAPL_GridCompGetFriendlies(GCS(PTRA), "TURBULENCE", BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GridCompGetFriendlies(GCS(CTM_STATE%PTRA), "TURBULENCE", BUNDLE, __RC__ ) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Diffusion Tracer Bundle" ) - if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, __RC__ ) #endif ! Fill the diffusion increments bundle !--------------------------------- - call Initialize_IncBundle_init(GC, GIM(DIFF), EXPORT, TRIincCTM, __RC__) + call Initialize_IncBundle_init(GC, GIM(CTM_STATE%DIFF), EXPORT, TRIincCTM, __RC__) ! Count tracers !-------------- - call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, __RC__ ) ! Get the names of all tracers to fill other turbulence bundles. !--------------------------------------------------------------- @@ -508,54 +533,47 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(NAMES(NUM_TRACERS),STAT=STATUS) VERIFY_(STATUS) - call ESMF_FieldBundleGet(BUNDLE, fieldNameList=NAMES, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE, fieldNameList=NAMES, __RC__ ) end if - if (do_ctmConvection) then + if (CTM_STATE%do_ctmConvection) then !------------------- ! Convection Tracers !------------------- - call ESMF_StateGet (GIM(CONV), 'ConvTR', BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_StateGet (GIM(CTM_STATE%CONV), 'ConvTR', BUNDLE, __RC__ ) - call MAPL_GridCompGetFriendlies(GCS(PTRA), "MOIST", BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GridCompGetFriendlies(GCS(CTM_STATE%PTRA), "MOIST", BUNDLE, __RC__ ) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Convective Transport Bundle" ) - if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, __RC__ ) #endif ! Fill the moist increments bundle !--------------------------------- - call Initialize_IncBundle_init(GC, GIM(CONV), EXPORT, MTRIincCTM, __RC__) + call Initialize_IncBundle_init(GC, GIM(CTM_STATE%CONV), EXPORT, MTRIincCTM, __RC__) - call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, __RC__ ) end if !---------------- ! AdvCore Tracers !---------------- - call ESMF_StateGet (GIM(ADV3), 'TRADV', BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_StateGet (GIM(CTM_STATE%ADV3), 'TRADV', BUNDLE, __RC__ ) - call MAPL_GridCompGetFriendlies(GCS(PTRA), "DYNAMICS", BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GridCompGetFriendlies(GCS(CTM_STATE%PTRA), "DYNAMICS", BUNDLE, __RC__ ) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": AdvCore Tracer Bundle" ) - if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, __RC__ ) #endif - call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, __RC__ ) ! Initialize the advection increments bundle (TRADVI) ! with tracer increment names !-------------------------------- - call Initialize_IncBundle_init(GC, GIM(ADV3), EXPORT, DYNinc, __RC__) + call Initialize_IncBundle_init(GC, GIM(CTM_STATE%ADV3), EXPORT, DYNinc, __RC__) ! Get the names of all tracers to fill other turbulence bundles. @@ -564,34 +582,30 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(NAMES(NUM_TRACERS),STAT=STATUS) VERIFY_(STATUS) - call ESMF_FieldBundleGet(BUNDLE, fieldNameList=NAMES, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE, fieldNameList=NAMES, __RC__ ) ELSE - if (do_ctmDiffusion) then + if (CTM_STATE%do_ctmDiffusion) then !------------------ ! Diffusion Tracers !------------------ - call ESMF_StateGet (GIM(DIFF), 'DiffTR' , BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_StateGet (GIM(CTM_STATE%DIFF), 'DiffTR' , BUNDLE, __RC__ ) - call MAPL_GridCompGetFriendlies(GCS(CHEM), "TURBULENCE", BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GridCompGetFriendlies(GCS(CTM_STATE%CHEM), "TURBULENCE", BUNDLE, __RC__ ) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Diffusion Tracer Bundle" ) - if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, __RC__ ) #endif ! Fill the diffusion increments bundle !--------------------------------- - call Initialize_IncBundle_init(GC, GIM(DIFF), EXPORT, TRIincCTM, __RC__) + call Initialize_IncBundle_init(GC, GIM(CTM_STATE%DIFF), EXPORT, TRIincCTM, __RC__) ! Count tracers !-------------- - call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, __RC__ ) ! Get the names of all tracers to fill other turbulence bundles. !--------------------------------------------------------------- @@ -599,64 +613,69 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) allocate(NAMES(NUM_TRACERS),STAT=STATUS) VERIFY_(STATUS) - call ESMF_FieldBundleGet(BUNDLE, fieldNameList=NAMES, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE, fieldNameList=NAMES, __RC__ ) end if - if (do_ctmConvection) then + if (CTM_STATE%do_ctmConvection) then !------------------- ! Convection Tracers !------------------- - call ESMF_StateGet (GIM(CONV), 'ConvTR', BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_StateGet (GIM(CTM_STATE%CONV), 'ConvTR', BUNDLE, __RC__ ) - call MAPL_GridCompGetFriendlies(GCS(CHEM), "MOIST", BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GridCompGetFriendlies(GCS(CTM_STATE%CHEM), "MOIST", BUNDLE, __RC__ ) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Convective Transport Bundle" ) - if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, __RC__ ) #endif ! Fill the moist increments bundle !--------------------------------- - call Initialize_IncBundle_init(GC, GIM(CONV), EXPORT, MTRIincCTM, __RC__) + call Initialize_IncBundle_init(GC, GIM(CTM_STATE%CONV), EXPORT, MTRIincCTM, __RC__) - call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, __RC__ ) IF (NUM_TRACERS .EQ. 0) THEN IF ( MAPL_am_I_root() ) THEN PRINT*, '=======================================' - PRINT*, '-----> No tracer friendly to MOIST' + PRINT*, '-----> No tracer was friendly to MOIST' PRINT*, '-----> Convection will not be performed' PRINT*, '=======================================' END IF - do_ctmConvection = .FALSE. + CTM_STATE%do_ctmConvection = .FALSE. + ELSE + IF ( MAPL_am_I_root() ) THEN + PRINT*, '=======================================' + PRINT*, '------ List of Convected Tracers ------' + PRINT*, '=======================================' + DO ib = 1, NUM_TRACERS + call ESMF_FieldBundleGet(BUNDLE, ib, FIELD, __RC__) + call ESMF_FieldGet(FIELD, name=varName, __RC__) + PRINT '(i4,a5,a20)', ib, '-->', TRIM(varName) + ENDDO + PRINT*, '=======================================' + END IF END IF end if !---------------- ! AdvCore Tracers !---------------- - call ESMF_StateGet (GIM(ADV3), 'TRADV', BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_StateGet (GIM(CTM_STATE%ADV3), 'TRADV', BUNDLE, __RC__ ) - call MAPL_GridCompGetFriendlies(GCS(CHEM), "DYNAMICS", BUNDLE, RC=STATUS ) - VERIFY_(STATUS) + call MAPL_GridCompGetFriendlies(GCS(CTM_STATE%CHEM), "DYNAMICS", BUNDLE, __RC__ ) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": AdvCore Tracer Bundle" ) - if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) + if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, __RC__ ) #endif ! Initialize the advection increments bundle (TRADVI) ! with tracer increment names !-------------------------------- - call Initialize_IncBundle_init(GC, GIM(ADV3), EXPORT, DYNinc, __RC__) + call Initialize_IncBundle_init(GC, GIM(CTM_STATE%ADV3), EXPORT, DYNinc, __RC__) - call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, RC=STATUS) - VERIFY_(STATUS) + call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, __RC__ ) END IF call MAPL_TimerOff(STATE,"INITIALIZE") @@ -724,15 +743,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: NQ type (ESMF_FieldBundle) :: Bundletest type (ESMF_Field) :: FIELD - - - + type (T_CTM_STATE), pointer :: CTM_STATE + type (CTM_WRAP) :: WRAP ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- - call ESMF_GridCompGet ( GC, name=COMP_NAME, config=CF, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet ( GC, name=COMP_NAME, config=CF, __RC__ ) Iam = trim(COMP_NAME) // "::" // TRIM(Iam) ! Get my internal MAPL_Generic state @@ -744,6 +761,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_TimerOn(STATE,"TOTAL") call MAPL_TimerOn(STATE,"RUN") + ! Get my private state from the component + !---------------------------------------- + call ESMF_UserCompGetInternalState(GC, 'CTM_GridComp', WRAP, STATUS ) + VERIFY_(STATUS) + + CTM_STATE => WRAP%PTR + ! Get the children`s states from the generic state !------------------------------------------------- @@ -751,17 +775,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) GCS=GCS, GIM=GIM, GEX=GEX, & IM = IM, JM = JM, LM = LM, & GCNames = GCNames, & - INTERNAL_ESMF_STATE = INTERNAL, & - RC=STATUS ) - VERIFY_(STATUS) + INTERNAL_ESMF_STATE = INTERNAL, __RC__ ) - call ESMF_ConfigGetAttribute(CF, DT, Label="RUN_DT:" , RC=STATUS) - VERIFY_(STATUS) + call ESMF_ConfigGetAttribute(CF, DT, Label="RUN_DT:" , __RC__ ) !--------------------- ! Cinderella Component: to derive variables for other components !--------------------- - I=ECTM + I = CTM_STATE%ECTM call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), & @@ -778,43 +799,41 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Initialize Dynamics increment bundle !-------------------------------------------- - call Initialize_IncBundle_run(GIM(ADV3), EXPORT, DYNinc, __RC__) - - IF (do_ctmAdvection) THEN - I=ADV3 + call Initialize_IncBundle_run(GIM(CTM_STATE%ADV3), EXPORT, DYNinc, __RC__) - call Pack_Chem_Groups( GIM(ADV3) ) ! Prepare to transport chemical families + IF (CTM_STATE%do_ctmAdvection) THEN + I = CTM_STATE%ADV3 - call MAPL_TimerOn (STATE,GCNames(I)) - call ESMF_GridCompRun (GCS(I), & - importState = GIM(I), & - exportState = GEX(I), & - clock = CLOCK, & - userRC = STATUS ) - VERIFY_(STATUS) - call MAPL_TimerOff(STATE,GCNames(I)) + call Pack_Chem_Groups( GIM(I) ) ! Prepare to transport chemical families - ! Compute Dynamics increments and fill bundle - !-------------------------------------------- - call Compute_IncBundle(GIM(ADV3), EXPORT, DYNinc, STATE, __RC__) + call MAPL_TimerOn (STATE,GCNames(I)) + call ESMF_GridCompRun (GCS(I), & + importState = GIM(I), & + exportState = GEX(I), & + clock = CLOCK, & + userRC = STATUS ) + VERIFY_(STATUS) + call MAPL_TimerOff(STATE,GCNames(I)) + ! Compute Dynamics increments and fill bundle + !-------------------------------------------- + call Compute_IncBundle(GIM(CTM_STATE%ADV3), EXPORT, DYNinc, STATE, __RC__) - call MAPL_GetPointer( GEX(ADV3), AREA, 'AREA', __RC__ ) - call MAPL_GetPointer( GEX(ECTM), PLE, 'PLE', __RC__ ) - call MAPL_GetPointer( GIM(ECTM), Q, 'Q', __RC__ ) - call Unpack_Chem_Groups( GIM(ADV3), PLE, AREA, Q ) ! Finish transporting chemical families + call MAPL_GetPointer( GEX(CTM_STATE%ADV3), AREA, 'AREA', __RC__ ) + call MAPL_GetPointer( GEX(CTM_STATE%ECTM), PLE, 'PLE', __RC__ ) + call MAPL_GetPointer( GIM(CTM_STATE%ECTM), Q, 'Q', __RC__ ) + call Unpack_Chem_Groups( GIM(CTM_STATE%ADV3), PLE, AREA, Q ) ! Finish transporting chemical families END IF !----------- ! Convection !----------- - IF (do_ctmConvection) THEN + IF (CTM_STATE%do_ctmConvection) THEN + I = CTM_STATE%CONV ! Initialize Moist increment bundle !---------------------------------- - call Initialize_IncBundle_run(GIM(CONV), EXPORT, MTRIincCTM, __RC__) - - I=CONV + call Initialize_IncBundle_run(GIM(I), EXPORT, MTRIincCTM, __RC__) call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), & @@ -827,14 +846,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Compute Moist increments and fill bundle !-------------------------------------------- - call Compute_IncBundle(GIM(CONV), EXPORT, MTRIincCTM, STATE, __RC__) + call Compute_IncBundle(GIM(I), EXPORT, MTRIincCTM, STATE, __RC__) END IF - IF (.NOT. enable_pTracers) THEN + IF (.NOT. CTM_STATE%enable_pTracers) THEN !---------- ! Chemistry: Phase 1 !---------- - I=CHEM + I = CTM_STATE%CHEM call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), & @@ -851,13 +870,12 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !---------- ! Diffusion !---------- - IF (do_ctmDiffusion) THEN + IF (CTM_STATE%do_ctmDiffusion) THEN + I = CTM_STATE%DIFF ! Initialize Diffusion increment bundle !---------------------------------- - call Initialize_IncBundle_run(GIM(DIFF), EXPORT, TRIincCTM, __RC__) - - I=DIFF + call Initialize_IncBundle_run(GIM(I), EXPORT, TRIincCTM, __RC__) call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), & @@ -870,14 +888,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Compute Diffusion increments and fill bundle !-------------------------------------------- - call Compute_IncBundle(GIM(DIFF), EXPORT, TRIincCTM, STATE, __RC__) + call Compute_IncBundle(GIM(I), EXPORT, TRIincCTM, STATE, __RC__) END IF - IF (enable_pTracers) THEN + IF (CTM_STATE%enable_pTracers) THEN !--------------- ! Passive Tracer !--------------- - I=PTRA + I = CTM_STATE%PTRA call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), & @@ -891,7 +909,7 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !---------- ! Chemistry: Phase 2 !---------- - I=CHEM + I = CTM_STATE%CHEM call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), &