! $Id: GEOS_SurfaceGridComp.F90,v 1.151 2009/03/27 15:48:31 ltakacs Exp $ #include "MAPL_Generic.h" !============================================================================= !BOP ! !MODULE: GEOS_Surface -- A composite component for the surface components. ! !INTERFACE: module GEOS_SurfaceGridCompMod ! !USES: use ESMF_Mod use MAPL_Mod use GEOS_LakeGridCompMod, only : LakeSetServices => SetServices use GEOS_LandiceGridCompMod, only : LandiceSetServices => SetServices use GEOS_SaltwaterGridCompMod, only : OceanSetServices => SetServices use GEOS_LandGridCompMod, only : LandSetServices => SetServices implicit none private type( ESMF_VM ) :: VMG ! !PUBLIC ROUTINES: public SetServices !============================================================================= ! !DESCRIPTION: ! ! {\tt GEOS\_Surface} is a light-weight gridded component that implements the ! interface to the tiled surface components. The surface computational components ! (LAND, LAKE, OCEAN, LANDICE) are its children. All of {\tt GEOS\_Surface}'s imports and exports ! are in the atmospheric model's grid. In {\tt GEOS\_Surface} these are transformed to the ! exchange grid, and the relevant portions of the exchange grid are passed to ! each of the children. The children's results are them replaced in ! the full exchange grid and transformed back to the atmospheric grid. ! ! {\tt GEOS\_Surface} has two run stages, as do its children. These are meant ! to interface with the two stages of {\tt GEOS\_Turbulence}. During the first run ! stage, the children all produce surface exchange coefficients, and during the ! second, they update the surface state and produce final values of the fluxes. ! ! {\tt GEOS\_Surface} keeps a Private Internal State called 'SURF_state' in the ! component object. In this state it saves the tranforms between the atmospheric ! grid and each of the children's exchange grids. This should be done more ! elegantly once ESMF has exchange grid support. It also has a \gg Internal State ! that is used to communicate between the two run methods. These internal states ! do not need to be saved in restarts. ! ! The four children of {\tt GEOS\_Surface} are given the names: ! 'LAKE', which treats inland freshwater bodies; 'LANDICE', which treats permanent ! glaciers; 'LAND', which treats all other land surface types, both bare and vegetated, ! as well as vegetated wetlands not considered freshwater bodies; and 'SALTWATER', which ! performs the surface calculations for all ocean areas. All four operate in lists ! of tiles that are nonoverlapping subsets of the exhange grid, and their union---the ! full exchange grid---tiles the entire sphere. ! ! By default MAPL_Generic tries to resolve Imports and Exports among ! the children; but the children of {\tt GEOS\_Surface} do not talk directly to each other, ! and all communication between them would need to be performed by {\tt GEOS\_Surface} manipulating ! their Import and Export states. Currently they do not communicate, but this will ! chage when runoff routing is implemented. !EOP integer :: LAKE integer :: LANDICE integer :: OCEAN integer :: LAND #ifdef AQUA_PLANET integer, parameter :: NUM_CHILDREN = 1 #else integer, parameter :: NUM_CHILDREN = 4 #endif character(len=ESMF_MAXSTR), pointer :: GCNames(:) integer :: CHILD_MASK(NUM_CHILDREN) ! Internal state and its wrapper ! ------------------------------ type T_SURFACE_STATE private type (MAPL_LocStreamXFORM) :: XFORM_IN (NUM_CHILDREN) type (MAPL_LocStreamXFORM) :: XFORM_OUT(NUM_CHILDREN) end type T_SURFACE_STATE type SURF_WRAP type (T_SURFACE_STATE), pointer :: PTR end type SURF_WRAP 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: This version uses the GEOS\_GenericSetServices, which in addition ! to setting default IRF methods, also allocates ! our instance of a generic state and puts it in the ! gridded component (GC). Here we override the Initialize and Run methods. ! The Run method is a two-stage method that implemets the interaction ! between the 2-stage children representing the various surface types and the 2-stage ! turbulence run methods. ! ! ! Note that, in addition to its explicit exports, ! the entire internal state, which is used to communicate between the two run stages, ! is exported using the ``friendly-to-self'' mechanism. !EOP !============================================================================= ! ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Locals integer :: I type (T_SURFACE_STATE), pointer :: SURF_INTERNAL_STATE type (SURF_wrap) :: WRAP type (MAPL_MetaComp ), pointer :: MAPL !============================================================================= ! Begin... ! Get my name and set-up traceback handle ! --------------------------------------- Iam = 'SetServices' call ESMF_GridCompGet( GC, NAME=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // Iam ! Set the Run entry point ! ----------------------- call MAPL_GridCompSetEntryPoint ( GC, ESMF_SETINIT, Initialize, RC=STATUS ) VERIFY_(STATUS) call MAPL_GridCompSetEntryPoint ( GC, ESMF_SETRUN, Run1, RC=STATUS ) VERIFY_(STATUS) call MAPL_GridCompSetEntryPoint ( GC, ESMF_SETRUN, Run2, RC=STATUS ) VERIFY_(STATUS) ! Allocate this instance of the internal state and put it in wrapper. ! ------------------------------------------------------------------- allocate( SURF_INTERNAL_STATE, stat=STATUS ) VERIFY_(STATUS) WRAP%PTR => SURF_INTERNAL_STATE ! Save pointer to the wrapped internal state in the GC ! ---------------------------------------------------- call ESMF_UserCompSetInternalState ( GC, 'SURF_state',wrap,status ) VERIFY_(STATUS) ! Set the state variable specs. ! ----------------------------- !BOP ! Imports are read-only quantities computed by other gridded components. ! Note that the turbulence fluxes appearing in the import state are ! the values computed by the first run stage of turbulence using fixed ! surface conditions. The Export versions of these fluxes are the final ! values actually used in the surface budgets. The same applies to some ! of the radiative fluxes, for which the values exported here are those ! actually used in the budget. ! !IMPORT STATE: call MAPL_AddImportSpec(GC, & LONG_NAME = 'surface_pressure', & UNITS = 'Pa', & SHORT_NAME = 'PS', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'surface_air_temperature', & UNITS = 'K', & SHORT_NAME = 'TA', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'surface_air_specific_humidity', & UNITS = '1', & SHORT_NAME = 'QA', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'surface_wind_speed', & UNITS = 'm s-1', & SHORT_NAME = 'SPEED', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'UA', & LONG_NAME = 'eastward_wind_bottom_level', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'VA', & LONG_NAME = 'northward_wind_bottom_level', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'surface_layer_height', & UNITS = 'm', & SHORT_NAME = 'DZ', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'surface geopotential height', & UNITS = 'm2 sec-2', & SHORT_NAME = 'PHIS', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'sensible_heat_flux', & UNITS = 'W m-2', & SHORT_NAME = 'SH', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'eastward_surface_stress_on_air', & UNITS = 'N m-2', & SHORT_NAME = 'TAUX', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'northward_surface_stress_on_air', & UNITS = 'N m-2', & SHORT_NAME = 'TAUY', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'evaporation', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'EVAP', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'dewfall', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'DEWL', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'frostfall', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'FRSL', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'derivative_of_sensible_heat_wrt_dry_static_energy',& UNITS = 'W m-2 K-1', & SHORT_NAME = 'DSH', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'derivative_of_eastward_surface_stress_wrt_Us', & UNITS = 'N s m-3', & SHORT_NAME = 'DFU', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'derivative_of_northward_surface_stress_wrt_Us', & UNITS = 'N s m-3', & SHORT_NAME = 'DFV', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'derivative_of_evaporation_wrt_QS', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'DEVAP', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'derivative_of_dewfall_wrt_QS', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'DDEWL', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'derivative_of_frostfall_wrt_QS', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'DFRSL', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'liquid_water_convective_precipitation', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'PCU', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'liquid_water_large_scale_precipitation', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'PLS', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'snowfall', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'SNO', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'DRPARN', & LONG_NAME = 'normalized_surface_downwelling_par_beam_flux', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'DFPARN', & LONG_NAME = 'normalized_surface_downwelling_par_diffuse_flux', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'DRNIRN' ,& LONG_NAME = 'normalized_surface_downwelling_nir_beam_flux',& UNITS = '1' ,& DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'DFNIRN' ,& LONG_NAME = 'normalized_surface_downwelling_nir_diffuse_flux',& UNITS = '1' ,& DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'DRUVRN' ,& LONG_NAME = 'normalized_surface_downwelling_uvr_beam_flux',& UNITS = '1' ,& DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC ,& SHORT_NAME = 'DFUVRN' ,& LONG_NAME = 'normalized_surface_downwelling_uvr_diffuse_flux',& UNITS = '1' ,& DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'LWDNSRF', & LONG_NAME = 'surface_downwelling_longwave_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) !wcc call MAPL_AddImportSpec(GC, & SHORT_NAME = 'SFC_RATIO', & !wcc LONG_NAME = 'ratio_topo_area_hori_area', & !wcc UNITS = '1', & !wcc DIMS = MAPL_DimsHorzOnly, & !wcc VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'ALW', & LONG_NAME = 'linearization_of_surface_upwelling_longwave_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'BLW', & LONG_NAME = 'linearization_of_surface_upwelling_longwave_flux', & UNITS = 'W m-2 K-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) ! !EXPORT STATE: call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_albedo_for_visible_beam', & UNITS = '1', & SHORT_NAME = 'ALBVR', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_albedo_for_visible_diffuse',& UNITS = '1', & SHORT_NAME = 'ALBVF', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_albedo_for_nearinfrared_beam', & UNITS = '1', & SHORT_NAME = 'ALBNR', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_albedo_for_nearinfraed_diffuse', & UNITS = '1', & SHORT_NAME = 'ALBNF', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'EMIS', & LONG_NAME = 'surface_emissivity', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'Z0', & LONG_NAME = 'surface_roughness', & UNITS = 'm', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'MOU10M', & LONG_NAME = 'zonal 10m wind from MO sfc', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'MOV10M', & LONG_NAME = 'meridional 10m wind from MO sfc', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'MOT2M', & LONG_NAME = 'temperature 2m wind from MO sfc', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'MOQ2M', & LONG_NAME = 'humidity 2m wind from MO sfc', & UNITS = 'kg kg-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'Z0H', & LONG_NAME = 'surface_roughness_for_heat', & UNITS = 'm', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'RI', & LONG_NAME = 'surface_bulk_richardson_number', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'RE', & LONG_NAME = 'surface_reynolds_number', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FRACI', & LONG_NAME = 'ice_covered_fraction_of_tile', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'QDWL', & LONG_NAME = 'surface_liquid_condensate', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'QFRL', & LONG_NAME = 'surface_ice_condensate', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SHAT', & LONG_NAME = 'effective_surface_dry_static_energy',& UNITS = 'm+2 s-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DELUS', & LONG_NAME = 'change_of_surface_eastward_velocity',& UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DELVS', & LONG_NAME = 'change_of_surface_northward_velocity',& UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DELSS', & LONG_NAME = 'change_of_surface_dry_static_energy',& UNITS = 'm+2 s-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DELTS', & LONG_NAME = 'change_of_surface_skin_temperature',& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DELQS', & LONG_NAME = 'change_of_surface_specific_humidity',& UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DLQLL', & LONG_NAME = 'change_of_surface_liquid_condensate',& UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DLQIL', & LONG_NAME = 'change_of_surface_frozen_condensate',& UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FRLAND', & LONG_NAME = 'fraction_of_land', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FRLANDICE', & LONG_NAME = 'fraction_of_land_ice', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FRLAKE', & LONG_NAME = 'fraction_of_lake', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FROCEAN', & LONG_NAME = 'fraction_of_ocean', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'USTAR', & LONG_NAME = 'surface_velocity_scale', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSTAR', & LONG_NAME = 'surface_temperature_scale', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'QSTAR', & LONG_NAME = 'surface_moisture_scale', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'BSTAR', & LONG_NAME = 'surface_bouyancy_scale', & UNITS = 'm s-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSOIL1', & LONG_NAME = 'soil_temperatures_layer_1' ,& UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'fractional_area_of_land_snowcover',& UNITS = '1' ,& SHORT_NAME = 'ASNOW' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_temperature_of_snow',& UNITS = 'K' ,& SHORT_NAME = 'TPSNOW' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_temperature_of_saturated_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPSAT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_temperature_of_unsaturated_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPUNST' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_temperature_of_wilted_zone',& UNITS = 'K' ,& SHORT_NAME = 'TPWLT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'fractional_area_of_saturated_zone',& UNITS = '1' ,& SHORT_NAME = 'FRSAT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'fractional_area_of_unsaturated_zone',& UNITS = '1' ,& SHORT_NAME = 'FRUST' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'fractional_area_of_wilting_zone',& UNITS = '1' ,& SHORT_NAME = 'FRWLT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'snow_water_equivalent_depth' ,& UNITS = 'mm' ,& SHORT_NAME = 'SNOMAS' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'surface_soil_wetness' ,& UNITS = '1' ,& SHORT_NAME = 'WET1' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'root_zone_soil_wetness' ,& UNITS = '1' ,& SHORT_NAME = 'WET2' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'leaf_area_index' ,& UNITS = '1' ,& SHORT_NAME = 'LAI' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'greeness_fraction' ,& UNITS = '1' ,& SHORT_NAME = 'GRN' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'canopy_height' ,& UNITS = 'm' ,& SHORT_NAME = 'Z2CH' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'root_length' ,& UNITS = 'mm' ,& SHORT_NAME = 'ROOTL' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'sensible_heat_flux_from_turbulence',& UNITS = 'W m-2', & SHORT_NAME = 'SH', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'eastward_surface_stress', & UNITS = 'N m-2', & SHORT_NAME = 'TAUX', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'northward_surface_stress', & UNITS = 'N m-2', & SHORT_NAME = 'TAUY', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'evaporation_from_turbulence', & UNITS = 'kg m-2 s-1', & SHORT_NAME = 'EVAP', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '10-meter_eastward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'U10M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '10-meter_northward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'V10M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'equivalent_neutral_10-meter_eastward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'U10N', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'equivalent_neutral_10-meter_northward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'V10N', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '50-meter_eastward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'U50M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '50-meter_northward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'V50M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '10-meter_air_temperature', & UNITS = 'K', & SHORT_NAME = 'T10M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '10-meter_specific_humidity', & UNITS = 'kg kg-1', & SHORT_NAME = 'Q10M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '2-meter_eastward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'U2M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '2-meter_northward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'V2M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '2-meter_air_temperature', & UNITS = 'K', & SHORT_NAME = 'T2M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = '2-meter_specific_humidity', & UNITS = 'kg kg-1', & SHORT_NAME = 'Q2M', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_air_temperature', & UNITS = 'K', & SHORT_NAME = 'TA', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_air_specific_humidity', & UNITS = 'kg kg-1', & SHORT_NAME = 'QA', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_eastward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'UA', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_northward_wind', & UNITS = 'm s-1', & SHORT_NAME = 'VA', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GUST', & LONG_NAME = 'gustiness', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'VENT', & LONG_NAME = 'surface_ventilation_velocity', & UNITS = 'm s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'land_water_ice_flag', & UNITS = '0-1-2', & SHORT_NAME = 'LWI', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'snow_depth' ,& UNITS = 'm' ,& SHORT_NAME = 'SNOWDP' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'eastward_stress_over_water',& UNITS = 'N m-2' ,& SHORT_NAME = 'TAUXW' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'northward_stress_over_water',& UNITS = 'N m-2' ,& SHORT_NAME = 'TAUYW' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'eastward_stress_over_ice', & UNITS = 'N m-2' ,& SHORT_NAME = 'TAUXI' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'northward_stress_over_ice', & UNITS = 'N m-2' ,& SHORT_NAME = 'TAUYI' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'open_water_upward_sensible_heat_flux' ,& UNITS = 'W m-2' ,& SHORT_NAME = 'SHWTR' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'sea_ice_upward_sensible_heat_flux' ,& UNITS = 'W m-2' ,& SHORT_NAME = 'SHICE' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'open_water_latent_energy_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'HLATWTR' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'sea_ice_latent_energy_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'HLATICE' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'open_water_net_downward_longwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'LWNDWTR' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'sea_ice_net_downward_longwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'LWNDICE' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'open_water_net_downward_shortwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'SWNDWTR' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'sea_ice_net_downward_shortwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'SWNDICE' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'ocean_snowfall' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'SNOWOCN' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'ocean_rainfall' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RAINOCN' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'evaporation' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'EVAPOUT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'upward_sensible_heat_flux' ,& UNITS = 'W m-2' ,& SHORT_NAME = 'SHOUT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'runoff_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNOFF' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'interception_loss_energy_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'EVPINT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'baresoil_evap_energy_flux' ,& UNITS = 'W m-2' ,& SHORT_NAME = 'EVPSOI' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'transpiration_energy_flux' ,& UNITS = 'W m-2' ,& SHORT_NAME = 'EVPVEG' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'snowpack_evaporation_energy_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'EVPICE' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'baseflow_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'BASEFLOW' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_runoff_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'RUNSURF' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'EVLAND', & LONG_NAME = 'Evaporation_land', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LHLAND', & LONG_NAME = 'Latent_heat_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SHLAND', & LONG_NAME = 'Sensible_heat_flux_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SWLAND', & LONG_NAME = 'Net_shortwave_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWLAND', & LONG_NAME = 'Net_longwave_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'GHLAND', & LONG_NAME = 'Ground_heating_land', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SMLAND', & LONG_NAME = 'Snowmelt_flux_land', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TWLAND', & LONG_NAME = 'Avail_water_storage_land', & UNITS = 'kg m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TELAND', & LONG_NAME = 'Total_energy_storage_land', & UNITS = 'J m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSLAND', & LONG_NAME = 'Total_snow_storage_land', & UNITS = 'kg m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DWLAND', & LONG_NAME = 'rate_of_change_of_total_land_water',& UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DHLAND', & LONG_NAME = 'rate_of_change_of_total_land_energy',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SPLAND', & LONG_NAME = 'rate_of_spurious_land_energy_source',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SPWATR', & LONG_NAME = 'rate_of_spurious_land_water_source',& UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SPSNOW', & LONG_NAME = 'rate_of_spurious_snow_energy',& UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'snowmelt_flux' ,& UNITS = 'kg m-2 s-1' ,& SHORT_NAME = 'SMELT' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'surface_outgoing_longwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'HLWUP' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'surface_net_downward_longwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'LWNDSRF' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC ,& LONG_NAME = 'surface_net_downward_shortwave_flux',& UNITS = 'W m-2' ,& SHORT_NAME = 'SWNDSRF' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & LONG_NAME = 'total_latent_energy_flux' ,& UNITS = 'W m-2' ,& SHORT_NAME = 'LHFX' ,& DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ACCUM', & LONG_NAME = 'net_ice_accumulation_rate', & UNITS = 'kg m-2 s-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'ITY', & LONG_NAME = 'vegetation_type', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'NITY', & LONG_NAME = 'NCEP_vegetation_type', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) ! !INTERNAL STATE: ! These are here only because they are passed between run1 and run2. ! They don't need to be saved in restarts. Note they are all exported ! by being made friendly to self. ! Some may be needed by turbulence, but not in a Friendly way; others ! are only diagnostics. call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'QS', & LONG_NAME = 'surface_specific_humidity', & UNITS = '1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'TS', & LONG_NAME = 'surface_skin_temperature', & UNITS = 'K', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'CT', & LONG_NAME = 'surface_exchange_coefficient_for_heat', & UNITS = 'kg m-2 s-1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'CQ', & LONG_NAME = 'surface_exchange_coefficient_for_moisture', & UNITS = 'kg m-2 s-1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'CM', & LONG_NAME = 'surface_exchange_coefficient_for_momentum', & UNITS = 'kg m-2 s-1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'CN', & LONG_NAME = 'surface_neutral_drag_coefficient', & UNITS = '1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'THAT', & LONG_NAME = 'effective_surface_skin_temperature',& UNITS = 'K', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'QHAT', & LONG_NAME = 'effective_surface_specific_humidity',& UNITS = '1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'UHAT', & LONG_NAME = 'effective_surface_eastward_velocity',& UNITS = 'm s-1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'VHAT', & LONG_NAME = 'effective_surface_northward_velocity',& UNITS = 'm s-1', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & LONG_NAME = 'air_density_at_surface', & UNITS = 'kg m-3', & SHORT_NAME = 'RHOS', & FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC ,& LONG_NAME = 'zero_plane_displacement_height' ,& UNITS = 'm' ,& SHORT_NAME = 'D0' ,& FriendlyTO = trim(COMP_NAME), & DIMS = MAPL_DimsHorzOnly ,& VLOCATION = MAPL_VLocationNone ,& RC=STATUS ) VERIFY_(STATUS) !EOP #ifndef AQUA_PLANET LAKE = MAPL_AddChild(GC, NAME='LAKE', SS=LakeSetServices, RC=STATUS) VERIFY_(STATUS) LANDICE = MAPL_AddChild(GC, NAME='LANDICE', SS=LandiceSetServices, RC=STATUS) VERIFY_(STATUS) #endif OCEAN = MAPL_AddChild(GC, NAME='SALTWATER', SS=OceanSetServices, RC=STATUS) VERIFY_(STATUS) #ifndef AQUA_PLANET LAND = MAPL_AddChild(GC, NAME='LAND', SS=LandSetServices, RC=STATUS) VERIFY_(STATUS) #endif ! Get my internal MAPL_Generic state !----------------------------------- call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) call MAPL_Get(MAPL, GCNAMES = GCNames, RC=STATUS) VERIFY_(STATUS) ASSERT_(NUM_CHILDREN == size(GCNames)) CHILD_MASK(OCEAN ) = MAPL_OCEAN #ifndef AQUA_PLANET CHILD_MASK(LAKE ) = MAPL_LAKE CHILD_MASK(LANDICE) = MAPL_LANDICE CHILD_MASK(LAND ) = MAPL_LAND #endif ! By default MAPL_Generic tries to resolve Imports and Exports among ! the children; but our children do not talk to each other, only to us ! -------------------------------------------------------------------- call MAPL_TerminateImport ( GC, CHILD = OCEAN, RC=STATUS ) VERIFY_(STATUS) #ifndef AQUA_PLANET call MAPL_TerminateImport ( GC, CHILD = LAKE, RC=STATUS ) VERIFY_(STATUS) call MAPL_TerminateImport ( GC, CHILD = LANDICE, RC=STATUS ) VERIFY_(STATUS) call MAPL_TerminateImport ( GC, CHILD = LAND, RC=STATUS ) VERIFY_(STATUS) #endif ! Set the Profiling timers ! ------------------------ call MAPL_TimerAdd(GC, name="INITIALIZE" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="InitChild" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="LocStreamCreate" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="LocStreamXForm" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="-RUN1" ,RC=STATUS) VERIFY_(STATUS) do I=1,NUM_CHILDREN call MAPL_TimerAdd(GC, name="--RUN1_"//trim(GCNames(I)) ,RC=STATUS) VERIFY_(STATUS) end do call MAPL_TimerAdd(GC, name="-RUN2" ,RC=STATUS) VERIFY_(STATUS) do I=1,NUM_CHILDREN call MAPL_TimerAdd(GC, name="--RUN2_"//trim(GCNames(I)) ,RC=STATUS) VERIFY_(STATUS) end do ! Call SetServices for children !------------------------------ call MAPL_GenericSetServices ( GC, RC=STATUS ) VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) end subroutine SetServices !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !IROUTINE: Initialize -- Initialize method for the GEOS Surface 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 Surface Composite Gridded Component. ! It reads the tiling file that defines the exchange grid and sets-up the ! location streams for its children. It then does a Generic_Initialize !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Local derived type aliases type (MAPL_MetaComp ), pointer :: MAPL type (MAPL_MetaComp ), pointer :: CHILD_MAPL type (MAPL_LocStream ) :: LOCSTREAM type (MAPL_LocStream ) :: EXCH type (MAPL_LocStream ) :: CHILD_LS type (ESMF_Grid ) :: GRID type (ESMF_GridComp ), pointer :: GCS(:) character(len=ESMF_MAXSTR) :: TILEFILE type (T_SURFACE_STATE), pointer :: SURF_INTERNAL_STATE type (SURF_wrap) :: WRAP integer :: I real, pointer :: FRLAND (:,:) real, pointer :: FRLANDICE(:,:) real, pointer :: FRLAKE (:,:) real, pointer :: FROCEAN (:,:) integer, pointer, dimension(:) :: TYPE !============================================================================= ! Begin... ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- call ESMF_GridCompGet ( GC, name=COMP_NAME, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // "Initialize" ! Get my internal MAPL_Generic state !----------------------------------- call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) call MAPL_TimerOn(MAPL,"INITIALIZE") ! Get my internal private state. This contains the transforms ! between the exchange grid and the atmos grid. !------------------------------------------------------------- call ESMF_UserCompGetInternalState(gc, 'SURF_state', wrap, status) VERIFY_(STATUS) SURF_INTERNAL_STATE => WRAP%PTR ! Get the grid ! ------------ call ESMF_GridCompGet( GC, grid=GRID, RC=STATUS ) VERIFY_(STATUS) ! Create the LocStream for the full exchange grid and put it in the state ! ----------------------------------------------------------------------- call MAPL_TimerOn(MAPL,"LocStreamCreate") call MAPL_Get(MAPL, ExchangeGrid=exch, rc=status) VERIFY_(STATUS) LOCSTREAM = EXCH call MAPL_Set (MAPL, LocStream=LOCSTREAM, RC=STATUS ) VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"LocStreamCreate") ! Get the children's GCS !----------------------- call MAPL_Get ( MAPL, GCS=GCS, RC=STATUS ) VERIFY_(STATUS) ! Create the children's location streams as subsets of the exhange grid !---------------------------------------------------------------------- call MAPL_TimerOn(MAPL,"LocStreamCreate") do I = 1, NUM_CHILDREN call MAPL_LocStreamCreate(CHILD_LS, LOCSTREAM, & NAME = GCNAMES(I) , & MASK = (/CHILD_MASK(I)/), & RC=STATUS ) VERIFY_(STATUS) call MAPL_GetObjectFromGC ( GCS(I) , CHILD_MAPL, RC=STATUS ) VERIFY_(STATUS) call MAPL_Set (CHILD_MAPL, LOCSTREAM=CHILD_LS, RC=STATUS ) VERIFY_(STATUS) end do call MAPL_TimerOff(MAPL,"LocStreamCreate") ! Call Initialize for every Child !-------------------------------- call MAPL_TimerOn(MAPL,"InitChild") call MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC=STATUS) VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"InitChild") ! Create LocStreams Surface_to_child and child_to_surface transforms !------------------------------------------------------------------- call MAPL_Get(MAPL, & TILETYPES = TYPE, & LOCSTREAM = LOCSTREAM, & RC=STATUS ) VERIFY_(STATUS) ! Static grid exports !-------------------- call MAPL_GetPointer(EXPORT, FRLAND, 'FRLAND', ALLOC=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FRLAKE, 'FRLAKE', ALLOC=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FRLANDICE, 'FRLANDICE', ALLOC=.true., RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FROCEAN, 'FROCEAN', ALLOC=.true., RC=STATUS) VERIFY_(STATUS) ! Fractional areas of each type onthe atmospheric grid, which is the grid ! attached to the surface locstream !------------------------------------------------------------------------ call MAPL_LocStreamFracArea( LOCSTREAM, MAPL_OCEAN , FROCEAN , RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamFracArea( LOCSTREAM, MAPL_LAND , FRLAND , RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamFracArea( LOCSTREAM, MAPL_LAKE , FRLAKE , RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamFracArea( LOCSTREAM, MAPL_LANDICE, FRLANDICE, RC=STATUS) VERIFY_(STATUS) FRLANDICE = max(min(FRLANDICE,1.0),0.0) FRLAND = max(min(FRLAND ,1.0),0.0) FRLAKE = max(min(FRLAKE ,1.0),0.0) FROCEAN = max(min(FROCEAN ,1.0),0.0) ! Create transforms to and from the child streams and the surface stream ! and save them in the surface internal state. !----------------------------------------------------------------------- call MAPL_TimerOn(MAPL,"LocStreamXForm") do I = 1, NUM_CHILDREN call MAPL_GetObjectFromGC ( GCS(I) , CHILD_MAPL, RC=STATUS ) VERIFY_(STATUS) call MAPL_Get (CHILD_MAPL, LOCSTREAM=CHILD_LS, RC=STATUS ) VERIFY_(STATUS) call MAPL_LocStreamCreateXform ( XFORM=SURF_INTERNAL_STATE%XFORM_IN(I), & LocStreamOut=CHILD_LS, & LocStreamIn=LOCSTREAM, & NAME=GCNAMES(I), & RC=STATUS ) VERIFY_(STATUS) call MAPL_LocStreamCreateXform ( XFORM=SURF_INTERNAL_STATE%XFORM_OUT(I), & LocStreamOut=LOCSTREAM, & LocStreamIn=CHILD_LS, & NAME=GCNAMES(I), & MASK_OUT=TYPE == CHILD_MASK(I), & RC=STATUS ) VERIFY_(STATUS) end do call MAPL_TimerOff(MAPL,"LocStreamXForm") ! All Done !--------- call MAPL_TimerOff(MAPL,"INITIALIZE") RETURN_(ESMF_SUCCESS) end subroutine Initialize !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !BOP ! !IROUTINE: RUN1 -- First stage Run method for the Surface component ! !INTERFACE: subroutine RUN1 ( 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: Interfaces to the children RUN1 methods, which compute ! the surface exchange coefficients. In addition to exchange coefficients ! for heat, moisture, and momentum, it also computes effective ! surface values of the diffused quantities on the atmospheric grid. ! These are exchange-coefficient-weighted averages of the tile values ! within an atmospheric grid box. !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Locals type (MAPL_MetaComp), pointer :: MAPL type (ESMF_GridComp), pointer :: GCS(:) type (ESMF_State), pointer :: GIM(:) type (ESMF_State), pointer :: GEX(:) type (ESMF_State) :: INTERNAL type (MAPL_LocStream) :: LOCSTREAM character(len=ESMF_MAXSTR), pointer :: GCNames(:) integer :: NT integer, pointer, dimension(:) :: TYPE type (T_SURFACE_STATE), pointer :: SURF_INTERNAL_STATE type (SURF_wrap) :: WRAP ! Pointers to imports real, pointer, dimension(:,:) :: PS real, pointer, dimension(:,:) :: TA real, pointer, dimension(:,:) :: QA real, pointer, dimension(:,:) :: DZ real, pointer, dimension(:,:) :: UU real, pointer, dimension(:,:) :: UWINDLM real, pointer, dimension(:,:) :: VWINDLM real, pointer, dimension(:,:) :: PCU real, pointer, dimension(:,:) :: PHIS ! Pointers to gridded internals real, pointer, dimension(:,:) :: CT real, pointer, dimension(:,:) :: CQ real, pointer, dimension(:,:) :: CM real, pointer, dimension(:,:) :: CN real, pointer, dimension(:,:) :: TH real, pointer, dimension(:,:) :: QH real, pointer, dimension(:,:) :: SH real, pointer, dimension(:,:) :: UH real, pointer, dimension(:,:) :: VH real, pointer, dimension(:,:) :: TS real, pointer, dimension(:,:) :: QS real, pointer, dimension(:,:) :: RHOS real, pointer, dimension(:,:) :: D0 ! Pointers to gridded exports real, pointer, dimension(:,:) :: RI real, pointer, dimension(:,:) :: RE real, pointer, dimension(:,:) :: QDWL real, pointer, dimension(:,:) :: QFRL real, pointer, dimension(:,:) :: USTAR real, pointer, dimension(:,:) :: BSTAR real, pointer, dimension(:,:) :: LAI real, pointer, dimension(:,:) :: GRN real, pointer, dimension(:,:) :: ROOTL real, pointer, dimension(:,:) :: Z2CH real, pointer, dimension(:,:) :: VNT real, pointer, dimension(:,:) :: GST real, pointer, dimension(:,:) :: Z0 real, pointer, dimension(:,:) :: MOU10M real, pointer, dimension(:,:) :: MOV10M real, pointer, dimension(:,:) :: MOT2M real, pointer, dimension(:,:) :: MOQ2M real, pointer, dimension(:,:) :: ITY real, pointer, dimension(:,:) :: NITY real, pointer, dimension(:,:) :: Z0H ! Pointers to tile versions of imports real, pointer, dimension(:) :: PSTILE real, pointer, dimension(:) :: TATILE real, pointer, dimension(:) :: QATILE real, pointer, dimension(:) :: DZTILE real, pointer, dimension(:) :: UUTILE real, pointer, dimension(:) :: UWINDLMTILE real, pointer, dimension(:) :: VWINDLMTILE real, pointer, dimension(:) :: PCUTILE ! Pointers to tiled versions of internals real, pointer, dimension(:) :: CTTILE => NULL() real, pointer, dimension(:) :: CMTILE => NULL() real, pointer, dimension(:) :: CQTILE => NULL() real, pointer, dimension(:) :: CNTILE => NULL() real, pointer, dimension(:) :: RETILE => NULL() real, pointer, dimension(:) :: RITILE => NULL() real, pointer, dimension(:) :: THTILE => NULL() real, pointer, dimension(:) :: QHTILE => NULL() real, pointer, dimension(:) :: UHTILE => NULL() real, pointer, dimension(:) :: VHTILE => NULL() real, pointer, dimension(:) :: TSTILE => NULL() real, pointer, dimension(:) :: QSTILE => NULL() real, pointer, dimension(:) :: D0TILE => NULL() ! Pointers to tiled versions of exports real, pointer, dimension(:) :: LAITILE => NULL() real, pointer, dimension(:) :: GRNTILE => NULL() real, pointer, dimension(:) :: ROOTLTILE => NULL() real, pointer, dimension(:) :: Z2CHTILE => NULL() real, pointer, dimension(:) :: VNTTILE => NULL() real, pointer, dimension(:) :: GSTTILE => NULL() real, pointer, dimension(:) :: Z0HTILE => NULL() real, pointer, dimension(:) :: Z0TILE => NULL() real, pointer, dimension(:) :: MOU10MTILE => NULL() real, pointer, dimension(:) :: MOV10MTILE => NULL() real, pointer, dimension(:) :: MOT2MTILE => NULL() real, pointer, dimension(:) :: MOQ2MTILE => NULL() real, pointer, dimension(:) :: ITYTILE => NULL() type (MAPL_MetaComp), pointer :: CHILD_MAPL integer :: I !============================================================================= ! Begin... ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- Iam = 'Run1' call ESMF_GridCompGet( GC, name=COMP_NAME, VM=VMG, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // Iam ! Get my internal MAPL_Generic state !----------------------------------- call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) call ESMF_UserCompGetInternalState(GC, 'SURF_state', wrap, status) VERIFY_(STATUS) SURF_INTERNAL_STATE => WRAP%PTR ! Start Total timer !------------------ call MAPL_TimerOn(MAPL,"TOTAL") call MAPL_TimerOn(MAPL,"-RUN1" ) ! Get parameters from generic state. !----------------------------------- call MAPL_Get(MAPL, & LOCSTREAM = LOCSTREAM, & GIM = GIM, & GEX = GEX, & TILETYPES = TYPE, & GCS = GCS, & GCNAMES = GCNAMES, & INTERNAL_ESMF_STATE = INTERNAL, & RC=STATUS ) VERIFY_(STATUS) ! Pointers to imports !-------------------- call MAPL_GetPointer(IMPORT , PS , 'PS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DZ , 'DZ' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , UU , 'SPEED' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , UWINDLM , 'UA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , VWINDLM , 'VA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , TA , 'TA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , QA , 'QA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , PCU , 'PCU' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , PHIS , 'PHIS' , RC=STATUS); VERIFY_(STATUS) ! Pointers to grid outputs !------------------------- ! These are computed by the children in tile space and transformed call MAPL_GetPointer(EXPORT , RI , 'RI' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RE , 'RE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , GRN , 'GRN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ROOTL , 'ROOTL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , Z2CH , 'Z2CH' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , VNT , 'VENT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , GST , 'GUST' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , Z0 , 'Z0' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOU10M , 'MOU10M' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOV10M , 'MOV10M' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOT2M , 'MOT2M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , MOQ2M , 'MOQ2M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , Z0H , 'Z0H' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , NITY , 'NITY' , RC=STATUS); VERIFY_(STATUS) ! Need to force LAI if GRN is required. call MAPL_GetPointer(EXPORT , LAI , 'LAI' , alloc=associated(GRN), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ITY , 'ITY' , alloc=associated(NITY), RC=STATUS) VERIFY_(STATUS) ! These are computed by SURFACE in grid space and have no tile versions call MAPL_GetPointer(EXPORT , SH , 'SHAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , QDWL , 'QDWL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , QFRL , 'QFRL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , BSTAR , 'BSTAR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , USTAR , 'USTAR' , RC=STATUS); VERIFY_(STATUS) ! These are force-allocated because run2 needs them or their space call MAPL_GetPointer(INTERNAL, TS , 'TS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, QS , 'QS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CT , 'CT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CQ , 'CQ' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CM , 'CM' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CN , 'CN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, QH , 'QHAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, TH , 'THAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, UH , 'UHAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, VH , 'VHAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, RHOS , 'RHOS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, D0 , 'D0' , RC=STATUS); VERIFY_(STATUS) ! Size of exchange grid !---------------------- NT = size(TYPE) ! Allocate tile versions of imports !----------------------------------- allocate( PSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DZTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( UUTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( UWINDLMTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( VWINDLMTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( TATILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( QATILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( PCUTILE(NT), STAT=STATUS) VERIFY_(STATUS) ! Imports at the tiles !--------------------- call MAPL_LocStreamTransform( LOCSTREAM, PSTILE, PS, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, TATILE, TA, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, QATILE, QA, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DZTILE, DZ, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, UUTILE, UU, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, UWINDLMTILE, UWINDLM, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, VWINDLMTILE, VWINDLM, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, PCUTILE, PCU, RC=STATUS); VERIFY_(STATUS) ! Allocate tile versions of internal !------------------------------------ ! We do not need a tile version of RHOS allocate( CTTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( CQTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( CMTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( CNTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( TSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( QSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( THTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( QHTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( UHTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( VHTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( D0TILE(NT), STAT=STATUS) VERIFY_(STATUS) ! Allocate tile versions of needed exports that are filled by children !--------------------------------------------------------------------- call MKTILE(LAI , LAITILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(GRN , GRNTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(ROOTL , ROOTLTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(Z2CH , Z2CHTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(VNT , VNTTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(GST , GSTTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(Z0H , Z0HTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(Z0 , Z0TILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(MOU10M , MOU10MTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(MOV10M , MOV10MTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(MOT2M , MOT2MTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(MOQ2M , MOQ2MTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(ITY , ITYTILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(RI , RITILE , NT, RC=STATUS); VERIFY_(STATUS) call MKTILE(RE , RETILE , NT, RC=STATUS); VERIFY_(STATUS) ! If the child does not produce them, we want these zeroed. !--------------------------------------------------------- UHTILE = 0.0 VHTILE = 0.0 D0TILE = 0.0 ! Do the run1 (surface layer calculations) for each child. !-------------------------------------------------------- do I = 1, NUM_CHILDREN call DOCDS(I, NT, RC=STATUS) VERIFY_(STATUS) end do ! Grid exports !------------- if(associated(GRNTILE)) then where(GRNTILE /= MAPL_UNDEF) GRNTILE = GRNTILE*LAITILE endif if(associated( RI)) then call MAPL_LocStreamTransform( LOCSTREAM, RI, RITILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( RE)) then call MAPL_LocStreamTransform( LOCSTREAM, RE, RETILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( LAI)) then call MAPL_LocStreamTransform( LOCSTREAM, LAI, LAITILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( GRN)) then call MAPL_LocStreamTransform( LOCSTREAM, GRN, GRNTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( ROOTL)) then call MAPL_LocStreamTransform( LOCSTREAM, ROOTL, ROOTLTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( Z2CH)) then call MAPL_LocStreamTransform( LOCSTREAM, Z2CH, Z2CHTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( VNT)) then call MAPL_LocStreamTransform( LOCSTREAM, VNT, VNTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( GST)) then call MAPL_LocStreamTransform( LOCSTREAM, GST, GSTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( Z0H)) then call MAPL_LocStreamTransform( LOCSTREAM, Z0H, Z0HTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( Z0)) then call MAPL_LocStreamTransform( LOCSTREAM, Z0, Z0TILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(ITY)) then call MAPL_LocStreamTransform( LOCSTREAM, ITY, ITYTILE, SAMPLE=.true., RC=STATUS) VERIFY_(STATUS) endif if(associated(MOU10M)) then call MAPL_LocStreamTransform( LOCSTREAM, MOU10M, MOU10MTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(MOV10M)) then call MAPL_LocStreamTransform( LOCSTREAM, MOV10M, MOV10MTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(MOT2M)) then call MAPL_LocStreamTransform( LOCSTREAM, MOT2M, MOT2MTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(MOQ2M)) then call MAPL_LocStreamTransform( LOCSTREAM, MOQ2M, MOQ2MTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(GRN)) then where(GRN /= MAPL_UNDEF .and. LAI>= 0.0) GRN = GRN/LAI elsewhere GRN = MAPL_UNDEF end where endif if( associated(NITY) ) then where ( ITY==1 ) NITY=1 where ( ITY==2 ) NITY=2 where ( ITY==3 ) NITY=4 where ( ITY==4 ) NITY=7 where ( ITY==5 ) NITY=9 where ( ITY==6 ) NITY=10 where ( ITY==7 ) NITY=11 where ( ITY==13) NITY=13 endif ! 1 ... broadleave-evergreen trees (tropical forest) MAP TO ITYP=1 ! 2 ... broadleave-deciduous trees MAP to ITYP=2 ! 3 ... broadleave and needle leave trees (mixed forest) ! (For this, we map 1/2 to ITYP=2 and 1/2 to ITYP=3) ! 4 ... needleleave-evergreen trees MAP to ITYP=3 ! 5 ... needleleave-deciduous trees (larch) MAP to ITYP=3 ! 6 ... broadleave trees with groundcover (savanna) ! (For this, we map 1/10 to ITYP=2 and 9/10 to ITYP=4) ! 7 ... groundcover only (perenial) MAP to ITYP=4 ! 8 ... broadleave shrubs with perenial groundcover ! (For this, we map 0.25(?) to ITYP=5 and 0.75 to ITYP=4) ! 9 ... broadleave shrubs with bare soil MAP to ITYP=5 ! 10 ... dwarf trees and shrubs with ground cover (trunda) MAP to ITYP=6 ! 11 ... bare soil MAP to ITYP=7 ! 12 ... cultivations (use parameters from type 7) MAP to ITYP=4 ! 13 ... glacial ! Effective surface values on atmos grid. These and the ceoffs ! are forced exports because run2 needs them. !------------------------------------------------------------- THTILE = THTILE*CTTILE QHTILE = QHTILE*CQTILE UHTILE = UHTILE*CMTILE VHTILE = VHTILE*CMTILE call MAPL_LocStreamTransform( LOCSTREAM, CT, CTTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, CM, CMTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, CQ, CQTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, CN, CNTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, TH, THTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, QH, QHTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, UH, UHTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, VH, VHTILE, RC=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, D0, D0TILE, RC=STATUS) VERIFY_(STATUS) ! These are in the internal state QH = QH/CQ TH = TH/CT UH = UH/CM VH = VH/CM RHOS = PS / ( MAPL_RGAS*TA*(1.+MAPL_VIREPS*QA) ) if(associated(QDWL )) QDWL = 0. if(associated(QFRL )) QFRL = 0. if(associated(SH )) SH = MAPL_CP*TH + PHIS if(associated(USTAR)) USTAR = sqrt(CM*UU/RHOS) if(associated(BSTAR)) BSTAR = (MAPL_GRAV/(RHOS*sqrt(CM*max(UU,1.e-30)/RHOS))) * & (CT*(TH-TA-(MAPL_GRAV/MAPL_CP)*DZ)/TA + MAPL_VIREPS*CQ*(QH-QA)) ! Clean-up !--------- if(associated( LAITILE)) deallocate( LAITILE) if(associated( GRNTILE)) deallocate( GRNTILE) if(associated(ROOTLTILE)) deallocate( ROOTLTILE) if(associated( Z2CHTILE)) deallocate( Z2CHTILE) if(associated( VNTTILE)) deallocate( VNTTILE) if(associated( GSTTILE)) deallocate( GSTTILE) if(associated( Z0HTILE)) deallocate( Z0HTILE) if(associated( Z0TILE)) deallocate( Z0TILE) if(associated( ITYTILE))deallocate( ITYTILE) if(associated(MOU10MTILE))deallocate(MOU10MTILE) if(associated(MOV10MTILE))deallocate(MOV10MTILE) if(associated(MOT2MTILE)) deallocate( MOT2MTILE) if(associated(MOQ2MTILE)) deallocate( MOQ2MTILE) if(associated( RITILE)) deallocate( RITILE) if(associated( RETILE)) deallocate( RETILE) if(associated( CTTILE)) deallocate( CTTILE) if(associated( CQTILE)) deallocate( CQTILE) if(associated( CMTILE)) deallocate( CMTILE) if(associated( CNTILE)) deallocate( CNTILE) if(associated( TSTILE)) deallocate( TSTILE) if(associated( QSTILE)) deallocate( QSTILE) if(associated( THTILE)) deallocate( THTILE) if(associated( QHTILE)) deallocate( QHTILE) if(associated( UHTILE)) deallocate( UHTILE) if(associated( VHTILE)) deallocate( VHTILE) if(associated( D0TILE)) deallocate( D0TILE) if(associated( DZTILE)) deallocate( DZTILE) if(associated( PSTILE)) deallocate( PSTILE) if(associated( PCUTILE)) deallocate( PCUTILE) if(associated( QATILE)) deallocate( QATILE) if(associated( TATILE)) deallocate( TATILE) if(associated( UUTILE)) deallocate( UUTILE) if(associated( UWINDLMTILE)) deallocate( UWINDLMTILE) if(associated( VWINDLMTILE)) deallocate( VWINDLMTILE) ! All done !----------- call ESMF_VMBarrier(VMG, rc=status) VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"-RUN1" ) call MAPL_TimerOff(MAPL,"TOTAL") RETURN_(ESMF_SUCCESS) contains subroutine DOCDS(type, NT, RC) integer, intent( IN) :: type integer, intent( IN) :: NT integer, optional, intent(OUT) :: RC ! Locals character(len=ESMF_MAXSTR) :: IAm integer :: STATUS integer :: N type (MAPL_LocStreamXFORM) :: XFORM real, pointer :: DUM(:) ! Begin... !---------- IAM = trim(COMP_NAME) // "DOCDS" call MAPL_TimerOn(MAPL, trim(GCNames(type))) call MAPL_TimerOn(MAPL,"--RUN1_"//trim(GCNames(type))) call MAPL_Get(MAPL, GCNAMES = GCNAMES, RC=STATUS ) VERIFY_(STATUS) ! Fill the child's locstream imports from the Surface exchange grid imports !-------------------------------------------------------------------------- XFORM = surf_internal_state%xform_in(type) call FILLIN_TILE(GIM(type), 'PS', PSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DZ', DZTILE, XFORM, RC=STATUS) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'UU', UUTILE, XFORM, RC=STATUS) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'UWINDLMTILE', UWINDLMTILE, XFORM, RC=STATUS) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'VWINDLMTILE', VWINDLMTILE, XFORM, RC=STATUS) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'TA', TATILE, XFORM, RC=STATUS) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'QA', QATILE, XFORM, RC=STATUS) VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'PCU', PCUTILE, XFORM, RC=STATUS) VERIFY_(STATUS) ! Allocate the child's needed exports !------------------------------------ ! Note that the first batch is really forced by the allocation in RUN1 proper. call MAPL_GetPointer(GEX(type), dum, 'TST', ALLOC=associated( TSTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'QST', ALLOC=associated( QSTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'TH', ALLOC=associated( THTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'QH', ALLOC=associated( QHTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'CHT', ALLOC=associated( CTTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'CQT', ALLOC=associated( CQTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'CMT', ALLOC=associated( CMTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'CNT', ALLOC=associated( CNTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'RIT', ALLOC=associated( RITILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'Z0', ALLOC=associated( Z0TILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum,'MOU10M',ALLOC=associated(MOU10MTILE),RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum,'MOV10M',ALLOC=associated(MOV10MTILE),RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum,'MOT2M',ALLOC=associated(MOT2MTILE),RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum,'MOQ2M',ALLOC=associated(MOQ2MTILE),RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'Z0H', ALLOC=associated(Z0HTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum,'VENT', ALLOC=associated(VNTTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum,'GUST', ALLOC=associated(GSTTILE), RC=STATUS) VERIFY_(STATUS) ! These cannot be verified, because they dont exists in all children. !------------------------------------------------------------------- call MAPL_GetPointer(GEX(type), dum, 'LAI', ALLOC=associated( LAITILE)) call MAPL_GetPointer(GEX(type), dum, 'GRN', ALLOC=associated( GRNTILE)) call MAPL_GetPointer(GEX(type), dum, 'ROOTL', ALLOC=associated(ROOTLTILE)) call MAPL_GetPointer(GEX(type), dum, 'Z2CH', ALLOC=associated( Z2CHTILE)) call MAPL_GetPointer(GEX(type), dum, 'D0', ALLOC=associated( D0TILE)) call MAPL_GetPointer(GEX(type), dum, 'UH', ALLOC=associated( UHTILE)) call MAPL_GetPointer(GEX(type), dum, 'VH', ALLOC=associated( VHTILE)) call MAPL_GetPointer(GEX(type), dum, 'RET', ALLOC=associated( RETILE)) call MAPL_GetPointer(GEX(type), dum, 'ITY', ALLOC=associated( ITYTILE)) ! Call Child !----------- call ESMF_GridCompRun (GCS(type), GIM(type), GEX(type), & CLOCK, 1-1, RC=STATUS ) VERIFY_(STATUS) ! Use childs exports to fill exchange grid exports. !-------------------------------------------------- XFORM = surf_internal_state%xform_out(type) ! Again the first batch is forced, but we test anyway since it does not hurt. if(associated(TSTILE)) then call FILLOUT_TILE(GEX(type), 'TST', TSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(QSTILE)) then call FILLOUT_TILE(GEX(type), 'QST', QSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(THTILE)) then call FILLOUT_TILE(GEX(type), 'TH', THTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(QHTILE)) then call FILLOUT_TILE(GEX(type), 'QH', QHTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(UHTILE)) then call FILLOUT_TILE(GEX(type), 'UH', UHTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(VHTILE)) then call FILLOUT_TILE(GEX(type), 'VH', VHTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(CTTILE)) then call FILLOUT_TILE(GEX(type), 'CHT', CTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(CQTILE)) then call FILLOUT_TILE(GEX(type), 'CQT', CQTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(CMTILE)) then call FILLOUT_TILE(GEX(type), 'CMT', CMTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(CNTILE)) then call FILLOUT_TILE(GEX(type), 'CNT', CNTILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(D0TILE)) then call FILLOUT_TILE(GEX(type), 'D0', D0TILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(RITILE)) then call FILLOUT_TILE(GEX(type), 'RIT', RITILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(RETILE)) then call FILLOUT_TILE(GEX(type), 'RET', RETILE, XFORM, RC=STATUS) VERIFY_(STATUS) endif if(associated(LAITILE)) then call FILLOUT_TILE(GEX(type), 'LAI', LAITILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(GRNTILE)) then call FILLOUT_TILE(GEX(type), 'GRN', GRNTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ROOTLTILE)) then call FILLOUT_TILE(GEX(type), 'ROOTL', ROOTLTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(Z2CHTILE)) then call FILLOUT_TILE(GEX(type), 'Z2CH', Z2CHTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(VNTTILE)) then call FILLOUT_TILE(GEX(type), 'VENT', VNTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(GSTTILE)) then call FILLOUT_TILE(GEX(type), 'GUST', GSTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(Z0HTILE)) then call FILLOUT_TILE(GEX(type), 'Z0H', Z0HTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(Z0TILE)) then call FILLOUT_TILE(GEX(type), 'Z0', Z0TILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ITYTILE)) then call FILLOUT_TILE(GEX(type), 'ITY', ITYTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(MOU10MTILE)) then call FILLOUT_TILE(GEX(type),'MOU10M',MOU10MTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(MOV10MTILE)) then call FILLOUT_TILE(GEX(type),'MOV10M',MOV10MTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(MOT2MTILE)) then call FILLOUT_TILE(GEX(type), 'MOT2M', MOT2MTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(MOQ2MTILE)) then call FILLOUT_TILE(GEX(type), 'MOQ2M', MOQ2MTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if call MAPL_TimerOff(MAPL,"--RUN1_"//trim(GCNames(type))) call MAPL_TimerOff(MAPL, trim(GCNames(type))) RETURN_(ESMF_SUCCESS) end subroutine DOCDS end subroutine RUN1 !BOP ! !IROUTINE: RUN2 -- Second Run method for the Surface component ! !INTERFACE: subroutine RUN2 ( 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: !EOP ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Local derived type aliases type (MAPL_MetaComp), pointer :: MAPL type (MAPL_SunOrbit) :: ORBIT type (ESMF_State) :: INTERNAL type (ESMF_Alarm) :: ALARM type (ESMF_GridComp), pointer :: GCS(:) type (ESMF_State), pointer :: GIM(:) type (ESMF_State), pointer :: GEX(:) type (ESMF_TimeInterval) :: DELT type (MAPL_LocStream) :: LOCSTREAM type (T_SURFACE_STATE), pointer :: surf_internal_state type (SURF_wrap) :: wrap character(len=ESMF_MAXSTR), pointer :: GCNames(:) integer :: IM, JM, NT real :: SC real, pointer, dimension(:,:) :: LATS real, pointer, dimension(:,:) :: LONS real, pointer, dimension(:) :: tileLATS real, pointer, dimension(:) :: tileLONS integer, pointer, dimension(:) :: type ! Pointers to imports real, pointer, dimension(:,:) :: PS real, pointer, dimension(:,:) :: DZ real, pointer, dimension(:,:) :: UU real, pointer, dimension(:,:) :: EVAP real, pointer, dimension(:,:) :: SH real, pointer, dimension(:,:) :: DEVAP real, pointer, dimension(:,:) :: DSH real, pointer, dimension(:,:) :: PCU real, pointer, dimension(:,:) :: PLS real, pointer, dimension(:,:) :: SNOFL real, pointer, dimension(:,:) :: TAUX real, pointer, dimension(:,:) :: TAUY real, pointer, dimension(:,:) :: DRPARN real, pointer, dimension(:,:) :: DFPARN real, pointer, dimension(:,:) :: DRNIRN real, pointer, dimension(:,:) :: DFNIRN real, pointer, dimension(:,:) :: DRUVRN real, pointer, dimension(:,:) :: DFUVRN real, pointer, dimension(:,:) :: LWDNSRF !wcc real, pointer, dimension(:,:) :: SFC_RATIO !wcc !wcc real, pointer, dimension(:,:) :: ALW real, pointer, dimension(:,:) :: BLW ! Pointers to internals real, pointer, dimension(:,:) :: TS real, pointer, dimension(:,:) :: QS real, pointer, dimension(:,:) :: CM real, pointer, dimension(:,:) :: CT real, pointer, dimension(:,:) :: CQ real, pointer, dimension(:,:) :: CN real, pointer, dimension(:,:) :: TH real, pointer, dimension(:,:) :: QH real, pointer, dimension(:,:) :: UH real, pointer, dimension(:,:) :: VH real, pointer, dimension(:,:) :: RHOS real, pointer, dimension(:,:) :: D0 ! Pointers to exports real, pointer, dimension(:,:) :: FRI real, pointer, dimension(:,:) :: EMISS real, pointer, dimension(:,:) :: ALBVR real, pointer, dimension(:,:) :: ALBVF real, pointer, dimension(:,:) :: ALBNF real, pointer, dimension(:,:) :: ALBNR real, pointer, dimension(:,:) :: DELSS real, pointer, dimension(:,:) :: DELUS real, pointer, dimension(:,:) :: DELVS real, pointer, dimension(:,:) :: DELTS real, pointer, dimension(:,:) :: DELQS real, pointer, dimension(:,:) :: DLQLL real, pointer, dimension(:,:) :: DLQIL real, pointer, dimension(:,:) :: TSOIL1 real, pointer, dimension(:,:) :: ASNOW real, pointer, dimension(:,:) :: TPSNO real, pointer, dimension(:,:) :: TPUST real, pointer, dimension(:,:) :: TPSAT real, pointer, dimension(:,:) :: TPWLT real, pointer, dimension(:,:) :: FRSAT real, pointer, dimension(:,:) :: FRUST real, pointer, dimension(:,:) :: FRWLT real, pointer, dimension(:,:) :: SNOMAS real, pointer, dimension(:,:) :: SNOWDP real, pointer, dimension(:,:) :: WET1 real, pointer, dimension(:,:) :: WET2 real, pointer, dimension(:,:) :: TAUXO real, pointer, dimension(:,:) :: TAUYO real, pointer, dimension(:,:) :: EVAPO real, pointer, dimension(:,:) :: SHO real, pointer, dimension(:,:) :: USTAR real, pointer, dimension(:,:) :: TSTAR real, pointer, dimension(:,:) :: QSTAR real, pointer, dimension(:,:) :: U10M real, pointer, dimension(:,:) :: V10M real, pointer, dimension(:,:) :: U10N real, pointer, dimension(:,:) :: V10N real, pointer, dimension(:,:) :: U50M real, pointer, dimension(:,:) :: V50M real, pointer, dimension(:,:) :: T10M real, pointer, dimension(:,:) :: Q10M real, pointer, dimension(:,:) :: U2M real, pointer, dimension(:,:) :: V2M real, pointer, dimension(:,:) :: T2M real, pointer, dimension(:,:) :: Q2M real, pointer, dimension(:,:) :: UAX real, pointer, dimension(:,:) :: VAX real, pointer, dimension(:,:) :: TA real, pointer, dimension(:,:) :: QA real, pointer, dimension(:,:) :: LWI real, pointer, dimension(:,:) :: FROCEAN real, pointer, dimension(:,:) :: FRLAKE real, pointer, dimension(:,:) :: FRLAND real, pointer, dimension(:,:) :: FRLANDICE real, pointer, dimension(:,:) :: HLATN real, pointer, dimension(:,:) :: HLATWTR real, pointer, dimension(:,:) :: HLATICE real, pointer, dimension(:,:) :: SHWTR real, pointer, dimension(:,:) :: SHICE real, pointer, dimension(:,:) :: TAUXW real, pointer, dimension(:,:) :: TAUXI real, pointer, dimension(:,:) :: TAUYW real, pointer, dimension(:,:) :: TAUYI real, pointer, dimension(:,:) :: LWNDWTR real, pointer, dimension(:,:) :: SWNDWTR real, pointer, dimension(:,:) :: LWNDICE real, pointer, dimension(:,:) :: SWNDICE real, pointer, dimension(:,:) :: SNOWOCN real, pointer, dimension(:,:) :: RAINOCN real, pointer, dimension(:,:) :: EVAPOU real, pointer, dimension(:,:) :: SHOU real, pointer, dimension(:,:) :: HLWUP real, pointer, dimension(:,:) :: LWNDSRF real, pointer, dimension(:,:) :: SWNDSRF real, pointer, dimension(:,:) :: RUNOFF real, pointer, dimension(:,:) :: RUNSURF real, pointer, dimension(:,:) :: BASEFLOW real, pointer, dimension(:,:) :: ACCUM real, pointer, dimension(:,:) :: SMELT real, pointer, dimension(:,:) :: EVEG real, pointer, dimension(:,:) :: EINT real, pointer, dimension(:,:) :: EICE real, pointer, dimension(:,:) :: ESOI real, pointer, dimension(:,:) :: EVLAND real, pointer, dimension(:,:) :: LHLAND real, pointer, dimension(:,:) :: SHLAND real, pointer, dimension(:,:) :: SWLAND real, pointer, dimension(:,:) :: LWLAND real, pointer, dimension(:,:) :: GHLAND real, pointer, dimension(:,:) :: SMLAND real, pointer, dimension(:,:) :: TWLAND real, pointer, dimension(:,:) :: TELAND real, pointer, dimension(:,:) :: TSLAND real, pointer, dimension(:,:) :: DWLAND real, pointer, dimension(:,:) :: DHLAND real, pointer, dimension(:,:) :: SPLAND real, pointer, dimension(:,:) :: SPWATR real, pointer, dimension(:,:) :: SPSNOW ! These are the tile versions of the imports real, pointer, dimension(:) :: PSTILE real, pointer, dimension(:) :: DZTILE real, pointer, dimension(:) :: UUTILE real, pointer, dimension(:) :: EVPTILE real, pointer, dimension(:) :: SHFTILE real, pointer, dimension(:) :: DEVTILE real, pointer, dimension(:) :: DSHTILE real, pointer, dimension(:) :: PCUTILE real, pointer, dimension(:) :: PLSTILE real, pointer, dimension(:) :: SNOFLTILE real, pointer, dimension(:) :: TAUXTILE real, pointer, dimension(:) :: TAUYTILE real, pointer, dimension(:) :: DFPTILE real, pointer, dimension(:) :: DRPTILE real, pointer, dimension(:) :: DFNTILE real, pointer, dimension(:) :: DRNTILE real, pointer, dimension(:) :: DFUTILE real, pointer, dimension(:) :: DRUTILE real, pointer, dimension(:) :: LWBTILE !wcc real, pointer, dimension(:) :: SFC_RATIOTILE !wcc !wcc real, pointer, dimension(:) :: ALWTILE real, pointer, dimension(:) :: BLWTILE ! These are tile versions of internals real, pointer, dimension(:) :: TSTILE real, pointer, dimension(:) :: QSTILE real, pointer, dimension(:) :: THTILE real, pointer, dimension(:) :: QHTILE real, pointer, dimension(:) :: UHTILE real, pointer, dimension(:) :: VHTILE real, pointer, dimension(:) :: CTTILE real, pointer, dimension(:) :: CQTILE real, pointer, dimension(:) :: CMTILE ! These are tile versions of exports real, pointer, dimension(:) :: FRTILE => NULL() real, pointer, dimension(:) :: EMISSTILE => NULL() real, pointer, dimension(:) :: ALBVRTILE => NULL() real, pointer, dimension(:) :: ALBVFTILE => NULL() real, pointer, dimension(:) :: ALBNFTILE => NULL() real, pointer, dimension(:) :: ALBNRTILE => NULL() real, pointer, dimension(:) :: DTSTILE => NULL() real, pointer, dimension(:) :: DQSTILE => NULL() real, pointer, dimension(:) :: TSOIL1TILE => NULL() real, pointer, dimension(:) :: ASNOWTILE => NULL() real, pointer, dimension(:) :: TPSNOTILE => NULL() real, pointer, dimension(:) :: TPUSTTILE => NULL() real, pointer, dimension(:) :: TPSATTILE => NULL() real, pointer, dimension(:) :: TPWLTTILE => NULL() real, pointer, dimension(:) :: FRSATTILE => NULL() real, pointer, dimension(:) :: FRUSTTILE => NULL() real, pointer, dimension(:) :: FRWLTTILE => NULL() real, pointer, dimension(:) :: SNOWTILE => NULL() real, pointer, dimension(:) :: SNODTILE => NULL() real, pointer, dimension(:) :: WET1TILE => NULL() real, pointer, dimension(:) :: WET2TILE => NULL() real, pointer, dimension(:) :: HLATNTILE => NULL() real, pointer, dimension(:) :: HLATWTRTILE => NULL() real, pointer, dimension(:) :: HLATICETILE => NULL() real, pointer, dimension(:) :: SHWTRTILE => NULL() real, pointer, dimension(:) :: SHICETILE => NULL() real, pointer, dimension(:) :: TAUXWTILE => NULL() real, pointer, dimension(:) :: TAUXITILE => NULL() real, pointer, dimension(:) :: TAUYWTILE => NULL() real, pointer, dimension(:) :: TAUYITILE => NULL() real, pointer, dimension(:) :: LWNDWTRTILE => NULL() real, pointer, dimension(:) :: SWNDWTRTILE => NULL() real, pointer, dimension(:) :: LWNDICETILE => NULL() real, pointer, dimension(:) :: SWNDICETILE => NULL() real, pointer, dimension(:) :: SNOWOCNTILE => NULL() real, pointer, dimension(:) :: RAINOCNTILE => NULL() real, pointer, dimension(:) :: EVAPOUTILE => NULL() real, pointer, dimension(:) :: SHOUTILE => NULL() real, pointer, dimension(:) :: HLWUPTILE => NULL() real, pointer, dimension(:) :: LWNDSRFTILE => NULL() real, pointer, dimension(:) :: SWNDSRFTILE => NULL() real, pointer, dimension(:) :: RUNOFFTILE => NULL() real, pointer, dimension(:) :: RUNSURFTILE => NULL() real, pointer, dimension(:) :: BASEFLOWTILE => NULL() real, pointer, dimension(:) :: ACCUMTILE => NULL() real, pointer, dimension(:) :: SMELTTILE => NULL() real, pointer, dimension(:) :: EVEGTILE => NULL() real, pointer, dimension(:) :: EINTTILE => NULL() real, pointer, dimension(:) :: EICETILE => NULL() real, pointer, dimension(:) :: ESOITILE => NULL() real, pointer, dimension(:) :: EVLANDTILE => NULL() real, pointer, dimension(:) :: LHLANDTILE => NULL() real, pointer, dimension(:) :: SHLANDTILE => NULL() real, pointer, dimension(:) :: SWLANDTILE => NULL() real, pointer, dimension(:) :: LWLANDTILE => NULL() real, pointer, dimension(:) :: GHLANDTILE => NULL() real, pointer, dimension(:) :: SMLANDTILE => NULL() real, pointer, dimension(:) :: TWLANDTILE => NULL() real, pointer, dimension(:) :: TELANDTILE => NULL() real, pointer, dimension(:) :: TSLANDTILE => NULL() real, pointer, dimension(:) :: DWLANDTILE => NULL() real, pointer, dimension(:) :: DHLANDTILE => NULL() real, pointer, dimension(:) :: SPLANDTILE => NULL() real, pointer, dimension(:) :: SPWATRTILE => NULL() real, pointer, dimension(:) :: SPSNOWTILE => NULL() real, pointer, dimension(:) :: SLITILE => NULL() real, pointer, dimension(:) :: ZTHTILE => NULL() real, pointer, dimension(:,:) :: TMP => NULL() real, pointer, dimension(:,:) :: Z0 => NULL() real, pointer, dimension(:,:) :: FAC => NULL() real, pointer, dimension(:,:) :: TAU => NULL() real, pointer, dimension(:,:) :: DTS => NULL() real, pointer, dimension(:,:) :: DQS => NULL() real, pointer, dimension(:,:) :: DRPAR real, pointer, dimension(:,:) :: DFPAR real, pointer, dimension(:,:) :: DRNIR real, pointer, dimension(:,:) :: DFNIR real, pointer, dimension(:,:) :: DRUVR real, pointer, dimension(:,:) :: DFUVR real, pointer, dimension(:,:) :: ZTH real, pointer, dimension(:,:) :: SLR integer :: I !============================================================================= ! Begin... ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- call ESMF_GridCompGet( GC, name=COMP_NAME, VM=VMG, RC=STATUS ) VERIFY_(STATUS) Iam = trim(COMP_NAME) // "Run2" ! Get my internal MAPL_Generic state !----------------------------------- call MAPL_GetObjectFromGC ( GC, MAPL, RC=STATUS) VERIFY_(STATUS) ! Start Total timer !------------------ call MAPL_TimerOn(MAPL,"TOTAL") call MAPL_TimerOn(MAPL,"-RUN2" ) ! Get parameters from generic state. !----------------------------------- call MAPL_Get(MAPL, & LOCSTREAM = LOCSTREAM, & GCS = GCS, & GCNAMES = GCNAMES, & GIM = GIM, & GEX = GEX, & LATS = LATS, & LONS = LONS, & TILELATS = tileLATS, & TILELONS = tileLONS, & TILETYPES = TYPE, & ORBIT = ORBIT, & INTERNAL_ESMF_STATE = INTERNAL, & RC=STATUS ) VERIFY_(STATUS) call ESMF_UserCompGetInternalState(gc, 'SURF_state', wrap, status) VERIFY_(STATUS) SURF_INTERNAL_STATE => WRAP%PTR ! Pointers to gridded imports !---------------------------- call MAPL_GetPointer(IMPORT , PS , 'PS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DZ , 'DZ' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , UU , 'SPEED' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , EVAP , 'EVAP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , SH , 'SH' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DEVAP , 'DEVAP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DSH , 'DSH' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , PCU , 'PCU' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , PLS , 'PLS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , SNOFL , 'SNO' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , TAUX , 'TAUX' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , TAUY , 'TAUY' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DRPARN , 'DRPARN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DFPARN , 'DFPARN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DRNIRN , 'DRNIRN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DFNIRN , 'DFNIRN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DRUVRN , 'DRUVRN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , DFUVRN , 'DFUVRN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , LWDNSRF , 'LWDNSRF', RC=STATUS); VERIFY_(STATUS) !wcc call MAPL_GetPointer(IMPORT , SFC_RATIO , 'SFC_RATIO', RC=STATUS); VERIFY_(STATUS) !wcc print *,'in surfaceGC.F90, sftc_ratio maxval=',maxval(SFC_RATIO) !wcc call MAPL_GetPointer(IMPORT , ALW , 'ALW' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT , BLW , 'BLW' , RC=STATUS); VERIFY_(STATUS) ! Pointers to gridded internals !------------------------------ call MAPL_GetPointer(INTERNAL, CM , 'CM' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CT , 'CT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CQ , 'CQ' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, CN , 'CN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, TH , 'THAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, QH , 'QHAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, UH , 'UHAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, VH , 'VHAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, TS , 'TS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, QS , 'QS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, RHOS , 'RHOS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, D0 , 'D0' , RC=STATUS); VERIFY_(STATUS) ! Pointers to gridded exports !---------------------------- call MAPL_GetPointer(EXPORT , ALBVR , 'ALBVR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ALBVF , 'ALBVF' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ALBNR , 'ALBNR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ALBNF , 'ALBNF' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , EMISS , 'EMIS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DELSS , 'DELSS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DELUS , 'DELUS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DELVS , 'DELVS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DELTS , 'DELTS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DELQS , 'DELQS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DLQLL , 'DLQLL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DLQIL , 'DLQIL' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , LWI , 'LWI' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TSOIL1 , 'TSOIL1' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ASNOW , 'ASNOW' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TPSNO , 'TPSNOW' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TPUST , 'TPUNST' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TPSAT , 'TPSAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TPWLT , 'TPWLT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , FRSAT , 'FRSAT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , FRUST , 'FRUST' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , FRWLT , 'FRWLT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SNOMAS , 'SNOMAS' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SNOWDP , 'SNOWDP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , WET1 , 'WET1' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , WET2 , 'WET2' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUXO , 'TAUX' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUYO , 'TAUY' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , EVAPO , 'EVAP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SHO , 'SH' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , USTAR , 'USTAR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TSTAR , 'TSTAR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , QSTAR , 'QSTAR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , U50M , 'U50M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , V50M , 'V50M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , U10M , 'U10M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , V10M , 'V10M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , U10N , 'U10N' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , V10N , 'V10N' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , T10M , 'T10M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , Q10M , 'Q10M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , U2M , 'U2M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , V2M , 'V2M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , T2M , 'T2M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , Q2M , 'Q2M' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , UAX , 'UA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , VAX , 'VA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TA , 'TA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , QA , 'QA' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , HLATN , 'LHFX' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , HLATWTR , 'HLATWTR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , HLATICE , 'HLATICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SHWTR , 'SHWTR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SHICE , 'SHICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUXW , 'TAUXW' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUXI , 'TAUXI' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUYW , 'TAUYW' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TAUYI , 'TAUYI' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , LWNDWTR , 'LWNDWTR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SWNDWTR , 'SWNDWTR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , LWNDICE , 'LWNDICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SWNDICE , 'SWNDICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SNOWOCN , 'SNOWOCN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RAINOCN , 'RAINOCN' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , EVAPOU , 'EVAPOUT', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SHOU , 'SHOUT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , HLWUP , 'HLWUP' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , LWNDSRF , 'LWNDSRF', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SWNDSRF , 'SWNDSRF', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RUNOFF , 'RUNOFF' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , RUNSURF , 'RUNSURF', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , BASEFLOW, 'BASEFLOW', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ACCUM , 'ACCUM' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SMELT , 'SMELT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , EVEG , 'EVPVEG' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , EINT , 'EVPINT' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , EICE , 'EVPICE' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , ESOI , 'EVPSOI' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , EVLAND , 'EVLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , LHLAND , 'LHLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SHLAND , 'SHLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SWLAND , 'SWLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , LWLAND , 'LWLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , GHLAND , 'GHLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SMLAND , 'SMLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TWLAND , 'TWLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TELAND , 'TELAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , TSLAND , 'TSLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DWLAND , 'DWLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , DHLAND , 'DHLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SPLAND , 'SPLAND' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SPWATR , 'SPWATR' , RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT , SPSNOW , 'SPSNOW' , RC=STATUS); VERIFY_(STATUS) ! Forec allocation for ice fraction for lwi mask call MAPL_GetPointer(EXPORT , FRI , 'FRACI' , alloc=associated(LWI) , rC=STATUS) VERIFY_(STATUS) FRI = max(min(FRI,1.0),0.0) ! Allocate some work arrays in grid and tile space !------------------------------------------------- IM = size(PS,1) JM = size(PS,2) NT = size(TYPE) allocate( Z0 (IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( TMP(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( FAC(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( TAU(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DTS(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DQS(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DRPAR(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DFPAR(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DRNIR(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DFNIR(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DRUVR(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DFUVR(IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( ZTH (IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( SLR (IM,JM), STAT=STATUS) VERIFY_(STATUS) allocate( DTSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DQSTILE(NT), STAT=STATUS) VERIFY_(STATUS) ! Get the insolation and zenith angle on grid and tiles !------------------------------------------------------ call ESMF_ClockGet(CLOCK, TIMESTEP=DELT, RC=STATUS) VERIFY_(STATUS) call MAPL_SunGetInsolation(LONS, LATS, & ORBIT, ZTH, SLR, & INTV = DELT, & CLOCK = CLOCK, & RC=STATUS ) VERIFY_(STATUS) call MAPL_GetResource( MAPL, SC, 'SOLAR_CONSTANT:', RC=STATUS) VERIFY_(STATUS) DRPAR = DRPARN * SLR * SC DFPAR = DFPARN * SLR * SC DRNIR = DRNIRN * SLR * SC DFNIR = DFNIRN * SLR * SC DRUVR = DRUVRN * SLR * SC DFUVR = DFUVRN * SLR * SC allocate( SLITILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( ZTHTILE(NT), STAT=STATUS) VERIFY_(STATUS) call MAPL_SunGetInsolation( & tileLONS, tileLATS, ORBIT, & ZTHTILE, SLITILE, & INTV = DELT, & CLOCK = CLOCK, & RC=STATUS ) VERIFY_(STATUS) ZTHTILE = max(0.0,ZTHTILE) ! We need atmsopheric version of the run1 outputs put back on tiles !------------------------------------------------------------------ allocate( TSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( QSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( THTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( QHTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( UHTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( VHTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( CTTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( CQTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( CMTILE(NT), STAT=STATUS) VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, THTILE, TH, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, QHTILE, QH, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, UHTILE, UH, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, VHTILE, VH, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, CTTILE, CT, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, CQTILE, CQ, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, CMTILE, CM, RC=STATUS); VERIFY_(STATUS) ! Allocate tile versions of imports !---------------------------------- allocate( PSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DZTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( UUTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( EVPTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( SHFTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DEVTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DSHTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( PCUTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( PLSTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate(SNOFLTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( TAUXTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( TAUYTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DRUTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DFUTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DRPTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DFPTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DRNTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( DFNTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( LWBTILE(NT), STAT=STATUS) VERIFY_(STATUS) !wcc allocate( SFC_RATIOTILE(NT), STAT=STATUS) !wcc VERIFY_(STATUS) !wcc allocate( ALWTILE(NT), STAT=STATUS) VERIFY_(STATUS) allocate( BLWTILE(NT), STAT=STATUS) VERIFY_(STATUS) ! Transform imports to the tiles !------------------------------- call MAPL_LocStreamTransform( LOCSTREAM, PSTILE , PS, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DZTILE , DZ, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, UUTILE , UU, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, EVPTILE , EVAP, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, SHFTILE , SH, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DEVTILE , DEVAP, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DSHTILE , DSH, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, PCUTILE , PCU, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, PLSTILE , PLS, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, SNOFLTILE, SNOFL, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, TAUXTILE , TAUX, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, TAUYTILE , TAUY, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DRUTILE , DRUVR, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DFUTILE , DFUVR, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DRPTILE , DRPAR, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DFPTILE , DFPAR, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DRNTILE , DRNIR, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DFNTILE , DFNIR, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, LWBTILE , LWDNSRF, RC=STATUS); VERIFY_(STATUS) !wcc call MAPL_LocStreamTransform( LOCSTREAM, SFC_RATIOTILE , SFC_RATIO, RC=STATUS); VERIFY_(STATUS) print *,'in surfaceGC, maxval of SFC_RATIOTILE=',maxval(SFC_RATIOTILE) !wcc !wcc !wcc call MAPL_LocStreamTransform( LOCSTREAM, ALWTILE , ALW, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, BLWTILE , BLW, RC=STATUS); VERIFY_(STATUS) ! The import taus come from turbulence and are stresses on the atmosphere TAUXTILE = -TAUXTILE TAUYTILE = -TAUYTILE DSHTILE = DSHTILE * MAPL_CP ! ??? ! If a grid export is required, allocate its tile version !-------------------------------------------------------- call MKTILE(ALBVR ,ALBVRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(ALBVF ,ALBVFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(ALBNR ,ALBNRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(ALBNF ,ALBNFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(EMISS ,EMISSTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(FRI ,FRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TSOIL1 ,TSOIL1TILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(ASNOW ,ASNOWTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TPSNO ,TPSNOTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TPUST ,TPUSTTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TPSAT ,TPSATTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TPWLT ,TPWLTTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(FRSAT ,FRSATTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(FRUST ,FRUSTTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(FRWLT ,FRWLTTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SNOMAS ,SNOWTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SNOWDP ,SNODTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(WET1 ,WET1TILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(WET2 ,WET2TILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(HLATN ,HLATNTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(HLATWTR ,HLATWTRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(HLATICE ,HLATICETILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE( SHWTR , SHWTRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE( SHICE , SHICETILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE( TAUXW , TAUXWTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE( TAUXI , TAUXITILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE( TAUYW , TAUYWTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE( TAUYI , TAUYITILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(LWNDWTR ,LWNDWTRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SWNDWTR ,SWNDWTRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(LWNDICE ,LWNDICETILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SWNDICE ,SWNDICETILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SNOWOCN ,SNOWOCNTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(RAINOCN ,RAINOCNTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(EVAPOU ,EVAPOUTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SHOU ,SHOUTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(HLWUP ,HLWUPTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(LWNDSRF ,LWNDSRFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SWNDSRF ,SWNDSRFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(RUNOFF ,RUNOFFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(RUNSURF ,RUNSURFTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(BASEFLOW,BASEFLOWTILE,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(ACCUM ,ACCUMTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SMELT ,SMELTTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(EVEG ,EVEGTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(EINT ,EINTTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(EICE ,EICETILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(ESOI ,ESOITILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(EVLAND ,EVLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(LHLAND ,LHLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SHLAND ,SHLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SWLAND ,SWLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(LWLAND ,LWLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(GHLAND ,GHLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SMLAND ,SMLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TWLAND ,TWLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TELAND ,TELANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(TSLAND ,TSLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(DWLAND ,DWLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(DHLAND ,DHLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SPLAND ,SPLANDTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SPWATR ,SPWATRTILE ,NT,RC=STATUS); VERIFY_(STATUS) call MKTILE(SPSNOW ,SPSNOWTILE ,NT,RC=STATUS); VERIFY_(STATUS) FRTILE = 0.0 do I = 1, NUM_CHILDREN call DOTYPE(I,RC=STATUS) VERIFY_(STATUS) end do ! New effective temperature and humidity !--------------------------------------- call MAPL_LocStreamTransform( LOCSTREAM, DTS, DTSTILE, RC=STATUS); VERIFY_(STATUS) call MAPL_LocStreamTransform( LOCSTREAM, DQS, DQSTILE, RC=STATUS); VERIFY_(STATUS) TH = TH + DTS QH = QH + DQS ! Transform other exports from exchange grid to agcm grid !--------------------------------------------------------- if(associated( TS)) then call MAPL_LocStreamTransform( LOCSTREAM, TS, TSTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( QS)) then call MAPL_LocStreamTransform( LOCSTREAM, QS, QSTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( ALBVR)) then call MAPL_LocStreamTransform( LOCSTREAM, ALBVR, ALBVRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( ALBVF)) then call MAPL_LocStreamTransform( LOCSTREAM, ALBVF, ALBVFTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( ALBNR)) then call MAPL_LocStreamTransform( LOCSTREAM, ALBNR, ALBNRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( ALBNF)) then call MAPL_LocStreamTransform( LOCSTREAM, ALBNF, ALBNFTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( EMISS)) then call MAPL_LocStreamTransform( LOCSTREAM, EMISS, EMISSTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( FRI )) then call MAPL_LocStreamTransform( LOCSTREAM, FRI , FRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TSOIL1)) then call MAPL_LocStreamTransform( LOCSTREAM, TSOIL1, TSOIL1TILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( WET1)) then call MAPL_LocStreamTransform( LOCSTREAM, WET1, WET1TILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( WET2)) then call MAPL_LocStreamTransform( LOCSTREAM, WET2, WET2TILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(ASNOW )) then call MAPL_LocStreamTransform( LOCSTREAM, ASNOW, ASNOWTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TPSNO )) then call MAPL_LocStreamTransform( LOCSTREAM, TPSNO, TPSNOTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TPUST )) then call MAPL_LocStreamTransform( LOCSTREAM, TPUST, TPUSTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TPSAT )) then call MAPL_LocStreamTransform( LOCSTREAM, TPSAT, TPSATTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TPWLT )) then call MAPL_LocStreamTransform( LOCSTREAM, TPWLT, TPWLTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(FRSAT )) then call MAPL_LocStreamTransform( LOCSTREAM, FRSAT, FRSATTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(FRUST )) then call MAPL_LocStreamTransform( LOCSTREAM, FRUST, FRUSTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(FRWLT )) then call MAPL_LocStreamTransform( LOCSTREAM, FRWLT, FRWLTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SNOMAS)) then call MAPL_LocStreamTransform( LOCSTREAM, SNOMAS, SNOWTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SNOWDP)) then call MAPL_LocStreamTransform( LOCSTREAM, SNOWDP, SNODTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( HLATN)) then call MAPL_LocStreamTransform( LOCSTREAM, HLATN, HLATNTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( HLATWTR)) then call MAPL_LocStreamTransform( LOCSTREAM, HLATWTR, HLATWTRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( HLATICE)) then call MAPL_LocStreamTransform( LOCSTREAM, HLATICE, HLATICETILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SHWTR)) then call MAPL_LocStreamTransform( LOCSTREAM, SHWTR, SHWTRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SHICE)) then call MAPL_LocStreamTransform( LOCSTREAM, SHICE, SHICETILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( TAUXW)) then call MAPL_LocStreamTransform( LOCSTREAM, TAUXW, TAUXWTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( TAUXI)) then call MAPL_LocStreamTransform( LOCSTREAM, TAUXI, TAUXITILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( TAUYW)) then call MAPL_LocStreamTransform( LOCSTREAM, TAUYW, TAUYWTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( TAUYI)) then call MAPL_LocStreamTransform( LOCSTREAM, TAUYI, TAUYITILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( LWNDWTR)) then call MAPL_LocStreamTransform( LOCSTREAM, LWNDWTR, LWNDWTRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SWNDWTR)) then call MAPL_LocStreamTransform( LOCSTREAM, SWNDWTR, SWNDWTRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( LWNDICE)) then call MAPL_LocStreamTransform( LOCSTREAM, LWNDICE, LWNDICETILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SWNDICE)) then call MAPL_LocStreamTransform( LOCSTREAM, SWNDICE, SWNDICETILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( RAINOCN)) then call MAPL_LocStreamTransform( LOCSTREAM, RAINOCN, RAINOCNTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SNOWOCN)) then call MAPL_LocStreamTransform( LOCSTREAM, SNOWOCN, SNOWOCNTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( EVAPOU)) then call MAPL_LocStreamTransform( LOCSTREAM, EVAPOU, EVAPOUTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SHOU)) then call MAPL_LocStreamTransform( LOCSTREAM, SHOU, SHOUTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( HLWUP)) then call MAPL_LocStreamTransform( LOCSTREAM, HLWUP, HLWUPTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( LWNDSRF)) then call MAPL_LocStreamTransform( LOCSTREAM, LWNDSRF, LWNDSRFTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SWNDSRF)) then call MAPL_LocStreamTransform( LOCSTREAM, SWNDSRF, SWNDSRFTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( RUNOFF)) then call MAPL_LocStreamTransform( LOCSTREAM, RUNOFF, RUNOFFTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( RUNSURF)) then call MAPL_LocStreamTransform( LOCSTREAM, RUNSURF, RUNSURFTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( BASEFLOW)) then call MAPL_LocStreamTransform( LOCSTREAM, BASEFLOW, BASEFLOWTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( ACCUM)) then call MAPL_LocStreamTransform( LOCSTREAM, ACCUM, ACCUMTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( SMELT)) then call MAPL_LocStreamTransform( LOCSTREAM, SMELT, SMELTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( EVEG)) then call MAPL_LocStreamTransform( LOCSTREAM, EVEG, EVEGTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( EINT)) then call MAPL_LocStreamTransform( LOCSTREAM, EINT, EINTTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( EICE)) then call MAPL_LocStreamTransform( LOCSTREAM, EICE, EICETILE, RC=STATUS) VERIFY_(STATUS) endif if(associated( ESOI)) then call MAPL_LocStreamTransform( LOCSTREAM, ESOI, ESOITILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(EVLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,EVLAND,EVLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(LHLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,LHLAND,LHLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SHLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,SHLAND,SHLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SWLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,SWLAND,SWLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(LWLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,LWLAND,LWLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(GHLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,GHLAND,GHLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SMLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,SMLAND,SMLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TWLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,TWLAND,TWLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TELAND)) then call MAPL_LocStreamTransform( LOCSTREAM,TELAND,TELANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(TSLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,TSLAND,TSLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(DWLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,DWLAND,DWLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(DHLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,DHLAND,DHLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SPLAND)) then call MAPL_LocStreamTransform( LOCSTREAM,SPLAND,SPLANDTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SPWATR)) then call MAPL_LocStreamTransform( LOCSTREAM,SPWATR,SPWATRTILE, RC=STATUS) VERIFY_(STATUS) endif if(associated(SPSNOW)) then call MAPL_LocStreamTransform( LOCSTREAM,SPSNOW,SPSNOWTILE, RC=STATUS) VERIFY_(STATUS) endif ! Fill exports computed on agcm grid !----------------------------------- if(associated( DELTS)) DELTS = DTS if(associated( DELQS)) DELQS = DQS if(associated( DELSS)) DELSS = MAPL_CP*DTS if(associated( DELUS)) DELUS = 0.0 if(associated( DELVS)) DELVS = 0.0 if(associated( TAUXO)) TAUXO = -TAUX if(associated( TAUYO)) TAUYO = -TAUY if(associated( EVAPO)) EVAPO = EVAP + DEVAP*DQS if(associated( SHO)) SHO = SH + DSH *DTS *MAPL_CP if(associated( DLQLL)) DLQLL = 0.0 if(associated( DLQIL)) DLQIL = 0.0 TAU = sqrt(TAUX**2+TAUY**2) if( associated(USTAR ) .or. associated(TSTAR ) .or. & associated(QSTAR ) ) then FAC = sqrt(TAU/RHOS) if(associated( USTAR)) USTAR = FAC if(associated( TSTAR)) TSTAR = (SH/MAPL_CP + DSH *DTS)/(RHOS*FAC) if(associated( QSTAR)) QSTAR = (EVAP + DEVAP*DQS)/(RHOS*FAC) end if FAC = sqrt(CN)/MAPL_KARMAN Z0 = max((DZ-D0),10.)/(exp(1.0/FAC)-1.0) ! 50m winds if( associated( U50M) .or. associated( V50M) ) then TMP = alog(1.0 + (50.)/Z0)*FAC if(associated( U50M)) U50M = UH - TAUX*TMP/CM if(associated( V50M)) V50M = VH - TAUY*TMP/CM end if ! 10m if( associated( U10M) .or. associated( V10M) .or. & associated( T10M) .or. associated( Q10M) ) then TMP = alog(1.0 + (10.)/Z0)*FAC if(associated( U10M) .or. associated( V10M)) then if(associated( U10M)) U10M = UH - TAUX*TMP/CM if(associated( V10M)) V10M = VH - TAUY*TMP/CM end if if(associated(T10M)) T10M = TH - (SH/MAPL_CP + DSH *DTS)*TMP/CT if(associated(Q10M)) Q10M = max( QH - (EVAP + DEVAP*DQS)*TMP/CQ , 0.0 ) end if if( associated( U10N) .or. associated( V10N) ) then TMP = alog(1.0 + (10.)/Z0)/(sqrt(TAU*RHOS) * MAPL_KARMAN ) if(associated( U10N)) U10N = UH - TAUX*TMP if(associated( V10N)) V10N = VH - TAUY*TMP end if ! 2m if( associated( U2M) .or. associated( V2M) .or. & associated( T2M) .or. associated( Q2M) ) then TMP = alog(1.0 + (2.0)/Z0)*FAC if(associated( U2M) .or. associated( V2M)) then if(associated( U2M)) U2M = UH - TAUX*TMP/CM if(associated( V2M)) V2M = VH - TAUY*TMP/CM end if if(associated(T2M)) T2M = TH - (SH/MAPL_CP + DSH *DTS)*TMP/CT if(associated(Q2M)) Q2M = max( QH - (EVAP + DEVAP*DQS)*TMP/CQ , 0.0 ) end if ! surface air values if( associated( UAX) .or. associated( VAX) .or. & associated( TA) .or. associated( QA) ) then if(associated( UAX) .or. associated( VAX)) then if(associated( UAX)) UAX = UH - TAUX/CM if(associated( VAX)) VAX = VH - TAUY/CM end if if(associated(TA)) TA = TH - (SH/MAPL_CP + DSH *DTS)/CT if(associated(QA)) QA = QH - (EVAP + DEVAP*DQS)/CQ end if ! Set Integer LWI flag !--------------------- if( associated(LWI) ) then call MAPL_GetPointer( EXPORT, FROCEAN, 'FROCEAN', RC=STATUS ) VERIFY_(STATUS) call MAPL_GetPointer( EXPORT, FRLAKE, 'FRLAKE' , RC=STATUS ) VERIFY_(STATUS) LWI = 1.0 ! Land where ( FROCEAN+FRLAKE >= 0.6 ) LWI = 0.0 ! Water where ( LWI==0 .and. FRI>0.5 ) LWI = 2.0 ! Ice where ( LWI==0 .and. TS<271.40 ) LWI = 2.0 ! Ice endif ! Fill WET1 over non-land points !------------------------------- if( associated(WET1) ) then where(WET1 == MAPL_UNDEF) WET1 = 1.0 endif ! Modify TSOIL1 to Kelvin !------------------------ if( associated(TSOIL1) ) then where ( TSOIL1 /= MAPL_Undef ) TSOIL1 = TSOIL1 + MAPL_TICE endif ! Fill SNOMAS over Glaciers !-------------------------- ! if( associated(SNOMAS) ) then ! call MAPL_GetPointer( EXPORT, FRLANDICE, 'FRLANDICE', RC=STATUS ) ! VERIFY_(STATUS) ! where ( SNOMAS /= MAPL_UNDEF ) SNOMAS = SNOMAS*1.E-3 ! where ( FRLANDICE > 0.9 ) SNOMAS = 4 ! endif ! Clean-up !--------- deallocate(TMP) deallocate(Z0 ) deallocate(FAC) deallocate(TAU) deallocate(DTS) deallocate(DQS) deallocate(DRPAR) deallocate(DFPAR) deallocate(DRNIR) deallocate(DFNIR) deallocate(DRUVR) deallocate(DFUVR) deallocate(ZTH ) deallocate(SLR ) deallocate( DTSTILE) deallocate( DQSTILE) deallocate( SLITILE) deallocate( ZTHTILE) deallocate( PSTILE) deallocate( UUTILE) deallocate( DZTILE) deallocate( SNOFLTILE) deallocate( PCUTILE) deallocate( PLSTILE) deallocate( LWBTILE) !wcc deallocate( SFC_RATIOTILE) !wcc !wcc deallocate( DRPTILE) deallocate( DFPTILE) deallocate( SHFTILE) deallocate( DSHTILE) deallocate( EVPTILE) deallocate( DEVTILE) deallocate( ALWTILE) deallocate( BLWTILE) deallocate( TAUXTILE) deallocate( TAUYTILE) deallocate( DFNTILE) deallocate( DRNTILE) deallocate( DFUTILE) deallocate( DRUTILE) if(associated(TSTILE )) deallocate(TSTILE ) if(associated(QSTILE )) deallocate(QSTILE ) if(associated(THTILE )) deallocate(THTILE ) if(associated(QHTILE )) deallocate(QHTILE ) if(associated(UHTILE )) deallocate(UHTILE ) if(associated(VHTILE )) deallocate(VHTILE ) if(associated(CTTILE )) deallocate(CTTILE ) if(associated(CQTILE )) deallocate(CQTILE ) if(associated(CMTILE )) deallocate(CMTILE ) if(associated(TSOIL1TILE )) deallocate(TSOIL1TILE ) if(associated(WET1TILE )) deallocate(WET1TILE ) if(associated(WET2TILE )) deallocate(WET2TILE ) if(associated(ASNOWTILE )) deallocate(ASNOWTILE ) if(associated(TPSNOTILE )) deallocate(TPSNOTILE ) if(associated(TPUSTTILE )) deallocate(TPUSTTILE ) if(associated(TPSATTILE )) deallocate(TPSATTILE ) if(associated(TPWLTTILE )) deallocate(TPWLTTILE ) if(associated(FRSATTILE )) deallocate(FRSATTILE ) if(associated(FRUSTTILE )) deallocate(FRUSTTILE ) if(associated(FRWLTTILE )) deallocate(FRWLTTILE ) if(associated(SNOWTILE )) deallocate(SNOWTILE ) if(associated(SNODTILE )) deallocate(SNODTILE ) if(associated(HLATNTILE )) deallocate(HLATNTILE ) if(associated(HLATWTRTILE )) deallocate(HLATWTRTILE ) if(associated(HLATICETILE )) deallocate(HLATICETILE ) if(associated( SHWTRTILE )) deallocate( SHWTRTILE ) if(associated( SHICETILE )) deallocate( SHICETILE ) if(associated( TAUXWTILE )) deallocate( TAUXWTILE ) if(associated( TAUXITILE )) deallocate( TAUXITILE ) if(associated( TAUYWTILE )) deallocate( TAUYWTILE ) if(associated( TAUYITILE )) deallocate( TAUYITILE ) if(associated(LWNDWTRTILE )) deallocate(LWNDWTRTILE ) if(associated(SWNDWTRTILE )) deallocate(SWNDWTRTILE ) if(associated(LWNDICETILE )) deallocate(LWNDICETILE ) if(associated(SWNDICETILE )) deallocate(SWNDICETILE ) if(associated(SNOWOCNTILE )) deallocate(SNOWOCNTILE ) if(associated(RAINOCNTILE )) deallocate(RAINOCNTILE ) if(associated(EVAPOUTILE )) deallocate(EVAPOUTILE ) if(associated(SHOUTILE )) deallocate(SHOUTILE ) if(associated(HLWUPTILE )) deallocate(HLWUPTILE ) if(associated(LWNDSRFTILE )) deallocate(LWNDSRFTILE ) if(associated(SWNDSRFTILE )) deallocate(SWNDSRFTILE ) if(associated(RUNOFFTILE )) deallocate(RUNOFFTILE ) if(associated(RUNSURFTILE )) deallocate(RUNSURFTILE ) if(associated(BASEFLOWTILE)) deallocate(BASEFLOWTILE) if(associated(ACCUMTILE )) deallocate(ACCUMTILE ) if(associated(SMELTTILE )) deallocate(SMELTTILE ) if(associated(EVEGTILE )) deallocate(EVEGTILE ) if(associated(EINTTILE )) deallocate(EINTTILE ) if(associated(EICETILE )) deallocate(EICETILE ) if(associated(ESOITILE )) deallocate(ESOITILE ) if(associated(EVLANDTILE )) deallocate(EVLANDTILE ) if(associated(LHLANDTILE )) deallocate(LHLANDTILE ) if(associated(SHLANDTILE )) deallocate(SHLANDTILE ) if(associated(SWLANDTILE )) deallocate(SWLANDTILE ) if(associated(LWLANDTILE )) deallocate(LWLANDTILE ) if(associated(GHLANDTILE )) deallocate(GHLANDTILE ) if(associated(SMLANDTILE )) deallocate(SMLANDTILE ) if(associated(TWLANDTILE )) deallocate(TWLANDTILE ) if(associated(TELANDTILE )) deallocate(TELANDTILE ) if(associated(TSLANDTILE )) deallocate(TSLANDTILE ) if(associated(DWLANDTILE )) deallocate(DWLANDTILE ) if(associated(DHLANDTILE )) deallocate(DHLANDTILE ) if(associated(SPLANDTILE )) deallocate(SPLANDTILE ) if(associated(SPWATRTILE )) deallocate(SPWATRTILE ) if(associated(SPSNOWTILE )) deallocate(SPSNOWTILE ) if(associated(ALBNFTILE )) deallocate(ALBNFTILE) if(associated(ALBNRTILE )) deallocate(ALBNRTILE) if(associated(ALBVFTILE )) deallocate(ALBVFTILE) if(associated(ALBVRTILE )) deallocate(ALBVRTILE) if(associated(EMISSTILE )) deallocate(EMISSTILE) if(associated(FRTILE )) deallocate(FRTILE ) call ESMF_VMBarrier(VMG, rc=status) VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"-RUN2" ) call MAPL_TimerOff(MAPL,"TOTAL") ! All done !----------- RETURN_(ESMF_SUCCESS) contains subroutine DOTYPE(type,RC) integer, intent(IN ) :: TYPE integer, optional, intent(OUT) :: RC ! Locals character(len=ESMF_MAXSTR) :: IAm integer :: STATUS real, pointer :: PTR1(:) type (MAPL_LocStreamXFORM) :: XFORM real, pointer :: DUM(:) call MAPL_TimerOn(MAPL, trim(GCNames(type))) call MAPL_TimerOn(MAPL,"--RUN2_"//trim(GCNames(type))) Iam = trim(COMP_NAME)//"RUN2_DOTYPE" ! Fill the child's import state on his location stream from ! variables on Surface's location stream. !---------------------------------------------------------- XFORM = surf_internal_state%xform_in(type) call FILLIN_TILE(GIM(type), 'PS', PSTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DZ', DZTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'UU', UUTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'EVAP', EVPTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'SH', SHFTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DEVAP', DEVTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DSH', DSHTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'SNO', SNOFLTILE,XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'PCU', PCUTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'PLS', PLSTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'TAUX', TAUXTILE,XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'TAUY', TAUYTILE,XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DRPAR', DRPTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DFPAR', DFPTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DRNIR', DRNTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DFNIR', DFNTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DRUVR', DRUTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'DFUVR', DFUTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'LWDNSRF',LWBTILE, XFORM, RC=STATUS); VERIFY_(STATUS) !wcc call FILLIN_TILE(GIM(type), 'SFC_RATIO',SFC_RATIOTILE, XFORM, RC=STATUS); VERIFY_(STATUS) !wcc call FILLIN_TILE(GIM(type), 'ALW', ALWTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'BLW', BLWTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'ZTH', ZTHTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'THATM', THTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'QHATM', QHTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'UHATM', UHTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'VHATM', VHTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'CTATM', CTTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'CQATM', CQTILE, XFORM, RC=STATUS); VERIFY_(STATUS) call FILLIN_TILE(GIM(type), 'CMATM', CMTILE, XFORM, RC=STATUS); VERIFY_(STATUS) ! Force allocation of the exports needed from the child by the FILLOUTs below !---------------------------------------------------------------------------- ! Some cannot be verified, because some children don't produce them call MAPL_GetPointer(GEX(type), dum, 'TP1' , ALLOC=associated(TSOIL1TILE )) call MAPL_GetPointer(GEX(type), dum, 'ASNOW' , ALLOC=associated(ASNOWTILE )) call MAPL_GetPointer(GEX(type), dum, 'TPSNOW' , ALLOC=associated(TPSNOTILE )) call MAPL_GetPointer(GEX(type), dum, 'TPUNST' , ALLOC=associated(TPUSTTILE )) call MAPL_GetPointer(GEX(type), dum, 'TPSAT' , ALLOC=associated(TPSATTILE )) call MAPL_GetPointer(GEX(type), dum, 'TPWLT' , ALLOC=associated(TPWLTTILE )) call MAPL_GetPointer(GEX(type), dum, 'FRSAT' , ALLOC=associated(FRSATTILE )) call MAPL_GetPointer(GEX(type), dum, 'FRUST' , ALLOC=associated(FRUSTTILE )) call MAPL_GetPointer(GEX(type), dum, 'FRWLT' , ALLOC=associated(FRWLTTILE )) call MAPL_GetPointer(GEX(type), dum, 'SNOWMASS', ALLOC=associated(SNOWTILE )) call MAPL_GetPointer(GEX(type), dum, 'SNOWDP' , ALLOC=associated(SNODTILE )) call MAPL_GetPointer(GEX(type), dum, 'WET1' , ALLOC=associated(WET1TILE )) call MAPL_GetPointer(GEX(type), dum, 'WET2' , ALLOC=associated(WET2TILE )) call MAPL_GetPointer(GEX(type), dum, 'RUNOFF' , ALLOC=associated(RUNOFFTILE )) call MAPL_GetPointer(GEX(type), dum, 'RUNSURF' , ALLOC=associated(RUNSURFTILE )) call MAPL_GetPointer(GEX(type), dum, 'BASEFLOW', ALLOC=associated(BASEFLOWTILE)) call MAPL_GetPointer(GEX(type), dum, 'ACCUM' , ALLOC=associated(ACCUMTILE )) call MAPL_GetPointer(GEX(type), dum, 'SMELT' , ALLOC=associated(SMELTTILE )) call MAPL_GetPointer(GEX(type), dum, 'EVPVEG' , ALLOC=associated(EVEGTILE )) call MAPL_GetPointer(GEX(type), dum, 'EVPINT' , ALLOC=associated(EINTTILE )) call MAPL_GetPointer(GEX(type), dum, 'EVPICE' , ALLOC=associated(EICETILE )) call MAPL_GetPointer(GEX(type), dum, 'EVPSOI' , ALLOC=associated(ESOITILE )) call MAPL_GetPointer(GEX(type), dum, 'EVLAND' , ALLOC=associated(EVLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'LHLAND' , ALLOC=associated(LHLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'SHLAND' , ALLOC=associated(SHLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'SWLAND' , ALLOC=associated(SWLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'LWLAND' , ALLOC=associated(LWLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'GHLAND' , ALLOC=associated(GHLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'SMLAND' , ALLOC=associated(SMLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'TWLAND' , ALLOC=associated(TWLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'TELAND' , ALLOC=associated(TELANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'TSLAND' , ALLOC=associated(TSLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'DWLAND' , ALLOC=associated(DWLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'DHLAND' , ALLOC=associated(DHLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'SPLAND' , ALLOC=associated(SPLANDTILE )) call MAPL_GetPointer(GEX(type), dum, 'SPWATR' , ALLOC=associated(SPWATRTILE )) call MAPL_GetPointer(GEX(type), dum, 'SPSNOW' , ALLOC=associated(SPSNOWTILE )) call MAPL_GetPointer(GEX(type), dum, 'FRACI' , ALLOC=associated( FRTILE )) call MAPL_GetPointer(GEX(type), dum, 'HLATWTR' , ALLOC=associated(HLATWTRTILE )) call MAPL_GetPointer(GEX(type), dum, 'HLATICE' , ALLOC=associated(HLATICETILE )) call MAPL_GetPointer(GEX(type), dum, 'SHWTR' , ALLOC=associated( SHWTRTILE )) call MAPL_GetPointer(GEX(type), dum, 'SHICE' , ALLOC=associated( SHICETILE )) call MAPL_GetPointer(GEX(type), dum, 'TAUXW' , ALLOC=associated( TAUXWTILE )) call MAPL_GetPointer(GEX(type), dum, 'TAUXI' , ALLOC=associated( TAUXITILE )) call MAPL_GetPointer(GEX(type), dum, 'TAUYW' , ALLOC=associated( TAUYWTILE )) call MAPL_GetPointer(GEX(type), dum, 'TAUYI' , ALLOC=associated( TAUYITILE )) call MAPL_GetPointer(GEX(type), dum, 'LWNDWTR' , ALLOC=associated(LWNDWTRTILE )) call MAPL_GetPointer(GEX(type), dum, 'SWNDWTR' , ALLOC=associated(SWNDWTRTILE )) call MAPL_GetPointer(GEX(type), dum, 'LWNDICE' , ALLOC=associated(LWNDICETILE )) call MAPL_GetPointer(GEX(type), dum, 'SWNDICE' , ALLOC=associated(SWNDICETILE )) call MAPL_GetPointer(GEX(type), dum, 'RAINOCN' , ALLOC=associated(RAINOCNTILE )) call MAPL_GetPointer(GEX(type), dum, 'SNOWOCN' , ALLOC=associated(SNOWOCNTILE )) ! All children can produce these call MAPL_GetPointer(GEX(type), dum, 'DELTS' , ALLOC=associated(DTSTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'DELQS' , ALLOC=associated(DQSTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'HLATN' , ALLOC=associated(HLATNTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'EVAPOUT', ALLOC=associated(EVAPOUTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'SHOUT' , ALLOC=associated(SHOUTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'HLWUP' , ALLOC=associated(HLWUPTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'LWNDSRF', ALLOC=associated(LWNDSRFTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'SWNDSRF', ALLOC=associated(SWNDSRFTILE), RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'ALBVR' , ALLOC=associated(ALBVRTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'ALBVF' , ALLOC=associated(ALBVFTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'ALBNR' , ALLOC=associated(ALBNRTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'ALBNF' , ALLOC=associated(ALBNFTILE) , RC=STATUS) VERIFY_(STATUS) call MAPL_GetPointer(GEX(type), dum, 'EMIS' , ALLOC=associated(EMISSTILE) , RC=STATUS) VERIFY_(STATUS) ! Run the child !-------------- call ESMF_GridCompRun (GCS(type), GIM(type), GEX(type), & CLOCK, 2-1, RC=STATUS ) VERIFY_(STATUS) ! Fill variables on Surface's location stream from the child's ! export state, which is on his location stream. !------------------------------------------------------------- XFORM = SURF_INTERNAL_STATE%XFORM_OUT(type) if(associated(TSTILE)) then call FILLOUT_TILE(GEX(type), 'TST', TSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(QSTILE)) then call FILLOUT_TILE(GEX(type), 'QST', QSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(DTSTILE)) then call FILLOUT_TILE(GEX(type), 'DELTS', DTSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(DQSTILE)) then call FILLOUT_TILE(GEX(type), 'DELQS', DQSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ALBVRTILE)) then call FILLOUT_TILE(GEX(type), 'ALBVR', ALBVRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ALBVFTILE)) then call FILLOUT_TILE(GEX(type), 'ALBVF', ALBVFTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ALBNRTILE)) then call FILLOUT_TILE(GEX(type), 'ALBNR', ALBNRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ALBNFTILE)) then call FILLOUT_TILE(GEX(type), 'ALBNF', ALBNFTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(EMISSTILE)) then call FILLOUT_TILE(GEX(type), 'EMIS', EMISSTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated( FRTILE)) then call FILLOUT_TILE(GEX(type), 'FRACI', FRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TSOIL1TILE)) then call FILLOUT_TILE(GEX(type), 'TP1', TSOIL1TILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SNOWTILE)) then call FILLOUT_TILE(GEX(type), 'SNOWMASS', SNOWTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ASNOWTILE)) then call FILLOUT_TILE(GEX(type), 'ASNOW', ASNOWTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TPSNOTILE)) then call FILLOUT_TILE(GEX(type), 'TPSNOW', TPSNOTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TPUSTTILE)) then call FILLOUT_TILE(GEX(type), 'TPUNST', TPUSTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TPSATTILE)) then call FILLOUT_TILE(GEX(type), 'TPSAT' , TPSATTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TPWLTTILE)) then call FILLOUT_TILE(GEX(type), 'TPWLT' , TPWLTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(FRSATTILE)) then call FILLOUT_TILE(GEX(type), 'FRSAT', FRSATTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(FRUSTTILE)) then call FILLOUT_TILE(GEX(type), 'FRUST', FRUSTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(FRWLTTILE)) then call FILLOUT_TILE(GEX(type), 'FRWLT', FRWLTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SNODTILE)) then call FILLOUT_TILE(GEX(type), 'SNOWDP', SNODTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(WET1TILE)) then call FILLOUT_TILE(GEX(type), 'WET1', WET1TILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(WET2TILE)) then call FILLOUT_TILE(GEX(type), 'WET2', WET2TILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(RUNOFFTILE)) then call FILLOUT_TILE(GEX(type), 'RUNOFF', RUNOFFTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(RUNSURFTILE)) then call FILLOUT_TILE(GEX(type), 'RUNSURF',RUNSURFTILE,XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(BASEFLOWTILE)) then call FILLOUT_TILE(GEX(type), 'BASEFLOW',BASEFLOWTILE,XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ACCUMTILE)) then call FILLOUT_TILE(GEX(type), 'ACCUM', ACCUMTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SMELTTILE)) then call FILLOUT_TILE(GEX(type), 'SMELT', SMELTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(EVEGTILE)) then call FILLOUT_TILE(GEX(type), 'EVPVEG', EVEGTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(EINTTILE)) then call FILLOUT_TILE(GEX(type), 'EVPINT', EINTTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(ESOITILE)) then call FILLOUT_TILE(GEX(type), 'EVPSOI', ESOITILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(EICETILE)) then call FILLOUT_TILE(GEX(type), 'EVPICE', EICETILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(EVLANDTILE)) then call FILLOUT_TILE(GEX(type), 'EVLAND', EVLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(LHLANDTILE)) then call FILLOUT_TILE(GEX(type), 'LHLAND', LHLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SHLANDTILE)) then call FILLOUT_TILE(GEX(type), 'SHLAND', SHLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SWLANDTILE)) then call FILLOUT_TILE(GEX(type), 'SWLAND', SWLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(LWLANDTILE)) then call FILLOUT_TILE(GEX(type), 'LWLAND', LWLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(GHLANDTILE)) then call FILLOUT_TILE(GEX(type), 'GHLAND', GHLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SMLANDTILE)) then call FILLOUT_TILE(GEX(type), 'SMLAND', SMLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TWLANDTILE)) then call FILLOUT_TILE(GEX(type), 'TWLAND', TWLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TELANDTILE)) then call FILLOUT_TILE(GEX(type), 'TELAND', TELANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TSLANDTILE)) then call FILLOUT_TILE(GEX(type), 'TSLAND', TSLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(DWLANDTILE)) then call FILLOUT_TILE(GEX(type), 'DWLAND', DWLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(DHLANDTILE)) then call FILLOUT_TILE(GEX(type), 'DHLAND', DHLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SPLANDTILE)) then call FILLOUT_TILE(GEX(type), 'SPLAND', SPLANDTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SPWATRTILE)) then call FILLOUT_TILE(GEX(type), 'SPWATR', SPWATRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SPSNOWTILE)) then call FILLOUT_TILE(GEX(type), 'SPSNOW', SPSNOWTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(EVAPOUTILE)) then call FILLOUT_TILE(GEX(type), 'EVAPOUT',EVAPOUTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SHOUTILE)) then call FILLOUT_TILE(GEX(type), 'SHOUT', SHOUTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(HLATNTILE)) then call FILLOUT_TILE(GEX(type), 'HLATN', HLATNTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(HLATWTRTILE)) then call FILLOUT_TILE(GEX(type), 'HLATWTR', HLATWTRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(HLATICETILE)) then call FILLOUT_TILE(GEX(type), 'HLATICE', HLATICETILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SHWTRTILE) ) then call FILLOUT_TILE(GEX(type), 'SHWTR', SHWTRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SHICETILE) ) then call FILLOUT_TILE(GEX(type), 'SHICE', SHICETILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TAUXWTILE) ) then call FILLOUT_TILE(GEX(type), 'TAUXW', TAUXWTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TAUXITILE) ) then call FILLOUT_TILE(GEX(type), 'TAUXI', TAUXITILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TAUYWTILE) ) then call FILLOUT_TILE(GEX(type), 'TAUYW', TAUYWTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(TAUYITILE) ) then call FILLOUT_TILE(GEX(type), 'TAUYI', TAUYITILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(LWNDWTRTILE)) then call FILLOUT_TILE(GEX(type), 'LWNDWTR', LWNDWTRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SWNDWTRTILE)) then call FILLOUT_TILE(GEX(type), 'SWNDWTR', SWNDWTRTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(LWNDICETILE)) then call FILLOUT_TILE(GEX(type), 'LWNDICE', LWNDICETILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SWNDICETILE)) then call FILLOUT_TILE(GEX(type), 'SWNDICE', SWNDICETILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(RAINOCNTILE)) then call FILLOUT_TILE(GEX(type), 'RAINOCN', RAINOCNTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SNOWOCNTILE)) then call FILLOUT_TILE(GEX(type), 'SNOWOCN', SNOWOCNTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(HLWUPTILE)) then call FILLOUT_TILE(GEX(type), 'HLWUP', HLWUPTILE, XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(LWNDSRFTILE)) then call FILLOUT_TILE(GEX(type), 'LWNDSRF',LWNDSRFTILE,XFORM, RC=STATUS) VERIFY_(STATUS) end if if(associated(SWNDSRFTILE)) then call FILLOUT_TILE(GEX(type), 'SWNDSRF',SWNDSRFTILE,XFORM, RC=STATUS) VERIFY_(STATUS) end if call MAPL_TimerOff(MAPL,"--RUN2_"//trim(GCNames(type))) call MAPL_TimerOff(MAPL, trim(GCNames(type))) RETURN_(ESMF_SUCCESS) end subroutine DOTYPE end subroutine RUN2 subroutine MKTILE(VAR, TILEVAR, NT, RC) real, pointer :: VAR(:,:) real, pointer :: TILEVAR(:) integer, intent(IN) :: NT integer, optional, intent(OUT) :: RC character(len=ESMF_MAXSTR) :: IAm='MKTILE' integer :: STATUS if(associated(VAR) .and. .not.associated(TILEVAR)) then allocate(TILEVAR(NT), STAT=STATUS) VERIFY_(STATUS) TILEVAR = MAPL_Undef end if RETURN_(ESMF_SUCCESS) end subroutine MKTILE subroutine FILLIN_TILE(STATE, NAME, TILE, XFORM, RC) type(ESMF_STATE), intent(INOUT) :: STATE character(len=*) :: NAME real :: TILE(:) type (MAPL_LocStreamXFORM) :: XFORM integer, optional, intent(OUT) :: RC ! Locals character(len=ESMF_MAXSTR) :: IAm='FILLIN_TILE' integer :: STATUS real, pointer :: PTR1(:) type (ESMF_Field) :: field type (ESMF_StateItemType), pointer :: ITEMTYPES(:) character(len=ESMF_MAXSTR ), pointer :: ITEMNAMES(:) integer :: ITEMCOUNT integer :: I logical :: found ! Get information from state !--------------------------- call ESMF_StateGet(STATE,ITEMCOUNT=ITEMCOUNT,RC=STATUS) VERIFY_(STATUS) ASSERT_(ITEMCOUNT>0) allocate(ITEMNAMES(ITEMCOUNT), STAT=STATUS) VERIFY_(STATUS) allocate(ITEMTYPES(ITEMCOUNT), STAT=STATUS) VERIFY_(STATUS) call ESMF_StateGet(STATE,ITEMNAMELIST=ITEMNAMES,STATEITEMTYPELIST=ITEMTYPES,RC=STATUS) VERIFY_(STATUS) ! If the field is not in the state being filled, we do nothing. !-------------------------------------------------------------- found = .false. do I = 1, ITEMCOUNT if (ITEMNAMES(I) /= NAME) cycle if (ITEMTYPES(I) /= ESMF_StateItem_Field) cycle found = .true. exit end do deallocate(ITEMNAMES) deallocate(ITEMTYPES) if (.not. found) then RETURN_(ESMF_SUCCESS) endif call ESMF_StateGet(STATE, NAME, FIELD, RC=STATUS) VERIFY_(ESMF_SUCCESS) ! Get the pointer to the variable to be filled. !---------------------------------------------- call MAPL_GetPointer(STATE, PTR1, NAME, RC=STATUS) VERIFY_(STATUS) ! Fill the variable from the provided stream variable. !----------------------------------------------------- call MAPL_LocStreamTransform( PTR1, XFORM, TILE, RC=STATUS ) VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) end subroutine FILLIN_TILE subroutine FILLOUT_TILE(STATE, NAME, TILE, XFORM, RC) type(ESMF_STATE), intent(INOUT) :: STATE character(len=*), intent(IN ) :: NAME real :: TILE(:) type (MAPL_LocStreamXFORM) :: XFORM integer, optional, intent(OUT ) :: RC ! Locals character(len=ESMF_MAXSTR) :: IAm='FILLOUT_TILE' integer :: STATUS real, pointer :: PTR1(:) type (ESMF_Field) :: field call ESMF_StateGet(STATE, NAME, FIELD, RC=STATUS) if (STATUS /= ESMF_SUCCESS) then RETURN_(ESMF_SUCCESS) endif call MAPL_GetPointer(STATE, PTR1, NAME,RC=STATUS) VERIFY_(STATUS) ASSERT_(associated(PTR1)) call MAPL_LocStreamTransform( TILE, XFORM, PTR1, RC=STATUS ) VERIFY_(STATUS) end subroutine FILLOUT_TILE end module GEOS_SurfaceGridCompMod