! +-======-+ ! Copyright (c) 2003-2018 United States Government as represented by ! the Admistrator of the National Aeronautics and Space Administration. ! All Rights Reserved. ! ! THIS OPEN SOURCE AGREEMENT ("AGREEMENT") DEFINES THE RIGHTS OF USE, ! REPRODUCTION, DISTRIBUTION, MODIFICATION AND REDISTRIBUTION OF CERTAIN ! COMPUTER SOFTWARE ORIGINALLY RELEASED BY THE UNITED STATES GOVERNMENT AS ! REPRESENTED BY THE GOVERNMENT AGENCY LISTED BELOW ("GOVERNMENT AGENCY"). ! THE UNITED STATES GOVERNMENT, AS REPRESENTED BY GOVERNMENT AGENCY, IS AN ! INTENDED THIRD-PARTY BENEFICIARY OF ALL SUBSEQUENT DISTRIBUTIONS OR ! REDISTRIBUTIONS OF THE SUBJECT SOFTWARE. ANYONE WHO USES, REPRODUCES, ! DISTRIBUTES, MODIFIES OR REDISTRIBUTES THE SUBJECT SOFTWARE, AS DEFINED ! HEREIN, OR ANY PART THEREOF, IS, BY THAT ACTION, ACCEPTING IN FULL THE ! RESPONSIBILITIES AND OBLIGATIONS CONTAINED IN THIS AGREEMENT. ! ! Government Agency: National Aeronautics and Space Administration ! Government Agency Original Software Designation: GSC-15354-1 ! Government Agency Original Software Title: GEOS-5 GCM Modeling Software ! User Registration Requested. Please Visit http://opensource.gsfc.nasa.gov ! Government Agency Point of Contact for Original Software: ! Dale Hithon, SRA Assistant, (301) 286-2691 ! ! +-======-+ ! $Id$ #include "MAPL_Generic.h" #define debug 0 !============================================================================= !BOP ! !MODULE: GEOS_PhysicsGridCompMod -- A Module to combine Short-Wave, Long-Wave Radiation Moist-Physics and Turbulence Gridded Components ! !INTERFACE: module GEOS_PhysicsGridCompMod ! !USES: use ESMF use MAPL_Mod use m_chars, only: uppercase use GEOS_SurfaceGridCompMod, only : SurfSetServices => SetServices use GEOS_MoistGridCompMod, only : MoistSetServices => SetServices use GEOS_TurbulenceGridCompMod, only : TurblSetServices => SetServices use GEOS_RadiationGridCompMod, only : RadiationSetServices => SetServices use GEOS_ChemGridCompMod, only : AChemSetServices => SetServices use GEOS_GwdGridCompMod, only : GwdSetServices => SetServices ! PGI Module that contains the initialization ! routines for the GPUs #ifdef _CUDA use cudafor #endif implicit none private ! !PUBLIC MEMBER FUNCTIONS: public SetServices !============================================================================= ! !DESCRIPTION: This gridded component (GC) combines the Radiation (Short-Wave and Long-Wave), ! Moist-Physics, Chem, Surface and Turbulence GCs into a new composite Physics GC. ! The Export Couplings of the Physics GC are the union of the Export ! Couplings of the individual child GCs, plus the combined tendencies needed by ! the dynamics. These last are the pressure-weighted tendencies of the atmospheric ! state variables U,V,T (due to external diabatic forcing), the tendency of the ! edge pressures, and a collection of "Friendly" tracers for advection. In the current ! version, the only friendly tracers are variables from Moist-Physics and Chem. ! !\begin{verbatim} ! DUDT .... Mass-Weighted U-Wind Tendency (Pa m /s) ! DVDT .... Mass-Weighted V-Wind Tendency (Pa m /s) ! DPEDT ... Edge-Pressure Tendency (Pa /s) ! DTDT .... Mass-Weighted Temperature Tendency (Pa K /s) ! TRACER .. Friendly Tracers (unknown) !\end{verbatim} !EOP integer :: GWD integer :: SURF integer :: CHEM integer :: MOIST integer :: TURBL integer :: RAD contains !BOP ! !IROUTINE: SetServices -- Sets ESMF services for this component ! !INTERFACE: subroutine SetServices ( GC, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(INOUT) :: GC ! gridded component integer, intent( OUT) :: RC ! return code ! !DESCRIPTION: The SetServices for the Physics GC needs to register its ! Initialize and Run. It uses the MAPL\_Generic construct for defining ! state specs and couplings among its children. In addition, it creates the ! children GCs (SURF, CHEM, RADIATION, MOIST, TURBULENCE) and runs their ! respective SetServices. !EOP !============================================================================= ! ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Locals type (MAPL_MetaComp), pointer :: MAPL CHARACTER(LEN=ESMF_MAXSTR) :: RATsProviderName integer :: I type (ESMF_Config) :: CF integer :: DO_OBIO, DO_CO2CNNEE, DO_CO2SC real :: SYNCTQ !============================================================================= ! Begin... ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'SetServices' call ESMF_GridCompGet( GC, NAME=COMP_NAME, CONFIG=CF, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // "::" // Iam ! 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 ) VERIFY_(STATUS) ! Create children`s gridded components and invoke their SetServices ! ----------------------------------------------------------------- ! Note chemistry must be added before surface so that chemistry has ! a change to put the fields in the AERO_DP bundle. Otherwise when ! surface reads the import restart AERO_DP will be empty and it will ! not be properly restarted GWD = MAPL_AddChild(GC, NAME='GWD', SS=GwdSetServices, RC=STATUS) VERIFY_(STATUS) MOIST = MAPL_AddChild(GC, NAME='MOIST', SS=MoistSetServices, RC=STATUS) VERIFY_(STATUS) TURBL = MAPL_AddChild(GC, NAME='TURBULENCE', SS=TurblSetServices, RC=STATUS) VERIFY_(STATUS) CHEM = MAPL_AddChild(GC, NAME='CHEMISTRY', SS=AChemSetServices, RC=STATUS) VERIFY_(STATUS) SURF = MAPL_AddChild(GC, NAME='SURFACE', SS=SurfSetServices, RC=STATUS) VERIFY_(STATUS) RAD = MAPL_AddChild(GC, NAME='RADIATION', SS=RadiationSetServices, RC=STATUS) VERIFY_(STATUS) ! Set the state variable specs. ! ----------------------------- call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource ( MAPL, DO_OBIO, Label="USE_OCEANOBIOGEOCHEM:",DEFAULT=0, RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource ( MAPL, DO_CO2CNNEE, Label="USE_CNNEE:",DEFAULT=0, RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource ( MAPL, DO_CO2SC, Label="USE_CO2SC:",DEFAULT=0, RC=STATUS) VERIFY_(STATUS) ! AMM - get SYNCTQ flag from config to know whether to terminate some imports ! --------------------------------------------------------------------------- call MAPL_GetResource ( MAPL, SYNCTQ, Label="SYNCTQ:", DEFAULT= 1.0, RC=STATUS) VERIFY_(STATUS) !BOS ! !IMPORT STATE: call MAPL_AddImportSpec(GC, & SHORT_NAME = 'U', & LONG_NAME = 'eastward_wind', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'V', & LONG_NAME = 'northward_wind', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'DZ', & LONG_NAME = 'surface_layer_height', & UNITS = 'm', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'TH', & LONG_NAME = 'potential_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'T', & LONG_NAME = 'air_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'S', & LONG_NAME = 'dry_static_energy', & UNITS = 'm+2 s-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'ZLE', & LONG_NAME = 'geopotential_height', & UNITS = 'm', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'PLE', & LONG_NAME = 'air_pressure', & UNITS = 'Pa', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'AREA', & LONG_NAME = 'Grid-Cell Area', & UNITS = 'm+2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) ! !EXPORT STATE: call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DTDT', & LONG_NAME = 'pressure_weighted_tendency_of_air_temperature_due_to_physics', & UNITS = 'Pa K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DTDTTOT', & LONG_NAME = 'tendency_of_air_temperature_due_to_physics', & UNITS = 'K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DTDTRAD', & LONG_NAME = 'tendency_of_air_temperature_due_to_radiation', & UNITS = 'K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DUDT', & LONG_NAME = 'tendency_of_eastward_wind_due_to_physics', & UNITS = 'm s-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DVDT', & LONG_NAME = 'tendency_of_northward_wind_due_to_physics', & UNITS = 'm s-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DPDTPHY', & LONG_NAME = 'tendency_of_pressure_at_bottom_edges_levels_due_to_physics',& UNITS = 'Pa s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DPEDT', & LONG_NAME = 'tendency_of_pressure_at_layer_edges_due_to_physics',& UNITS = 'Pa s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DMDT', & LONG_NAME = 'vertically_integrated_mass_tendency_due_to_physics', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'THIM', & LONG_NAME = 'pressure_weighted_tendency_of_potential_temperature_due_to_moist_processes',& UNITS = 'Pa K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TIM', & LONG_NAME = 'tendency_of_air_temperature_due_to_moist_processes',& UNITS = 'K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TIMFRIC', & LONG_NAME = 'tendency_of_air_temperature_due_to_moist_processes_friction',& UNITS = 'K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SIT', & LONG_NAME = 'pressure_weighted_tendency_of_dry_static_energy_due_to_turbulence',& UNITS = 'Pa m+2 s-3', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TIT', & LONG_NAME = 'tendency_of_air_temperature_due_to_turbulence', & UNITS = 'K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'UIT', & LONG_NAME = 'tendency_of_eastward_wind_due_to_turbulence', & UNITS = 'm s-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'VIT', & LONG_NAME = 'tendency_of_northward_wind_due_to_turbulence', & UNITS = 'm s-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'QVIT', & LONG_NAME = 'tendency_of_specific_humidity_due_to_turbulence', & UNITS = 'kg kg-1 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'QLLSIT', & LONG_NAME = 'tendency_of_liquid_condensate_due_to_turbulence', & UNITS = 'kg kg-1 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'QILSIT', & LONG_NAME = 'tendency_of_frozen_condensate_due_to_turbulence', & UNITS = 'kg kg-1 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'OXIT', & LONG_NAME = 'tendency_of_odd_oxygen_due_to_turbulence', & UNITS = 'mol mol-1 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'OXIM', & LONG_NAME = 'tendency_of_odd_oxygen_due_to_moist_processes', & UNITS = 'mol mol-1 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TIF', & LONG_NAME = 'tendency_of_air_temperature_due_to_friction', & UNITS = 'K s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TRADV ', & LONG_NAME = 'advected_quantities', & UNITS = 'X', & DATATYPE = MAPL_BundleItem, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'upward_net_turbulence_heat_flux', & UNITS = 'W m-2', & SHORT_NAME = 'FTB', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'upward_net_turbulence_eastward_momentum_flux', & UNITS = 'm+2 s-2', & SHORT_NAME = 'FTU', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'upward_net_turbulence_northward_momentum_flux', & UNITS = 'm+2 s-2', & SHORT_NAME = 'FTV', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TRANA', & LONG_NAME = 'analyzed_quantities', & UNITS = 'X', & DATATYPE = MAPL_BundleItem, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'KEPHY', & LONG_NAME = 'vertically_integrated_kinetic_energy_tendency_across_physics', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PEPHY', & LONG_NAME = 'vertically_integrated_potential_energy_tendency_across_physics', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PERAD', & LONG_NAME = 'vertically_integrated_potential_energy_tendency_across_radiation', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PETRB', & LONG_NAME = 'vertically_integrated_potential_energy_tendency_across_turbulence', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PEMST', & LONG_NAME = 'vertically_integrated_potential_energy_tendency_across_moist', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PEFRI', & LONG_NAME = 'vertically_integrated_potential_energy_tendency_due_to_friction', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PEGWD', & LONG_NAME = 'vertically_integrated_potential_energy_tendency_across_gwd', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( gc, & SHORT_NAME = 'PECUF', & LONG_NAME = 'vertically_integrated_potential_energy_tendency_due_to_cumulus_friction', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQVDTTRBINT', & LONG_NAME = 'vertically_integrated_water_vapor_tendency_due_to_turbulence', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQVDTMSTINT', & LONG_NAME = 'vertically_integrated_water_vapor_tendency_due_to_moist_processes', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQVDTCHMINT', & LONG_NAME = 'vertically_integrated_water_vapor_tendency_due_to_chemistry', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQLDTMSTINT', & LONG_NAME = 'vertically_integrated_liquid_water_tendency_due_to_moist_processes',& UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQIDTMSTINT', & LONG_NAME = 'vertically_integrated_ice_tendency_due_to_moist_processes', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DOXDTCHMINT', & LONG_NAME = 'vertically_integrated_odd_oxygen_tendency_due_to_chemistry', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQVDTPHYINT', & LONG_NAME = 'vertically_integrated_water_vapor_tendency_due_to_physics', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQLDTPHYINT', & LONG_NAME = 'vertically_integrated_liquid_water_tendency_due_to_physics', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQIDTPHYINT', & LONG_NAME = 'vertically_integrated_ice_tendency_due_to_physics', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DOXDTPHYINT', & LONG_NAME = 'vertically_integrated_odd_oxygen_tendency_due_to_physics', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQVDTSCL', & LONG_NAME = 'tendency_of_water_vapor_due_to_mass_scaling', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQLDTSCL', & LONG_NAME = 'tendency_of_cloud_water_due_to_mass_scaling', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DQIDTSCL', & LONG_NAME = 'tendency_of_cloud_ice_due_to_mass_scaling', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & RC=STATUS ) VERIFY_(STATUS) ! Ozone and Oxygen volume mixing ratio in ppmv (not mol/mol) ! ---------------------------------------------------------- call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'O3PPMV', & CHILD_ID = CHEM, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'OX', & CHILD_ID = CHEM, & RC=STATUS ) VERIFY_(STATUS) ! The following are exported up for Atmos Ana purposes ! ---------------------------------------------------- call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'Q', & CHILD_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'QCTOT', & CHILD_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'U10M', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'V10M', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'U10N', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'V10N', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'SNOMAS', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'WET1', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'TSOIL1', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'LWI', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'TS', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'FRLAND', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'FRLANDICE', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'FRLAKE', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'FROCEAN', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'FRACI', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec ( GC , & SHORT_NAME = 'Z0', & CHILD_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) !EOS ! Set internal connections between the children`s IMPORTS and EXPORTS ! ------------------------------------------------------------------- ! !CONNECTIONS: ! Turbulence imports !------------------- call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/ 'RADLW ', 'RADLWC' /), & DST_ID = TURBL, & SRC_ID = RAD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'QV ','QLLS','QILS','QLCN', & 'QICN','CLLS','CLCN' /), & DST_ID = TURBL, & SRC_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'CT ','CM ','CQ ', & 'BSTAR','USTAR' /), & DST_ID = TURBL, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) ! Radiation Imports !------------------- call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'QV ','QL ','QI ','QR ','QS ', & 'QLLS ','QILS ','QLCN ','QICN ', & 'QRTOT','QSTOT', & 'RL ','RR ','RI ','RS ','FCLD ' /), & DST_ID = RAD, & SRC_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'ALBVR ','ALBVF ','ALBNR ','ALBNF ', & 'EMIS ','TS ', & 'FRLAND ','FROCEAN' /), & DST_ID = RAD, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) ! ----------------------------------------------------------------- ! Radiatively active species and required units ! Specie Units Contents ! ------ ------- ------------------- ! OX mol/mol Odd oxygen or ozone volume mixing ratio ! O3 kg/kg Ozone mass fraction ! CH4 mol/mol Methane ! N2O mol/mol Nitrous oxide ! CFC11 mol/mol CFC-11 (CCl3F) ! CFC12 mol/mol CFC-12 (CCl2F2) ! HCFC22 mol/mol HCFC-22 (CHClF2) ! ----------------------------------------------------------------- CALL MAPL_AddConnectivity( GC, & SHORT_NAME = (/'OX ','O3 ','CH4 ','N2O ', & 'CFC11 ','CFC12 ','HCFC22' /), & DST_ID=RAD, SRC_ID=CHEM, RC=STATUS ) VERIFY_(STATUS) ! ----------------------------------------------------------------- call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AERO'/), & DST_ID = RAD, & SRC_ID = CHEM, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SRC_NAME = 'TS', & DST_NAME = 'TSINST', & SRC_ID = SURF, & DST_ID = RAD, & RC=STATUS ) VERIFY_(STATUS) ! Surface Imports !---------------- call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'PCU','PLS','SNO' /), & DST_ID = SURF, & SRC_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'ALW ','BLW ', & 'DRPARN','DFPARN','DRNIRN', & 'DFNIRN','DRUVRN','DFUVRN' /), & DST_ID = SURF, & SRC_ID = RAD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SRC_NAME = 'LWS0', & DST_NAME = 'LWDNSRF', & SRC_ID = RAD, & DST_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) IF((DO_OBIO /= 0) .OR. (DO_CO2SC /= 0)) THEN call MAPL_AddConnectivity ( GC, & SRC_NAME = 'CO2SC001', & DST_NAME = 'CO2SC', & SRC_ID = CHEM, & DST_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) ENDIF call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AERO_DP'/), & SRC_ID = CHEM, & DST_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'FSWBAND ', 'FSWBANDNA'/), & SRC_ID = RAD, & DST_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) ! Imports for GWD !---------------- call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'Q ','QI ','LS_PRCP'/), & DST_ID = GWD, & SRC_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) ! Chemistry Imports ! ----------------- call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/ 'Q ', 'RH2 ', 'CN_PRCP ', & 'TPREC ', 'SNO ', 'DQDT ', & 'FCLD ', 'LS_PRCP ', 'CNV_MFC ', & 'CNV_MFD ', 'QL ', 'PFL_CN ', & 'PFL_LSAN', 'PFI_CN ', 'PFI_LSAN', & 'QCTOT ', 'CNV_QC ', 'LFR ', & 'QLTOT ', 'QLCN ', 'QICN ' /), & DST_ID = CHEM, & SRC_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'ZPBL'/), & DST_ID = CHEM, & SRC_ID = TURBL, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/ 'LWI ', 'FRLAND ', 'FRLANDICE', & 'FROCEAN ', 'FRLAKE ', 'WET1 ', & 'GRN ', 'USTAR ', 'U10M ', & 'V10M ', 'SH ', 'Z0H ', & 'LAI ', 'TSOIL1 ', 'FRACI ', & 'TA ', 'T2M ', 'SWNDSRF ', & 'ALBVF ', 'ASNOW ', 'U10N ', & 'V10N ', 'TS ', 'CM ', & 'CN ', 'RHOS ', 'WET2 ', & 'SNOMAS ', 'SNOWDP ' /), & DST_ID = CHEM, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) if (DO_CO2CNNEE == 1) then call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'CNNEE'/), & DST_ID = CHEM, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) endif call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/ 'TAUCLI', 'TAUCLW', 'CLDTT ', & 'DFPAR ', 'DRPAR ' /), & DST_ID = CHEM, & SRC_ID = RAD, & RC=STATUS ) VERIFY_(STATUS) ! Moist Imports !-------------- call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'KH ','KPBL ','KPBL_SC', & 'TKE '/), & DST_ID = MOIST, & SRC_ID = TURBL, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'TS'/), & DST_ID = MOIST, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'FRLAND ','FROCEAN'/), & DST_ID = MOIST, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'FRLAND','EVAP ','SH '/), & DST_ID = TURBL, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) !-srf-gf-scheme call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'USTAR', 'TSTAR', 'QSTAR', 'T2M ', & 'Q2M ', 'TA ', 'QA ', 'SH ', & 'EVAP ' & /), & DST_ID = MOIST, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) !-srf-gf-scheme !-------------- DONIF Additional Moist Imports call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'VSCSFC'/), & DST_ID = MOIST, & SRC_ID = TURBL, & RC=STATUS ) VERIFY_(STATUS) !Aerosol call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'AERO_ACI'/), & DST_ID = MOIST, & SRC_ID = CHEM, & RC=STATUS ) VERIFY_(STATUS) !Gravity wave drag parameters for subgrid scale V call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'TAUGWX'/), & DST_ID = MOIST, & SRC_ID = GWD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'TAUGWY'/), & DST_ID = MOIST, & SRC_ID = GWD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'TAUOROX'/), & DST_ID = MOIST, & SRC_ID = GWD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'TAUOROY'/), & DST_ID = MOIST, & SRC_ID = GWD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'RADLW'/), & DST_ID = MOIST, & SRC_ID = RAD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'RADSW'/), & DST_ID = MOIST, & SRC_ID = RAD, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'ALH'/), & DST_ID = MOIST, & SRC_ID = TURBL, & RC=STATUS ) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'TAUX', 'TAUY'/), & DST_ID = MOIST, & SRC_ID = SURF, & RC=STATUS ) VERIFY_(STATUS) ! New connections needed for NCEP GWD call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'KPBL'/), & DST_ID = GWD, & SRC_ID = TURBL, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddConnectivity ( GC, & SHORT_NAME = (/'DTDT_moist','CNV_FRC '/), & DST_ID = GWD, & SRC_ID = MOIST, & RC=STATUS ) VERIFY_(STATUS) !EOP ! Disable connectivities of Surface imports that are filled manually from ! turbulence bundles. !------------------------------------------------------------------------ call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'SH ','TAUX ','TAUY ','EVAP ','DEWL ','FRSL ', & 'DSH ','DFU ','DFV ','DEVAP','DDEWL','DFRSL', & 'UA ','VA ' /), & CHILD = SURF, & RC=STATUS ) VERIFY_(STATUS) !AMM terminate TA import - will fill it here with value after moist if ( SYNCTQ.eq.1.) then call MAPL_TerminateImport ( GC, & SHORT_NAME = (/ 'TA ' /), & CHILD = SURF, & RC=STATUS ) VERIFY_(STATUS) endif call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'TR ','TRG','DTG' /), & CHILD = TURBL, & RC=STATUS ) VERIFY_(STATUS) !AMM terminate T and TH imports to turb - will fill it here with value after moist if ( SYNCTQ.eq.1.) then call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'T ','TH' /), & CHILD = TURBL, & RC=STATUS ) VERIFY_(STATUS) endif call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'MTR'/), & CHILD = MOIST, & RC=STATUS) VERIFY_(STATUS) !AMM terminate TH import to moist - will fill it here with value after gwd if ( SYNCTQ.eq.1.) then call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'TH'/), & CHILD = MOIST, & RC=STATUS) VERIFY_(STATUS) endif !AMM terminate TH import for chem - will fill it here with value after turb if ( SYNCTQ.eq.1.) then call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'TH'/), & CHILD = CHEM, & RC=STATUS) VERIFY_(STATUS) !AMM terminate T import for RAD - will fill it here with value after turb call MAPL_TerminateImport ( GC, & SHORT_NAME = (/'T'/), & CHILD = RAD, & RC=STATUS) VERIFY_(STATUS) endif call MAPL_TimerAdd(GC, name="INITIALIZE" ,RC=STATUS) VERIFY_(STATUS) ! Set a profiling timer for GPU initialization ! -------------------------------------------- #ifdef _CUDA call MAPL_TimerAdd(GC, name="-GPUINIT" ,RC=STATUS) VERIFY_(STATUS) #endif call MAPL_TimerAdd(GC, name="RUN" ,RC=STATUS) VERIFY_(STATUS) call MAPL_GenericSetServices ( GC, RC=STATUS ) VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) end subroutine SetServices !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !IROUTINE: Initialize -- Initialize method for the composite Physics Gridded Component ! !INTERFACE: subroutine Initialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code ! !DESCRIPTION: The Initialize method of the Physics Composite Gridded Component. ! It acts as a driver for the initializtion of the five children: Radiation, ! Turbulence, Moist, Chem, and Surface. It also sets up the frieldly connections ! between the children and their sibling Turbulence, as well as with their ! ``uncles'' Advection and Analysis. ! ! For the turbulence tracer bundle, U and V come from ! the import state, S is computed here from T and Z and kept ! in the export state, the rest are friendlies from MOIST and CHEM. ! ! The turbulence default behavior is a friendly with a zero flux ! lower boundary condition and not producing a tendency. ! Default tracers are put at the end of the bundles with a single ! call; all others have to be done manually. ! ! Any of the children`s exports that are friendly to advection or analysis ! are put in the respective bundles by a single MAPL_Generic call. Remember ! that friendly exports are were automatically allocated by the children ! during the initialization sequence of the entire tree below Physics, which ! is the first thing done here. ! The increment tracer bundles for Moist and Turbulence are created with empty fields ! except for those tracers which have explicit tendency Exports. ! !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Local derived type aliases type (MAPL_MetaComp), pointer :: STATE type (ESMF_GridComp), pointer :: GCS(:) type (ESMF_State), pointer :: GIM(:) type (ESMF_State), pointer :: GEX(:) type (ESMF_FieldBundle) :: BUNDLE, iBUNDLE type (ESMF_Field) :: FIELD type (ESMF_Grid) :: GRID integer :: NUM_TRACERS integer :: I integer :: NA character(len=ESMF_MAXSTR), pointer :: NAMES(:) character(len=ESMF_MAXSTR) :: myNAME character(len=ESMF_MAXSTR) :: iNAME ! Variables needed for GPU initialization #ifdef _CUDA type (ESMF_VM) :: VM integer :: MYID ! MPI Rank integer :: NCPUS ! MPI Size integer :: num_devices integer :: devicenum, inum #endif !============================================================================= ! Begin... ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- !define PRINT_STATES Iam = "Initialize" call ESMF_GridCompGet ( GC, name=COMP_NAME, GRID=GRID, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // "::" // Iam ! Get my MAPL_Generic state !-------------------------- call MAPL_GetObjectFromGC ( GC, STATE, RC=STATUS) VERIFY_(STATUS) #ifdef _CUDA ! Initialize the GPUs ! ------------------- !! Step One: Get our rank and size !! ------------------------------- call ESMF_VmGetCurrent(VM, rc=status) VERIFY_(STATUS) call ESMF_VmGet(VM, localPet=MYID, petCount=NCPUS, rc=STATUS) VERIFY_(STATUS) !! Step Two: Initialize the GPUs !! ----------------------------- call MAPL_TimerOn(STATE,"TOTAL") call MAPL_TimerOn(STATE,"INITIALIZE") call MAPL_TimerOn(STATE,"-GPUINIT") STATUS = cudaGetDeviceCount(num_devices) if (STATUS /= 0) then write (*,*) "cudaGetDeviceCount failed: ", cudaGetErrorString(STATUS) ASSERT_(.FALSE.) end if devicenum = mod(MYID, num_devices) STATUS = cudaSetDevice(devicenum) if (STATUS /= 0) then write (*,*) "cudaSetDevice failed: ", cudaGetErrorString(STATUS) ASSERT_(.FALSE.) end if STATUS = cudaDeviceSetCacheConfig(cudaFuncCachePreferL1) if (STATUS /= 0) then write (*,*) "cudaDeviceSetCacheConfig failed: ", cudaGetErrorString(STATUS) ASSERT_(.FALSE.) end if call MAPL_TimerOff(STATE,"-GPUINIT") call MAPL_TimerOff(STATE,"INITIALIZE") call MAPL_TimerOff(STATE,"TOTAL") #endif ! Call Initialize for every Child !-------------------------------- call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) VERIFY_(STATUS) call MAPL_TimerOn(STATE,"TOTAL") call MAPL_TimerOn(STATE,"INITIALIZE") #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": IMPORT State" ) if ( MAPL_am_I_root() ) call ESMF_StatePrint ( IMPORT, rc=STATUS ) call WRITE_PARALLEL ( trim(Iam)//": EXPORT State" ) if ( MAPL_am_I_root() ) call ESMF_StatePrint ( EXPORT, rc=STATUS ) #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) ! Fill the turbulence tracer bundle: S, U, and V come from ! the import state, the rest are friendlies from MOIST and CHEM. ! For now, only S, U, V, and QV are non-default. Default tracers go last ! in the bundle. This will have to be done better later by using ! a default attribute. ! ! The turbulence default behavior is a friendly with a zero flux ! boundary condition, Default tracers do not expect a surface values ! and do not produce produce a tendency or other products. ! ! Default tracers are put at the end of the bundles with a single ! call; all others have to be done manually. ! ----------------------------------------------------------------- call ESMF_StateGet (GIM(TURBL), 'TR' , BUNDLE, RC=STATUS ) VERIFY_(STATUS) ! Add Non-Friendlies from Dynamics call ESMF_StateGet (IMPORT, 'S' , FIELD, RC=STATUS ) VERIFY_(STATUS) call ESMF_AttributeSet(FIELD, NAME="DiffuseLike" ,VALUE="S", RC=STATUS ) VERIFY_(STATUS) call ESMF_AttributeSet(FIELD, NAME="WeightedTendency",VALUE=.TRUE., RC=STATUS ) VERIFY_(STATUS) call MAPL_FieldBundleAdd (BUNDLE, FIELD, RC=STATUS ) VERIFY_(STATUS) call ESMF_StateGet (IMPORT, 'U' , FIELD, RC=STATUS ) VERIFY_(STATUS) call ESMF_AttributeSet(FIELD, NAME="DiffuseLike" ,VALUE="U", RC=STATUS ) VERIFY_(STATUS) call MAPL_FieldBundleAdd (BUNDLE, FIELD, RC=STATUS ) VERIFY_(STATUS) call ESMF_StateGet (IMPORT, 'V' , FIELD, RC=STATUS ) VERIFY_(STATUS) call ESMF_AttributeSet(FIELD, NAME="DiffuseLike" ,VALUE="U", RC=STATUS ) VERIFY_(STATUS) call MAPL_FieldBundleAdd (BUNDLE, FIELD, RC=STATUS ) VERIFY_(STATUS) ! Add Friendlies from Moist (We assume QV is among these, all others are treated as default) call MAPL_GridCompGetFriendlies(GCS(MOIST) , "TURBULENCE", BUNDLE, RC=STATUS ) VERIFY_(STATUS) ! Add Friendlies from Chem (These are default tracers--zero surface flux) call MAPL_GridCompGetFriendlies(GCS(CHEM), "TURBULENCE", BUNDLE, RC=STATUS ) VERIFY_(STATUS) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Turbulence Tracer Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Count tracers !-------------- call ESMF_FieldBundleGet(BUNDLE,FieldCount=NUM_TRACERS, RC=STATUS) VERIFY_(STATUS) ! Get the names of all tracers to fill other turbulence bundles. !--------------------------------------------------------------- allocate(NAMES(NUM_TRACERS),STAT=STATUS) VERIFY_(STATUS) call ESMF_FieldBundleGet(BUNDLE, fieldNameList=NAMES, RC=STATUS) VERIFY_(STATUS) ! Fill the increments bundle that turbulence will export. ! These fields come from the physics EXPORT, ones not there ! will have an empty field. !------------------------------------------------------------ call ESMF_StateGet ( GEX(TURBL), 'TRI', BUNDLE, RC=STATUS ) VERIFY_(STATUS) do I=1,NUM_TRACERS select case (trim(NAMES(I))) case ('Q') iNAME = 'QVIT' case default iNAME = trim(NAMES(I)) // 'IT' end select call ESMFL_StateGetField (EXPORT, (/iNAME/), & BUNDLE, (/trim(NAMES(I))//'IT'/), RC=STATUS ) VERIFY_(STATUS) end do #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Turbulence Increment Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Fill the turbulence bundle of surface skin values !-------------------------------------------------- call ESMF_StateGet ( GIM(TURBL), 'TRG', BUNDLE, RC=STATUS ) VERIFY_(STATUS) do I=1,NUM_TRACERS iNAME = trim(NAMES(I)) // 'HAT' call ESMFL_StateGetField (GEX(SURF), (/iNAME/), BUNDLE, RC=STATUS ) VERIFY_(STATUS) end do #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Turbulence Surface Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Fill the turbulence bundle of changes of surface skin values !------------------------------------------------------------- call ESMF_StateGet ( GIM(TURBL), 'DTG', BUNDLE, RC=STATUS ) VERIFY_(STATUS) do I=1,NUM_TRACERS select case (trim(NAMES(I))) case('S') iNAME = 'DELSS' case('U') iNAME = 'DELUS' case('V') iNAME = 'DELVS' case('Q') iNAME = 'DELQS' case default iNAME = NAMES(I) end select call ESMFL_StateGetField (GEX(SURF), (/iNAME/), & BUNDLE, (/trim(NAMES(I))//'DEL'/), RC=STATUS ) VERIFY_(STATUS) end do #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Turbulence DTG Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Fill the turbulence FSTAR bundle (surface fluxes) !----------------------------------- call ESMF_StateGet ( GEX(TURBL), 'FSTAR', BUNDLE, RC=STATUS ) VERIFY_(STATUS) do I=1,NUM_TRACERS select case (trim(NAMES(I))) case('S') iNAME = 'SH' case('U') iNAME = 'TAUX' case('V') iNAME = 'TAUY' case('Q') iNAME = 'EVAP' case default iNAME = NAMES(I) end select call ESMFL_StateGetField (GIM(SURF), (/iNAME/), & BUNDLE, (/trim(NAMES(I))//'FLX'/), RC=STATUS ) VERIFY_(STATUS) end do #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Surface Flux Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Fill the turbulence DFSTAR bundle d(surface fluxes)/d(TG) !---------------------------------------------------------- call ESMF_StateGet ( GEX(TURBL), 'DFSTAR', BUNDLE, RC=STATUS ) VERIFY_(STATUS) do I=1,NUM_TRACERS select case (trim(NAMES(I))) case('S') iNAME = 'DSH' case('U') iNAME = 'DFU' case('V') iNAME = 'DFV' case('Q') iNAME = 'DEVAP' case default iNAME = NAMES(I) end select call ESMFL_StateGetField (GIM(SURF), (/iNAME/), & BUNDLE, (/trim(NAMES(I))//'DFL'/), RC=STATUS ) VERIFY_(STATUS) end do #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Surface Flux Derivative Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif deallocate(NAMES) ! Fill export bundle of child quantities to be advected !------------------------------------------------------ call ESMF_StateGet(EXPORT, 'TRADV', BUNDLE, RC=STATUS ) VERIFY_(STATUS) call MAPL_GridCompGetFriendlies(GCS, "DYNAMICS", BUNDLE, RC=STATUS ) VERIFY_(STATUS) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Advection Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Fill export bundle of child quantities to be analyzed !------------------------------------------------------ call ESMF_StateGet(EXPORT, 'TRANA', BUNDLE, RC=STATUS ) VERIFY_(STATUS) call MAPL_GridCompGetFriendlies(GCS, "ANALYSIS", BUNDLE, RC=STATUS ) VERIFY_(STATUS) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Analysis Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Fill export bundle of child quantities to go thru CONVECTIVE transport ! No need for tendencies at this point; scavenging may be controled by ! field attributes (TBD) !----------------------------------------------------------------------- call ESMF_StateGet (GIM(MOIST), 'MTR', BUNDLE, RC=STATUS ) VERIFY_(STATUS) call MAPL_GridCompGetFriendlies(GCS, "MOIST", BUNDLE, RC=STATUS ) VERIFY_(STATUS) #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Convective Transport Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( BUNDLE, rc=STATUS ) #endif ! Fill the moist increments bundle !--------------------------------- call ESMF_StateGet (GEX(MOIST), 'MTRI', iBUNDLE, RC=STATUS ) VERIFY_(STATUS) call ESMF_FieldBundleGet(BUNDLE, FieldCount=NA, RC=STATUS) VERIFY_(STATUS) do I=1,NA call ESMF_FieldBundleGet(BUNDLE, I, FIELD, RC=STATUS) VERIFY_(STATUS) call ESMF_FieldGet (FIELD, NAME=myNAME, RC=STATUS) VERIFY_(STATUS) iNAME = trim(myNAME) // 'IM' call ESMFL_StateGetField (EXPORT, (/iNAME/), iBUNDLE, RC=STATUS ) VERIFY_(STATUS) end do #ifdef PRINT_STATES call WRITE_PARALLEL ( trim(Iam)//": Convective Transport Tendency Bundle" ) if ( MAPL_am_I_root() ) call ESMF_FieldBundlePrint ( iBUNDLE, rc=STATUS ) #endif call MAPL_TimerOff(STATE,"INITIALIZE") call MAPL_TimerOff(STATE,"TOTAL") ! All Done !--------- RETURN_(ESMF_SUCCESS) end subroutine Initialize !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !BOP ! !IROUTINE: Run -- Run method for the composite Physics Gridded Component ! !INTERFACE: subroutine Run ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code ! !DESCRIPTION: The run method for the physics calls the children`s ! run methods. It also prepares inputs and couplings amongst them. ! Its main outputs are the combined tendencies needed by the dynamics. !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Local derived type aliases type (MAPL_MetaComp), pointer :: STATE type (MAPL_MetaComp), pointer :: MAPL_MOIST type (ESMF_GridComp), pointer :: GCS(:) type (ESMF_State), pointer :: GIM(:) type (ESMF_State), pointer :: GEX(:) type (ESMF_State) :: INTERNAL type (ESMF_State) :: INTERNAL_MOIST type (ESMF_Grid) :: grid type (ESMF_Config) :: CF type (ESMF_FieldBundle) :: BUNDLE character(len=ESMF_MAXSTR),pointer :: GCNames(:) character(len=ESMF_MAXSTR) :: DUMMY integer :: I, L, K, N integer :: IM, JM, LM, KM, NQ logical :: NEED_TOT logical :: NEED_FRI logical :: NEED_TTN logical :: NEED_STN logical :: DPEDT_PHYS real :: DT real :: SYNCTQ, DOPHYSICS real, pointer, dimension(:,:,:) :: S, T, ZLE, TH, PLE, U, V real, pointer, dimension(:,:,:) :: DM, DPI, TOT, FRI, TTN, STN real, pointer, dimension(:,:,:) :: QV, QLLS, QLCN, QILS, QICN, QW real, pointer, dimension(:,:,:) :: ptr3d real, pointer, dimension(:,:,:) :: DUDT real, pointer, dimension(:,:,:) :: DVDT real, pointer, dimension(:,:,:) :: DTDT real, pointer, dimension(:,:,:) :: DTDTTOT real, pointer, dimension(:,:,:) :: DTDTRAD real, pointer, dimension(:,:,:) :: DPDTPHY real, pointer, dimension(:,:,:) :: DPDT real, pointer, dimension(:,:) :: DMDT real, pointer, dimension(:,:,:) :: DOXDTCHM real, pointer, dimension(:,:,:) :: DQVDTMST, DQVDTTRB, DQVDTCHM real, pointer, dimension(:,:,:) :: DQLDTTRB, DQIDTTRB real, pointer, dimension(:,:,:) :: DQLDTSCL, DQIDTSCL, DQVDTSCL real, pointer, dimension(:,:,:) :: DQLDTMST, DQIDTMST real, pointer, dimension(:,:,:) :: DPDTMST, DPDTTRB real, pointer, dimension(:,:,:) :: TIR, TIM, TIMFRIC, TIT, TIF real, pointer, dimension(:,:,:) :: UIM, VIM, THIM real, pointer, dimension(:,:,:) :: UIT, VIT, SIT real, pointer, dimension(:,:,:) :: UIG, VIG, TIG, TICU real, pointer, dimension(:,:,:) :: FTU, FTV real, pointer, dimension(:,:,:) :: INTDIS, TOPDIS real, pointer, dimension(:,: ) :: SRFDIS real, pointer, dimension(:,: ) :: TAUX, TAUY, CM real, pointer, dimension(:,: ) :: DQVDTPHYINT, DQLDTPHYINT, DQIDTPHYINT, DOXDTPHYINT real, pointer, dimension(:,: ) :: DQVDTTRBINT, DQVDTMSTINT, DQVDTCHMINT real, pointer, dimension(:,: ) :: DQLDTMSTINT, DQIDTMSTINT, DOXDTCHMINT real, pointer, dimension(:,: ) :: PERAD,PETRB,PEMST,PEFRI,PEGWD,PECUF real, pointer, dimension(:,: ) :: PEPHY real, pointer, dimension(:,: ) :: KEPHY real, pointer, dimension(:,: ) :: KETND real, pointer, dimension(:,: ) :: UA, VA real, pointer, dimension(:,: ) :: AREA real*8, allocatable, dimension(:,:) :: sumq real, allocatable, dimension(:,:) :: psdry real*8, allocatable, dimension(:,:,:) :: ple_new real*8 :: psdry_old real*8 :: psdry_new real*8 :: psdry_dif !AMM real, pointer, dimension(:,:,:) :: TGWD, DTDTGWD, THFORMOIST real, pointer, dimension(:,:,:) :: SAFTERMOIST, THAFMOIST real, pointer, dimension(:,:,:) :: THFORCHEM, TFORRAD real, pointer, dimension(:,:) :: TFORSURF real, pointer, dimension(:,:,:) :: SFORTURB, THFORTURB, TFORTURB real, pointer, dimension(:,:,:) :: SAFDIFFUSE, SAFUPDATE real, allocatable, dimension(:,:,:) :: PK real, allocatable, dimension(:,:,:) :: TDPOLD, TDPNEW real(kind=MAPL_R8), allocatable, dimension(:,:) :: sumdq real(kind=MAPL_R8), allocatable, dimension(:,:) :: dwdt real(kind=MAPL_R8), allocatable, dimension(:,:,:) :: dq character(len=ESMF_MAXSTR), allocatable :: Names(:) !-srf-gf-scheme real, pointer, dimension(:,:,:) :: DTDT_BL, DQDT_BL INTEGER, PARAMETER :: DXDT_BL=1 !-srf-gf-scheme !============================================================================= ! Begin... ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- Iam = "Run" call ESMF_GridCompGet ( GC, name=COMP_NAME, config=CF, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // "::" // Iam call ESMF_GridCompGet ( GC, grid=grid, rc=status ) VERIFY_(STATUS) ! Get my internal MAPL_Generic state !----------------------------------- call MAPL_GetObjectFromGC ( GC, STATE, RC=STATUS) VERIFY_(STATUS) call MAPL_TimerOn(STATE,"TOTAL") call MAPL_TimerOn(STATE,"RUN") call MAPL_GetResource(STATE, DUMMY, Label="DPEDT_PHYS:", default='YES', RC=STATUS) VERIFY_(STATUS) DUMMY = uppercase(DUMMY) DPEDT_PHYS = TRIM(DUMMY).eq.'YES' ! Get the children`s states from the generic state !------------------------------------------------- call MAPL_Get ( STATE, & GCS=GCS, GIM=GIM, GEX=GEX, & IM = IM, JM = JM, LM = LM, & GCNames = GCNames, & INTERNAL_ESMF_STATE = INTERNAL, & RC=STATUS ) VERIFY_(STATUS) call ESMF_ConfigGetAttribute(CF, DT, Label="RUN_DT:" , RC=STATUS) VERIFY_(STATUS) call ESMF_StateGet (EXPORT, 'TRADV', BUNDLE, RC=STATUS ) VERIFY_(STATUS) call ESMFL_BundleGetPointertoData( BUNDLE,'Q' ,QV , RC=STATUS) VERIFY_(STATUS) call ESMFL_BundleGetPointertoData( BUNDLE,'QLLS',QLLS, RC=STATUS) VERIFY_(STATUS) call ESMFL_BundleGetPointertoData( BUNDLE,'QLCN',QLCN, RC=STATUS) VERIFY_(STATUS) call ESMFL_BundleGetPointertoData( BUNDLE,'QILS',QILS, RC=STATUS) VERIFY_(STATUS) call ESMFL_BundleGetPointertoData( BUNDLE,'QICN',QICN, RC=STATUS) VERIFY_(STATUS) call MAPL_GetObjectFromGC ( GCS(MOIST), MAPL_MOIST, RC=STATUS) VERIFY_(STATUS) call MAPL_Get ( MAPL_MOIST, INTERNAL_ESMF_STATE = INTERNAL_MOIST, RC=STATUS ) VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL_MOIST, QW, 'QW', RC=STATUS) VERIFY_(STATUS) ! Initialize Passive Tracer QW ! ---------------------------- QW = QV+QLLS+QLCN+QILS+QICN ! Get Global PHYSICS Parameters ! ----------------------------- call MAPL_GetResource(STATE, SYNCTQ, 'SYNCTQ:', DEFAULT= 1.0, RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource(STATE, DOPHYSICS, 'DOPHYSICS:', DEFAULT= 1.0, RC=STATUS) VERIFY_(STATUS) ! Pointers to Imports !-------------------- call MAPL_GetPointer(IMPORT, U, 'U' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, V, 'V' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, T, 'T' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, S, 'S' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, TH, 'TH' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, ZLE, 'ZLE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, PLE, 'PLE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, AREA, 'AREA' , RC=STATUS); VERIFY_(STATUS) allocate( TDPOLD(IM,JM,LM),stat=STATUS ) VERIFY_(STATUS) TDPOLD = T(:,:,1:LM) * (PLE(:,:,1:LM)-PLE(:,:,0:LM-1)) allocate(DM(IM,JM,LM),stat=STATUS) VERIFY_(STATUS) DM = (PLE(:,:,1:LM)-PLE(:,:,0:LM-1))*(1.0/MAPL_GRAV) allocate(DPI(IM,JM,LM),stat=STATUS) VERIFY_(STATUS) DPI = 1./(PLE(:,:,1:LM)-PLE(:,:,0:LM-1)) ! Create Old Dry Mass Variables ! ----------------------------- allocate( psdry( IM,JM ), STAT=STATUS ) ; VERIFY_(STATUS) allocate( sumq( IM,JM ), STAT=STATUS ) ; VERIFY_(STATUS) allocate( ple_new(IM,JM,0:LM),STAT=STATUS ) ; VERIFY_(STATUS) #if debug sumq = 0.0_8 do L=1,lm sumq = sumq + ( qv(:,:,L)+qlls(:,:,L)+qlcn(:,:,L)+qils(:,:,L)+qicn(:,:,L) )*( PLE(:,:,L)-PLE(:,:,L-1) ) enddo psdry(:,:) = ple(:,:,LM) - sumq(:,:) call MAPL_AreaMean( psdry_old, psdry, area, grid, rc=STATUS ) VERIFY_(STATUS) #endif ! Pointers to Exports !-------------------- call MAPL_GetPointer(EXPORT, DUDT, 'DUDT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DVDT, 'DVDT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DTDT, 'DTDT' , RC=STATUS); VERIFY_(STATUS) !-srf-gf-scheme call MAPL_GetPointer(EXPORT, DTDTTOT, 'DTDTTOT' , alloc=.true., RC=STATUS); VERIFY_(STATUS) ! call MAPL_GetPointer(EXPORT, DTDTTOT, 'DTDTTOT' , RC=STATUS); VERIFY_(STATUS) !-srf-gf-scheme call MAPL_GetPointer(EXPORT, DTDTRAD, 'DTDTRAD' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DPDTPHY, 'DPDTPHY' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DPDT, 'DPEDT' , alloc=.true., RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DMDT, 'DMDT' , RC=STATUS); VERIFY_(STATUS) !-srf-gf-scheme ! call MAPL_GetPointer(EXPORT, TIT, 'TIT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, TIT, 'TIT' , alloc=.true.,RC=STATUS); VERIFY_(STATUS) !-srf-gf-scheme call MAPL_GetPointer(EXPORT, TIM, 'TIM' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, TIMFRIC, 'TIMFRIC' , RC=STATUS); VERIFY_(STATUS) !-srf-gf-scheme ! call MAPL_GetPointer(EXPORT, TIF, 'TIF' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, TIF, 'TIF' , alloc=.true.,RC=STATUS); VERIFY_(STATUS) !-srf-gf-scheme call MAPL_GetPointer(EXPORT, FTU, 'FTU' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FTV, 'FTV' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, KEPHY, 'KEPHY', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, PEPHY, 'PEPHY', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, PERAD, 'PERAD', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, PETRB, 'PETRB', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, PEMST, 'PEMST', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, PEFRI, 'PEFRI', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, PEGWD, 'PEGWD', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, PECUF, 'PECUF', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQVDTMSTINT, 'DQVDTMSTINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQLDTMSTINT, 'DQLDTMSTINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQIDTMSTINT, 'DQIDTMSTINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQVDTTRBINT, 'DQVDTTRBINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQVDTCHMINT, 'DQVDTCHMINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DOXDTCHMINT, 'DOXDTCHMINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQVDTPHYINT, 'DQVDTPHYINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQLDTPHYINT, 'DQLDTPHYINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DQIDTPHYINT, 'DQIDTPHYINT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DOXDTPHYINT, 'DOXDTPHYINT', RC=STATUS); VERIFY_(STATUS) ! Get and allocate pointers to Exports that have been put in turbulence ! bundle, as well as the required tendencies in the children`s exports. !------------------------------------------------------------------------ if(associated(DUDT)) then call MAPL_GetPointer(EXPORT , UIT, 'UIT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(MOIST) , UIM, 'DUDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(GWD) , UIG, 'DUDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) end if if(associated(DVDT)) then call MAPL_GetPointer(EXPORT , VIT, 'VIT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(MOIST) , VIM, 'DVDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(GWD) , VIG, 'DVDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) end if if(associated(DTDT) .or. associated(TIM) .or. associated(DTDTTOT)) then call MAPL_GetPointer(GEX(MOIST) , THIM, 'DTHDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) end if if(associated(DTDT) .or. associated(TIT) .or. associated(DTDTTOT)) then call MAPL_GetPointer(EXPORT , SIT, 'SIT', alloc=.true., RC=STATUS) VERIFY_(STATUS) end if if(associated(DTDT) .or. associated(DTDTRAD) .or. associated(DTDTTOT)) then call MAPL_GetPointer(GEX(RAD ) , TIR, 'DTDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) end if if(associated(DTDT) .or. associated(TIF) .or. associated(DTDTTOT)) then call MAPL_GetPointer(GEX(TURBL), INTDIS, 'INTDIS', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(TURBL), TOPDIS, 'TOPDIS', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(TURBL), SRFDIS, 'SRFDIS', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(GWD ) , TIG, 'DTDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(MOIST), TICU,'DTDTFRIC', alloc=.true., RC=STATUS) VERIFY_(STATUS) end if call MAPL_GetPointer ( EXPORT, DQVDTTRB, 'QVIT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( EXPORT, DQLDTTRB, 'QLLSIT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( EXPORT, DQIDTTRB, 'QILSIT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( GEX(TURBL), DPDTTRB , 'DPDTTRB', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( GEX(MOIST), DPDTMST , 'DPDTMST', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( GEX(MOIST), DQVDTMST, 'DQDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( GEX(CHEM), DQVDTCHM, 'H2O_TEND', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( GEX(MOIST), DQLDTMST, 'DQLDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( GEX(MOIST), DQIDTMST, 'DQIDT', alloc=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer (EXPORT, DQVDTSCL, 'DQVDTSCL', RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer (EXPORT, DQLDTSCL, 'DQLDTSCL', RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer (EXPORT, DQIDTSCL, 'DQIDTSCL', RC=STATUS) VERIFY_(STATUS) if(associated(DOXDTCHMINT)) then call MAPL_GetPointer ( GEX(CHEM), DOXDTCHM, 'OX_TEND', alloc=.true., RC=STATUS) VERIFY_(STATUS) end if call MAPL_GetPointer ( GIM(SURF), UA, 'UA', RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer ( GIM(SURF), VA, 'VA', RC=STATUS) VERIFY_(STATUS) UA = U(:,:,LM) VA = V(:,:,LM) !---------------------- if ( SYNCTQ.eq.1. ) then ! AMM 1/24/14 - Code to sequentially update T after each child - get pointer to T in gwd export ! All control for this is here - children just have added exports to be used here ! Sequence here is to get all the needed pointers to import and export states of children ! get pointer to gwd export of updated T call MAPL_GetPointer ( GEX(GWD), TGWD, 'T', alloc = .true., RC=STATUS);VERIFY_(STATUS) ! get pointer to gwd export of GWD DTDT - do this to force allocate it if we need it here call MAPL_GetPointer ( GEX(GWD), DTDTGWD, 'DTDT', alloc = .true., RC=STATUS);VERIFY_(STATUS) ! get pointer to moist import TH (moist has an import T, but its never used in there) call MAPL_GetPointer ( GIM(MOIST), THFORMOIST, 'TH', RC=STATUS) ! get pointer to moist export of updated TH and S after moist (S does not include PHIS yet) call MAPL_GetPointer ( GEX(MOIST), THAFMOIST, 'THMOIST', alloc = .true., RC=STATUS) call MAPL_GetPointer ( GEX(MOIST), SAFTERMOIST, 'SMOIST', alloc = .true., RC=STATUS) ! get pointer to TA in surf import bundle call MAPL_GetPointer ( GIM(SURF), TFORSURF, 'TA', RC=STATUS) ! get pointer to turb import state bundle and then to S in the bundle - used in diffuse call ESMF_StateGet(GIM(TURBL), 'TR', BUNDLE, RC=STATUS ) call ESMFL_BundleGetPointerToData(BUNDLE,'S',SFORTURB, RC=STATUS) ! get pointer to turb state imports of T and TH - used in refresh call MAPL_GetPointer ( GIM(TURBL), THFORTURB, 'TH', RC=STATUS) call MAPL_GetPointer ( GIM(TURBL), TFORTURB, 'T', RC=STATUS) ! get pointer to turb export of S after run 1 call MAPL_GetPointer ( GEX(TURBL), SAFDIFFUSE, 'SAFDIFFUSE', alloc = .true., RC=STATUS) ! get pointer to turb export of S after run 2 call MAPL_GetPointer ( GEX(TURBL), SAFUPDATE, 'SAFUPDATE', alloc = .true., RC=STATUS) ! get pointer to T in chem and rad import bundles call MAPL_GetPointer ( GIM(CHEM), THFORCHEM, 'TH', RC=STATUS) call MAPL_GetPointer ( GIM(RAD), TFORRAD, 'T', RC=STATUS) ! AMM - Will need PK to get from T to TH and back allocate(PK(IM,JM,LM),stat=STATUS);VERIFY_(STATUS) PK = ((0.5*(PLE(:,:,0:LM-1) + PLE(:,:,1:LM ) ))/100000.)**(MAPL_RGAS/MAPL_CP) endif !-srf-gf-scheme call MAPL_GetPointer(GEX(MOIST), DTDT_BL, 'DTDT_BL', alloc = .true. ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(GEX(MOIST), DQDT_BL, 'DQDT_BL', alloc = .true. ,RC=STATUS); VERIFY_(STATUS) !-srf-gf-scheme if ( DOPHYSICS.eq.1. ) then ! Gravity Wave Drag ! (must be first to use Q from dynamics, ! as it was when it was in superdyn.) !---------------------------------------- I=GWD 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_GenericRunCouplers (STATE, I, CLOCK, RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Moist Processes !---------------- ! ! AMM - compute TH using T after GWD and write on moist import state TH if ( SYNCTQ.eq.1. ) then THFORMOIST = TGWD / PK endif I=MOIST 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_GenericRunCouplers (STATE, I, CLOCK, RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Surface Stage 1 !---------------- ! AMM - Update TA for surf using TH after MOIST if ( SYNCTQ.eq.1. ) then TFORSURF = THAFMOIST(:,:,LM)*PK(:,:,LM) endif !-srf-gf-scheme if(DXDT_BL==1) then DTDT_BL=THAFMOIST*PK DQDT_BL=QV endif !-srf-gf-scheme I=SURF call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), importState=GIM(I), exportState=GEX(I), clock=CLOCK, PHASE=1, userRC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Aerosol/Chemistry Stage 1 !-------------------------- if ( SYNCTQ.eq.1. ) then THFORCHEM = THAFMOIST endif I=CHEM call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), importState=GIM(I), exportState=GEX(I), clock=CLOCK, phase=1, userRC=STATUS ); VERIFY_(STATUS) call MAPL_GenericRunCouplers (STATE, I, CLOCK, RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Turbulence Stage 1 !------------------- ! AMM - compute S after MOIST ( use moist S export and add phi s) and stuff S into turb TR bundle ! write on turb imports of T and TH with values after moist if ( SYNCTQ.eq.1. ) then do k = 1,LM SFORTURB(:,:,k) = SAFTERMOIST(:,:,k) + ZLE(:,:,LM) * MAPL_GRAV enddo TFORTURB = THAFMOIST*PK THFORTURB = THAFMOIST endif I=TURBL call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), importState=GIM(I), exportState=GEX(I), clock=CLOCK, PHASE=1, userRC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Surface Stage 2 !---------------- if ( SYNCTQ.eq.1. ) then !AMM - update TA for surface using turb updated S - assume change in S is all change in T TforSURF = TforSURF + ( SafDIFFUSE(:,:,LM) - SforTURB(:,:,LM) ) / MAPL_CP ! set THforCHEM and TforRAD using turb run 1 updated S - assume change in S is all change in T THFORCHEM = THFORTURB + (SafDIFFUSE -SforTURB) *PK / MAPL_CP TFORRAD = TFORTURB + (SafDIFFUSE -SforTURB) / MAPL_CP endif I=SURF call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), importState=GIM(I), exportState=GEX(I), clock=CLOCK, PHASE=2, userRC=STATUS ); VERIFY_(STATUS) call MAPL_GenericRunCouplers (STATE, I, CLOCK, RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Turbulence Stage 2 !------------------- if ( SYNCTQ.eq.1. ) then !AMM update turb S import using S from the result of turb 1 SFORTURB = SAFDIFFUSE endif I=TURBL call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), importState=GIM(I), exportState=GEX(I), clock=CLOCK, PHASE=2, userRC=STATUS ); VERIFY_(STATUS) call MAPL_GenericRunCouplers (STATE, I, CLOCK, RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Aerosol/Chemistry Stage 2 !-------------------------- if ( SYNCTQ.eq.1. ) then ! AMM - Now Update T (for RAD) and TH (for CHEM) using S after turb run 2 assume change in S is all change in T THFORCHEM = THFORCHEM + ( SAFUPDATE -SAFDIFFUSE ) *PK / MAPL_CP TFORRAD = TFORRAD + ( SAFUPDATE -SafDIFFUSE) / MAPL_CP endif !-srf-gf-scheme if(DXDT_BL==1) then DTDT_BL=(TFORRAD-DTDT_BL)/DT DQDT_BL=(QV-DQDT_BL)/DT endif !-srf-gf-scheme I=CHEM call MAPL_TimerOn (STATE,GCNames(I)) call ESMF_GridCompRun (GCS(I), importState=GIM(I), exportState=GEX(I), clock=CLOCK, PHASE=2, userRC=STATUS ); VERIFY_(STATUS) call MAPL_GenericRunCouplers (STATE, I, CLOCK, RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) ! Radiation !---------- I=RAD 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_GenericRunCouplers (STATE, I, CLOCK, RC=STATUS ); VERIFY_(STATUS) call MAPL_TimerOff(STATE,GCNames(I)) !AMM if ( SYNCTQ.eq.1. ) then deallocate(PK) endif endif ! end of if do physics condition ! Fill the physics tendencies for the dynamics state variables. ! Q and other tracers are updated by their respective components ! and may be friendly to dynamics. !--------------------------------------------------------------- NEED_TOT = associated(DTDTTOT) .or. associated(DTDT) NEED_FRI = associated( TIF) .or. NEED_TOT NEED_TTN = associated( TIM) .or. NEED_TOT NEED_STN = associated( TIT) .or. NEED_TOT if(NEED_FRI) then allocate(FRI(IM,JM,LM),stat=STATUS) VERIFY_(STATUS) FRI = INTDIS + TOPDIS ! FRI(:,:,LM) = FRI(:,:,LM) + SRFDIS end if if(NEED_TTN) then allocate(TTN(IM,JM,LM),stat=STATUS) VERIFY_(STATUS) TTN = THIM*( 0.5*(PLE(:,:,1:LM)+PLE(:,:,0:LM-1))/MAPL_P00 )**MAPL_KAPPA ! Note: P**Kappa consistent with MOIST version end if if(NEED_STN) then allocate(STN(IM,JM,LM),stat=STATUS) VERIFY_(STATUS) STN = SIT*(1./MAPL_CP) end if if(associated(DUDT )) DUDT = UIM + UIT + UIG if(associated(DVDT )) DVDT = VIM + VIT + VIG if(associated(KEPHY )) KEPHY = 0.0 if(associated(PEPHY )) PEPHY = 0.0 if(associated(PERAD )) PERAD = 0.0 if(associated(PETRB )) PETRB = 0.0 if(associated(PEMST )) PEMST = 0.0 if(associated(PEFRI )) PEFRI = 0.0 if(associated(PEGWD )) PEGWD = 0.0 if(associated(PECUF )) PECUF = 0.0 if(associated(DUDT) .and. associated(DVDT) .and. associated(KEPHY)) then do L=1,LM KEPHY = KEPHY + ((U(:,:,L)+(0.5*DT)*DUDT(:,:,L))*DUDT(:,:,L) + & (V(:,:,L)+(0.5*DT)*DVDT(:,:,L))*DVDT(:,:,L) ) * & DM(:,:,L) end do end if if(NEED_TOT) then allocate(TOT(IM,JM,LM),stat=STATUS) VERIFY_(STATUS) TOT = TIR & ! Mass-Weighted Temperature Tendency due to Radiation + STN & ! Mass-Weighted Temperature Tendency due to Turbulent Mixing + TTN & ! Mass-Weighted Temperature Tendency due to Moist Processes + FRI & ! Mass-Weighted Temperature Tendency due to Friction (Turbulence) + TIG & ! Mass-Weighted Temperature Tendency due to GWD + TICU ! Mass-Weighted Temperature Tendency due to Cumulus Friction if(associated(PERAD )) then do L=1,LM PERAD = PERAD + TIR(:,:,L)*(MAPL_CP/MAPL_GRAV) end do end if if(associated(PETRB )) then do L=1,LM PETRB = PETRB + STN(:,:,L)*(MAPL_CP/MAPL_GRAV) end do end if if(associated(PEMST )) then do L=1,LM PEMST = PEMST + TTN(:,:,L)*(MAPL_CP/MAPL_GRAV) end do end if if(associated(PEFRI )) then do L=1,LM PEFRI = PEFRI + FRI(:,:,L)*(MAPL_CP/MAPL_GRAV) end do end if if(associated(PEGWD )) then do L=1,LM PEGWD = PEGWD + TIG(:,:,L)*(MAPL_CP/MAPL_GRAV) end do end if if(associated(PECUF )) then do L=1,LM PECUF = PECUF + TICU(:,:,L)*(MAPL_CP/MAPL_GRAV) end do end if if(associated(DTDT )) then DTDT = TOT if(associated(PEPHY )) then do L=1,LM PEPHY = PEPHY + DTDT(:,:,L)*(MAPL_CP/MAPL_GRAV) end do end if end if if(associated(DTDTTOT)) DTDTTOT = TOT * DPI deallocate(TOT) end if if(associated(DTDTRAD)) DTDTRAD = TIR * DPI if(associated(TIM )) TIM = TTN * DPI if(associated(TIMFRIC)) TIMFRIC = TICU* DPI if(associated(TIT )) TIT = STN * DPI if(associated(TIF )) TIF = FRI * DPI if( DPEDT_PHYS ) then allocate(sumdq(IM,JM)) allocate( dwdt(IM,JM)) allocate( dq(IM,JM,LM)) call ESMF_StateGet (EXPORT, 'TRADV', BUNDLE, RC=STATUS ) VERIFY_(STATUS) call ESMF_FieldBundleGet ( BUNDLE, fieldCount=NQ, RC=STATUS ) VERIFY_(STATUS) allocate( NAMES(NQ),STAT=STATUS ) VERIFY_(STATUS) call ESMF_FieldBundleGet ( BUNDLE, fieldNameList=NAMES, rc=STATUS ) VERIFY_(STATUS) ! Add diagnostic for scaling tendency of QI and QL -> fill diagnostic with "before" value ! ------------------------------------------------ if( associated(DQVDTSCL) ) DQVDTSCL = QV if( associated(DQLDTSCL) ) DQLDTSCL = (QLLS+QLCN) if( associated(DQIDTSCL) ) DQIDTSCL = (QILS+QICN) ! Compute Total Water Mass Change due to Physics Sources and Sinks ! ---------------------------------------------------------------- do l=1,lm dq(:,:,L) = QV(:,:,L) ! - DT*DQVDTCHM(:,:,L) We do not keep dry-mass budget for CHEM constituents dq(:,:,L) = dq(:,:,L) + QLLS(:,:,L) dq(:,:,L) = dq(:,:,L) + QLCN(:,:,L) dq(:,:,L) = dq(:,:,L) + QILS(:,:,L) dq(:,:,L) = dq(:,:,L) + QICN(:,:,L) dq(:,:,L) = dq(:,:,L) - QW(:,:,L) enddo ! Modify P and Q such that Pdry is conserved ! ------------------------------------------ ple_new = ple*1.0_8 sumdq = 0.0 DPDT(:,:,0) = 0.0 do l=1,lm sumdq = sumdq + dq(:,:,L) * ( ple(:,:,L)-ple(:,:,L-1) ) / DT dpdt(:,:,L) = sumdq ple_new(:,:,L) = ple_new(:,:,L) + dt*dpdt(:,:,L) ! dwdt(:,:) = 1.0_8/( 1.0_8 + dq(:,:,L) ) dwdt(:,:) = (ple(:,:,L)-ple(:,:,L-1)) / (ple_new(:,:,L)-ple_new(:,:,L-1)) do N=1,NQ call ESMFL_BundleGetPointertoData( BUNDLE, trim(NAMES(N)), PTR3D, RC=STATUS) VERIFY_(STATUS) if( trim(NAMES(N)) /= 'CLCN' .and. & ! Exclude: Advected Convective and Large-Scale trim(NAMES(N)) /= 'CLLS' ) then ! -------- Cloud Fractions PTR3D(:,:,L) = PTR3d(:,:,L) * dwdt(:,:) endif end do end do ! Create New Dry Mass Variables ! ----------------------------- #if debug sumq = 0.0_8 do L=1,lm sumq = sumq + ( qv(:,:,L)+qlls(:,:,L)+qlcn(:,:,L)+qils(:,:,L)+qicn(:,:,L) )*( PLE_NEW(:,:,L)-PLE_NEW(:,:,L-1) ) enddo psdry(:,:) = ple_new(:,:,LM) - sumq(:,:) call MAPL_AreaMean( psdry_new, psdry, area, grid, rc=STATUS ) VERIFY_(STATUS) psdry_dif = psdry_new - psdry_old if(MAPL_AM_I_ROOT() ) then write(6,1001) psdry_old/100, psdry_new/100, psdry_new/psdry_old,psdry_dif/100 1001 format(1x,'PSDRY_OLD: ',g21.14,' PSDRY_NEW: ',g21.14,' RATIO: ',g25.18,' DIF: ',g21.14) endif #endif ! Add diagnostic for scaling tendency of QI and QL -> update diagnostic with "after" value ! ------------------------------------------------ if( associated(DQVDTSCL) ) DQVDTSCL = ( QV - DQVDTSCL )/DT if( associated(DQLDTSCL) ) DQLDTSCL = ( QLLS+QLCN - DQLDTSCL )/DT if( associated(DQIDTSCL) ) DQIDTSCL = ( QILS+QICN - DQIDTSCL )/DT deallocate( sumdq ) deallocate( dwdt ) deallocate( names ) deallocate( sumq ) deallocate( psdry ) deallocate( ple_new ) else DPDT = 0.0 if( associated(DQVDTSCL) ) DQVDTSCL = 0.0 if( associated(DQLDTSCL) ) DQLDTSCL = 0.0 if( associated(DQIDTSCL) ) DQIDTSCL = 0.0 endif if(associated(DMDT)) DMDT(:,:) = DPDT(:,:,LM)*(1.0/MAPL_GRAV) if( associated(DPDTPHY) ) then do L=1,LM DPDTPHY(:,:,L) = dpdt(:,:,L) enddo endif allocate( TDPNEW(IM,JM,LM),stat=STATUS ) VERIFY_(STATUS) do L=1,LM TDPNEW(:,:,L) = ( T(:,:,L) + DT*DTDT(:,:,L)*DPI(:,:,L) ) * ( PLE(:,:,L)-PLE(:,:,L-1) + DT*(DPDT(:,:,L)-DPDT(:,:,L-1)) ) enddo DTDT = ( TDPNEW - TDPOLD )/DT deallocate( TDPNEW ) deallocate( TDPOLD ) if(associated(FTU)) then FTU(:,:,0) = 0.0 do L=1,LM FTU(:,:,L) = FTU(:,:,L-1) - UIT(:,:,L)*(ZLE(:,:,L)-ZLE(:,:,L-1)) end do end if if(associated(FTV)) then FTV(:,:,0) = 0.0 do L=1,LM FTV(:,:,L) = FTV(:,:,L-1) - VIT(:,:,L)*(ZLE(:,:,L)-ZLE(:,:,L-1)) end do end if ! QV Tendencies ! ------------- if(associated(DQVDTPHYINT)) then DQVDTPHYINT = 0.0 do L=1,LM DQVDTPHYINT = DQVDTPHYINT + ( DQVDTMST(:,:,L) & + DQVDTTRB(:,:,L) & + DQVDTCHM(:,:,L) ) * DM(:,:,L) end do end if if(associated(DQVDTTRBINT)) then DQVDTTRBINT = 0.0 do L=1,LM DQVDTTRBINT = DQVDTTRBINT + DQVDTTRB(:,:,L)*DM(:,:,L) end do end if if(associated(DQVDTMSTINT)) then DQVDTMSTINT = 0.0 do L=1,LM DQVDTMSTINT = DQVDTMSTINT + DQVDTMST(:,:,L)*DM(:,:,L) end do end if if(associated(DQVDTCHMINT)) then DQVDTCHMINT = 0.0 do L=1,LM DQVDTCHMINT = DQVDTCHMINT + DQVDTCHM(:,:,L)*DM(:,:,L) end do end if ! QL Tendencies ! ------------- if(associated(DQLDTPHYINT)) then DQLDTPHYINT = 0.0 do L=1,LM DQLDTPHYINT = DQLDTPHYINT + DQLDTMST(:,:,L)*DM(:,:,L) end do end if if(associated(DQLDTMSTINT)) then DQLDTMSTINT = 0.0 do L=1,LM DQLDTMSTINT = DQLDTMSTINT + DQLDTMST(:,:,L)*DM(:,:,L) end do end if ! QI Tendencies ! ------------- if(associated(DQIDTPHYINT)) then DQIDTPHYINT = 0.0 do L=1,LM DQIDTPHYINT = DQIDTPHYINT + DQIDTMST(:,:,L)*DM(:,:,L) end do end if if(associated(DQIDTMSTINT)) then DQIDTMSTINT = 0.0 do L=1,LM DQIDTMSTINT = DQIDTMSTINT + DQIDTMST(:,:,L)*DM(:,:,L) end do end if ! OX Tendencies ! ------------- if(associated(DOXDTPHYINT)) then DOXDTPHYINT = 0.0 do L=1,LM DOXDTPHYINT = DOXDTPHYINT + DOXDTCHM(:,:,L)*DM(:,:,L) end do DOXDTPHYINT = DOXDTPHYINT * (MAPL_O3MW/MAPL_AIRMW) end if if(associated(DOXDTCHMINT)) then DOXDTCHMINT = 0.0 do L=1,LM DOXDTCHMINT = DOXDTCHMINT + DOXDTCHM(:,:,L)*DM(:,:,L) end do DOXDTCHMINT = DOXDTCHMINT * (MAPL_O3MW/MAPL_AIRMW) end if if(associated(DM )) deallocate(DM ) if(associated(DPI)) deallocate(DPI) if(associated(FRI)) deallocate(FRI) if(associated(TTN)) deallocate(TTN) if(associated(STN)) deallocate(STN) !-srf-gf-scheme if(DXDT_BL==2) then !- save 'boundary layer' tendencies of Q and T for the convection scheme DQDT_BL = DQVDTTRB DTDT_BL = 0. !- for SCM setup, TIT/TIF are not associated if( associated(TIF)) DTDT_BL = DTDT_BL + TIF if( associated(TIT)) DTDT_BL = DTDT_BL + TIT endif !-srf-gf-scheme call MAPL_TimerOff(STATE,"RUN") call MAPL_TimerOff(STATE,"TOTAL") RETURN_(ESMF_SUCCESS) end subroutine Run !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module GEOS_PhysicsGridCompMod