diff --git a/Externals.cfg b/Externals.cfg index dfa8bc0..93470ec 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -2,14 +2,14 @@ required = True repo_url = git@github.com:GEOS-ESM/ESMA_env.git local_path = ./@env -tag = v2.0.2 +tag = v2.1.5 protocol = git [ESMA_cmake] required = True repo_url = git@github.com:GEOS-ESM/ESMA_cmake.git local_path = ./@cmake -tag = v2.1.2 +tag = v3.0.3 externals = Externals.cfg protocol = git @@ -25,7 +25,7 @@ sparse = ../../../config/GMAO_Shared.sparse required = True repo_url = git@github.com:GEOS-ESM/MAPL.git local_path = ./src/Shared/@MAPL -tag = v2.0.0 +tag = v2.1.4 protocol = git [FVdycoreCubed_GridComp] diff --git a/components.yaml b/components.yaml index 6c27da9..b2f68bc 100644 --- a/components.yaml +++ b/components.yaml @@ -1,13 +1,13 @@ env: local: ./@env remote: ../ESMA_env.git - tag: v2.0.2 + tag: v2.1.5 develop: master cmake: local: ./@cmake remote: ../ESMA_cmake.git - tag: v2.1.2 + tag: v3.0.3 develop: develop ecbuild: @@ -25,7 +25,7 @@ GMAO_Shared: MAPL: local: ./src/Shared/@MAPL remote: ../MAPL.git - tag: v2.0.0 + tag: v2.1.4 develop: develop FMS: diff --git a/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl b/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl index 20840cb..f4cd57c 100755 --- a/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl +++ b/src/Applications/GEOSctm_App/MERRA2_ExtData.rc.tmpl @@ -7,11 +7,10 @@ PrimaryExports%% #------------ # Climatilogy #------------ -FRLAND '1' Y N 0 0.0 1.0 FRLAND /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_400.const_2d_asm_Nx.climatology.nc4 -FRLAKE '1' Y N 0 0.0 1.0 FRLAKE /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_400.const_2d_asm_Nx.climatology.nc4 -FRLANDICE '1' Y N 0 0.0 1.0 FRLANDICE /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_400.const_2d_asm_Nx.climatology.nc4 -FROCEAN '1' Y N 0 0.0 1.0 FROCEAN /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_400.const_2d_asm_Nx.climatology.nc4 -SGH 'm' Y N 0 0.0 1.0 SGH /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_400.const_2d_asm_Nx.climatology.nc4 +FRLAND '1' Y N 0 0.0 1.0 FRLAND /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_301.const_2d_ctm_Nx.00000000.nc4 +FRLAKE '1' Y N 0 0.0 1.0 FRLAKE /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_301.const_2d_ctm_Nx.00000000.nc4 +FRLANDICE '1' Y N 0 0.0 1.0 FRLANDICE /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_301.const_2d_ctm_Nx.00000000.nc4 +FROCEAN '1' Y N 0 0.0 1.0 FROCEAN /discover/nobackup/projects/gmi/gmidata2/input/metfields/rawMERRA2/MERRA2_301.const_2d_ctm_Nx.00000000.nc4 #------------- # 2D Variables @@ -49,7 +48,6 @@ RHOA '1' N N 0 0.0 1.0 CM '1' N N 0 0.0 1.0 CDM /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg1_2d_flx_Nx.%y4%m2%d2.nc4 CN '1' N N 0 0.0 1.0 CN /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg1_2d_flx_Nx.%y4%m2%d2.nc4 TA 'K' N N 0 0.0 1.0 TLML /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg1_2d_flx_Nx.%y4%m2%d2.nc4 -PS 'Pa' N N 0 0.0 1.0 PS /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg1_2d_slv_Nx.%y4%m2%d2.nc4 SLP 'Pa' N N 0 0.0 1.0 SLP /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg1_2d_slv_Nx.%y4%m2%d2.nc4 TROPP 'Pa' N N 0 0.0 1.0 TROPPB /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg1_2d_slv_Nx.%y4%m2%d2.nc4 T10M 'K' N N 0 0.0 1.0 T10M /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg1_2d_slv_Nx.%y4%m2%d2.nc4 @@ -68,7 +66,7 @@ PHIS 'm+2 s-2' N N 0 0.0 1.0 #--------------------- # 3D variables at edge #--------------------- -PLE '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 +#PLE '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 ZLE 'm' N N 0 0.0 1.0 ZLE /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_nav_Ne.%y4%m2%d2.nc4 KH 'm+2 s-1' N N 0 0.0 1.0 KH /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_trb_Ne.%y4%m2%d2.nc4 CNV_MFC 'kg m-2 s-1' N N 0 0.0 1.0 CMFMC /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_mst_Ne.%y4%m2%d2.nc4 @@ -95,7 +93,6 @@ FCLD '1' N N 0 0.0 1.0 CNV_MFD 'kg m-2 s-1' N N 0 0.0 1.0 DTRAIN /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_cld_Nv.%y4%m2%d2.nc4 TAUCLW '1' N N 0 0.0 1.0 TAUCLW /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_cld_Nv.%y4%m2%d2.nc4 TAUCLI '1' N N 0 0.0 1.0 TAUCLI /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_cld_Nv.%y4%m2%d2.nc4 -DELP 'Pa' N N 0 0.0 1.0 DELP /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.tavg3_3d_cld_Nv.%y4%m2%d2.nc4 QLTOT1 'kg kg-1' N N 0;-@nhmsDT 0.0 1.0 QL /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_asm_Nv.%y4%m2%d2.nc4 QITOT1 'kg kg-1' N N 0;-@nhmsDT 0.0 1.0 QI /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_asm_Nv.%y4%m2%d2.nc4 U 'm s-1' N N 0 0.0 1.0 U /discover/nobackup/projects/gmao/merra2/data/products/d5124_m2_@sMonth/Y%y4/M%m2/@MERRA2type.inst3_3d_asm_Nv.%y4%m2%d2.nc4 @@ -117,8 +114,11 @@ DQLDT 'kg/kg/s' N N 0 0.0 1.0 #---------------- #AdvCore Specific #---------------- -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 +PS '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 +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 +#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 UC1;VC1 'm s-1' N N 0;@nhmsDT 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/Applications/GEOSctm_App/ctm_run.j b/src/Applications/GEOSctm_App/ctm_run.j index 54ef4f8..899ee89 100755 --- a/src/Applications/GEOSctm_App/ctm_run.j +++ b/src/Applications/GEOSctm_App/ctm_run.j @@ -21,7 +21,6 @@ umask 022 limit stacksize unlimited -@SETENVS ####################################################################### # Configuration Settings @@ -518,11 +517,16 @@ if( ${DRIVING_DATASETS} == MERRA2) then set sMonth = jan00 set MERRA2type = MERRA2_300 set data_Transition_Date = 20100101 - else if( $startYear > 2009 ) then + else if( $startYear > 2009 && $startYear < 2020 ) then set sYear = 2010 set sMonth = jan10 set MERRA2type = MERRA2_400 set data_Transition_Date = 20200101 + else if( $startYear > 2019 ) then + set sYear = 2020 + set sMonth = jan10 + set MERRA2type = MERRA2_400 + set data_Transition_Date = 20300101 endif set newstring = "EXTDATA_CF: ${COMPNAME}_ExtData_${sYear}.rc" @@ -892,6 +896,8 @@ python bundleParser.py setenv YEAR $yearc ./linkbcs +@SETENVS + # Run GEOSctm.x # ------------- if( $USE_SHMEM == 1 ) $GEOSBIN/RmShmKeys_sshmpi.csh @@ -899,7 +905,11 @@ if( $USE_SHMEM == 1 ) $GEOSBIN/RmShmKeys_sshmpi.csh $RUN_CMD $NPES ./GEOSctm.x if( $USE_SHMEM == 1 ) $GEOSBIN/RmShmKeys_sshmpi.csh -set rc = $status +if( -e EGRESS ) then + set rc = 0 +else + set rc = -1 +endif echo GEOSctm Run Status: $rc diff --git a/src/Applications/GEOSctm_App/ctm_setup b/src/Applications/GEOSctm_App/ctm_setup index ab7acf7..25abcb4 100755 --- a/src/Applications/GEOSctm_App/ctm_setup +++ b/src/Applications/GEOSctm_App/ctm_setup @@ -1197,6 +1197,9 @@ else if( $MPI == intelmpi ) then cat > $HOMDIR/SETENV.commands << EOF setenv I_MPI_DAPL_UD enable +setenv I_MPI_SHM_HEAP_VSIZE 512 +setenv I_MPI_ADJUST_ALLREDUCE 12 +setenv I_MPI_ADJUST_GATHERV 3 EOF endif # if mpi diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt index bd4fea6..e9a20b6 100644 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt +++ b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CMakeLists.txt @@ -1,22 +1,11 @@ esma_set_this () -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 - ) -endif () +set (SRCS + CTM_ConvectionGridCompMod.F90 + GmiConvectionMethod_mod.F90 + convectiveTransport_mod.F90 + CTM_rasCalculationsMod.F90 + ) esma_add_library (${this} SRCS ${SRCS} diff --git a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 index 5b689af..78edfba 100644 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 +++ b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/CTM_ConvectionGridCompMod.F90 @@ -14,13 +14,16 @@ MODULE CTM_ConvectionGridCompMod ! USE ESMF USE MAPL_Mod - USE GmiConvectionMethod_mod ! GMI Convection component - USE GenericConvectionMethod_mod ! Generic Convection component + !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: @@ -40,8 +43,10 @@ MODULE CTM_ConvectionGridCompMod !------------------------------------------------------------------------- TYPE Convection_State PRIVATE - TYPE(gmiConvection_GridComp), POINTER :: gmiCONV => null() - TYPE(genConvection_GridComp), POINTER :: genCONV => null() + logical :: det_ent ! flag for doing detrainment then entrainment + logical :: do_downdraft ! flag for doing downdrafts + integer :: numSpecies + logical, pointer :: isFixedConcentration(:) => null() END TYPE Convection_State TYPE Convection_WRAP @@ -51,8 +56,21 @@ MODULE CTM_ConvectionGridCompMod integer :: convecType ! 1: Generic Convection (only convective transport) ! 2: GMI convection - TYPE(RASPARAM_Type) :: RASPARAMS - logical :: enable_rasCalculations = .FALSE. + logical :: det_ent ! flag for doing detrainment then entrainment + logical :: do_downdraft ! flag for doing downdrafts + +! logical, pointer :: isFixedConcentration(:) + integer :: numSpecies + 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 + + 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 @@ -136,9 +154,19 @@ 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 rcEsmfReadLogical(convConfigFile, det_ent, & + & "det_ent:", default=.false., rc=STATUS ) + VERIFY_(STATUS) + + call rcEsmfReadLogical(convConfigFile, do_downdraft, & + & "do_downdraft:", default=.false., rc=STATUS ) + VERIFY_(STATUS) + + IF ( MAPL_AM_I_ROOT() ) THEN + PRINT*," -----> det_ent = ", det_ent + PRINT*," -----> do_downdraft = ", do_downdraft + PRINT *,"Done Reading the Convection Resource File" + END IF ! ========================== IMPORT STATE ========================= @@ -149,14 +177,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 +205,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 +212,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 +235,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" @@ -322,17 +293,19 @@ SUBROUTINE Initialize_ ( gc, impConv, expConv, clock, rc ) type(ESMF_State) :: internal type(MAPL_VarSpec), pointer :: InternalSpec(:) type (ESMF_Config) :: convConfigFile + type (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) :: NAME, speciesName + integer :: ic rc = 0 @@ -355,6 +328,14 @@ SUBROUTINE Initialize_ ( gc, impConv, expConv, clock, rc ) call MAPL_TimerOn(ggSTATE,"TOTAL") call MAPL_TimerOn(ggSTATE,"INITIALIZE") + ! Get my private state from the component + !---------------------------------------- + + call ESMF_UserCompGetInternalState(gc, 'Convection_state', WRAP, STATUS) + VERIFY_(STATUS) + + conv_state => WRAP%PTR + convConfigFile = ESMF_ConfigCreate(rc=STATUS ) VERIFY_(STATUS) @@ -375,7 +356,7 @@ SUBROUTINE Initialize_ ( gc, impConv, expConv, clock, rc ) ! 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 +374,21 @@ 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 ) - 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 ) - VERIFY_(STATUS) - end if + i2 = dims(1) + j2 = dims(2) + km = dims(3) + k2 = km + ivert = km + ilong = i2-i1+1 - IF (enable_rasCalculations) THEN - IF (MAPL_AM_I_ROOT()) PRINT*, TRIM(Iam)//': Doing RAS Calculations' - CALL INIT_RASPARAMS(RASPARAMS) - ENDIF + ! Get the bundles containing the quantities to be diffused, + !---------------------------------------------------------- + + call ESMF_StateGet(impConv, 'ConvTR' , ConvTR, RC=STATUS) + VERIFY_(STATUS) + + call ESMF_FieldBundleGet(ConvTR, fieldCOUNT=numSpecies, RC=STATUS) + VERIFY_(STATUS) call MAPL_TimerOff(ggSTATE,"INITIALIZE") call MAPL_TimerOff(ggSTATE,"TOTAL") @@ -480,8 +440,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 @@ -491,9 +449,39 @@ SUBROUTINE Run_ ( gc, impConv, expConv, clock, rc ) type(ESMF_Time) :: TIME type (MAPL_MetaComp), pointer :: ggState - !REAL :: qmin, qmax - !real, pointer, dimension(:,:,:) :: CNV_MFC => null() - !real, pointer, dimension(:,:,:) :: CNV_MFD => null() + 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(:) + logical, pointer :: isFixedConcentration(:) + character(len=ESMF_MAXSTR) :: NAME, speciesName +!EOP +!------------------------------------------------------------------------- +!BOC ! Get my name and set-up traceback handle ! --------------------------------------- @@ -504,32 +492,144 @@ SUBROUTINE Run_ ( gc, impConv, expConv, clock, rc ) ! 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 + call ESMF_FieldBundleGet(ConvTR, fieldCOUNT=numSpecies, RC=STATUS) + VERIFY_(STATUS) -! Run -! --- - if (convecType == 1) then - CALL runGenericConvection ( genCONV, impConv, expConv, nymd, nhms, & - cdt, enable_rasCalculations, STATUS ) + ! Get the tracers from the ESMF Bundle + !------------------------------------- + ALLOCATE(concentration(numSpecies), STAT=STATUS) + VERIFY_(STATUS) + + allocate(isFixedConcentration(numSpecies), STAT=STATUS) + VERIFY_(STATUS) + isFixedConcentration(:) = .FALSE. + + DO ic = 1, 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) + + !Identify fixed species such as O2, N2, ad. + !------------------------------------------ + if (TRIM(NAME) == 'ACET' .OR. TRIM(NAME) == 'N2' .OR. & + TRIM(NAME) == 'O2' .OR. TRIM(NAME) == 'NUMDENS') THEN + isFixedConcentration(ic) = .TRUE. + end if + + ! 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 (det_ent, do_downdraft, pbl, cmf, & + dtrain, eu, ed, md, gridBoxHeight, mass, kel, press3e, & + concentration, isFixedConcentration, cellArea, tdt, & + i1, i2, j1, j2, k1, k2, ilong, ivert, 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, numSpecies + call ESMF_FieldBundleGet(ConvTR, ic, FIELD, RC=STATUS) + VERIFY_(STATUS) + + call ESMF_FieldGet(FIELD, name=NAME, RC=STATUS) VERIFY_(STATUS) - elseif (convecType == 2) then - CALL runGmiConvection ( gmiCONV, impConv, expConv, nymd, nhms, & - cdt, enable_rasCalculations, 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 + + DEALLOCATE(isFixedConcentration) + CALL CleanArrayPointer(concentration, STATUS) + VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) @@ -575,13 +675,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,190 +686,26 @@ 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 @@ -785,7 +717,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 +726,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 +736,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/GenericConvectionMethod_mod.F90 b/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/GenericConvectionMethod_mod.F90 deleted file mode 100644 index 10a2bbe..0000000 --- a/src/Components/GEOSctm_GridComp/CTMconvection_GridComp/GenericConvectionMethod_mod.F90 +++ /dev/null @@ -1,622 +0,0 @@ -!------------------------------------------------------------------------- -! NASA/GSFC, Software Systems Support Office, Code 610.3 ! -!------------------------------------------------------------------------- -!BOP -! -! !MODULE: GenericConvectionMethod_mod -! -! !INTERFACE: -! -#include "MAPL_Generic.h" -! - module GenericConvectionMethod_mod -! -! !USES: - use ESMF - use MAPL_Mod - !USE Chem_UtilMod - USE convectiveTransport_mod - use GmiArrayBundlePointer_mod - USE GmiESMFrcFileReading_mod -! - implicit none -! - INTEGER, PARAMETER :: DBL = KIND(0.00D+00) -! -! !PUBLIC MEMBER FUNCTIONS: - private - public :: initializeGenericConvection - public :: runGenericConvection - public :: finalizeGenericConvection -! -! !PUBLIC DATA MEMBERS: - public :: genConvection_GridComp -! - TYPE genConvection_GridComp - character(len=ESMF_MAXSTR) :: name = "Generic Convection" - - ! Dimension - INTEGER :: i1, i2, im, j1, j2, jm, km - - ! Surface area of grid cells - REAL(KIND=DBL), POINTER :: cellArea(:,:) - - logical :: det_ent ! flag for doing detrainment then entrainment - logical :: do_downdraft ! flag for doing downdrafts - - logical, pointer :: isFixedConcentration(:) - logical :: FIRST - END TYPE genConvection_GridComp -! - character(len=ESMF_MAXSTR) :: rcfilen = 'CTM_GridComp.rc' -! - 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 -! -! !DESCRIPTION: -! Generic convection for the convective transport only. -! -! !AUTHOR: -! -! !REVISION HISTORY: -! -!EOP -!------------------------------------------------------------------------- - CONTAINS -!------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: initializeGenericConvection -! -! !INTERFACE: -! - subroutine initializeGenericConvection (self, impConv, expConv, nymd, nhms, & - grid, tdt, rc) -! -! !INPUT PARAMETERS: - INTEGER, INTENT(IN) :: nymd, nhms ! Time from AGCM - REAL, INTENT(IN) :: tdt ! Chemistry time step (secs) - TYPE(ESMF_GRID), INTENT(IN) :: grid -! -! !OUTPUT PARAMETERS: - INTEGER, INTENT(out) :: rc ! Error return code: - ! 0 - all is well - ! 1 - -! -! !INPUT/OUTPUT PARAMETERS: - TYPE(ESMF_State), INTENT(INOUT) :: impConv ! Import State - TYPE(ESMF_State), INTENT(INOUT) :: expConv ! Export State - type (genConvection_GridComp), intent(inOut) :: self -! -! !DESCRIPTION: -! Reads in Convection related variables from the resource file. -! -! !LOCAL VARIABLES: - ! Grid cell area can be set by initialize - ! --------------------------------------- - REAL, POINTER, DIMENSION(:,:) :: cellArea - integer :: i1, i2, j1, j2, km, im, jm - integer :: k1, k2 - integer :: numSpecies, ic, is - integer :: STATUS - type (ESMF_Config) :: convConfigFile - REAL, ALLOCATABLE :: var2D(:,:) - character(len=ESMF_MAXSTR) :: varName, fileName - character(len=ESMF_MAXSTR) :: IAm = "initializeGenericConvection" -!EOP -!------------------------------------------------------------------------- -!BOC - ! Get the GMI grid information - i1 = self%i1 - i2 = self%i2 - im = self%im - j1 = self%j1 - j2 = self%j2 - jm = self%jm - km = self%km - - k1 = 1 - k2 = km - - self%FIRST = .TRUE. - - !################################ - ! Begin reading the resource file - !################################ - - IF ( MAPL_AM_I_ROOT() ) THEN - PRINT *," " - PRINT *,TRIM(IAm)//":" - PRINT *,"Starting Reading the Convection Resource File" - ENDIF - - convConfigFile = ESMF_ConfigCreate(rc=STATUS ) - VERIFY_(STATUS) - - call ESMF_ConfigLoadFile(convConfigFile, TRIM(rcfilen), rc=STATUS ) - VERIFY_(STATUS) - - - call rcEsmfReadLogical(convConfigFile, self%det_ent, & - & "det_ent:", default=.false., rc=STATUS ) - VERIFY_(STATUS) - - call rcEsmfReadLogical(convConfigFile, self%do_downdraft, & - & "do_downdraft:", default=.false., rc=STATUS ) - VERIFY_(STATUS) - - IF ( MAPL_AM_I_ROOT() ) THEN - PRINT*," -----> det_ent = ", self%det_ent - PRINT*," -----> do_downdraft = ", self%do_downdraft - PRINT *,"Done Reading the Convection Resource File" - END IF - - !############################## - ! End reading the resource file - !############################## - - ! Grid box surface area, m^{2} - ! ---------------------------- - CALL MAPL_GetPointer(impConv, cellArea, 'AREA', rc=STATUS) - VERIFY_(STATUS) - ALLOCATE(self%cellArea(i1:i2,j1:j2), STAT=STATUS) - VERIFY_(STATUS) - self%cellArea(i1:i2,j1:j2)=cellArea(:,:) - - return - - end subroutine initializeGenericConvection -!EOC -!------------------------------------------------------------------------- -!BOP -! -! IROUTINE: runGenericConvection -! -! !INTERFACE: -! - subroutine runGenericConvection (self, impConv, expConv, nymd, nhms, & - tdt, enable_rasCalculations, rc) -! -! !USES: -! -! !INPUT PARAMETERS: - TYPE(ESMF_State), INTENT(INOUT) :: impConv ! Import State - INTEGER, INTENT(IN) :: nymd, nhms ! time - REAL, INTENT(IN) :: tdt ! chemical timestep (secs) - LOGICAL, INTENT(IN) :: enable_rasCalculations ! do RAS calculations? -! -! !OUTPUT PARAMETERS: - INTEGER, INTENT(OUT) :: rc ! Error return code: - ! 0 - all is well - ! 1 - -! -! !INPUT/OUTPUT PARAMETERS: - TYPE(ESMF_State), INTENT(INOUT) :: expConv ! Export State - type (genConvection_GridComp), intent(inOut) :: self -! -! !DESCRIPTION: -! Runs the convection component. -! -! !LOCAL VARIABLES: - REAL, POINTER, DIMENSION(:,:) :: zpbl - REAL, POINTER, DIMENSION(:,:,:) :: ple, zle, totalMass - REAL, POINTER, DIMENSION(:,:,:) :: CNV_MFC, CNV_MFD, T - - integer :: STATUS - integer :: numSpecies, ic, kR, ik, is - integer :: i1, i2, j1, j2, km, im, jm - integer :: k1, k2, ivert, ilong - REAL, ALLOCATABLE :: pl(:,:,:) - - 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), allocatable :: zmdu (:, :, :) - REAL(KIND=DBL), allocatable :: zmeu (:, :, :) - REAL(KIND=DBL), allocatable :: zmed (:, :, :) - REAL(KIND=DBL), allocatable :: zmmd (:, :, :) - REAL(KIND=DBL), allocatable :: zmmu (:, :, :) - REAL(KIND=DBL), allocatable :: hkdu (:, :, :) - REAL(KIND=DBL), allocatable :: hkeu (:, :, :) - REAL(KIND=DBL), allocatable :: hkmu (:, :, :) - REAL(KIND=DBL) :: cdt - - type (ESMF_Field) :: FIELD - type (ESMF_Array) :: ARRAY - type (ESMF_FieldBundle) :: ConvTR - REAL, POINTER, DIMENSION(:,:,:) :: S - - type (ESMF_Config) :: convConfigFile - type (t_GmiArrayBundle), pointer :: concentration(:) - character(len=ESMF_MAXSTR) :: IAm = "runGenericConvection" - character(len=ESMF_MAXSTR) :: NAME, speciesName -!EOP -!------------------------------------------------------------------------- -!BOC - - ! Get the GMI grid information - i1 = self%i1 - i2 = self%i2 - im = self%im - j1 = self%j1 - j2 = self%j2 - jm = self%jm - km = self%km - - k1 = 1 - 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=numSpecies, RC=STATUS) - VERIFY_(STATUS) - - ! Get the molecular weights of species to be convected - ! Identify the "fixed" tracers - ! Map the convected tracer indices into the GMI tracer indices - !------------------------------------------------------------- - - IF (self%FIRST) THEN - self%FIRST = .FALSE. - - allocate(self%isFixedConcentration(numSpecies), STAT=STATUS) - VERIFY_(STATUS) - self%isFixedConcentration(:) = .FALSE. - - DO ic = 1, 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) - - !Identify fixed species such as O2, N2, ad. - if (TRIM(NAME) == 'ACET' .OR. TRIM(NAME) == 'N2' .OR. & - TRIM(NAME) == 'O2' .OR. TRIM(NAME) == 'NUMDENS') THEN - self%isFixedConcentration(ic) = .TRUE. - end if - - END DO - - convConfigFile = ESMF_ConfigCreate(rc=STATUS ) - VERIFY_(STATUS) - - call ESMF_ConfigLoadFile(convConfigFile, TRIM(rcfilen), rc=STATUS ) - VERIFY_(STATUS) - - END IF - - ! Get the tracers from the ESMF Bundle - !------------------------------------- - ALLOCATE(concentration(numSpecies), STAT=STATUS) - VERIFY_(STATUS) - - DO ic = 1, 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=STATUS); VERIFY_(STATUS) - CALL MAPL_GetPointer(impConv, zpbl, 'ZPBL', RC=STATUS); VERIFY_(STATUS) - CALL MAPL_GetPointer(impConv, ple, 'PLE', RC=STATUS); VERIFY_(STATUS) - CALL MAPL_GetPointer(impConv, totalMass, 'MASS', RC=STATUS); VERIFY_(STATUS) - CALL MAPL_GetPointer(impConv, zle, 'ZLE', RC=STATUS); VERIFY_(STATUS) - IF (enable_rasCalculations) THEN - CALL MAPL_GetPointer(expConv, CNV_MFD, 'CNV_MFD', RC=STATUS); VERIFY_(STATUS) - CALL MAPL_GetPointer(expConv, CNV_MFC, 'CNV_MFC', RC=STATUS); VERIFY_(STATUS) - ELSE - CALL MAPL_GetPointer(impConv, CNV_MFD, 'CNV_MFD', RC=STATUS); VERIFY_(STATUS) - CALL MAPL_GetPointer(impConv, CNV_MFC, 'CNV_MFC', RC=STATUS); VERIFY_(STATUS) - ENDIF - - 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) - - 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 - - cdt = tdt - - call doGenericConvectiveTransport (self%det_ent, self%do_downdraft, pbl, cmf, & - dtrain, eu, ed, md, gridBoxHeight, mass, kel, press3e, & - concentration, self%isFixedConcentration, self%cellArea, cdt, & - i1, i2, j1, j2, k1, k2, ilong, ivert, numSpecies) - - deallocate(pbl ) - deallocate(dtrain, cmf, kel, eu, ed, md) - deallocate(press3e, press3c, mass, gridBoxHeight, pl) - - ! Pass bacck the tracers to the ESMF Bundle - !------------------------------------------ - DO ic = 1, numSpecies - call ESMF_FieldBundleGet(ConvTR, ic, FIELD, RC=STATUS) - VERIFY_(STATUS) - - call ESMF_FieldGet(FIELD, name=NAME, RC=STATUS) - VERIFY_(STATUS) - - call ESMFL_BundleGetPointerToData(ConvTR, NAME, S, RC=STATUS) - VERIFY_(STATUS) - - ! 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 - - end subroutine RunGenericConvection -!EOC -!------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: FinalizeGenericConvection -! -! !INTERFACE: -! - subroutine FinalizeGenericConvection (self) -! -! !INPUT/OUTPUT PARAMETERS: - type (genConvection_GridComp), intent(inout) :: self -! -! !LOCAL VARIABLES: - character(len=ESMF_MAXSTR) :: IAm = "finalizeGenericConvection" -!EOP -!------------------------------------------------------------------------- -!BOC - IF ( MAPL_AM_I_ROOT() ) THEN - PRINT *," " - PRINT *,TRIM(IAm)//":" - PRINT *,"Completed Convection" - ENDIF - - return - - end subroutine FinalizeGenericConvection -!EOC -!------------------------------------------------------------------------- -!BOP -! -! !IROUTINE: doGenericConvectiveTransport -! -! !INTERFACE: -! - subroutine doGenericConvectiveTransport (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 doGenericConvectiveTransport.' - 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 doGenericConvectiveTransport -!EOC -!----------------------------------------------------------------------------- - end module GenericConvectionMethod_mod 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 4a91d08..77fc4f7 100644 --- a/src/Components/GEOSctm_GridComp/GEOS_ctmEnvGridComp.F90 +++ b/src/Components/GEOSctm_GridComp/GEOS_ctmEnvGridComp.F90 @@ -13,10 +13,11 @@ module GEOS_ctmEnvGridComp ! !USES: use ESMF use MAPL_Mod - 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 FV_StateMod, only: calcCourantNumberMassFlux => fv_computeMassFluxes + use m_set_eta, only: set_eta + use fv_arrays_mod, only: FVPRC + use GEOS_FV3_UtilitiesMod, only: a2d2c + use CTM_rasCalculationsMod, only: INIT_RASPARAMS, DO_RAS, RASPARAM_Type implicit none private @@ -24,41 +25,40 @@ module GEOS_ctmEnvGridComp ! !PUBLIC MEMBER FUNCTIONS: public SetServices - public compAreaWeightedAverage - interface compAreaWeightedAverage - module procedure compAreaWeightedAverage_2d - module procedure compAreaWeightedAverage_3d - end interface ! ! !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 :: GPKG = 1000.0d0 ! grams per kg + real(r8), parameter :: MWTAIR = 28.96d0 ! molecular weight of air 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 !------------------------------------------------------------------------- @@ -93,39 +93,63 @@ 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_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 +167,65 @@ 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 = 'PLE0', & +! LONG_NAME = 'pressure_at_layer_edges_before_advection', & +! UNITS = 'Pa', & +! DIMS = MAPL_DimsHorzVert, & +! VLOCATION = MAPL_VLocationEdge, __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__ ) call MAPL_AddImportSpec ( gc, & SHORT_NAME = 'UC0', & @@ -169,8 +234,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 +243,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 +252,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,16 +261,14 @@ 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', & @@ -216,8 +276,7 @@ subroutine SetServices ( GC, RC ) UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) + __RC__ ) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'FROCEAN', & @@ -225,48 +284,80 @@ subroutine SetServices ( GC, RC ) UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & - RC=STATUS ) - VERIFY_(STATUS) + __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) + VLOCATION = MAPL_VLocationNone, __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_AddImportSpec(GC, & SHORT_NAME = 'ZLE', & LONG_NAME = 'geopotential_height', & UNITS = 'm', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationEdge, __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', & @@ -307,60 +398,40 @@ subroutine SetServices ( GC, RC ) 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 +446,6 @@ subroutine SetServices ( GC, RC ) DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, __RC__) - call MAPL_AddImportSpec ( gc, & - SHORT_NAME = 'DELP', & - LONG_NAME = 'pressure_thickness', & - UNITS = 'Pa', & - DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationCenter, __RC__ ) ENDIF ! output_forcingData END IF @@ -395,8 +460,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 +468,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 +476,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 +484,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 +492,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,59 +500,50 @@ 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) + VLOCATION = MAPL_VLocationCenter, __RC__) - IF ( TRIM(metType) == 'MERRA1' ) THEN + IF ( TRIM(state%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) + VLOCATION = MAPL_VLocationCenter, __RC__ ) END IF call MAPL_AddExportSpec(GC, & @@ -500,52 +551,74 @@ subroutine SetServices ( GC, RC ) LONG_NAME = 'geopotential_height', & UNITS = 'm', & DIMS = MAPL_DimsHorzVert, & - VLOCATION = MAPL_VLocationEdge, RC=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationEdge, __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 = '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__ ) + + 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=STATUS ) - VERIFY_(STATUS) + 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=STATUS ) - VERIFY_(STATUS) + 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=STATUS ) - VERIFY_(STATUS) + 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=STATUS ) - VERIFY_(STATUS) + 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=STATUS ) - VERIFY_(STATUS) + VLOCATION = MAPL_VLocationNone, __RC__ ) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'QLCN', & @@ -564,7 +637,7 @@ subroutine SetServices ( GC, 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,14 +646,7 @@ subroutine SetServices ( GC, RC ) VLOCATION = MAPL_VLocationNone, __RC__) call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'SGH', & - LONG_NAME = 'isotropic_stdv_GWD_topography', & - UNITS = 'm', & - DIMS = MAPL_DimsHorzOnly, & - VLOCATION = MAPL_VLocationNone, __RC__) - - call MAPL_AddExportSpec(GC, & - SHORT_NAME = 'PHIS', & + SHORT_NAME = 'PHIS_input', & LONG_NAME = 'surface_geopotential_height', & UNITS = 'm2 s-2', & DIMS = MAPL_DimsHorzOnly, & @@ -600,20 +666,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', & @@ -647,15 +699,12 @@ subroutine SetServices ( GC, RC ) ! 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) @@ -696,38 +745,50 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) 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 ! 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 +827,13 @@ 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(:,:,:) :: PLE1 => null() + !real, pointer, dimension(:,:,:) :: PLE0 => null() real, pointer, dimension(:,:,:) :: UC0 => null() real, pointer, dimension(:,:,:) :: UC1 => null() real, pointer, dimension(:,:,:) :: VC0 => null() @@ -783,6 +846,8 @@ 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() @@ -807,6 +872,11 @@ 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() @@ -818,12 +888,8 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) real, pointer, dimension(:,:) :: FRACI => null() real, pointer, dimension(:,:) :: LFR => null() - real, pointer, dimension(:,:) :: flashRate => 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() @@ -843,8 +909,6 @@ 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() @@ -852,8 +916,6 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) 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() @@ -862,17 +924,29 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) 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 :: km, k, is, ie, js, je, ik, nc, IM, JM, LM integer :: ndt, isd, ied, jsd, jed, i, j, l real(FVPRC) :: DT ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- - call ESMF_GridCompGet ( GC, name=COMP_NAME, Grid=esmfGrid, RC=STATUS ) - VERIFY_(STATUS) + call ESMF_GridCompGet ( GC, name=COMP_NAME, Grid=esmfGrid, __RC__ ) Iam = trim(COMP_NAME) // TRIM(Iam) ! Get my internal MAPL_Generic state @@ -882,6 +956,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,84 +971,108 @@ 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, PLE0, 'PLE0', __RC__ ) + !call MAPL_GetPointer ( IMPORT, PLE1, 'PLE1', __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 + call MAPL_GetPointer ( IMPORT, PS0, 'PS0', __RC__ ) + call MAPL_GetPointer ( IMPORT, PS1, 'PS1', __RC__ ) + + 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 + + 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) + + 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*(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 !----------------------------------- - 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 - ELSEIF ( TRIM(metType) == 'MERRA1') THEN + ELSEIF ( TRIM(CTMenv_STATE%metType) == 'MERRA1') THEN !--------------------------------- ! RH2 and ZLE if using MERRA1 data !--------------------------------- @@ -980,64 +1085,34 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! --------------------------------------- ! 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', __RC__ ) + Uexp = UC0 + ENDIF + + IF (ASSOCIATED(VC0)) THEN + call MAPL_GetPointer ( EXPORT, Vexp, 'V', __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,85 +1120,371 @@ 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 derive_LFR_BYNCY() + + !---------------------------------------------- + ! If you choose to output specific forcing data + !---------------------------------------------- + IF (CTMenv_STATE%output_forcingData) THEN + call export_to_HISTORY() + END IF + + END IF ! .NOT. enable_pTracers + + call MAPL_TimerOff(ggState,"RUN") + call MAPL_TimerOff(ggState,"TOTAL") + + ! All Done + ! -------- + 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', ALLOC=.TRUE., __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: CN_PRCP + ! Exports: LFR, BYNCY + ! CNV_MFC is already available from either the Import or Export state + 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__ ) - 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 + + !IF (ASSOCIATED(CNV_MFC) .AND. ASSOCIATED(CN_PRCP)) THEN + IF ( 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 - 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) + 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, & + call computeFlashRate (ggState, nc, LM, TS, CNV_TOPP, FROCEAN, & CN_PRCP, CAPE, CNV_MFC, TH, PLE, ZLE, flashRate, RC=STATUS) - VERIFY_(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', ALLOC=.TRUE., __RC__ ) + call MAPL_GetPointer ( EXPORT, CNV_MFD, 'CNV_MFD', ALLOC=.TRUE., __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', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(CNV_MFC)) THEN + call MAPL_GetPointer ( EXPORT, CNV_MFCexp, 'CNV_MFC', ALLOC=.TRUE., __RC__ ) + CNV_MFCexp(:,:,:) = CNV_MFC(:,:,:) + ENDIF + + call MAPL_GetPointer ( IMPORT, CNV_MFD, 'CNV_MFD', ALLOC=.TRUE., __RC__ ) + IF (ASSOCIATED(CNV_MFD)) THEN + call MAPL_GetPointer ( EXPORT, CNV_MFDexp, 'CNV_MFD', ALLOC=.TRUE., __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__ ) - LFR(:,:) = flashRate(:,:) - - DEALLOCATE(CNV_TOPP, CAPE, flashRate) + 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() - !---------------------------------------------- - ! If you choose to output specific forcing data - !---------------------------------------------- - IF (output_forcingData) THEN - call MAPL_GetPointer ( IMPORT, PSimp, 'PS', __RC__ ) + 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', 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) + ENDIF + + end subroutine derive_QICN_QLCN + ! + !------------------------------------------------------- + ! + subroutine export_to_HISTORY() + + IF (ASSOCIATED(PS0)) THEN call MAPL_GetPointer ( EXPORT, PSexp, 'PS', __RC__ ) - PSexp = PSimp - call MAPL_GetPointer ( IMPORT, SLPimp, 'SLP', __RC__ ) + PSexp(:,:) = PS0 + ENDIF + + call MAPL_GetPointer ( IMPORT, SLPimp, 'SLP', __RC__ ) + IF (ASSOCIATED(SLPimp)) THEN 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__ ) + ENDIF + + call MAPL_GetPointer ( IMPORT, PHISimp, 'PHIS', __RC__ ) + IF (ASSOCIATED(PHISimp)) THEN + call MAPL_GetPointer ( EXPORT, PHISexp, 'PHIS_input', __RC__ ) PHISexp = PHISimp - call MAPL_GetPointer ( IMPORT, DELPimp, 'DELP', __RC__ ) + ENDIF + + IF (ASSOCIATED(PLE)) THEN call MAPL_GetPointer ( EXPORT, DELPexp, 'DELP', __RC__ ) - DELPexp = DELPimp + call compute_DELP(DELPexp, PLE) + ENDIF + IF (ASSOCIATED(QITOT)) THEN call MAPL_GetPointer ( EXPORT, QITOTexp, 'QITOT', __RC__ ) QITOTexp = QITOT + ENDIF + + IF (ASSOCIATED(QLTOT)) THEN 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 + ENDIF + + IF (ASSOCIATED(Q)) THEN call MAPL_GetPointer ( EXPORT, Q_exp, 'Q', __RC__ ) Q_exp = Q + ENDIF + + IF (ASSOCIATED(TS)) THEN call MAPL_GetPointer ( EXPORT, TSexp, 'TS', __RC__ ) TSexp = TS - END IF + ENDIF - END IF ! .NOT. enable_pTracers + end subroutine export_to_HISTORY - call MAPL_TimerOff(ggState,"RUN") - call MAPL_TimerOff(ggState,"TOTAL") + 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 - ! All Done - ! -------- - RETURN_(ESMF_SUCCESS) + KM = SIZE(DELP, 3) - end subroutine Run + 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 @@ -1135,13 +1496,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 @@ -1292,123 +1653,6 @@ subroutine airdens_ ( AIRDENS, PLE, TH, Q, im, jm, lm ) end subroutine airdens_ !EOC !----------------------------------------------------------------------- -!BOP - function compAreaWeightedAverage_2d (var2D, vm, cellArea) result(wAverage) -! -! !INPUT PARAMETER: - real :: var2D(:,:) - real :: cellArea(:,:) - type (ESMF_VM) :: VM -! -! RETURNED VALUE: - real :: wAverage -! -! DESCRIPTION: -! Computes the area weighted average of a 2d variable. -! -!EOP -!----------------------------------------------------------------------- -!BOC - logical, save :: first = .true. - real(r8) , save :: sumArea - real(r8) :: sumWeight - integer :: ik, im, jm, STATUS, RC - real(r8), pointer :: weightVals(:,:) - real(r8) :: sumWeight_loc, sumArea_loc - character(len=ESMF_MAXSTR) :: IAm = 'compAreaWeightedAverage_2d' - - ! Determine the earth surface area - if (first) then - sumArea_loc = SUM( cellArea (:,:) ) - call MAPL_CommsAllReduceSum(vm, sendbuf= sumArea_loc, & - recvbuf= sumArea, & - cnt=1, RC=status) - VERIFY_(STATUS) - - first = .false. - end if - - im = size(cellArea,1) - jm = size(cellArea,2) - - allocate(weightVals(im,jm)) - weightVals(:,:) = cellArea(:,:)*var2D(:,:) - - sumWeight_loc = SUM( weightVals(:,:) ) - - call MAPL_CommsAllReduceSum(vm, sendbuf= sumWeight_loc, recvbuf= sumWeight, & - cnt=1, RC=status) - VERIFY_(STATUS) - - wAverage = sumWeight/sumArea - - deallocate(weightVals) - - return - - end function compAreaWeightedAverage_2d -!EOC -!----------------------------------------------------------------------- -!BOP - function compAreaWeightedAverage_3d (var3D, vm, cellArea) result(wAverage) -! -! !INPUT PARAMETER: - real :: var3D(:,:,:) - real :: cellArea(:,:) - type (ESMF_VM) :: VM -! -! RETURNED VALUE: - real :: wAverage -! -! DESCRIPTION: -! Computes the area weighted average of a 3d variable. -! -!EOP -!----------------------------------------------------------------------- -!BOC - logical, save :: first = .true. - real(r8) , save :: sumArea - real(r8) :: sumWeight - integer :: ik, im, jm, STATUS, RC - real(r8), pointer :: weightVals(:,:) - real(r8) :: sumWeight_loc, sumArea_loc - character(len=ESMF_MAXSTR) :: IAm = 'compAreaWeightedAverage_3d' - - ! Determine the earth surface area - if (first) then - sumArea_loc = SUM( cellArea (:,:) ) - call MAPL_CommsAllReduceSum(vm, sendbuf= sumArea_loc, & - recvbuf= sumArea, & - cnt=1, RC=status) - VERIFY_(STATUS) - - first = .false. - end if - - im = size(cellArea,1) - jm = size(cellArea,2) - - allocate(weightVals(im,jm)) - weightVals(:,:) = 0.0d0 - DO ik = lbound(var3D,3), ubound(var3D,3) - weightVals(:,:) = weightVals(:,:) + cellArea(:,:)*var3D(:,:,ik) - END DO - - sumWeight_loc = SUM( weightVals(:,:) ) - - call MAPL_CommsAllReduceSum(vm, sendbuf= sumWeight_loc, recvbuf= sumWeight, & - cnt=1, RC=status) - VERIFY_(STATUS) - - wAverage = sumWeight/sumArea - - deallocate(weightVals) - - return - - end function compAreaWeightedAverage_3d -!EOC -!----------------------------------------------------------------------- !BOP ! !IROUTINE: computeFlashRate ! @@ -1536,63 +1780,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] ! ---------------- diff --git a/src/Components/GEOSctm_GridComp/GEOS_ctmGridCompMod.F90 b/src/Components/GEOSctm_GridComp/GEOS_ctmGridCompMod.F90 index d3ca6d9..a6aa186 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,78 @@ 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 ) - VERIFY_(STATUS) + call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, __RC__ ) 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,165 +223,166 @@ 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 + 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 + ! EXPORT States for Increment Bundles: !--------------- call MAPL_AddExportSpec(GC, & 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,21 @@ 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 @@ -430,8 +453,8 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Add the AK and BK information ! ----------------------------- - call ESMF_GridCompGet(GC,grid=grid,__RC__) - call MAPL_GridGet(grid, globalCellCountPerDim=counts,__RC__) + call ESMF_GridCompGet(GC,grid=grid, __RC__) + call MAPL_GridGet(grid, globalCellCountPerDim=counts, __RC__) lm = counts(3) allocate(ak(lm+1),stat=status) VERIFY_(STATUS) @@ -439,68 +462,66 @@ subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) VERIFY_(STATUS) call set_eta(lm,ls,ptop,pint,ak,bk) call ESMF_AttributeSet(grid,name='GridAK', itemCount=LM+1, & - valuelist=ak,rc=status) - VERIFY_(STATUS) + valuelist=ak, __RC__) call ESMF_AttributeSet(grid,name='GridBK', itemCount=LM+1, & - valuelist=bk,rc=status) - VERIFY_(STATUS) + valuelist=bk, __RC__) 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 +529,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 +578,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 +609,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,26 +739,30 @@ 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 !----------------------------------- - call MAPL_GetObjectFromGC ( GC, STATE, RC=STATUS) - VERIFY_(STATUS) + call MAPL_GetObjectFromGC ( GC, STATE, __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 !------------------------------------------------- @@ -752,16 +771,14 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) IM = IM, JM = JM, LM = LM, & GCNames = GCNames, & INTERNAL_ESMF_STATE = INTERNAL, & - RC=STATUS ) - VERIFY_(STATUS) + __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 +795,43 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Initialize Dynamics increment bundle !-------------------------------------------- - call Initialize_IncBundle_run(GIM(ADV3), EXPORT, DYNinc, __RC__) + call Initialize_IncBundle_run(GIM(CTM_STATE%ADV3), EXPORT, DYNinc, __RC__) - IF (do_ctmAdvection) THEN - I=ADV3 - 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(CTM_STATE%ADV3) ) ! 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 ! Initialize Moist increment bundle !---------------------------------- - call Initialize_IncBundle_run(GIM(CONV), EXPORT, MTRIincCTM, __RC__) + call Initialize_IncBundle_run(GIM(CTM_STATE%CONV), EXPORT, MTRIincCTM, __RC__) - I=CONV + I=CTM_STATE%CONV call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), & @@ -827,14 +844,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(CTM_STATE%CONV), 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 +868,13 @@ subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) !---------- ! Diffusion !---------- - IF (do_ctmDiffusion) THEN + IF (CTM_STATE%do_ctmDiffusion) THEN ! Initialize Diffusion increment bundle !---------------------------------- - call Initialize_IncBundle_run(GIM(DIFF), EXPORT, TRIincCTM, __RC__) + call Initialize_IncBundle_run(GIM(CTM_STATE%DIFF), EXPORT, TRIincCTM, __RC__) - I=DIFF + I=CTM_STATE%DIFF call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), & @@ -870,14 +887,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(CTM_STATE%DIFF), 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 +908,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), &