! $Id: GEOS_IrradGridComp.F90,v 1.51.10.2 2008/08/29 14:55:04 trayanov Exp $ #include "MAPL_Generic.h" !============================================================================= !BOP ! !MODULE: GEOS_Irrad -- A Module to compute longwaves radiative transfer ! through a cloudy atmosphere ! !INTERFACE: module GEOS_IrradGridCompMod ! !USES: use ESMF_Mod use MAPL_Mod use GEOS_UtilsMod implicit none private ! !PUBLIC ROUTINES: public SetServices !============================================================================= ! !DESCRIPTION: ! ! {\tt Irrad} is a light-weight gridded component to compute longwave ! radiative fluxes. It operates on the ESMF grid that appears in the ! gridded component passed to its {\tt Initialize} method. Unlike ! heavier gridded components, it does not enforce its own grid. ! The only restrictions are that it be a 3-dimensional grid ! in which one dimension is aligned with the vertical coordinate and ! only the horizontal dimensions are decomposed. ! ! The radiative transfer calculation is based on M-D Chou's IRRAD routine. ! A full documentation of the code may be found in ! "A Thermal Infrared Radiation Parameterization for Atmospheric Studies" ! M.-D. Chou et al., NASA/TM-2001-104606, Vol. 19, 55 pp, 2003. ! Based on the 1996-version of the Air Force Geophysical Laboratory HITRAN data ! base (Rothman et al., 1998), the parameterization includes the absorption due ! to major gaseous absorption (water vapor, CO2 , O3 ) and most of the minor ! trace gases (N2O, CH4 , CFC's), as well as clouds and aerosols. The thermal ! infrared spectrum is divided into nine bands and a subband. To achieve a high ! degree of accuracy and speed, various approaches of computing the transmission ! function are applied to different spectral bands and gases. The gaseous ! transmission function is computed either using the k-distribution method or ! the table look-up method. To include the effect of scattering due to clouds ! and aerosols, the optical thickness is scaled by the single-scattering albedo ! and asymmetry factor. The optical thickness, the single-scattering albedo, ! and the asymmetry factor of clouds are parameterized as functions of the ice ! and water content and the particle size. ! All outputs are optional and are filled only if they have been ! initialized by a coupler. ! ! The net (+ve downward) fluxes are returned at the layer ! interfaces, which are indexed from the top of the atmosphere (L=0) ! to the surface. It also computes the sensitivity of net downward flux to ! surface temperature and emission by the surface. ! The full transfer calculation, including the linearization w.r.t. the surface temperature, ! is done intermitently, on the component's main time step and its results are ! kept in the internal state. Exports are refreshed each heartbeat based on the ! latest surface temperature. ! ! Radiation should be called either before or after thos components ! (usually SURFACE and DYNAMICS) that use its fluxes and modify ! its inputs. If it is called before, the intemittent refresh should ! occur during the first step of the radiation cycle, while if it ! is called after, it should occur during the last step. The behavior ! of the component needs to be somewhat different in these two cases ! and so a means is provided, through the logical attribute CALL_LAST in ! configuration, of telling the component how it is being used. The ! default is CALL_LAST = "TRUE". ! !EOP 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, optional :: RC ! return code ! ! DESCRIPTION: This version uses the MAPL_GenericSetServices. This function sets ! the Initialize and Finalize services, as well as allocating ! our instance of a generic state and putting it in the ! gridded component (GC). Here we only need to set the run method and ! add the state variable specifications (also generic) to our instance ! of the generic state. This is the way our true state variables get into ! the ESMF_State INTERNAL, which is in the MAPL_MetaComp. !EOP !============================================================================= ! ! ErrLog Variables character(len=ESMF_MAXSTR) :: IAm integer :: STATUS character(len=ESMF_MAXSTR) :: COMP_NAME ! Local derived type aliases type (ESMF_Config ) :: CF integer :: MY_STEP integer :: ACCUMINT real :: DT !============================================================================= ! 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_SETRUN, Run, RC=STATUS) VERIFY_(STATUS) ! Get the configuration ! --------------------- call ESMF_GridCompGet( GC, CONFIG = CF, RC=STATUS ) VERIFY_(STATUS) ! Get the intervals; "heartbeat" must exist ! ----------------------------------------- call ESMF_ConfigGetAttribute( CF, DT, Label="RUN_DT:" , RC=STATUS) VERIFY_(STATUS) ! Refresh interval defaults to heartbeat. This will also be read by ! MAPL_Generic and set as the component's main time step. ! ----------------------------------------------------------------- call ESMF_ConfigGetAttribute( CF, DT, Label=trim(COMP_NAME)//"_DT:", default=DT, RC=STATUS) VERIFY_(STATUS) MY_STEP = nint(DT) ! Averaging interval defaults to the refresh interval. !----------------------------------------------------- call ESMF_ConfigGetAttribute(CF, DT, Label=trim(COMP_NAME)//'Avrg:', default=DT, RC=STATUS) VERIFY_(STATUS) ACCUMINT = nint(DT) ! Set the state variable specs. ! ----------------------------- !BOP ! !IMPORT STATE: call MAPL_AddImportSpec(GC, & SHORT_NAME = 'PLE', & LONG_NAME = 'air_pressure', & UNITS = 'Pa', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'T', & LONG_NAME = 'air_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'QV', & LONG_NAME = 'specific_humidity', & UNITS = '1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'QL', & LONG_NAME = 'mass_fraction_of_cloud_liquid_water_in_air', & UNITS = '1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'QI', & LONG_NAME = 'mass_fraction_of_cloud_ice_in_air', & UNITS = '1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'QR', & LONG_NAME = 'mass_fraction_of_rain_water_in_air',& UNITS = '1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'RL', & LONG_NAME = 'effective_radius_of_cloud_liquid_water_particles', & UNITS = 'm', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'RI', & LONG_NAME = 'effective_radius_of_cloud_ice_particles', & UNITS = 'm', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'RR', & LONG_NAME = 'effective_radius_of_rain_particles',& UNITS = 'm', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'O3', & LONG_NAME = 'ozone_mixing_ratio', & UNITS = '1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'CH4', & LONG_NAME = 'methane_concentration', & UNITS = 'pppv', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'N2O', & LONG_NAME = 'nitrous_oxide_concentration', & UNITS = 'pppv', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'CFC11', & LONG_NAME = 'CFC11_concentration', & UNITS = 'pppv', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'CFC12', & LONG_NAME = 'CFC12_concentration', & UNITS = 'pppv', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'CFC22', & LONG_NAME = 'CFC22_concentration', & UNITS = 'pppv', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'FCLD', & LONG_NAME = 'cloud_area_fraction_in_atmosphere_layer', & UNITS = '1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'TS', & LONG_NAME = 'surface_skin_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'EMIS', & LONG_NAME = 'surface_emissivity', & UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & AVERAGING_INTERVAL = ACCUMINT, & REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'SFC_RATIO', & LONG_NAME = 'ratio_topo_area_hori_area', & !wcc UNITS = '1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & !wcc AVERAGING_INTERVAL = ACCUMINT, & !wcc REFRESH_INTERVAL = MY_STEP, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & SHORT_NAME = 'PREF', & LONG_NAME = 'reference_air_pressure', & UNITS = 'Pa', & DIMS = MAPL_DimsVertOnly, & VLOCATION = MAPL_VLocationEdge, & RC=STATUS ) VERIFY_(STATUS) ! Instantaneous TS is used only for updating the IR fluxes due to TS change call MAPL_AddImportSpec(GC, & SHORT_NAME = 'TSINST', & LONG_NAME = 'surface_skin_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, & RC=STATUS ) VERIFY_(STATUS) call MAPL_AddImportSpec(GC, & LONG_NAME = 'aerosols', & UNITS = '1', & SHORT_NAME = 'AERO', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, & DATATYPE = MAPL_BundleItem, & RC=STATUS ) VERIFY_(STATUS) ! !EXPORT STATE: call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FLX', & LONG_NAME = 'net_downward_longwave_flux_in_air', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FLC', & LONG_NAME = 'net_downward_longwave_flux_in_air_assuming_clear_sky', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FLA', & LONG_NAME = 'net_downward_longwave_flux_in_air_assuming_clear_sky_and_no_aerosol',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'SFCEM', & LONG_NAME = 'longwave_flux_emitted_from_surface', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'DSFDTS', & LONG_NAME = 'sensitivity_of_longwave_flux_emitted_from_surface_to_surface_temperature', & UNITS = 'W m-2 K-1', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TSREFF', & LONG_NAME = 'surface_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'OLR', & LONG_NAME = 'upwelling_longwave_flux_at_toa', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'OLC', & LONG_NAME = 'upwelling_longwave_flux_at_toa_assuming_clear_sky',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'OLA', & LONG_NAME = 'upwelling_longwave_flux_at_toa_assuming_clear_sky_and_no_aerosol',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FLNS', & LONG_NAME = 'surface_net_downward_longwave_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FLNSC', & LONG_NAME = 'surface_net_downward_longwave_flux_assuming_clear_sky',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'FLNSA', & LONG_NAME = 'surface_net_downward_longwave_flux_assuming_clear_sky_and_no_aerosol',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LWS', & LONG_NAME = 'surface_downwelling_longwave_flux', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LCS', & LONG_NAME = 'surface_downwelling_longwave_flux_assuming_clear_sky',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'LAS', & LONG_NAME = 'surface_downwelling_longwave_flux_assuming_clear_sky_and_no_aerosol',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'CLDTMP', & LONG_NAME = 'cloud_top_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'CLDPRS', & LONG_NAME = 'cloud_top_pressure', & UNITS = 'Pa', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddExportSpec(GC, & SHORT_NAME = 'TAUIR', & LONG_NAME = 'longwave_cloud_optical_thickness_at_800_cm-1',& UNITS = 'W m-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationCenter, RC=STATUS ) VERIFY_(STATUS) ! Irrad does not have a "real" internal state. To update the net_longwave_flux ! due to the change of surface temperature every time step, we keep ! several variables in the internal state. ! !INTERNAL STATE: call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'FLX', & LONG_NAME = 'net_downward_longwave_flux_in_air', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'FLC', & LONG_NAME = 'net_downward_longwave_flux_in_air_for_clear_sky(INTERNAL)', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'FLA', & LONG_NAME = 'net_downward_longwave_flux_in_air_for_clear_sky_and_no_aerosol', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'DFDTS', & LONG_NAME = 'sensitivity_of_net_downward_longwave_flux_in_air_to_surface_temperature', & UNITS = 'W m-2 K-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'DFDTSC', & LONG_NAME = 'sensitivity_of_net_downward_longwave_flux_in_air_to_surface_temperature_for_clear_sky',& UNITS = 'W m-2 K-1', & DIMS = MAPL_DimsHorzVert, & VLOCATION = MAPL_VLocationEdge, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'SFCEM', & LONG_NAME = 'longwave_flux_emitted_from_surface', & UNITS = 'W m-2', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) call MAPL_AddInternalSpec(GC, & SHORT_NAME = 'TS', & LONG_NAME = 'surface_temperature', & UNITS = 'K', & DIMS = MAPL_DimsHorzOnly, & VLOCATION = MAPL_VLocationNone, RC=STATUS ) VERIFY_(STATUS) !EOP ! Set the Profiling timers ! ------------------------ call MAPL_TimerAdd(GC, name="-LW_DRIVER" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="--IRRAD" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="--MISC" ,RC=STATUS) VERIFY_(STATUS) call MAPL_TimerAdd(GC, name="-UPDATE_FLX" ,RC=STATUS) VERIFY_(STATUS) ! Set generic init and final methods ! ---------------------------------- call MAPL_GenericSetServices ( GC, RC=STATUS) VERIFY_(STATUS) RETURN_(ESMF_SUCCESS) end subroutine SetServices !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !BOP ! ! IROUTINE: RUN -- Run method for the LW component ! !INTERFACE: subroutine RUN ( GC, IMPORT, EXPORT, CLOCK, RC ) ! !ARGUMENTS: type(ESMF_GridComp), intent(inout) :: GC ! Gridded component type(ESMF_State), intent(inout) :: IMPORT ! Import state type(ESMF_State), intent(inout) :: EXPORT ! Export state type(ESMF_Clock), intent(inout) :: CLOCK ! The clock integer, optional, intent( out) :: RC ! Error code: ! ! DESCRIPTION: Periodically refreshes the fluxes and their derivatives ! w.r.t surface skin temperature. On every step it produces ! a linear estimate of the fluxes based on the instantaneous ! surface temperature. !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 (ESMF_State) :: INTERNAL type (ESMF_Alarm) :: ALARM type (ESMF_FieldBundle) :: BUNDLE type (ESMF_Field) :: FIELD integer :: IM, JM, LM, NA integer :: CalledLast ! Pointers to internal real, pointer, dimension(:,: ) :: SFCEM_INT real, pointer, dimension(:,: ) :: TS_INT real, pointer, dimension(:,:,:) :: FLX_INT real, pointer, dimension(:,:,:) :: FLC_INT real, pointer, dimension(:,:,:) :: FLA_INT real, pointer, dimension(:,:,:) :: DFDTS real, pointer, dimension(:,:,:) :: DFDTSC real, external :: getco2 !============================================================================= ! Begin... ! Get the target components name and set-up traceback handle. ! ----------------------------------------------------------- Iam = "Run" call ESMF_GridCompGet( GC, name=COMP_NAME, 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 MAPL_TimerOn(MAPL,"TOTAL") ! Get parameters from generic state. The RUNALARM is used to control ! the calling of the full transfer calculation !------------------------------------------------------------------- call MAPL_Get(MAPL, & IM=IM, JM=JM, LM=LM, & RUNALARM = ALARM, & INTERNAL_ESMF_STATE = INTERNAL, & RC=STATUS ) VERIFY_(STATUS) ! Determine number of aerosols !----------------------------- call ESMF_StateGet(IMPORT, 'AERO' , BUNDLE, RC=STATUS) VERIFY_(STATUS) call ESMF_FieldBundleGet(BUNDLE, fieldCOUNT=NA, RC=STATUS) VERIFY_(STATUS) ! Pointers to Internals; these are needed by both Update and Refresh !------------------------------------------------------------------- call MAPL_GetPointer(INTERNAL, SFCEM_INT, 'SFCEM', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, FLX_INT, 'FLX', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, FLC_INT, 'FLC', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, FLA_INT, 'FLA', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, TS_INT, 'TS', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, DFDTS, 'DFDTS', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(INTERNAL, DFDTSC, 'DFDTSC',RC=STATUS); VERIFY_(STATUS) ! Determine calling sequence !--------------------------- call MAPL_GetResource(MAPL,CalledLast,'CALLED_LAST:', default=1, RC=STATUS) VERIFY_(STATUS) ! Fill exported fluxed based on latest Ts !---------------------------------------- if(CalledLast/=0) then call MAPL_TimerOn(MAPL,"-UPDATE_FLX") call Update_Flx( IM,JM,LM, RC=STATUS ) VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"-UPDATE_FLX") endif ! If it is time, refresh internal state. !--------------------------------------- if ( ESMF_AlarmIsRinging (ALARM, RC=STATUS) ) then call ESMF_AlarmRingerOff(ALARM, RC=STATUS) VERIFY_(STATUS) call MAPL_TimerOn(MAPL,"-LW_DRIVER") call LW_Driver( IM,JM,LM,NA, RC=STATUS ) VERIFY_(STATUS) !ALT the next line looks like mispelled. Apparently nobody uses it, so I am commenting it out ! call ESMF_StateSetAttribute(INTERNAL,"GOES_Initialize",ESMF_TRUE, RC=STATUS) ! VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"-LW_DRIVER") endif ! Fill exported fluxes based on latest Ts !---------------------------------------- if(CalledLast==0) then call MAPL_TimerOn(MAPL,"-UPDATE_FLX") call Update_Flx( IM,JM,LM, RC=STATUS ) VERIFY_(STATUS) call MAPL_TimerOff(MAPL,"-UPDATE_FLX") endif call MAPL_TimerOff(MAPL,"TOTAL") ! All done !----------- RETURN_(ESMF_SUCCESS) contains !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! subroutine Lw_Driver(IM,JM,LM,NA,RC) integer, intent(IN ) :: IM, JM, LM, NA integer, optional, intent(OUT) :: RC ! Locals character(len=ESMF_MAXSTR) :: IAm integer :: STATUS ! local variables logical, parameter :: HIGH = .true. logical, parameter :: TRACE = .true. logical, parameter :: OVERCAST = .false. integer, parameter :: NS = 1 ! number of sub-grid surface types integer, parameter :: KICE = 1 integer, parameter :: KLIQUID = 2 integer, parameter :: KRAIN = 3 real :: CO2 real :: TAUCRIT ! pressure seperating low and middle clouds real :: PRS_LOW_MID ! pressure seperating low and middle clouds real :: PRS_MID_HIGH ! pressure seperating low and high clouds integer :: LCLDMH ! model level seperating high and middle clouds integer :: LCLDLM ! model level seperating low and middle clouds character(len=ESMF_MAXSTR), pointer :: AEROSOLS(:) integer :: i, j, K, L, YY, DOY real, dimension (IM,JM) :: T2M ! fractional cover of sub-grid regions real, dimension (IM,JM,NS) :: FS ! fractional cover of sub-grid regions real, dimension (IM,JM,NS) :: TG ! land or ocean surface temperature real, dimension (IM,JM,NS,10) :: EG ! land or ocean surface emissivity real, dimension (IM,JM,NS) :: TV ! vegetation temperature real, dimension (IM,JM,NS,10) :: EV ! vegetation emissivity real, dimension (IM,JM,NS,10) :: RV ! vegetation reflectivity ! real, dimension (IM,JM,LM,10,NA):: TAUAL ! aerosol optical thickness ! real, dimension (IM,JM,LM,10,NA):: SSAAL ! aerosol single-scattering albedo ! real, dimension (IM,JM,LM,10,NA):: ASYAL ! aerosol asymmetry factor real, dimension (IM,JM,LM,3) :: CWC ! cloud water mixing ratio real, dimension (IM,JM,LM,3) :: REFF ! effective radius of cloud particles real, dimension (IM,JM,LM,10) :: TAUDIAG real, dimension (IM,JM,LM) :: RH, PL type (ESMF_Time) :: CURRENTTIME ! pointers to import !------------------- real, pointer, dimension(: ) :: PREF real, pointer, dimension(:,: ) :: TS real, pointer, dimension(:,: ) :: EMIS !wcc real, pointer, dimension(:,: ) :: SFC_RATIO !wcc !wcc real, pointer, dimension(:,:,:) :: PLE, T, Q, O3 real, pointer, dimension(:,:,:) :: CH4, N2O, CFC11, CFC12, CFC22 real, pointer, dimension(:,:,:) :: QL, QI, QR real, pointer, dimension(:,:,:) :: RI, RL, RR, FCLD real, pointer, dimension(:,:,:,:) :: RAERO real, pointer, dimension(:,:,:) :: QAERO ! pointers to exports !-------------------- real, pointer, dimension(:,: ) :: CLDPRS real, pointer, dimension(:,: ) :: CLDTMP real, pointer, dimension(:,:,:) :: TAUIR ! Begin... !---------- IAm = "Lw_Driver" call MAPL_TimerOn(MAPL,"--MISC") ! Pointer to Imports used only for full transfer calculation !----------------------------------------------------------- call MAPL_GetPointer(IMPORT, PLE, 'PLE', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, T, 'T', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, Q, 'QV', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, QL, 'QL', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, QI, 'QI', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, QR, 'QR', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, RL, 'RL', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, RI, 'RI', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, RR, 'RR', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, O3, 'O3', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, CH4, 'CH4', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, N2O, 'N2O', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, CFC11,'CFC11',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, CFC12,'CFC12',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, CFC22,'CFC22',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, FCLD, 'FCLD', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, EMIS, 'EMIS', RC=STATUS); VERIFY_(STATUS) !wcc call MAPL_GetPointer(IMPORT, SFC_RATIO, 'SFC_RATIO', RC=STATUS); VERIFY_(STATUS) !wcc !wcc call MAPL_GetPointer(IMPORT, PREF, 'PREF', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(IMPORT, TS, 'TS', RC=STATUS); VERIFY_(STATUS) call ESMF_StateGet(IMPORT, 'AERO' , BUNDLE, RC=STATUS) VERIFY_(STATUS) allocate(RAERO(IM,JM,LM,NA),STAT=STATUS) VERIFY_(STATUS) allocate(AEROSOLS(NA), STAT=STATUS) VERIFY_(STATUS) do K=1,NA call ESMF_FieldBundleGet(BUNDLE, K, FIELD, RC=STATUS) VERIFY_(STATUS) call ESMF_FieldGet(FIELD, NAME=AEROSOLS(K), RC=STATUS) VERIFY_(STATUS) call ESMFL_BundleGetPointerToData(BUNDLE, K, QAERO, RC=STATUS) VERIFY_(STATUS) RAERO(:,:,:,K) = QAERO end do PL = 0.5*(PLE(:,:,:UBOUND(PLE,3)-1)+PLE(:,:,LBOUND(PLE,3)+1:)) RH = Q/GEOS_QSAT(T,PL,PASCALS=.true.) ! Get trace gases concentrations by volume (pppv) from configuration !------------------------------------------------------------------- call MAPL_GetResource( MAPL, CO2, 'CO2:', default=350.e-6, RC=STATUS) VERIFY_(STATUS) if(CO2<0.0) then call ESMF_ClockGet(CLOCK, currTIME=CURRENTTIME, RC=STATUS) VERIFY_(STATUS) call ESMF_TimeGet (CURRENTTIME, YY=YY, DayOfYear=DOY, RC=STATUS) VERIFY_(STATUS) CO2 = GETCO2(YY,DOY) endif call MAPL_GetResource( MAPL, TAUCRIT , 'TAUCRIT:' , DEFAULT=0.30 , & RC=STATUS) VERIFY_(STATUS) TAUCRIT = TAUCRIT/2.13 call MAPL_GetResource( MAPL, PRS_LOW_MID, 'PRS_LOW_MID_CLOUDS:', DEFAULT=70000., & RC=STATUS) VERIFY_(STATUS) call MAPL_GetResource( MAPL, PRS_MID_HIGH, 'PRS_MID_HIGH_CLOUDS:', DEFAULT=40000., & RC=STATUS) VERIFY_(STATUS) ! Compute surface air temperature ("2 m") adiabatically !------------------------------------------------------ T2M = T(:,:,LM)*(0.5*(1.0 + PLE(:,:,LM-1)/PLE(:,:,LM)))**(-MAPL_KAPPA) ! For now, use the same emissivity for all bands !----------------------------------------------- do K = 1, 10 !wcc EG(:,:,1,K) = EMIS(:,:) EG(:,:,1,K) = EMIS(:,:)*SFC_RATIO(:,:) !wcc end do ! For now, hardwire vegetation and aerosol parameters !---------------------------------------------------- FS = 1.0 TG(:,:,1) = TS TV(:,:,1) = TS EV = 0.0 RV = 0.0 ! TAUAL = 0.00 ! SSAAL = 0.99 ! ASYAL = 0.75 ! Copy cloud constituent properties into contiguous buffers !---------------------------------------------------------- CWC (:,:,:,KICE ) = QI CWC (:,:,:,KLIQUID) = QL CWC (:,:,:,KRAIN ) = QR REFF(:,:,:,KICE ) = RI * 1.0e6 REFF(:,:,:,KLIQUID) = RL * 1.0e6 REFF(:,:,:,KRAIN ) = RR * 1.0e6 ! Determine the model level seperating high and middle clouds !------------------------------------------------------------ LCLDMH = 1 do K = 1, LM if( PREF(K) >= PRS_MID_HIGH ) then LCLDMH = K exit end if end do ! Determine the model level seperating low and middle clouds !----------------------------------------------------------- LCLDLM = LM do K = 1, LM if( PREF(K) >= PRS_LOW_MID ) then LCLDLM = K exit end if end do call MAPL_TimerOff(MAPL,"--MISC") ! Do longwave calculations on a list of soundings ! This fills the internal state !------------------------------------------------ call MAPL_TimerOn(MAPL,"--IRRAD") call IRRAD( IM*JM, LM, PLE, & T, Q, O3, T2M, CO2, & HIGH, TRACE, N2O, CH4, CFC11, CFC12, CFC22, & OVERCAST, CWC, FCLD, LCLDMH, LCLDLM, REFF, & NS, FS, TG, EG, TV, EV, RV, & NA, AEROSOLS,RAERO,RH, & ! AEROSOL, NA, TAUAL, SSAAL, ASYAL, & FLX_INT, FLC_INT, FLA_INT, DFDTS, SFCEM_INT, TAUDIAG ) call MAPL_TimerOff(MAPL,"--IRRAD") ! Ming-Dah defines the surface emitted as positive downwards !----------------------------------------------------------- SFCEM_INT = -SFCEM_INT ! Clear sky linearization w.r.t Ts not implemented !------------------------------------------------- DFDTSC = 0.0 ! Save surface temperature in internal state !------------------------------------------- TS_INT = TS ! Export some cloud properties in the infrared !--------------------------------------------- call MAPL_TimerOn (MAPL,"--MISC") call MAPL_GetPointer(EXPORT, CLDPRS, 'CLDPRS' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, CLDTMP, 'CLDTMP' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, TAUIR, 'TAUIR' ,RC=STATUS); VERIFY_(STATUS) if(associated(TAUIR)) TAUIR = 0.5*(TAUDIAG(:,:,:,3)+TAUDIAG(:,:,:,4)) if(associated(CLDTMP).or.associated(CLDPRS)) then if(associated(CLDTMP)) CLDTMP = MAPL_UNDEF if(associated(CLDPRS)) CLDPRS = MAPL_UNDEF do j=1,jm do i=1,im do l=1,lm if(0.5*(TAUDIAG(I,J,L,3)+TAUDIAG(I,J,L,4))>TAUCRIT) then if(associated(CLDTMP)) CLDTMP(I,J) = T (I,J,L) if(associated(CLDPRS)) CLDPRS(I,J) = PLE(I,J,L-1) exit end if end do end do end do end if deallocate(RAERO) deallocate(AEROSOLS) call MAPL_TimerOff(MAPL,"--MISC") ! All done !----------- RETURN_(ESMF_SUCCESS) end subroutine LW_Driver !------------------------------------------------ !------------------------------------------------ subroutine Update_Flx(IM,JM,LM,RC) integer, intent(IN ) :: IM, JM, LM integer, optional, intent(OUT) :: RC ! Locals character(len=ESMF_MAXSTR) :: Iam integer :: STATUS real, dimension(IM,JM) :: DELT integer :: K type(ESMF_Logical) :: INIT ! pointer to import real, pointer, dimension(:,: ) :: TSINST ! pointers to export real, pointer, dimension(:,:,:) :: FLX real, pointer, dimension(:,:,:) :: FLC real, pointer, dimension(:,:,:) :: FLA real, pointer, dimension(:,: ) :: TSREFF real, pointer, dimension(:,: ) :: SFCEM real, pointer, dimension(:,: ) :: DSFDTS real, pointer, dimension(:,: ) :: OLR real, pointer, dimension(:,: ) :: OLC real, pointer, dimension(:,: ) :: OLA real, pointer, dimension(:,: ) :: FLNS real, pointer, dimension(:,: ) :: FLNSC real, pointer, dimension(:,: ) :: FLNSA real, pointer, dimension(:,: ) :: LWS real, pointer, dimension(:,: ) :: LCS real, pointer, dimension(:,: ) :: LAS ! Begin... !---------- IAm = "Update_Flx" ! Pointers to Exports !-------------------- call MAPL_GetPointer(EXPORT, FLX , 'FLX', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FLC , 'FLC', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FLA , 'FLA', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, TSREFF, 'TSREFF',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, SFCEM , 'SFCEM', RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, DSFDTS, 'DSFDTS',RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, OLR , 'OLR' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, OLC , 'OLC' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, OLA , 'OLA' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, LWS , 'LWS' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, LCS , 'LCS' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, LAS , 'LAS' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FLNS , 'FLNS' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FLNSC , 'FLNSC' ,RC=STATUS); VERIFY_(STATUS) call MAPL_GetPointer(EXPORT, FLNSA , 'FLNSA' ,RC=STATUS); VERIFY_(STATUS) ! Pointers to Imports !-------------------- call MAPL_GetPointer(IMPORT, TSINST, 'TSINST', RC=STATUS); VERIFY_(STATUS) ! Update fluxes !-------------- DELT = TSINST - TS_INT do K = 0, LM if(associated(FLX)) FLX(:,:,K) = FLX_INT(:,:,K) + DFDTS (:,:,K) * DELT if(associated(FLC)) FLC(:,:,K) = FLC_INT(:,:,K) + DFDTSC(:,:,K) * DELT if(associated(FLA)) FLA(:,:,K) = FLA_INT(:,:,K) + DFDTSC(:,:,K) * DELT end do if(associated(DSFDTS)) DSFDTS = - DFDTS (:,:,LM) if(associated(SFCEM )) SFCEM = SFCEM_INT - DFDTS (:,:,LM) * DELT if(associated(OLR )) OLR = -(FLX_INT(:,:, 0) + DFDTS (:,:, 0) * DELT) if(associated(OLC )) OLC = -(FLC_INT(:,:, 0) + DFDTSC(:,:, 0) * DELT) if(associated(OLA )) OLA = -(FLA_INT(:,:, 0) + DFDTSC(:,:, 0) * DELT) if(associated(LWS )) LWS = FLX_INT(:,:,LM) + SFCEM_INT if(associated(LCS )) LCS = FLC_INT(:,:,LM) + SFCEM_INT if(associated(LAS )) LAS = FLA_INT(:,:,LM) + SFCEM_INT if(associated(FLNS )) FLNS = FLX_INT(:,:,LM) + DFDTS (:,:,LM) * DELT if(associated(FLNSC )) FLNSC = FLC_INT(:,:,LM) + DFDTSC(:,:,LM) * DELT if(associated(FLNSA )) FLNSA = FLA_INT(:,:,LM) + DFDTSC(:,:,LM) * DELT ! Reference surface temperature for export consistent with updated fluxes !------------------------------------------------------------------------ if(associated(TSREFF)) TSREFF = TSINST ! All done !----------- RETURN_(ESMF_SUCCESS) end subroutine Update_Flx end subroutine RUN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! end module GEOS_IrradGridCompMod