!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! !! !! GNU General Public License !! !! !! !! This file is part of the Flexible Modeling System (FMS). !! !! !! !! FMS is free software; you can redistribute it and/or modify !! !! it and are expected to follow the terms of the GNU General Public !! !! License as published by the Free Software Foundation. !! !! !! !! FMS is distributed in the hope that it will be useful, !! !! but WITHOUT ANY WARRANTY; without even the implied warranty of !! !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !! !! GNU General Public License for more details. !! !! !! !! You should have received a copy of the GNU General Public License !! !! along with FMS; if not, write to: !! !! Free Software Foundation, Inc. !! !! 59 Temple Place, Suite 330 !! !! Boston, MA 02111-1307 USA !! !! or see: !! !! http://www.gnu.org/licenses/gpl.txt !! !! !! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! module physics_driver_mod ! ! fil ! ! ! ! ! ! Provides high level interfaces for calling the entire ! FMS atmospheric physics package. ! ! physics_driver_mod accesses the model's physics modules and ! obtains tendencies and boundary fluxes due to the physical ! processes that drive atmospheric time tendencies and supply ! boundary forcing to the surface models. ! ! ! This version of physics_driver_mod has been designed around the implicit ! version diffusion scheme of the GCM. It requires two routines to advance ! the model one time step into the future. These two routines ! correspond to the down and up sweeps of the standard tridiagonal solver. ! Radiation, Rayleigh damping, gravity wave drag, vertical diffusion of ! momentum and tracers, and the downward pass of vertical diffusion for ! temperature and specific humidity are performed in the down routine. ! The up routine finishes the vertical diffusion and computes moisture ! related terms (convection,large-scale condensation, and precipitation). ! ! ! ! ! native format restart file ! ! ! ! netcdf format restart file ! ! ! ! ! ! ! ! ! ! ! Deal with conservation of total energy? ! ! shared modules: use time_manager_mod, only: time_type, get_time, operator (-), & time_manager_init use field_manager_mod, only: field_manager_init, MODEL_ATMOS use tracer_manager_mod, only: tracer_manager_init, & get_number_tracers, & get_tracer_names use atmos_tracer_driver_mod, only: atmos_tracer_driver_init, & atmos_tracer_driver_time_vary, & atmos_tracer_driver_endts, & atmos_tracer_driver, & atmos_tracer_driver_end use fms_mod, only: mpp_clock_id, mpp_clock_begin, & mpp_clock_end, CLOCK_MODULE_DRIVER, & fms_init, & open_namelist_file, stdlog, & write_version_number, field_size, & file_exist, error_mesg, FATAL, & WARNING, NOTE, check_nml_error, & open_restart_file, read_data, & close_file, mpp_pe, mpp_root_pe, & write_data, mpp_error, mpp_chksum use fms_io_mod, only: get_restart_io_mode, & register_restart_field, restart_file_type, & save_restart, get_mosaic_tile_file use constants_mod, only: RDGAS use diag_manager_mod, only: register_diag_field, send_data ! shared radiation package modules: use rad_utilities_mod, only: aerosol_type, radiative_gases_type, & rad_utilities_init, rad_output_type,& cld_specification_type, & surface_type, & atmos_input_type, microphysics_type ! component modules: use cosp_driver_mod, only: cosp_driver_init, cosp_driver, & cosp_driver_end use moist_processes_mod, only: moist_processes, & moist_processes_init, & moist_processes_time_vary, & moist_processes_endts, & moist_processes_end, & moist_alloc_init, & moist_alloc_end, & doing_strat!, & ! moist_processes_restart use moistproc_kernels_mod, only: moistproc_init, moistproc_end use vert_turb_driver_mod, only: vert_turb_driver, & vert_turb_driver_init, & vert_turb_driver_end, & vert_turb_driver_restart use vert_diff_driver_mod, only: vert_diff_driver_down, & vert_diff_driver_up, & vert_diff_driver_init, & vert_diff_driver_end, & surf_diff_type use radiation_driver_mod, only: radiation_driver_init, & define_rad_times, define_surface, & define_atmos_input_fields, & radiation_driver_time_vary, & radiation_driver_endts, & radiation_driver, & return_cosp_inputs, & atmos_input_dealloc, & microphys_dealloc, & surface_dealloc, & radiation_driver_end, & radiation_driver_restart use cloud_spec_mod, only: cloud_spec_init, cloud_spec, & cloud_spec_dealloc, cloud_spec_end use aerosol_mod, only: aerosol_init, aerosol_driver, & aerosol_time_vary, & aerosol_endts, & aerosol_dealloc, aerosol_end use radiative_gases_mod, only: radiative_gases_init, & radiative_gases_time_vary, & radiative_gases_endts, & define_radiative_gases, & radiative_gases_dealloc, & radiative_gases_end, & radiative_gases_restart use damping_driver_mod, only: damping_driver, & damping_driver_init, & damping_driver_time_vary, & damping_driver_endts, & damping_driver_end, & damping_driver_restart use grey_radiation_mod, only: grey_radiation_init, grey_radiation, & grey_radiation_end #ifdef SCM ! Option to add SCM radiative tendencies from forcing to lw_tendency ! and radturbten use scm_forc_mod, only: use_scm_rad, add_scm_tdtlw, add_scm_tdtsw #endif !----------------------------------------------------------------- implicit none private !--------------------------------------------------------------------- ! physics_driver_mod accesses the model's physics modules and ! obtains tendencies and boundary fluxes due to the physical ! processes that drive atmospheric time tendencies and supply ! boundary forcing to the surface models. !--------------------------------------------------------------------- !--------------------------------------------------------------------- !----------- version number for this module ------------------- character(len=128) :: version = '$Id: physics_driver.F90,v 17.0.2.1.6.1.2.1.2.1.2.2.2.1 2009/11/19 20:00:56 wfc Exp $' character(len=128) :: tagname = '$Name: mom4p1_pubrel_dec2009_nnz $' !--------------------------------------------------------------------- !------- interfaces -------- public physics_driver_init, physics_driver_down, & physics_driver_down_time_vary, physics_driver_up_time_vary, & physics_driver_down_endts, physics_driver_up_endts, & physics_driver_moist_init, physics_driver_moist_end, & physics_driver_up, physics_driver_end, & do_moist_in_phys_up, get_diff_t, & get_radturbten, zero_radturbten, physics_driver_restart private & ! called from physics_driver_init: read_restart_file, read_restart_nc, & ! called from physics_driver_down: check_args, & ! called from check_args: check_dim interface check_dim module procedure check_dim_2d, check_dim_3d, check_dim_4d end interface !--------------------------------------------------------------------- !------- namelist ------ logical :: do_moist_processes = .true. ! call moist_processes routines real :: tau_diff = 3600. ! time scale for smoothing diffusion ! coefficients logical :: do_cosp = .false. ! activate COSP simulator ? logical :: do_modis_yim = .true. ! activate simple modis simulator ? logical :: do_radiation = .true. ! calculating radiative fluxes and ! heating rates? logical :: do_grey_radiation = .false. ! do grey radiation scheme? real :: R1 = 0.25 ! rif:(09/10/09) In Grey radiation we are computing just the total real :: R2 = 0.25 ! SW radiation. We need to divide it into 4 components real :: R3 = 0.25 ! to go through the Coupler and Ice modules. real :: R4 = 0.25 ! Sum[R(i)*SW] = SW real :: diff_min = 1.e-3 ! minimum value of a diffusion ! coefficient beneath which the ! coefficient is reset to zero logical :: diffusion_smooth = .true. ! diffusion coefficients should be ! smoothed in time? logical :: use_cloud_tracers_in_radiation = .true. ! if true, use lsc cloud tracer fields ! in radiation (these transported on ! current step, will have non-realizable ! total cloud areas at some points); if ! false, then use balanced (realizable) ! fields saved at end of last step ! only an issue when both lsc and conv ! clouds are active (AM3) logical :: donner_meso_is_largescale = .true. ! donner meso clouds are treated as ! largescale (rather than convective) ! as far as the COSP simulator is ! concerned ? logical :: allow_cosp_precip_wo_clouds = .true. ! COSP will see {ls, cv} precip in grid- ! boxes w/o {ls, cv} clouds ? ! ! !calculating radiative fluxes and ! heating rates? ! ! !call moist_processes routines ! ! !time scale for smoothing diffusion ! coefficients ! ! !minimum value of a diffusion ! coefficient beneath which the ! coefficient is reset to zero ! ! !diffusion coefficients should be ! smoothed in time? ! ! ! namelist / physics_driver_nml / do_radiation, & do_cosp, & do_modis_yim, & donner_meso_is_largescale, & allow_cosp_precip_wo_clouds, & do_moist_processes, tau_diff, & diff_min, diffusion_smooth, & use_cloud_tracers_in_radiation, & do_grey_radiation, R1, R2, R3, R4 !--------------------------------------------------------------------- !------- public data ------ ! ! Defined in vert_diff_driver_mod, republished here. See vert_diff_mod for details. ! public surf_diff_type ! defined in vert_diff_driver_mod, republished ! here !--------------------------------------------------------------------- !------- private data ------ !-------------------------------------------------------------------- ! list of restart versions readable by this module: ! ! version 1: initial implementation 1/2003, contains diffusion coef- ! ficient contribution from cu_mo_trans_mod. This variable ! is generated in physics_driver_up (moist_processes) and ! used on the next step in vert_diff_down, necessitating ! its storage. ! ! version 2: adds pbltop as generated in vert_turb_driver_mod. This ! variable is then used on the next timestep by topo_drag ! (called from damping_driver_mod), necessitating its ! storage. ! ! version 3: adds the diffusion coefficients which are passed to ! vert_diff_driver. These diffusion are saved should ! smoothing of vertical diffusion coefficients be turned ! on. ! ! version 4: adds a logical variable, convect, which indicates whether ! or not the grid column is convecting. This diagnostic is ! needed by the entrain_module in vert_turb_driver. ! ! version 5: adds radturbten when strat_cloud_mod is active, adds ! lw_tendency when edt_mod or entrain_mod is active. ! ! version 6: adds donner cell and meso cloud variables when donner_deep ! is activated. ! version 7: adds shallow convection cloud variables when uw_conv ! is activated. ! version 8: adds lsc cloud props for radiation. only readable when in ! netcdf mode. !--------------------------------------------------------------------- integer, dimension(8) :: restart_versions = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) !-------------------------------------------------------------------- ! the following allocatable arrays are either used to hold physics ! data between timesteps when required, or hold physics data between ! physics_down and physics_up. ! ! diff_cu_mo contains contribution to difusion coefficient ! coming from cu_mo_trans_mod (called from ! moist_processes in physics_driver_up) and then used ! as input on the next time step to vert_diff_down ! called in physics_driver_down. ! diff_t vertical diffusion coefficient for temperature ! which optionally may be time smoothed, meaning ! values must be saved between steps ! diff_m vertical diffusion coefficient for momentum ! which optionally may be time smoothed, meaning ! values must be saved between steps ! radturbten the sum of the radiational and turbulent heating, ! generated in both physics_driver_down (radiation) ! and physics_driver_up (turbulence) and then used ! in moist_processes ! lw_tendency longwave heating rate, generated in radiation and ! needed in vert_turb_driver when either edt_mod ! or entrain_mod is active. must be saved because ! radiation is not calculated on each step. ! pbltop top of boundary layer obtained from vert_turb_driver ! and then used on the next timestep in topo_drag_mod ! called from damping_driver_down ! convect flag indicating whether convection is occurring in ! a grid column. generated in physics_driver_up and ! then used in vert_turb_driver called from ! physics_driver_down on the next step. !---------------------------------------------------------------------- real, dimension(:,:,:), allocatable :: diff_cu_mo, diff_t, diff_m real, dimension(:,:,:), allocatable :: radturbten, lw_tendency real, dimension(:,:) , allocatable :: pbltop, cush, cbmf logical, dimension(:,:) , allocatable :: convect real, dimension(:,:,:), allocatable :: & cell_cld_frac, cell_liq_amt, & cell_liq_size, cell_ice_amt, cell_ice_size, & cell_droplet_number, & meso_cld_frac, meso_liq_amt, meso_liq_size, & meso_ice_amt, meso_ice_size, & meso_droplet_number, & lsc_cloud_area, lsc_liquid, & lsc_ice, lsc_droplet_number, & shallow_cloud_area, shallow_liquid, & shallow_ice, shallow_droplet_number, & temp_last, q_last real, dimension(:,:,:,:), allocatable :: tau_stoch, lwem_stoch, & stoch_cloud_type, stoch_conc_drop, & stoch_conc_ice, stoch_size_drop, & stoch_size_ice real, dimension(:,:,:), allocatable :: fl_lsrain, fl_lssnow, & fl_lsgrpl, & fl_ccrain, fl_ccsnow, & mr_ozone real, dimension(:,:), allocatable :: daytime integer, dimension(:,:) , allocatable :: nsum_out real , dimension(:,:) , allocatable :: tsurf_save !--- for netcdf restart type(restart_file_type), pointer, save :: Phy_restart => NULL() type(restart_file_type), pointer, save :: Til_restart => NULL() logical :: in_different_file = .false. logical :: do_netcdf_restart = .true. integer :: vers integer :: now_doing_strat integer :: now_doing_entrain integer :: now_doing_edt real, allocatable :: r_convect(:,:) !--------------------------------------------------------------------- ! internal timing clock variables: !--------------------------------------------------------------------- integer :: radiation_clock, damping_clock, turb_clock, & tracer_clock, diff_up_clock, diff_down_clock, & moist_processes_clock, cosp_clock !-------------------------------------------------------------------- ! miscellaneous control variables: !--------------------------------------------------------------------- logical :: do_check_args = .true. ! argument dimensions should ! be checked ? logical :: module_is_initialized = .false. ! module has been initialized ? logical :: doing_edt ! edt_mod has been activated ? logical :: doing_entrain ! entrain_mod has been activated ? logical :: doing_donner ! donner_deep_mod has been ! activated ? logical :: doing_uw_conv ! uw_conv shallow cu mod has been ! activated ? logical :: doing_liq_num = .false. ! Prognostic cloud droplet number has ! been activated? integer :: nt ! total no. of tracers integer :: ntp ! total no. of prognostic tracers integer :: ncol ! number of stochastic columns type(radiative_gases_type) :: Rad_gases_tv type(time_type) :: Rad_time logical :: need_aerosols, need_clouds, need_gases, & need_basic logical :: do_strat integer :: num_uw_tracers !--------------------------------------------------------------------- !--------------------------------------------------------------------- character(len=4) :: mod_name = 'phys' character(len=32) :: tracer_units, tracer_name character(len=128) :: diaglname real :: missing_value = -999. logical :: step_to_call_cosp = .false. logical :: include_donmca_in_cosp integer :: id_tdt_phys, id_qdt_phys, & id_tdt_phys_vdif_dn, & id_tdt_phys_vdif_up, & id_tdt_phys_turb, & id_tdt_phys_moist integer, dimension(:), allocatable :: id_tracer_phys_vdif_dn, & id_tracer_phys_vdif_up, & id_tracer_phys_turb, & id_tracer_phys_moist contains !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! PUBLIC SUBROUTINES ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !##################################################################### ! ! ! physics_driver_init is the constructor for physics_driver_mod. ! ! ! physics_driver_init is the constructor for physics_driver_mod. ! ! ! ! current time ! ! ! reference prssure profiles ! ! ! array of model latitudes at cell corners [radians] ! ! ! array of model longitudes at cell corners [radians] ! ! ! axis indices, (/x,y,pf,ph/) ! (returned from diag axis manager) ! ! ! atmospheric tracer fields ! ! ! surface diffusion derived type ! ! ! pressure at model interface levels ! ! ! OPTIONAL: present when running eta vertical coordinate, ! index of lowest model level above ground ! ! ! OPTIONAL: present when running eta vertical coordinate, ! mask to remove points below ground ! ! ! ! ! subroutine physics_driver_init (Time, lonb, latb, axes, pref, & trs, Surf_diff, phalf, mask, kbot, & diffm, difft ) !--------------------------------------------------------------------- ! physics_driver_init is the constructor for physics_driver_mod. !--------------------------------------------------------------------- type(time_type), intent(in) :: Time real,dimension(:,:), intent(in) :: lonb, latb integer,dimension(4), intent(in) :: axes real,dimension(:,:), intent(in) :: pref real,dimension(:,:,:,:), intent(inout) :: trs type(surf_diff_type), intent(inout) :: Surf_diff real,dimension(:,:,:), intent(in) :: phalf real,dimension(:,:,:), intent(in), optional :: mask integer,dimension(:,:), intent(in), optional :: kbot real, dimension(:,:,:), intent(out), optional :: diffm, difft !--------------------------------------------------------------------- ! intent(in) variables: ! ! Time current time (time_type) ! lonb longitude of the grid box corners [ radians ] ! latb latitude of the grid box corners [ radians ] ! axes axis indices, (/x,y,pf,ph/) ! (returned from diag axis manager) ! pref two reference profiles of pressure at nlev+1 levels ! pref(nlev+1,1)=101325. and pref(nlev+1,2)=81060. ! phalf pressure at model interface levels ! [ Pa ] ! ! intent(inout) variables: ! ! trs atmosperic tracer fields ! Surf_diff surface diffusion derived type variable ! ! intent(in), optional variables: ! ! mask present when running eta vertical coordinate, ! mask to remove points below ground ! kbot present when running eta vertical coordinate, ! index of lowest model level above ground ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: real, dimension (size(lonb,1)-1, size(latb,2)-1) :: sgsmtn character(len=64), dimension(:), pointer :: aerosol_names => NULL() character(len=64), dimension(:), pointer :: aerosol_family_names => NULL() integer :: id, jd, kd, n integer :: ierr, io, unit, logunit integer :: ndum integer :: moist_processes_init_clock, damping_init_clock, & turb_init_clock, diff_init_clock, & cloud_spec_init_clock, aerosol_init_clock, & grey_radiation_init_clock , radiative_gases_init_clock, & radiation_init_clock, tracer_init_clock, & cosp_init_clock !--------------------------------------------------------------------- ! local variables: ! ! sgsmtn sgs orography obtained from mg_drag_mod; ! appears to not be currently used ! aerosol_names names associated with the activated aerosols ! that will be seen by the radiation package ! aerosol_family_names ! names associated with the activated aerosol ! families that will be seen by the radiation package ! id,jd,kd model dimensions on the processor ! ierr error code ! io io status returned from an io call ! unit unit number used for an i/ operation !--------------------------------------------------------------------- ! if routine has already been executed, return. !--------------------------------------------------------------------- if (module_is_initialized) return !--------------------------------------------------------------------- ! verify that the modules used by this module that are not called ! later in this subroutine have already been initialized. !--------------------------------------------------------------------- call fms_init call rad_utilities_init call time_manager_init call tracer_manager_init call field_manager_init (ndum) !-------------------------------------------------------------------- ! read namelist. !-------------------------------------------------------------------- if ( file_exist('input.nml')) then unit = open_namelist_file () ierr=1; do while (ierr /= 0) read (unit, nml=physics_driver_nml, iostat=io, end=10) ierr = check_nml_error(io, 'physics_driver_nml') enddo 10 call close_file (unit) endif if(do_radiation .and. do_grey_radiation) & call error_mesg('physics_driver_init','do_radiation and do_grey_radiation cannot both be .true.',FATAL) call get_restart_io_mode(do_netcdf_restart) !-------------------------------------------------------------------- ! write version number and namelist to log file. !-------------------------------------------------------------------- call write_version_number (version, tagname) logunit = stdlog() if (mpp_pe() == mpp_root_pe() ) & write(logunit, nml=physics_driver_nml) !--------------------------------------------------------------------- ! define the model dimensions on the local processor. !--------------------------------------------------------------------- id = size(lonb,1)-1 jd = size(latb,2)-1 kd = size(trs,3) call get_number_tracers (MODEL_ATMOS, num_tracers=nt, & num_prog=ntp) !--------------------------------------------------------------------- radiation_clock = & mpp_clock_id( ' Physics_down: Radiation', & grain=CLOCK_MODULE_DRIVER ) cosp_clock = & mpp_clock_id( ' Physics_down: COSP', & grain=CLOCK_MODULE_DRIVER ) damping_clock = & mpp_clock_id( ' Physics_down: Damping', & grain=CLOCK_MODULE_DRIVER ) turb_clock = & mpp_clock_id( ' Physics_down: Vert. Turb.', & grain=CLOCK_MODULE_DRIVER ) tracer_clock = & mpp_clock_id( ' Physics_down: Tracer', & grain=CLOCK_MODULE_DRIVER ) diff_down_clock = & mpp_clock_id( ' Physics_down: Vert. Diff.', & grain=CLOCK_MODULE_DRIVER ) diff_up_clock = & mpp_clock_id( ' Physics_up: Vert. Diff.', & grain=CLOCK_MODULE_DRIVER ) moist_processes_clock = & mpp_clock_id( ' Physics_up: Moist Processes', & grain=CLOCK_MODULE_DRIVER ) moist_processes_init_clock = & mpp_clock_id( ' Physics_driver_init: Moist Processes: Initialization', & grain=CLOCK_MODULE_DRIVER ) damping_init_clock = & mpp_clock_id( ' Physics_driver_init: Damping: Initialization', & grain=CLOCK_MODULE_DRIVER ) turb_init_clock = & mpp_clock_id( ' Physics_driver_init: Vert. Turb.: Initialization', & grain=CLOCK_MODULE_DRIVER ) diff_init_clock = & mpp_clock_id( ' Physics_driver_init: Vert. Diff.: Initialization', & grain=CLOCK_MODULE_DRIVER ) cloud_spec_init_clock = & mpp_clock_id( ' Physics_driver_init: Cloud spec: Initialization', & grain=CLOCK_MODULE_DRIVER ) cosp_init_clock = & mpp_clock_id( ' Physics_driver_init: COSP: Initialization', & grain=CLOCK_MODULE_DRIVER ) aerosol_init_clock = & mpp_clock_id( ' Physics_driver_init: Aerosol: Initialization', & grain=CLOCK_MODULE_DRIVER ) grey_radiation_init_clock = & mpp_clock_id( ' Physics_driver_init: Grey Radiation: Initialization', & grain=CLOCK_MODULE_DRIVER ) radiative_gases_init_clock = & mpp_clock_id( ' Physics_driver_init: Radiative gases: Initialization', & grain=CLOCK_MODULE_DRIVER ) radiation_init_clock = & mpp_clock_id( ' Physics_driver_init: Radiation: Initialization', & grain=CLOCK_MODULE_DRIVER ) tracer_init_clock = & mpp_clock_id( ' Physics_driver_init: Tracer: Initialization', & grain=CLOCK_MODULE_DRIVER ) !----------------------------------------------------------------------- call mpp_clock_begin ( moist_processes_init_clock ) call moist_processes_init (id, jd, kd, lonb, latb, pref(:,1),& axes, Time, doing_donner, & doing_uw_conv, & num_uw_tracers, do_strat, & do_cosp_in=do_cosp, & donner_meso_is_largescale_in= & donner_meso_is_largescale, & include_donmca_in_cosp_out = & include_donmca_in_cosp) if ( (include_donmca_in_cosp) .and. & (.not. allow_cosp_precip_wo_clouds) ) then call error_mesg ('physics_driver_init', & 'if cosp is to see donmca, then must allow cvctv precip in & &grid boxes w/o cvctv clouds', FATAL) endif call mpp_clock_end ( moist_processes_init_clock ) !----------------------------------------------------------------------- ! initialize damping_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( damping_init_clock ) call damping_driver_init (lonb, latb, pref(:,1), axes, Time, & sgsmtn) call mpp_clock_end ( damping_init_clock ) !----------------------------------------------------------------------- ! initialize vert_turb_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( turb_init_clock ) call vert_turb_driver_init (lonb, latb, id, jd, kd, axes, Time, & doing_edt, doing_entrain) call mpp_clock_end ( turb_init_clock ) !----------------------------------------------------------------------- ! initialize vert_diff_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( diff_init_clock ) call vert_diff_driver_init (Surf_diff, id, jd, kd, axes, Time ) call mpp_clock_end ( diff_init_clock ) if (do_radiation) then !----------------------------------------------------------------------- ! initialize cloud_spec_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( cloud_spec_init_clock ) call cloud_spec_init (pref, lonb, latb, axes, Time) call mpp_clock_end ( cloud_spec_init_clock ) !----------------------------------------------------------------------- ! initialize aerosol_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( aerosol_init_clock ) call aerosol_init (lonb, latb, aerosol_names, aerosol_family_names) call mpp_clock_end ( aerosol_init_clock ) !----------------------------------------------------------------------- ! initialize radiative_gases_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( radiative_gases_init_clock ) call radiative_gases_init (pref, latb, lonb) call mpp_clock_end ( radiative_gases_init_clock ) !----------------------------------------------------------------------- ! initialize radiation_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( radiation_init_clock ) call radiation_driver_init (lonb, latb, pref, axes, time, & aerosol_names, & aerosol_family_names, do_cosp, ncol) call mpp_clock_end ( radiation_init_clock ) !--------------------------------------------------------------------- ! deallocate space for local pointers. !--------------------------------------------------------------------- deallocate (aerosol_names, aerosol_family_names) else if (do_moist_processes) then !----------------------------------------------------------------------- ! initialize aerosol_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( aerosol_init_clock ) call aerosol_init (lonb, latb, aerosol_names, aerosol_family_names) call mpp_clock_end ( aerosol_init_clock ) endif ! do_radiation if(do_grey_radiation) then call mpp_clock_begin ( grey_radiation_init_clock ) call grey_radiation_init(axes, Time) call mpp_clock_end ( grey_radiation_init_clock ) endif !----------------------------------------------------------------------- ! initialize atmos_tracer_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( tracer_init_clock ) call atmos_tracer_driver_init (lonb, latb, trs, axes, time, & phalf, mask) call mpp_clock_end ( tracer_init_clock ) !--------------------------------------------------------------------- ! allocate space for the module variables. !--------------------------------------------------------------------- allocate ( diff_t (id, jd, kd) ) allocate ( diff_m (id, jd, kd) ) allocate ( diff_cu_mo (id, jd, kd) ) allocate ( pbltop (id, jd) ) allocate ( cush (id, jd) ); cush=-1. !miz allocate ( cbmf (id, jd) ); cbmf=0.0 !miz allocate ( convect (id, jd) ) allocate ( radturbten (id, jd, kd)) allocate ( lw_tendency(id, jd, kd)) allocate ( r_convect (id, jd) ) !-------------------------------------------------------------------- ! these variables needed to preserve rain fluxes, q and T from end ! of one step for use in COSP simulator on next step. !-------------------------------------------------------------------- allocate (fl_lsrain (id, jd, kd)) allocate (fl_lssnow (id, jd, kd)) allocate (fl_lsgrpl (id, jd, kd)) allocate (fl_ccrain (id, jd, kd)) allocate (fl_ccsnow (id, jd, kd)) allocate (mr_ozone (id, jd, kd)) allocate (daytime (id, jd )) allocate ( temp_last (id, jd, kd)) allocate ( q_last (id, jd, kd)) fl_lsrain = 0. fl_lssnow = 0. fl_lsgrpl = 0. fl_ccrain = 0. fl_ccsnow = 0. mr_ozone = 0. daytime = 0. temp_last = 0. q_last = 0. !-------------------------------------------------------------------- ! these variables needed to preserve radiative inputs to COSP from ! physics_driver_down to physics_driver_up. !-------------------------------------------------------------------- if (do_cosp .or. do_modis_yim) then allocate ( tau_stoch (id, jd, kd,ncol)) allocate ( lwem_stoch (id, jd, kd,ncol)) allocate ( stoch_cloud_type (id, jd, kd,ncol)) allocate ( stoch_conc_drop (id, jd, kd,ncol)) allocate ( stoch_conc_ice (id, jd, kd,ncol)) allocate ( stoch_size_drop (id, jd, kd,ncol)) allocate ( stoch_size_ice (id, jd, kd,ncol)) allocate ( tsurf_save (id, jd) ) tau_stoch = 0. lwem_stoch = 0. stoch_cloud_type = 0. stoch_conc_drop = 0. stoch_conc_ice = 0. stoch_size_drop = 0. stoch_size_ice = 0. tsurf_save = 0. endif if (doing_donner) then allocate (cell_cld_frac (id, jd, kd) ) allocate (cell_liq_amt (id, jd, kd) ) allocate (cell_liq_size (id, jd, kd) ) allocate (cell_ice_amt (id, jd, kd) ) allocate (cell_ice_size (id, jd, kd) ) allocate (cell_droplet_number (id, jd, kd) ) allocate (meso_cld_frac (id, jd, kd) ) allocate (meso_liq_amt (id, jd, kd) ) allocate (meso_liq_size (id, jd, kd) ) allocate (meso_ice_amt (id, jd, kd) ) allocate (meso_ice_size (id, jd, kd) ) allocate (meso_droplet_number (id, jd, kd) ) allocate (nsum_out (id, jd) ) cell_cld_frac = 0. cell_liq_amt = 0. cell_liq_size = 0. cell_ice_amt = 0. cell_ice_size = 0. cell_droplet_number = 0. meso_cld_frac = 0. meso_liq_amt = 0. meso_liq_size = 0. meso_ice_amt = 0. meso_ice_size = 0. meso_droplet_number = 0. nsum_out = 1 endif allocate (lsc_cloud_area (id, jd, kd) ) allocate (lsc_liquid (id, jd, kd) ) allocate (lsc_ice (id, jd, kd) ) allocate (lsc_droplet_number (id, jd, kd) ) lsc_cloud_area = 0. lsc_liquid = 0. lsc_ice = 0. lsc_droplet_number = 0. if (doing_uw_conv) then allocate (shallow_cloud_area (id, jd, kd) ) allocate (shallow_liquid (id, jd, kd) ) allocate (shallow_ice (id, jd, kd) ) allocate (shallow_droplet_number (id, jd, kd) ) shallow_cloud_area = 0. shallow_liquid = 0. shallow_ice = 0. shallow_droplet_number = 0. endif !-------------------------------------------------------------------- ! call physics_driver_read_restart to obtain initial values for the module ! variables. Also register restart fields to be ready for intermediate restart if ! do_netcdf_restart is true. !-------------------------------------------------------------------- if(do_netcdf_restart) call physics_driver_register_restart if(file_exist('INPUT/physics_driver.res.nc')) then call read_restart_nc else call read_restart_file endif vers = restart_versions(size(restart_versions(:))) !--------------------------------------------------------------------- ! if desired, define variables to return diff_m and diff_t. !--------------------------------------------------------------------- if (present(difft)) then difft = diff_t endif if (present(diffm)) then diffm = diff_m endif !--------------------------------------------------------------------- ! initialize module diagnostics !--------------------------------------------------------------------- id_tdt_phys_vdif_dn = register_diag_field ( mod_name, & 'tdt_phys_vdif_dn', axes(1:3), Time, & 'temperature tendency from physics driver vdif down', & 'K/s', missing_value=missing_value) id_tdt_phys_vdif_up = register_diag_field ( mod_name, & 'tdt_phys_vdif_up', axes(1:3), Time, & 'temperature tendency from physics driver vdif up', & 'K/s', missing_value=missing_value) id_tdt_phys_turb = register_diag_field ( mod_name, & 'tdt_phys_turb', axes(1:3), Time, & 'temperature tendency from physics driver vdif turb', & 'K/s', missing_value=missing_value) id_tdt_phys_moist = register_diag_field ( mod_name, & 'tdt_phys_moist', axes(1:3), Time, & 'temperature tendency from physics driver moist processes', & 'K/s', missing_value=missing_value) id_tdt_phys = register_diag_field ( mod_name, & 'tdt_phys', axes(1:3), Time, & 'temperature tendency from physics ', & 'K/s', missing_value=missing_value) id_qdt_phys = register_diag_field ( mod_name, & 'qdt_phys', axes(1:3), Time, & 'specific humidity tendency from physics ', & 'kg/kg/s', missing_value=missing_value) allocate (id_tracer_phys_vdif_dn(nt)) allocate (id_tracer_phys_vdif_up(nt)) allocate (id_tracer_phys_turb(nt)) allocate (id_tracer_phys_moist(nt)) do n = 1,nt call get_tracer_names (MODEL_ATMOS, n, name = tracer_name, & units = tracer_units) diaglname = trim(tracer_name)// & ' tendency from physics driver vdif down' id_tracer_phys_vdif_dn(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_phys_vdif_dn', & axes(1:3), Time, trim(diaglname), & TRIM(tracer_units)//'/s', & missing_value=missing_value) diaglname = trim(tracer_name)// & ' tendency from physics driver vdif up' id_tracer_phys_vdif_up(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_phys_vdif_up', & axes(1:3), Time, trim(diaglname), & TRIM(tracer_units)//'/s', & missing_value=missing_value) diaglname = trim(tracer_name)// & ' tendency from physics driver vert turb' id_tracer_phys_turb(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_phys_turb', & axes(1:3), Time, trim(diaglname), & TRIM(tracer_units)//'/s', & missing_value=missing_value) diaglname = trim(tracer_name)// & ' tendency from physics driver moist processes' id_tracer_phys_moist(n) = & register_diag_field ( mod_name, & TRIM(tracer_name)//'_phys_moist', & axes(1:3), Time, trim(diaglname), & TRIM(tracer_units)//'/s', & missing_value=missing_value) end do !-------------------------------------------------------------------- ! if COSP is activated, call its initialization routine. !-------------------------------------------------------------------- if (do_cosp) then call mpp_clock_begin ( cosp_init_clock ) call cosp_driver_init (Time, axes, kd, ncol) call mpp_clock_end ( cosp_init_clock ) endif !--------------------------------------------------------------------- ! mark the module as initialized. !--------------------------------------------------------------------- module_is_initialized = .true. !----------------------------------------------------------------------- end subroutine physics_driver_init !###################################################################### ! ! ! physics_driver_time_vary makes sure that all time-dependent, spacially- ! independent calculations are completed before entering window or thread ! loops. Resultant fields are usually saved as module variables in the ! module where needed. ! ! ! physics_driver_time_vary makes sure that all time-dependent, spacially- ! independent calculations are completed before entering window or thread ! loops. Resultant fields are usually saved as module variables in the ! module where needed. ! ! ! ! current time ! ! ! time of next time step ! ! ! subroutine physics_driver_down_time_vary (Time, Time_next, gavg_rrv, dt) !--------------------------------------------------------------------- ! physics_driver_down_time_vary makes sure that all time-dependent, ! spacially-independent calculations are completed before entering window ! or thread loops. Resultant fields are usually saved as module variables in ! the module where needed. !----------------------------------------------------------------------- type(time_type), intent(in) :: Time, Time_next real, dimension(:), intent(in) :: gavg_rrv real, intent(in) :: dt !--------------------------------------------------------------------- if (do_radiation) then !---------------------------------------------------------------------- ! call define_rad_times to obtain the time to be used in the rad- ! iation calculation (Rad_time) and to determine which, if any, ! externally-supplied inputs to radiation_driver must be obtained on ! this timestep. logical flags are returned indicating the need or ! lack of need for the aerosol fields, the cloud fields, the rad- ! iative gas fields, and the basic atmospheric variable fields. !---------------------------------------------------------------------- call define_rad_times (Time, Time_next, Rad_time, & need_aerosols, need_clouds, & need_gases, need_basic) call aerosol_time_vary (Rad_time) call radiative_gases_time_vary (Rad_time, gavg_rrv, & Rad_gases_tv) call radiation_driver_time_vary (Rad_time, Rad_gases_tv) !-------------------------------------------------------------------- ! define step_to_call_cosp to indicate that this is a radiation ! step and therefore one on which COSP should be called in ! physics_driver_up. !-------------------------------------------------------------------- if (need_basic) then step_to_call_cosp = .true. else step_to_call_cosp = .false. endif endif call damping_driver_time_vary (dt) call atmos_tracer_driver_time_vary (Time) !------------------------------------------------------------------------- end subroutine physics_driver_down_time_vary !###################################################################### subroutine physics_driver_down_endts(is,js) integer, intent(in) :: is,js call damping_driver_endts call atmos_tracer_driver_endts IF (do_radiation) THEN CALL aerosol_endts CALL radiation_driver_endts (is, js, Rad_gases_tv) CALL radiative_gases_endts END IF !-------------------------------------------------------------------- ! set a flag to indicate that this check was done and need not be ! done again. !-------------------------------------------------------------------- do_check_args = .false. end subroutine physics_driver_down_endts !################################################################### subroutine physics_driver_up_time_vary (Time, dt) !--------------------------------------------------------------------- ! physics_driver_up_time_vary makes sure that all time-dependent, ! spacially-independent calculations are completed before entering ! window or thread loops. Resultant fields are usually saved as ! module variables in the module where needed. !----------------------------------------------------------------------- type(time_type), intent(in) :: Time real, intent(in) :: dt call aerosol_time_vary (Time) call moist_processes_time_vary (dt) !---------------------------------------------------------------------- end subroutine physics_driver_up_time_vary !###################################################################### subroutine physics_driver_up_endts (is,js) integer, intent(in) :: is,js call moist_processes_endts (is,js) call aerosol_endts end subroutine physics_driver_up_endts !##################################################################### subroutine physics_driver_moist_init (ix,jx,kx,lx) integer, intent(in) :: ix,jx, kx, lx call moist_alloc_init (ix,jx,kx,lx) call moistproc_init (ix,jx,kx, num_uw_tracers, do_strat) end subroutine physics_driver_moist_init !###################################################################### subroutine physics_driver_moist_end call moist_alloc_end call moistproc_end (do_strat) end subroutine physics_driver_moist_end !###################################################################### ! ! ! physics_driver_down calculates "first pass" physics tendencies, ! associated with radiation, damping and turbulence, and obtains ! the vertical diffusion tendencies to be passed to the surface and ! used in the semi-implicit vertical diffusion calculation. ! ! ! physics_driver_down calculates "first pass" physics tendencies, ! associated with radiation, damping and turbulence, and obtains ! the vertical diffusion tendencies to be passed to the surface and ! used in the semi-implicit vertical diffusion calculation. ! ! ! ! previous time, for variable um, vm, tm, qm, rm ! ! ! current time ! ! ! next time, used for diagnostics ! ! ! array of model latitudes at model points [radians] ! ! ! array of model longitudes at model points [radians] ! ! ! grid box area - current not used ! ! ! pressure at model interface levels (offset from t,q,u,v,r) ! ! ! pressure at full levels ! ! ! height at model interface levels ! ! ! height at full levels ! ! ! zonal wind at current time step ! ! ! meridional wind at current time step ! ! ! temperature at current time step ! ! ! specific humidity at current time step ! ! ! multiple 3d tracer fields at current time step ! ! ! zonal wind at previous time step ! ! ! meridional wind at previous time step ! ! ! temperature at previous time step ! ! ! specific humidity at previous time step ! ! ! multiple 3d tracer fields at previous time step ! ! ! multiple 3d diagnostic tracer fields ! ! ! fraction of land coverage in a model grid point ! ! ! boundary layer roughness ! ! ! surface albedo ! ! ! surface radiative temperature ! ! ! boundary layer wind speed (frictional speed) ! ! ! ??? ! ! ! boundary layer specific humidity ! ! ! derivative of zonal surface stress w.r.t zonal wind speed ! ! ! derivative of meridional surface stress w.r.t meridional wind speed ! ! ! boundary layer meridional component of wind shear ! ! ! boundary layer zonal component of wind shear ! ! ! zonal wind tendency ! ! ! meridional wind tendency ! ! ! temperature tendency ! ! ! moisture tracer tendencies ! ! ! multiple tracer tendencies ! ! ! Shortwave flux from radiation package ! ! ! Longwave flux from radiation package ! ! ! cosine of zenith angle ! ! ! ! ! Surface diffusion ! ! ! array containing global average of tracer volume mixing ratio ! !! ! OPTIONAL: present when running eta vertical coordinate, ! index of lowest model level above ground ! ! ! OPTIONAL: present when running eta vertical coordinate, ! mask to remove points below ground ! ! ! ! OPTIONAL: present when do_moist_processes=.false. ! cu_mo_trans diffusion coefficients, which are passed through to vert_diff_down. ! Should not be present when do_moist_processes=.true., since these ! values are passed out from moist_processes. ! ! ! ! OPTIONAL: present when do_moist_processes=.false. ! Should not be present when do_moist_processes=.true., since these ! values are passed out from moist_processes. ! ! ! subroutine physics_driver_down (is, ie, js, je, & Time_prev, Time, Time_next, & lat, lon, area, & p_half, p_full, z_half, z_full, & phalfgrey, & u, v, t, q, r, um, vm, tm, qm, rm, & frac_land, rough_mom, & albedo, albedo_vis_dir, albedo_nir_dir,& albedo_vis_dif, albedo_nir_dif, & t_surf_rad, & u_star, b_star, q_star, & dtau_du, dtau_dv, tau_x, tau_y, & udt, vdt, tdt, qdt, rdt, & flux_sw, & flux_sw_dir, & flux_sw_dif, & flux_sw_down_vis_dir, & flux_sw_down_vis_dif, & flux_sw_down_total_dir, & flux_sw_down_total_dif, & flux_sw_vis, & flux_sw_vis_dir, & flux_sw_vis_dif, & flux_lw, coszen, gust, & Surf_diff, gavg_rrv, & mask, kbot, diff_cum_mom, & moist_convect, diffm, difft ) !--------------------------------------------------------------------- ! physics_driver_down calculates "first pass" physics tendencies, ! associated with radiation, damping and turbulence, and obtains ! the vertical diffusion tendencies to be passed to the surface and ! used in the semi-implicit vertical diffusion calculation. !----------------------------------------------------------------------- integer, intent(in) :: is, ie, js, je type(time_type), intent(in) :: Time_prev, Time, & Time_next real,dimension(:,:), intent(in) :: lat, lon, area real,dimension(:,:,:), intent(in) :: p_half, p_full, & z_half, z_full, & u , v , t , q , & um, vm, tm, qm, & phalfgrey real,dimension(:,:,:,:), intent(inout) :: r real,dimension(:,:,:,:), intent(inout) :: rm real,dimension(:,:), intent(in) :: frac_land, & rough_mom, & albedo, t_surf_rad, & albedo_vis_dir, albedo_nir_dir, & albedo_vis_dif, albedo_nir_dif, & u_star, b_star, & q_star, dtau_du, dtau_dv real,dimension(:,:), intent(inout) :: tau_x, tau_y real,dimension(:,:,:), intent(inout) :: udt,vdt,tdt,qdt real,dimension(:,:,:,:), intent(inout) :: rdt real,dimension(:,:), intent(out) :: flux_sw, & flux_sw_dir, & flux_sw_dif, flux_lw, & coszen, gust, & flux_sw_down_vis_dir, & flux_sw_down_vis_dif, & flux_sw_down_total_dir, & flux_sw_down_total_dif, & flux_sw_vis, & flux_sw_vis_dir, & flux_sw_vis_dif type(surf_diff_type), intent(inout) :: Surf_diff real,dimension(:), intent(in) :: gavg_rrv real,dimension(:,:,:), intent(in) ,optional :: mask integer, dimension(:,:), intent(in) ,optional :: kbot real, dimension(:,:,:), intent(in) ,optional :: diff_cum_mom logical, dimension(:,:), intent(in) ,optional :: moist_convect real, dimension(:,:,:), intent(out) ,optional :: diffm, difft !----------------------------------------------------------------------- ! intent(in) variables: ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! Time_prev previous time, for variables um,vm,tm,qm,rm ! (time_type) ! Time current time, for variables u,v,t,q,r (time_type) ! Time_next next time, used for diagnostics (time_type) ! lat latitude of model points [ radians ] ! lon longitude of model points [ radians ] ! area grid box area - currently not used [ m**2 ] ! p_half pressure at half levels (offset from t,q,u,v,r) ! [ Pa ] ! p_full pressure at full levels [ Pa } ! z_half height at half levels [ m ] ! z_full height at full levels [ m ] ! u zonal wind at current time step [ m / s ] ! v meridional wind at current time step [ m / s ] ! t temperature at current time step [ deg k ] ! q specific humidity at current time step kg / kg ] ! r multiple 3d tracer fields at current time step ! um,vm zonal and meridional wind at previous time step ! tm,qm temperature and specific humidity at previous ! time step ! rm multiple 3d tracer fields at previous time step ! frac_land ! rough_mom ! albedo ! albedo_vis_dir surface visible direct albedo [ dimensionless ] ! albedo_nir_dir surface nir direct albedo [ dimensionless ] ! albedo_vis_dif surface visible diffuse albedo [ dimensionless ] ! albedo_nir_dif surface nir diffuse albedo [ dimensionless ] ! t_surf_rad ! u_star ! b_star ! q_star ! dtau_du ! dtau_dv ! ! intent(inout) variables: ! ! tau_x ! tau_y ! udt zonal wind tendency [ m / s**2 ] ! vdt meridional wind tendency [ m / s**2 ] ! tdt temperature tendency [ deg k / sec ] ! qdt specific humidity tendency ! [ kg vapor / kg air / sec ] ! rdt multiple tracer tendencies [ unit / unit / sec ] ! rd multiple 3d diagnostic tracer fields ! [ unit / unit / sec ] ! Surf_diff surface_diffusion_type variable ! ! intent(out) variables: ! ! flux_sw ! flux_sw_dir net shortwave surface flux (down-up) [ w / m^2 ] ! flux_sw_dif net shortwave surface flux (down-up) [ w / m^2 ] ! flux_sw_down_vis_dir downward shortwave surface flux in visible spectrum [ w / m^2 ] ! flux_sw_down_vis_dif downward shortwave surface flux in visible spectrum [ w / m^2 ] ! flux_sw_down_total_dir total downward shortwave surface flux [ w / m^2 ] ! flux_sw_down_total_dif total downward shortwave surface flux [ w / m^2 ] ! flux_sw_vis net downward shortwave surface flux in visible spectrum [ w / m^2 ] ! flux_sw_vis_dir net downward shortwave surface flux in visible spectrum [ w / m^2 ] ! flux_sw_vis_dif net downward shortwave surface flux in visible spectrum [ w / m^2 ] ! flux_lw ! coszen ! gust ! ! intent(in), optional variables: ! ! mask mask that designates which levels do not have data ! present (i.e., below ground); 0.=no data, 1.=data ! kbot lowest level which has data ! note: both mask and kbot must be present together. ! !----------------------------------------------------------------------- !--------------------------------------------------------------------- ! local variables: real, dimension(size(u,1),size(u,2),size(u,3)) :: diff_t_vert, & diff_m_vert real, dimension(size(u,1),size(u,2)) :: z_pbl type(aerosol_type) :: Aerosol type(cld_specification_type) :: Cld_spec type(radiative_gases_type) :: Rad_gases type(atmos_input_type) :: Atmos_input type(surface_type) :: Surface type(rad_output_type) :: Radiation type(microphysics_type) :: Lsc_microphys, & Meso_microphys,& Cell_microphys,& Shallow_microphys, & Model_microphys integer :: sec, day, n real :: dt, alpha, dt2 logical :: used !--------------------------------------------------------------------- ! local variables: ! ! diff_t_vert vertical diffusion coefficient for temperature ! calculated on the current step ! diff_m_vert vertical diffusion coefficient for momentum ! calculated on the current step ! z_pbl height of planetary boundary layer ! Aerosol aerosol_type variable describing the aerosol ! fields to be seen by the radiation package ! Cld_spec cld_specification_type variable describing the ! cloud field to be seen by the radiation package ! Rad_gases radiative_gases_type variable describing the ! radiatively-active gas distribution to be seen ! by the radiation package ! Atmos_input atmos_input_type variable describing the atmos- ! pheric state to be seen by the radiation package ! Surface surface_type variable describing the surface ! characteristics to be seen by the radiation ! package ! Radiation rad_output_type variable containing the variables ! output from the radiation package, for passage ! to other modules ! Rad_time time at which the radiation calculation is to ! apply [ time_type ] ! Lsc_microphys microphysics_type variable containing the micro- ! physical characteristics of the large-scale ! clouds to be seen by the radiation package ! Meso_microphys microphysics_type variable containing the micro- ! physical characteristics of the mesoscale ! clouds to be seen by the radiation package ! Cell_microphys microphysics_type variable containing the micro- ! physical characteristics of the cell-scale ! clouds to be seen by the radiation package ! Shallow_microphys ! microphysics_type variable containing the micro- ! physical characteristics of the cell-scale ! clouds to be seen by the radiation package ! sec, day second and day components of the time_type ! variable ! dt model physics time step [ seconds ] ! alpha ratio of physics time step to diffusion-smoothing ! time scale ! need_aerosols need to obtain aerosol data on this time step ! to input to the radiation package ? ! need_clouds need to obtain cloud data on this time step ! to input to the radiation package ? ! need_gases need to obtain radiative gas data on this time ! step to input to the radiation package ? ! need_basic need to obtain atmospheric state variables on ! this time step to input to the radiation package? ! !--------------------------------------------------------------------- !--------------------------------------------------------------------- ! verify that the module is initialized. !--------------------------------------------------------------------- if ( .not. module_is_initialized) then call error_mesg ('physics_driver_mod', & 'module has not been initialized', FATAL) endif !--------------------------------------------------------------------- ! if COSP is activated, save the surface (skin) temperature for ! its use. !--------------------------------------------------------------------- if (do_cosp) then tsurf_save(is:ie,js:je) = t_surf_rad endif !--------------------------------------------------------------------- ! check the size of the input arguments. this is only done on the ! first call to physics_driver_down. !--------------------------------------------------------------------- if (do_check_args) call check_args & (lat, lon, area, p_half, p_full, z_half, z_full, & u, v, t, q, r, um, vm, tm, qm, rm, & udt, vdt, tdt, qdt, rdt) !--------------------------------------------------------------------- ! compute the physics time step (from tau-1 to tau+1). !--------------------------------------------------------------------- call get_time (Time_next - Time_prev, sec, day) dt = real(sec + day*86400) if (do_radiation) then !---------------------------------------------------------------------- ! prepare to calculate radiative forcings. obtain the valid time ! at which the radiation calculation is to apply, the needed atmos- ! pheric fields, and any needed inputs from other physics modules. !--------------------------------------------------------------------- call mpp_clock_begin ( radiation_clock ) !--------------------------------------------------------------------- ! call define_surface to define a surface_type variable containing ! the surface albedoes and land fractions for each grid box. this ! variable must be provided on all timesteps for use in generating ! netcdf output. !--------------------------------------------------------------------- call define_surface (is, ie, js, je, albedo, albedo_vis_dir, & albedo_nir_dir, albedo_vis_dif, & albedo_nir_dif, frac_land, Surface) !--------------------------------------------------------------------- ! if the basic atmospheric input variables to the radiation package ! are needed, pass the model pressure (p_full, p_half), temperature ! (t, t_surf_rad) and specific humidity (q) to subroutine ! define_atmos_input_fields, which will put these fields and some ! additional auxiliary fields into the form desired by the radiation ! package and store them as components of the derived-type variable ! Atmos_input. !--------------------------------------------------------------------- if (need_basic) then call define_atmos_input_fields & (is, ie, js, je, p_full, p_half, t, q, & t_surf_rad, r, gavg_rrv, Atmos_input, kbot=kbot) endif !--------------------------------------------------------------------- ! if the aerosol fields are needed as input to the radiation_package, ! call aerosol_driver to access the aerosol data and place it into ! an aerosol_type derived-type variable Aerosol. !--------------------------------------------------------------------- if (need_aerosols) then call aerosol_driver (is, js, Rad_time, r, & Atmos_input%phalf, Atmos_input%pflux, & Aerosol) endif !--------------------------------------------------------------------- ! if the cloud fields are needed, call cloud_spec to retrieve bulk ! cloud data and place it into a cld_specification_type derived-type ! variable Cld_spec and retrieve microphysical data which is returned ! in microphysics_type variables Lsc_microphys, Meso_microphys and ! Cell_microphys and Shallow_microphys, when applicable. !--------------------------------------------------------------------- if (need_clouds) then if (use_cloud_tracers_in_radiation) then if (doing_donner .and. doing_uw_conv) then call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & ! lsc_area_in = lsc_cloud_area, & ! lsc_liquid_in=lsc_liquid, lsc_ice_in=lsc_ice, & ! lsc_droplet_number_in=lsc_droplet_number,& r=r(:,:,:,1:ntp), & shallow_cloud_area = shallow_cloud_area(is:ie,js:je,:), & shallow_liquid = shallow_liquid(is:ie,js:je,:), & shallow_ice = shallow_ice(is:ie,js:je,:), & shallow_droplet_number = shallow_droplet_number(is:ie,js:je,:), & cell_cld_frac= cell_cld_frac(is:ie,js:je,:), & cell_liq_amt=cell_liq_amt(is:ie,js:je,:), & cell_liq_size=cell_liq_size(is:ie,js:je,:), & cell_ice_amt= cell_ice_amt(is:ie,js:je,:), & cell_ice_size= cell_ice_size(is:ie,js:je,:), & cell_droplet_number= cell_droplet_number(is:ie,js:je,:), & meso_cld_frac= meso_cld_frac(is:ie,js:je,:), & meso_liq_amt=meso_liq_amt(is:ie,js:je,:), & meso_liq_size=meso_liq_size(is:ie,js:je,:), & meso_ice_amt= meso_ice_amt(is:ie,js:je,:), & meso_ice_size= meso_ice_size(is:ie,js:je,:), & meso_droplet_number= meso_droplet_number(is:ie,js:je,:), & nsum_out=nsum_out(is:ie,js:je) ) else if (doing_donner) then call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & ! lsc_area_in = lsc_cloud_area, & ! lsc_liquid_in=lsc_liquid, lsc_ice_in=lsc_ice, & ! lsc_droplet_number_in=lsc_droplet_number,& r=r(:,:,:,1:ntp), & cell_cld_frac= cell_cld_frac(is:ie,js:je,:), & cell_liq_amt=cell_liq_amt(is:ie,js:je,:), & cell_liq_size=cell_liq_size(is:ie,js:je,:), & cell_ice_amt= cell_ice_amt(is:ie,js:je,:), & cell_ice_size= cell_ice_size(is:ie,js:je,:), & cell_droplet_number= cell_droplet_number(is:ie,js:je,:), & meso_cld_frac= meso_cld_frac(is:ie,js:je,:), & meso_liq_amt=meso_liq_amt(is:ie,js:je,:), & meso_liq_size=meso_liq_size(is:ie,js:je,:), & meso_ice_amt= meso_ice_amt(is:ie,js:je,:), & meso_ice_size= meso_ice_size(is:ie,js:je,:), & meso_droplet_number= meso_droplet_number(is:ie,js:je,:), & nsum_out=nsum_out(is:ie,js:je) ) else if (doing_uw_conv) then call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & ! lsc_area_in = lsc_cloud_area, & ! lsc_liquid_in=lsc_liquid, lsc_ice_in=lsc_ice, & ! lsc_droplet_number_in=lsc_droplet_number,& r=r(:,:,:,1:ntp), & shallow_cloud_area = shallow_cloud_area(is:ie,js:je,:), & shallow_liquid = shallow_liquid(is:ie,js:je,:), & shallow_ice = shallow_ice(is:ie,js:je,:), & shallow_droplet_number = shallow_droplet_number(is:ie,js:je,:)) else call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & ! lsc_area_in = lsc_cloud_area, & ! lsc_liquid_in=lsc_liquid, lsc_ice_in=lsc_ice, & ! lsc_droplet_number_in=lsc_droplet_number,& r=r(:,:,:,1:ntp)) endif ! (doing_donner) else ! (use_cloud_tracers_in_radiation) if (doing_donner .and. doing_uw_conv) then call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & lsc_area_in = lsc_cloud_area(is:ie,js:je,:), & lsc_liquid_in=lsc_liquid(is:ie,js:je,:), & lsc_ice_in=lsc_ice(is:ie,js:je,:), & lsc_droplet_number_in=lsc_droplet_number(is:ie,js:je,:),& r=r(:,:,:,1:ntp), & shallow_cloud_area = shallow_cloud_area(is:ie,js:je,:), & shallow_liquid = shallow_liquid(is:ie,js:je,:), & shallow_ice = shallow_ice(is:ie,js:je,:), & shallow_droplet_number = shallow_droplet_number(is:ie,js:je,:), & cell_cld_frac= cell_cld_frac(is:ie,js:je,:), & cell_liq_amt=cell_liq_amt(is:ie,js:je,:), & cell_liq_size=cell_liq_size(is:ie,js:je,:), & cell_ice_amt= cell_ice_amt(is:ie,js:je,:), & cell_ice_size= cell_ice_size(is:ie,js:je,:), & cell_droplet_number= cell_droplet_number(is:ie,js:je,:), & meso_cld_frac= meso_cld_frac(is:ie,js:je,:), & meso_liq_amt=meso_liq_amt(is:ie,js:je,:), & meso_liq_size=meso_liq_size(is:ie,js:je,:), & meso_ice_amt= meso_ice_amt(is:ie,js:je,:), & meso_ice_size= meso_ice_size(is:ie,js:je,:), & meso_droplet_number= meso_droplet_number(is:ie,js:je,:), & nsum_out=nsum_out(is:ie,js:je) ) else if (doing_donner) then call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & lsc_area_in = lsc_cloud_area(is:ie,js:je,:), & lsc_liquid_in=lsc_liquid(is:ie,js:je,:), & lsc_ice_in=lsc_ice(is:ie,js:je,:), & lsc_droplet_number_in=lsc_droplet_number(is:ie,js:je,:),& r=r(:,:,:,1:ntp), & cell_cld_frac= cell_cld_frac(is:ie,js:je,:), & cell_liq_amt=cell_liq_amt(is:ie,js:je,:), & cell_liq_size=cell_liq_size(is:ie,js:je,:), & cell_ice_amt= cell_ice_amt(is:ie,js:je,:), & cell_ice_size= cell_ice_size(is:ie,js:je,:), & cell_droplet_number= cell_droplet_number(is:ie,js:je,:), & meso_cld_frac= meso_cld_frac(is:ie,js:je,:), & meso_liq_amt=meso_liq_amt(is:ie,js:je,:), & meso_liq_size=meso_liq_size(is:ie,js:je,:), & meso_ice_amt= meso_ice_amt(is:ie,js:je,:), & meso_ice_size= meso_ice_size(is:ie,js:je,:), & meso_droplet_number= meso_droplet_number(is:ie,js:je,:), & nsum_out=nsum_out(is:ie,js:je) ) else if (doing_uw_conv) then call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & lsc_area_in = lsc_cloud_area(is:ie,js:je,:), & lsc_liquid_in=lsc_liquid(is:ie,js:je,:), & lsc_ice_in=lsc_ice(is:ie,js:je,:), & lsc_droplet_number_in=lsc_droplet_number(is:ie,js:je,:),& r=r(:,:,:,1:ntp), & shallow_cloud_area = shallow_cloud_area(is:ie,js:je,:), & shallow_liquid = shallow_liquid(is:ie,js:je,:), & shallow_ice = shallow_ice(is:ie,js:je,:), & shallow_droplet_number = shallow_droplet_number(is:ie,js:je,:)) else call cloud_spec (is, ie, js, je, lat, & z_half, z_full, Rad_time, & Atmos_input, Surface, Cld_spec, & Lsc_microphys, Meso_microphys, & Cell_microphys, Shallow_microphys, & lsc_area_in = lsc_cloud_area(is:ie,js:je,:), & lsc_liquid_in=lsc_liquid(is:ie,js:je,:), & lsc_ice_in=lsc_ice(is:ie,js:je,:), & lsc_droplet_number_in=lsc_droplet_number(is:ie,js:je,:),& r=r(:,:,:,1:ntp)) endif ! (doing_donner) endif ! (use_cloud_tracers_in_radiation) endif ! (need_clouds) !--------------------------------------------------------------------- ! if the radiative gases are needed, call define_radiative_gases to ! obtain the values to be used for the radiatively-active gases and ! place them in radiative_gases_type derived-type variable Rad_gases. !--------------------------------------------------------------------- if (need_gases) then !-------------------------------------------------------------------- ! fill the contents of the radiative_gases_type variable which ! will be passed to the radiation package. !--------------------------------------------------------------------- Rad_gases%ch4_tf_offset = Rad_gases_tv%ch4_tf_offset Rad_gases%n2o_tf_offset = Rad_gases_tv%n2o_tf_offset Rad_gases%co2_tf_offset = Rad_gases_tv%co2_tf_offset Rad_gases%ch4_for_next_tf_calc = Rad_gases_tv%ch4_for_next_tf_calc Rad_gases%n2o_for_next_tf_calc = Rad_gases_tv%n2o_for_next_tf_calc Rad_gases%co2_for_next_tf_calc = Rad_gases_tv%co2_for_next_tf_calc Rad_gases%rrvch4 = Rad_gases_tv%rrvch4 Rad_gases%rrvn2o = Rad_gases_tv%rrvn2o Rad_gases%rrvf11 = Rad_gases_tv%rrvf11 Rad_gases%rrvf12 = Rad_gases_tv%rrvf12 Rad_gases%rrvf113 = Rad_gases_tv%rrvf113 Rad_gases%rrvf22 = Rad_gases_tv%rrvf22 Rad_gases%rrvco2 = Rad_gases_tv%rrvco2 Rad_gases%time_varying_co2 = Rad_gases_tv%time_varying_co2 Rad_gases%time_varying_ch4 = Rad_gases_tv%time_varying_ch4 Rad_gases%time_varying_n2o = Rad_gases_tv%time_varying_n2o Rad_gases%time_varying_f11 = Rad_gases_tv%time_varying_f11 Rad_gases%time_varying_f12 = Rad_gases_tv%time_varying_f12 Rad_gases%time_varying_f113 = Rad_gases_tv%time_varying_f113 Rad_gases%time_varying_f22 = Rad_gases_tv%time_varying_f22 Rad_gases%Co2_time = Rad_gases_tv%Co2_time Rad_gases%Ch4_time = Rad_gases_tv%Ch4_time Rad_gases%N2o_time = Rad_gases_tv%N2o_time Rad_gases%use_model_supplied_co2 = Rad_gases_tv%use_model_supplied_co2 Rad_gases%co2_for_last_tf_calc = Rad_gases_tv%co2_for_last_tf_calc Rad_gases%ch4_for_last_tf_calc = Rad_gases_tv%ch4_for_last_tf_calc Rad_gases%n2o_for_last_tf_calc = Rad_gases_tv%n2o_for_last_tf_calc call define_radiative_gases (is, ie, js, je, Rad_time, lat, & Atmos_input, r, Time_next, Rad_gases) endif !--------------------------------------------------------------------- ! allocate the components of a rad_output_type variable which will ! be used to return the output from radiation_driver_mod that is ! needed by other modules. !--------------------------------------------------------------------- allocate (Radiation%tdt_rad (size(q,1), size(q,2),size(q,3),1)) allocate (Radiation%ufsw (size(q,1), size(q,2),size(q,3)+1,1)) allocate (Radiation%dfsw (size(q,1), size(q,2),size(q,3)+1,1)) allocate (Radiation%ufsw_clr (size(q,1), size(q,2),size(q,3)+1,1)) allocate (Radiation%dfsw_clr (size(q,1), size(q,2),size(q,3)+1,1)) allocate (Radiation%flux_sw_surf (size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_surf_dir (size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_surf_dif (size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_down_vis_dir (size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_down_vis_dif (size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_down_total_dir(size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_down_total_dif(size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_vis (size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_vis_dir (size(q,1), size(q,2),1 )) allocate (Radiation%flux_sw_vis_dif (size(q,1), size(q,2),1 )) allocate (Radiation%flux_lw_surf (size(q,1), size(q,2) )) allocate (Radiation%coszen_angle (size(q,1), size(q,2) )) allocate (Radiation%tdtlw (size(q,1), size(q,2),size(q,3))) allocate (Radiation%flxnet (size(q,1), size(q,2),size(q,3)+1)) allocate (Radiation%flxnetcf (size(q,1), size(q,2),size(q,3)+1)) !-------------------------------------------------------------------- ! call radiation_driver to perform the radiation calculation. !-------------------------------------------------------------------- call radiation_driver (is, ie, js, je, Time, Time_next, lat, & lon, Surface, Atmos_input, Aerosol, r, & Cld_spec, Rad_gases, Lsc_microphys, & Meso_microphys, Cell_microphys,& Shallow_microphys, Model_microphys, & Radiation=Radiation, mask=mask, kbot=kbot) !--------------------------------------------------------------------- ! if COSP is activated and this is a step upon which the cosp ! simulator is to be called, verify that stochastic clouds are ! also activated. if they are not, then exit, since COSP should only ! be requested when stochastic clouds are active. !--------------------------------------------------------------------- if (do_cosp .or. do_modis_yim) then if (step_to_call_cosp) then !--------------------------------------------------------------------- ! call return_cosp_inputs to retrieve the radiation inputs needed ! by COSP. !--------------------------------------------------------------------- call return_cosp_inputs & (is, ie, js, je, donner_meso_is_largescale, & Time_next, Atmos_input, stoch_cloud_type, & stoch_conc_drop, stoch_conc_ice, stoch_size_drop, & stoch_size_ice, tau_stoch, lwem_stoch, & Model_microphys, & do_cosp, do_modis_yim, Lsc_microphys) mr_ozone(is:ie,js:je,:) = Rad_gases%qo3(:,:,:) where (Radiation%flux_sw_surf(:,:,1) > 0.0) daytime(is:ie,js:je) = 1.0 elsewhere daytime(is:ie,js:je) = 0.0 endwhere ! daytime(is:ie,js:je) = 1.0 endif ! (step_to_call_cosp) endif ! (do_cosp) !------------------------------------------------------------------- ! process the variables returned from radiation_driver_mod. the ! radiative heating rate is added to the accumulated physics heating ! rate (tdt). net surface lw and sw fluxes and the cosine of the ! zenith angle are placed in locations where they can be exported ! for use in other component models. the lw heating rate is stored ! in a module variable for potential use in other physics modules. ! the radiative heating rate is also added to a variable which is ! accumulating the radiative and turbulent heating rates, and which ! is needed by strat_cloud_mod. !------------------------------------------------------------------- tdt = tdt + Radiation%tdt_rad(:,:,:,1) flux_sw = Radiation%flux_sw_surf(:,:,1) flux_sw_dir = Radiation%flux_sw_surf_dir(:,:,1) flux_sw_dif = Radiation%flux_sw_surf_dif(:,:,1) flux_sw_down_vis_dir = Radiation%flux_sw_down_vis_dir(:,:,1) flux_sw_down_vis_dif = Radiation%flux_sw_down_vis_dif(:,:,1) flux_sw_down_total_dir = Radiation%flux_sw_down_total_dir(:,:,1) flux_sw_down_total_dif = Radiation%flux_sw_down_total_dif(:,:,1) flux_sw_vis = Radiation%flux_sw_vis(:,:,1) flux_sw_vis_dir = Radiation%flux_sw_vis_dir(:,:,1) flux_sw_vis_dif = Radiation%flux_sw_vis_dif(:,:,1) flux_lw = Radiation%flux_lw_surf coszen = Radiation%coszen_angle lw_tendency(is:ie,js:je,:) = Radiation%tdtlw(:,:,:) radturbten (is:ie,js:je,:) = radturbten(is:ie,js:je,:) + & Radiation%tdt_rad(:,:,:,1) !-------------------------------------------------------------------- ! deallocate the arrays used to return the radiation_driver_mod ! output. !-------------------------------------------------------------------- deallocate ( Radiation%tdt_rad ) deallocate ( Radiation%ufsw ) deallocate ( Radiation%dfsw ) deallocate ( Radiation%ufsw_clr ) deallocate ( Radiation%dfsw_clr ) deallocate ( Radiation%flux_sw_surf ) deallocate ( Radiation%flux_sw_surf_dir ) deallocate ( Radiation%flux_sw_surf_dif ) deallocate ( Radiation%flux_sw_down_vis_dir ) deallocate ( Radiation%flux_sw_down_vis_dif ) deallocate ( Radiation%flux_sw_down_total_dir ) deallocate ( Radiation%flux_sw_down_total_dif ) deallocate ( Radiation%flux_sw_vis ) deallocate ( Radiation%flux_sw_vis_dir ) deallocate ( Radiation%flux_sw_vis_dif ) deallocate ( Radiation%flux_lw_surf ) deallocate ( Radiation%coszen_angle ) deallocate ( Radiation%tdtlw ) deallocate ( Radiation%flxnet ) deallocate ( Radiation%flxnetcf ) !--------------------------------------------------------------------- ! call routines to deallocate the components of the derived type ! arrays input to radiation_driver. !--------------------------------------------------------------------- if (need_gases) then call radiative_gases_dealloc (Rad_gases) endif if (need_clouds) then call cloud_spec_dealloc (Cld_spec, Lsc_microphys, & Meso_microphys, Cell_microphys, & Shallow_microphys) endif if (need_aerosols) then call aerosol_dealloc (Aerosol) endif if (need_basic) then call atmos_input_dealloc (Atmos_input) call microphys_dealloc (Model_microphys) endif call surface_dealloc (Surface) call mpp_clock_end ( radiation_clock ) else flux_sw = 0.0 flux_sw_dir = 0.0 flux_sw_dif = 0.0 flux_sw_down_vis_dir = 0.0 flux_sw_down_vis_dif = 0.0 flux_sw_down_total_dir = 0.0 flux_sw_down_total_dif = 0.0 flux_sw_vis = 0.0 flux_sw_vis_dir = 0.0 flux_sw_vis_dif = 0.0 flux_lw = 0.0 coszen = 0.0 lw_tendency(is:ie,js:je,:) = 0.0 endif ! do_radiation if(do_grey_radiation) then !rif:(09/10/09) call grey_radiation(is, js, Time, Time_next, lat, lon, phalfgrey, albedo, t_surf_rad, t, tdt, flux_sw, flux_lw) coszen = 1.0 flux_sw_dir = R1*flux_sw flux_sw_dif = R2*flux_sw flux_sw_vis_dir = R3*flux_sw flux_sw_vis_dif = R4*flux_sw endif #ifdef SCM ! Option to add SCM radiative tendencies from forcing to lw_tendency ! and radturbten if (use_scm_rad) then call add_scm_tdtlw( lw_tendency(is:ie,js:je,:) ) call add_scm_tdtlw( radturbten (is:ie,js:je,:) ) call add_scm_tdtsw( radturbten (is:ie,js:je,:) ) endif #endif !---------------------------------------------------------------------- ! call damping_driver to calculate the various model dampings that ! are desired. !---------------------------------------------------------------------- z_pbl(:,:) = pbltop(is:ie,js:je) call mpp_clock_begin ( damping_clock ) call damping_driver (is, js, lat, Time_next, dt, & p_full, p_half, z_full, z_half, & um, vm, tm, qm, rm(:,:,:,1:ntp), & udt, vdt, tdt, qdt, rdt,& z_pbl , mask=mask, kbot=kbot) call mpp_clock_end ( damping_clock ) !--------------------------------------------------------------------- ! If moist_processes is not called in physics_driver_down then values ! of convect must be passed in via the optional argument "moist_convect". !--------------------------------------------------------------------- if(.not.do_moist_processes) then if(present(moist_convect)) then convect(is:ie,js:je) = moist_convect else call error_mesg('physics_driver_down', & 'moist_convect be present when do_moist_processes=.false.',FATAL) endif endif !--------------------------------------------------------------------- ! call vert_turb_driver to calculate diffusion coefficients. save ! the planetary boundary layer height on return. !--------------------------------------------------------------------- if (id_tdt_phys_turb > 0) then used = send_data ( id_tdt_phys_turb, -2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_turb(n) > 0) then used = send_data ( id_tracer_phys_turb(n), -2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do call mpp_clock_begin ( turb_clock ) call vert_turb_driver (is, js, Time, Time_next, dt, & lw_tendency(is:ie,js:je,:), frac_land, & p_half, p_full, z_half, z_full, u_star, & b_star, q_star, rough_mom, lat, & convect(is:ie,js:je), & u, v, t, q, r(:,:,:,1:ntp), um, vm, & tm, qm, rm(:,:,:,1:ntp), & udt, vdt, tdt, qdt, rdt, & diff_t_vert, diff_m_vert, gust, z_pbl, & mask=mask, kbot=kbot ) call mpp_clock_end ( turb_clock ) pbltop(is:ie,js:je) = z_pbl(:,:) if (id_tdt_phys_turb > 0) then used = send_data ( id_tdt_phys_turb, +2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_turb(n) > 0) then used = send_data ( id_tracer_phys_turb(n), +2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do !----------------------------------------------------------------------- ! process any tracer fields. !----------------------------------------------------------------------- call mpp_clock_begin ( tracer_clock ) call atmos_tracer_driver (is, ie, js, je, Time, lon, lat, & area, z_pbl, rough_mom, & frac_land, p_half, p_full, & u, v, t, q, r, & rm, rdt, dt, & u_star, b_star, q_star, & z_half, z_full, t_surf_rad, albedo, & Time_next, & flux_sw_down_vis_dir, flux_sw_down_vis_dif, & mask, kbot) call mpp_clock_end ( tracer_clock ) !----------------------------------------------------------------------- ! If moist_processes is not called in physics_driver_down then values ! of the cu_mo_trans diffusion coefficients must be passed in via ! the optional argument "diff_cum_mom". !----------------------------------------------------------------------- if(.not.do_moist_processes) then if(present(diff_cum_mom)) then diff_cu_mo(is:ie,js:je,:) = diff_cum_mom else call error_mesg('physics_driver_down', & 'diff_cum_mom must be present when do_moist_processes=.false.',FATAL) endif endif !----------------------------------------------------------------------- ! optionally use an implicit calculation of the vertical diffusion ! coefficients. ! ! the vertical diffusion coefficients are solved using an implicit ! solution to the following equation: ! ! dK/dt = - ( K - K_cur) / tau_diff ! ! where K = diffusion coefficient ! K_cur = diffusion coefficient diagnosed from current ! time steps' state ! tau_diff = time scale for adjustment ! ! in the code below alpha = dt / tau_diff !--------------------------------------------------------------------- if (diffusion_smooth) then call get_time (Time_next - Time, sec, day) dt2 = real(sec + day*86400) alpha = dt2/tau_diff diff_m(is:ie,js:je,:) = (diff_m(is:ie,js:je,:) + & alpha*(diff_m_vert(:,:,:) + & diff_cu_mo(is:ie,js:je,:)) )/& (1. + alpha) where (diff_m(is:ie,js:je,:) < diff_min) diff_m(is:ie,js:je,:) = 0.0 end where diff_t(is:ie,js:je,:) = (diff_t(is:ie,js:je,:) + & alpha*diff_t_vert(:,:,:) )/ & (1. + alpha) where (diff_t(is:ie,js:je,:) < diff_min) diff_t(is:ie,js:je,:) = 0.0 end where else diff_t(is:ie,js:je,:) = diff_t_vert diff_m(is:ie,js:je,:) = diff_m_vert + diff_cu_mo(is:ie, js:je,:) end if !----------------------------------------------------------------------- ! call vert_diff_driver_down to calculate the first pass atmos- ! pheric vertical diffusion. !----------------------------------------------------------------------- if (id_tdt_phys_vdif_dn > 0) then used = send_data ( id_tdt_phys_vdif_dn, -2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_vdif_dn(n) > 0) then used = send_data ( id_tracer_phys_vdif_dn(n), -2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do call mpp_clock_begin ( diff_down_clock ) radturbten(is:ie,js:je,:) = radturbten(is:ie,js:je,:) - tdt(:,:,:) call vert_diff_driver_down (is, js, Time_next, dt, p_half, & p_full, z_full, & diff_m(is:ie,js:je,:), & diff_t(is:ie,js:je,:), & um ,vm ,tm ,qm ,rm(:,:,:,1:ntp), & dtau_du, dtau_dv, tau_x, tau_y, & udt, vdt, tdt, qdt, rdt, & Surf_diff, & mask=mask, kbot=kbot ) if (id_tdt_phys_vdif_dn > 0) then used = send_data ( id_tdt_phys_vdif_dn, +2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_vdif_dn(n) > 0) then used = send_data ( id_tracer_phys_vdif_dn(n), +2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do !--------------------------------------------------------------------- ! if desired, return diff_m and diff_t to calling routine. !----------------------------------------------------------------------- if (present(difft)) then difft = diff_t(is:ie,js:je,:) endif if (present(diffm)) then diffm = diff_m(is:ie,js:je,:) endif call mpp_clock_end ( diff_down_clock ) end subroutine physics_driver_down !####################################################################### ! ! ! physics_driver_up completes the calculation of vertical diffusion ! and also handles moist physical processes. ! ! ! physics_driver_up completes the calculation of vertical diffusion ! and also handles moist physical processes. ! ! ! ! previous time, for variable um, vm, tm, qm, rm ! ! ! current time ! ! ! next time, used for diagnostics ! ! ! array of model latitudes at model points [radians] ! ! ! array of model longitudes at model points [radians] ! ! ! grid box area - current not used ! ! ! pressure at model interface levels (offset from t,q,u,v,r) ! ! ! pressure at full levels ! ! ! height at model interface levels ! ! ! height at full levels ! ! ! Veritical pressure tendency ! ! ! zonal wind at current time step ! ! ! meridional wind at current time step ! ! ! temperature at current time step ! ! ! specific humidity at current time step ! ! ! multiple 3d tracer fields at current time step ! ! ! zonal wind at previous time step ! ! ! meridional wind at previous time step ! ! ! temperature at previous time step ! ! ! specific humidity at previous time step ! ! ! multiple 3d tracer fields at previous time step ! ! ! fraction of land coverage in a model grid point ! ! ! zonal wind tendency ! ! ! meridional wind tendency ! ! ! temperature tendency ! ! ! moisture tracer tendencies ! ! ! multiple tracer tendencies ! ! ! ! ! ! ! ! ! Surface diffusion ! ! ! OPTIONAL: present when running eta vertical coordinate, ! index of lowest model level above ground ! ! ! OPTIONAL: present when running eta vertical coordinate, ! mask to remove points below ground ! ! ! subroutine physics_driver_up (is, ie, js, je, & Time_prev, Time, Time_next, & lat, lon, area, & p_half, p_full, z_half, z_full, & omega, & u, v, t, q, r, um, vm, tm, qm, rm, & frac_land, & u_star, b_star, q_star, & udt, vdt, tdt, qdt, rdt, & Surf_diff, & lprec, fprec, gust, & mask, kbot, & hydrostatic, phys_hydrostatic ) !---------------------------------------------------------------------- ! physics_driver_up completes the calculation of vertical diffusion ! and also handles moist physical processes. !--------------------------------------------------------------------- integer, intent(in) :: is, ie, js, je type(time_type), intent(in) :: Time_prev, Time, & Time_next real,dimension(:,:), intent(in) :: lat, lon, area real,dimension(:,:,:), intent(in) :: p_half, p_full, & omega, & z_half, z_full, & u , v , t , q , & um, vm, tm, qm real,dimension(:,:,:,:),intent(in) :: r,rm real,dimension(:,:), intent(in) :: frac_land real,dimension(:,:), intent(in) :: u_star, b_star, q_star real,dimension(:,:,:), intent(inout) :: udt,vdt,tdt,qdt real,dimension(:,:,:,:),intent(inout) :: rdt type(surf_diff_type), intent(inout) :: Surf_diff real,dimension(:,:), intent(out) :: lprec, fprec real,dimension(:,:), intent(inout) :: gust real,dimension(:,:,:), intent(in), optional :: mask integer,dimension(:,:), intent(in), optional :: kbot logical, intent(in), optional :: hydrostatic, phys_hydrostatic !----------------------------------------------------------------------- ! intent(in) variables: ! ! is,ie,js,je starting/ending subdomain i,j indices of data in ! the physics_window being integrated ! Time_prev previous time, for variables um,vm,tm,qm,rm ! (time_type) ! Time current time, for variables u,v,t,q,r (time_type) ! Time_next next time, used for diagnostics (time_type) ! lat latitude of model points [ radians ] ! lon longitude of model points [ radians ] ! area grid box area - currently not used [ m**2 ] ! p_half pressure at half levels (offset from t,q,u,v,r) ! [ Pa ] ! p_full pressure at full levels [ Pa } ! omega ! z_half height at half levels [ m ] ! z_full height at full levels [ m ] ! u zonal wind at current time step [ m / s ] ! v meridional wind at current time step [ m / s ] ! t temperature at current time step [ deg k ] ! q specific humidity at current time step kg / kg ] ! r multiple 3d tracer fields at current time step ! um,vm zonal and meridional wind at previous time step ! tm,qm temperature and specific humidity at previous ! time step ! rm multiple 3d tracer fields at previous time step ! frac_land ! rough_mom ! albedo ! t_surf_rad ! u_star ! b_star ! q_star ! dtau_du ! dtau_dv ! ! intent(inout) variables: ! ! tau_x ! tau_y ! udt zonal wind tendency [ m / s**2 ] ! vdt meridional wind tendency [ m / s**2 ] ! tdt temperature tendency [ deg k / sec ] ! qdt specific humidity tendency ! [ kg vapor / kg air / sec ] ! rdt multiple tracer tendencies [ unit / unit / sec ] ! Surf_diff surface_diffusion_type variable ! gust ! ! intent(out) variables: ! ! lprec ! fprec ! ! intent(in), optional variables: ! ! mask mask that designates which levels do not have data ! present (i.e., below ground); 0.=no data, 1.=data ! kbot lowest level which has data ! note: both mask and kbot must be present together. ! !-------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real, dimension(size(u,1), size(u,2), size(u,3)) :: diff_cu_mo_loc real, dimension(size(u,1), size(u,2)) :: gust_cv real, dimension(size(u,1), size(u,2)) :: land_mask integer :: sec, day real :: dt real, dimension(size(t,1), size(t,2)) :: u_sfc, v_sfc real, dimension(size(t,1), size(t,2), size(t,3)+1) :: pflux real, dimension(size(t,1), size(t,2), size(t,3)) :: & tca, cca, rhoi, lsliq, lsice, ccliq, & ccice, reff_lsclliq, reff_lsclice, & reff_ccclliq, reff_ccclice, & reff_lsprliq, reff_lsprice, & reff_ccprliq, reff_ccprice, & fl_lsrain_loc, fl_lssnow_loc, & fl_lsgrpl_loc, & fl_ccrain_loc, fl_ccsnow_loc, mr_ozone_loc real, dimension(size(t,1), size(t,2), size(t,3), ncol) :: & stoch_mr_liq, stoch_mr_ice, & stoch_size_liq, stoch_size_frz integer :: i, j , k, n integer :: nls, ncc real :: alphb integer :: flag_ls, flag_cc integer :: kmax logical :: used !--------------------------------------------------------------------- ! local variables: ! ! diff_cu_mo_loc diffusion coefficient contribution due to ! cumulus momentum transport ! gust_cv ! sec, day second and day components of the time_type ! variable ! dt physics time step [ seconds ] ! !--------------------------------------------------------------------- type(aerosol_type) :: Aerosol !--------------------------------------------------------------------- ! verify that the module is initialized. !--------------------------------------------------------------------- if ( .not. module_is_initialized) then call error_mesg ('physics_driver_mod', & 'module has not been initialized', FATAL) endif !---------------------------------------------------------------------- ! define number of model layers. !---------------------------------------------------------------------- kmax = size(u,3) !---------------------------------------------------------------------- ! compute the physics time step (from tau-1 to tau+1). !--------------------------------------------------------------------- call get_time (Time_next-Time_prev, sec, day) dt = real(sec+day*86400) !------------------------------------------------------------------ ! call vert_diff_driver_up to complete the vertical diffusion ! calculation. !------------------------------------------------------------------ if (id_tdt_phys_vdif_up > 0) then used = send_data ( id_tdt_phys_vdif_up, -2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_vdif_up(n) > 0) then used = send_data ( id_tracer_phys_vdif_up(n), -2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do call mpp_clock_begin ( diff_up_clock ) call vert_diff_driver_up (is, js, Time_next, dt, p_half, & Surf_diff, tdt, qdt, rdt, mask=mask, & kbot=kbot) radturbten(is:ie,js:je,:) = radturbten(is:ie,js:je,:) + tdt(:,:,:) call mpp_clock_end ( diff_up_clock ) if (id_tdt_phys_vdif_up > 0) then used = send_data ( id_tdt_phys_vdif_up, +2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_vdif_up(n) > 0) then used = send_data ( id_tracer_phys_vdif_up(n), +2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do !----------------------------------------------------------------------- ! if the fms integration path is being followed, call moist processes ! to compute moist physics, including convection and processes ! involving condenstion. !----------------------------------------------------------------------- if (do_moist_processes) then if (id_tdt_phys_moist > 0) then used = send_data ( id_tdt_phys_moist, -2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_moist(n) > 0) then used = send_data ( id_tracer_phys_moist(n), -2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do call mpp_clock_begin ( moist_processes_clock ) !----------------------------------------------------------------------- if (.NOT. do_grey_radiation) then !rif:(09/02/09) to avoid a call to Aerosol when using do_grey_radiation ! Get aerosol mass concentrations pflux(:,:,1) = 0.0E+00 do i=2,size(p_full,3) pflux(:,:,i) = 0.5E+00*(p_full(:,:,i-1) + p_full(:,:,i)) end do pflux(:,:,size(p_full,3)+1) = p_full(:,:,size(p_full,3)) call aerosol_driver (is, js, Time, r, & p_half, pflux, & Aerosol) end if !-------------------------------------------------------------------- ! on steps on which the cosp simulator is called, move the values ! of precip flux saved on the previous step so they will not be ! overwritten on the upcoming call to moist_processes. !-------------------------------------------------------------------- if (do_cosp) then if (step_to_call_cosp) then fl_lsrain_loc(:,:,:) = fl_lsrain(is:ie,js:je,:) fl_lssnow_loc(:,:,:) = fl_lssnow(is:ie,js:je,:) fl_lsgrpl_loc(:,:,:) = fl_lsgrpl(is:ie,js:je,:) fl_ccrain_loc(:,:,:) = fl_ccrain(is:ie,js:je,:) fl_ccsnow_loc(:,:,:) = fl_ccsnow(is:ie,js:je,:) mr_ozone_loc(:,:,:) = mr_ozone (is:ie,js:je,:) endif endif if (doing_donner .and. doing_uw_conv) then call moist_processes (is, ie, js, je, Time_next, dt, & frac_land, p_half, p_full, z_half, z_full, omega, & diff_t(is:ie,js:je,:), radturbten(is:ie,js:je,:), & cush(is:ie,js:je), cbmf(is:ie,js:je), &!miz pbltop(is:ie,js:je), u_star, b_star, q_star, &!miz t, q, r, u, v, tm, qm, rm, um, vm, tdt, qdt, rdt, udt, & vdt, diff_cu_mo_loc, convect(is:ie,js:je), lprec, & fprec, fl_lsrain(is:ie,js:je,:), fl_lssnow(is:ie,js:je,:), & fl_ccrain(is:ie,js:je,:), fl_ccsnow(is:ie,js:je,:), & gust_cv, area, lat, lsc_cloud_area(is:ie,js:je,:), & lsc_liquid(is:ie,js:je,:), lsc_ice(is:ie,js:je,:), & lsc_droplet_number(is:ie,js:je,:), Aerosol, mask=mask, & kbot=kbot, shallow_cloud_area=shallow_cloud_area(is:ie,js:je,:), & shallow_liquid=shallow_liquid(is:ie,js:je,:), & shallow_ice= shallow_ice(is:ie,js:je,:), & shallow_droplet_number= shallow_droplet_number(is:ie,js:je,:), & cell_cld_frac= cell_cld_frac(is:ie,js:je,:), & cell_liq_amt=cell_liq_amt(is:ie,js:je,:), & cell_liq_size=cell_liq_size(is:ie,js:je,:), & cell_ice_amt= cell_ice_amt(is:ie,js:je,:), & cell_ice_size= cell_ice_size(is:ie,js:je,:), & cell_droplet_number= cell_droplet_number(is:ie,js:je,:), & meso_cld_frac= meso_cld_frac(is:ie,js:je,:), & meso_liq_amt=meso_liq_amt(is:ie,js:je,:), & meso_liq_size=meso_liq_size(is:ie,js:je,:), & meso_ice_amt= meso_ice_amt(is:ie,js:je,:), & meso_ice_size= meso_ice_size(is:ie,js:je,:), & meso_droplet_number= meso_droplet_number(is:ie,js:je,:), & nsum_out=nsum_out(is:ie,js:je), & hydrostatic=hydrostatic, phys_hydrostatic=phys_hydrostatic ) else if (doing_donner) then call moist_processes (is, ie, js, je, Time_next, dt, frac_land, & p_half, p_full, z_half, z_full, omega, & diff_t(is:ie,js:je,:), & radturbten(is:ie,js:je,:), & cush (is:ie,js:je), & cbmf (is:ie,js:je), & pbltop(is:ie,js:je), &!miz u_star, b_star, q_star, &!miz t, q, r, u, v, tm, qm, rm, um, vm, & tdt, qdt, rdt, udt, vdt, diff_cu_mo_loc , & convect(is:ie,js:je), lprec, fprec, & fl_lsrain(is:ie,js:je,:), fl_lssnow(is:ie,js:je,:), & fl_ccrain(is:ie,js:je,:), fl_ccsnow(is:ie,js:je,:), & gust_cv, area, lat, & lsc_cloud_area(is:ie,js:je,:), & lsc_liquid(is:ie,js:je,:), & lsc_ice(is:ie,js:je,:), & lsc_droplet_number(is:ie,js:je,:), & Aerosol, mask=mask, kbot=kbot, & cell_cld_frac= cell_cld_frac(is:ie,js:je,:), & cell_liq_amt=cell_liq_amt(is:ie,js:je,:), & cell_liq_size=cell_liq_size(is:ie,js:je,:), & cell_ice_amt= cell_ice_amt(is:ie,js:je,:), & cell_ice_size= cell_ice_size(is:ie,js:je,:), & cell_droplet_number= cell_droplet_number(is:ie,js:je,:), & meso_cld_frac= meso_cld_frac(is:ie,js:je,:), & meso_liq_amt=meso_liq_amt(is:ie,js:je,:), & meso_liq_size=meso_liq_size(is:ie,js:je,:), & meso_ice_amt= meso_ice_amt(is:ie,js:je,:), & meso_ice_size= meso_ice_size(is:ie,js:je,:), & meso_droplet_number= meso_droplet_number(is:ie,js:je,:), & nsum_out=nsum_out(is:ie,js:je), & hydrostatic=hydrostatic, phys_hydrostatic=phys_hydrostatic ) else if (doing_uw_conv) then call moist_processes (is, ie, js, je, Time_next, dt, frac_land, & p_half, p_full, z_half, z_full, omega, & diff_t(is:ie,js:je,:), & radturbten(is:ie,js:je,:), & cush (is:ie,js:je), &! cbmf (is:ie,js:je), &! pbltop(is:ie,js:je), &!miz u_star, b_star, q_star, &!miz t, q, r, u, v, tm, qm, rm, um, vm, & tdt, qdt, rdt, udt, vdt, diff_cu_mo_loc , & convect(is:ie,js:je), lprec, fprec, & fl_lsrain(is:ie,js:je,:), fl_lssnow(is:ie,js:je,:), & fl_ccrain(is:ie,js:je,:), fl_ccsnow(is:ie,js:je,:), & gust_cv, area, lat, & lsc_cloud_area(is:ie,js:je,:), & lsc_liquid(is:ie,js:je,:), & lsc_ice(is:ie,js:je,:), & lsc_droplet_number(is:ie,js:je,:), & Aerosol, mask=mask, kbot= kbot, & shallow_cloud_area= shallow_cloud_area(is:ie,js:je,:), & shallow_liquid=shallow_liquid(is:ie,js:je,:), & shallow_ice= shallow_ice(is:ie,js:je,:), & shallow_droplet_number= shallow_droplet_number(is:ie,js:je,:), & hydrostatic=hydrostatic, phys_hydrostatic=phys_hydrostatic ) else call moist_processes (is, ie, js, je, Time_next, dt, frac_land, & p_half, p_full, z_half, z_full, omega, & diff_t(is:ie,js:je,:), & radturbten(is:ie,js:je,:), & cush (is:ie,js:je), &! cbmf (is:ie,js:je), &! pbltop(is:ie,js:je), &!miz u_star, b_star, q_star, &!miz t, q, r, u, v, tm, qm, rm, um, vm, & tdt, qdt, rdt, udt, vdt, diff_cu_mo_loc , & convect(is:ie,js:je), lprec, fprec, & fl_lsrain(is:ie,js:je,:), fl_lssnow(is:ie,js:je,:), & fl_ccrain(is:ie,js:je,:), fl_ccsnow(is:ie,js:je,:), & gust_cv, area, lat, & lsc_cloud_area(is:ie,js:je,:), & lsc_liquid(is:ie,js:je,:), & lsc_ice(is:ie,js:je,:), & lsc_droplet_number(is:ie,js:je,:), & Aerosol, mask=mask, kbot=kbot, & hydrostatic=hydrostatic, phys_hydrostatic=phys_hydrostatic ) endif call mpp_clock_end ( moist_processes_clock ) diff_cu_mo(is:ie, js:je,:) = diff_cu_mo_loc(:,:,:) radturbten(is:ie,js:je,:) = 0.0 !--------------------------------------------------------------------- ! add the convective gustiness effect to that previously obtained ! from non-convective parameterizations. !--------------------------------------------------------------------- gust = sqrt( gust*gust + gust_cv*gust_cv) if (id_tdt_phys_moist > 0) then used = send_data ( id_tdt_phys_moist, +2.0*tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif do n=1,nt if (id_tracer_phys_moist(n) > 0) then used = send_data ( id_tracer_phys_moist(n), +2.0*rdt(:,:,:,n), & Time_next, is, js, 1, rmask=mask ) endif end do if (id_tdt_phys > 0) then used = send_data ( id_tdt_phys, tdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif if (id_qdt_phys > 0) then used = send_data ( id_qdt_phys, qdt(:,:,:), & Time_next, is, js, 1, rmask=mask ) endif endif ! do_moist_processes if(ASSOCIATED(Aerosol%aerosol))deallocate(Aerosol%aerosol) if(ASSOCIATED(Aerosol%family_members))deallocate(Aerosol%family_members) if(ASSOCIATED(Aerosol%aerosol_names))deallocate(Aerosol%aerosol_names) call mpp_clock_begin ( cosp_clock ) if (do_cosp) then if (step_to_call_cosp) then !--------------------------------------------------------------------- ! on the first step of a job segment, the values of t,q and precip ! flux will not be available at the proper time level. in this case ! denoted by temp-_last = 0.0, use values from the current step for ! t, q and precip flux. !--------------------------------------------------------------------- alphb = SUM(temp_last(is:ie,js:je,:)) if (alphb == 0.) then temp_last(is:ie,js:je,:) = t(:,:,:) + dt*tdt(:,:,:) q_last(is:ie,js:je,:) = q(:,:,:) + dt*qdt(:,:,:) fl_lsrain_loc(:,:,:) = fl_lsrain(is:ie,js:je,:) fl_lssnow_loc(:,:,:) = fl_lssnow(is:ie,js:je,:) fl_lsgrpl_loc(:,:,:) = fl_lsgrpl(is:ie,js:je,:) fl_ccrain_loc(:,:,:) = fl_ccrain(is:ie,js:je,:) fl_ccsnow_loc(:,:,:) = fl_ccsnow(is:ie,js:je,:) endif !---------------------------------------------------------------------- ! define the total and convective cloud fractions in each grid box as ! the average over the stochastic columns. !---------------------------------------------------------------------- tca = 0. cca = 0. do n=1,ncol where (stoch_cloud_type(is:ie,js:je,:,n) > 0) tca(:,:,:) = tca(:,:,:) + 1.0 end where where (stoch_cloud_type(is:ie,js:je,:,n) == 2) cca(:,:,:) = cca(:,:,:) + 1.0 end where end do tca = tca/ float(ncol) cca = cca/ float(ncol) !-------------------------------------------------------------------- ! define the atmospheric density to use in converting concentrations ! to mixing ratios. !-------------------------------------------------------------------- do k=1, size(stoch_cloud_type,3) do j=1, size(stoch_cloud_type,2) do i=1, size(stoch_cloud_type,1) rhoi(i,j,k) = RDGAS*temp_last(i+is-1,j+js-1,k)/ & p_full(i,j,k) end do end do end do !-------------------------------------------------------------------- ! convert the condensate concentrations in each stochastic column to ! mixing ratios. !-------------------------------------------------------------------- do n=1,ncol do k=1, size(stoch_cloud_type,3) do j=1, size(stoch_cloud_type,2) do i=1, size(stoch_cloud_type,1) stoch_mr_liq(i,j,k,n) = 1.0e-03* & stoch_conc_drop(i+is-1,j+js-1,k,n)*rhoi(i,j,k) stoch_mr_ice(i,j,k,n) = 1.0e-03* & stoch_conc_ice (i+is-1,j+js-1,k,n)*rhoi(i,j,k) stoch_size_liq(i,j,k,n) = 1.0e-06* & stoch_size_drop(i+is-1,j+js-1,k,n) stoch_size_frz(i,j,k,n) = 1.0e-06* & stoch_size_ice (i+is-1,j+js-1,k,n) end do end do end do end do stoch_mr_liq = stoch_mr_liq/(1.0-stoch_mr_liq) stoch_mr_ice = stoch_mr_ice/(1.0-stoch_mr_ice) !--------------------------------------------------------------------- ! define the grid box mean largescale and convective condensate ! mixing ratios and sizes. !--------------------------------------------------------------------- lsliq = 0. lsice = 0. ccliq = 0. ccice = 0. reff_lsclliq = 0. reff_lsclice = 0. reff_ccclliq = 0. reff_ccclice = 0. reff_lsprliq = 0. reff_lsprice = 0. reff_ccprliq = 0. reff_ccprice = 0. do k=1, size(stoch_cloud_type,3) do j=1, size(stoch_cloud_type,2) do i=1, size(stoch_cloud_type,1) nls = 0 ncc = 0 do n=1,ncol if (stoch_cloud_type(i+is-1,j+js-1,k,n) == 1) then nls = nls + 1 lsliq(i,j,k) = lsliq(i,j,k) + & stoch_conc_drop(i+is-1,j+js-1,k,n) lsice(i,j,k) = lsice(i,j,k) + & stoch_conc_ice (i+is-1,j+js-1,k,n) reff_lsclliq(i,j,k) = reff_lsclliq(i,j,k) + & stoch_size_drop(i+is-1,j+js-1,k,n) reff_lsclice(i,j,k) = reff_lsclice(i,j,k) + & stoch_size_ice (i+is-1,j+js-1,k,n) else if (stoch_cloud_type(i+is-1,j+js-1,k,n) == 2)then ncc = ncc + 1 ccliq(i,j,k) = ccliq(i,j,k) + & stoch_conc_drop(i+is-1,j+js-1,k,n) ccice(i,j,k) = ccice(i,j,k) + & stoch_conc_ice (i+is-1,j+js-1,k,n) reff_ccclliq(i,j,k) = reff_ccclliq(i,j,k) + & stoch_size_drop(i+is-1,j+js-1,k,n) reff_ccclice(i,j,k) = reff_ccclice(i,j,k) + & stoch_size_ice (i+is-1,j+js-1,k,n) endif end do if (nls > 0) then lsliq(i,j,k) = 1.0e-03*lsliq(i,j,k)/float(nls) lsice(i,j,k) = 1.0e-03*lsice(i,j,k)/float(nls) reff_lsclliq(i,j,k) = 1.0e-06* & reff_lsclliq (i,j,k)/float(nls) reff_lsclice(i,j,k) = 1.0e-06* & reff_lsclice (i,j,k)/float(nls) endif if (ncc > 0) then ccliq(i,j,k) = 1.0e-03*ccliq(i,j,k)/float(ncc) ccice(i,j,k) = 1.0e-03*ccice(i,j,k)/float(ncc) reff_ccclliq(i,j,k) = 1.0e-06* & reff_ccclliq (i,j,k) /float(ncc) reff_ccclice(i,j,k) = 1.0e-06* & reff_ccclice (i,j,k) /float(ncc) endif ccliq(i,j,k) = ccliq(i,j,k)*rhoi(i,j,k)/ & (1.0-ccliq(i,j,k)) ccice(i,j,k) = ccice(i,j,k)*rhoi(i,j,k)/ & (1.0-ccice(i,j,k)) lsliq(i,j,k) = lsliq(i,j,k)*rhoi(i,j,k)/ & (1.0-lsliq(i,j,k)) lsice(i,j,k) = lsice(i,j,k)*rhoi(i,j,k)/ & (1.0-lsice(i,j,k)) end do end do end do !--------------------------------------------------------------------- ! define land_mask array. set it to 1 over land, 0 over ocean; define ! based on frac_land > 0.5 being land. !--------------------------------------------------------------------- where (frac_land > 0.50) land_mask(:,:) = 1.0 elsewhere land_mask(:,:) = 0.0 end where if (allow_cosp_precip_wo_clouds) then else !-------------------------------------------------------------------- ! allow ls precip only in columns containing ls cloud. allow ! convective precip only in columns with convective cloud, !-------------------------------------------------------------------- do j=1, size(stoch_cloud_type,2) do i=1, size(stoch_cloud_type,1) flag_ls = 0 flag_cc = 0 do k=1, size(stoch_cloud_type,3) do n=1,ncol if (stoch_cloud_type(i+is-1,j+js-1,k,n) == 1) then flag_ls = 1 exit else if(stoch_cloud_type(i+is-1,j+js-1,k,n) == 2) then flag_cc = 1 exit endif end do if (flag_ls == 1 .and. flag_cc == 1) exit end do if (flag_ls == 0) then fl_lsrain_loc(i,j,:) = 0. fl_lssnow_loc(i,j,:) = 0. fl_lsgrpl_loc(i,j,:) = 0. endif if (flag_cc == 0) then fl_ccrain_loc(i,j,:) = 0. fl_ccsnow_loc(i,j,:) = 0. endif end do end do endif !--------------------------------------------------------------------- ! pass in the large-scale graupel flux, lowest-level u and v wind ! components. !--------------------------------------------------------------------- fl_lsgrpl = 0. u_sfc = u(:,:,kmax) v_sfc = v(:,:,kmax) !--------------------------------------------------------------------- ! call the cosp simulator to produce the desired outputs. !--------------------------------------------------------------------- call cosp_driver (lat*180./ACOS(-1.0), lon*180./ACOS(-1.0), & daytime(is:ie,js:je), & p_half, & p_full, z_half, & z_full, u_sfc, v_sfc, mr_ozone_loc, & temp_last(is:ie,js:je,:), & q_last(is:ie,js:je,:), tca, cca, lsliq, & lsice, ccliq, ccice, & fl_lsrain_loc, fl_lssnow_loc, fl_lsgrpl_loc,& fl_ccrain_loc, fl_ccsnow_loc,& reff_lsclliq, reff_lsclice, reff_lsprliq, & reff_lsprice, reff_ccclliq, reff_ccclice, & reff_ccprliq, reff_ccprice, & tsurf_save(is:ie, js:je), land_mask, & Time_next, is, js, & stoch_mr_liq_in =stoch_mr_liq, & stoch_mr_ice_in =stoch_mr_ice, & stoch_size_liq_in =stoch_size_liq, & stoch_size_frz_in = stoch_size_frz, & tau_stoch_in = tau_stoch(is:ie,js:je,:,:),& lwem_stoch_in = lwem_stoch(is:ie,js:je,:,:), & stoch_cloud_type_in = stoch_cloud_type(is:ie,js:je,:,:)) endif ! (step_to_call_cosp) endif ! (do_cosp) call mpp_clock_end ( cosp_clock ) !-------------------------------------------------------------------- ! save t and q from end of step for use with next call to COSP !-------------------------------------------------------------------- temp_last(is:ie,js:je,:) = t(:,:,:) + tdt(:,:,:)*dt q_last (is:ie,js:je,:) = q(:,:,:) + qdt(:,:,:)*dt !----------------------------------------------------------------------- end subroutine physics_driver_up !####################################################################### ! ! ! physics_driver_end is the destructor for physics_driver_mod. ! ! ! physics_driver_end is the destructor for physics_driver_mod. ! ! ! ! current time ! ! ! subroutine physics_driver_end (Time) !--------------------------------------------------------------------- ! physics_driver_end is the destructor for physics_driver_mod. !--------------------------------------------------------------------- type(time_type), intent(in) :: Time !-------------------------------------------------------------------- ! intent(in) variables: ! ! Time current time [ time_type(days, seconds) ] ! !-------------------------------------------------------------------- integer :: moist_processes_term_clock, damping_term_clock, turb_term_clock, & diff_term_clock, cloud_spec_term_clock, aerosol_term_clock, & grey_radiation_term_clock, radiative_gases_term_clock, & radiation_term_clock, tracer_term_clock, cosp_term_clock moist_processes_term_clock = & mpp_clock_id( ' Phys_driver_term: MP: Termination', & grain=CLOCK_MODULE_DRIVER ) damping_term_clock = & mpp_clock_id( ' Phys_driver_term: Damping: Termination', & grain=CLOCK_MODULE_DRIVER ) turb_term_clock = & mpp_clock_id( ' Phys_driver_term: Vert. Turb.: Termination', & grain=CLOCK_MODULE_DRIVER ) diff_term_clock = & mpp_clock_id( ' Phys_driver_term: Vert. Diff.: Termination', & grain=CLOCK_MODULE_DRIVER ) cloud_spec_term_clock = & mpp_clock_id( ' Phys_driver_term: Cloud spec: Termination', & grain=CLOCK_MODULE_DRIVER ) cosp_term_clock = & mpp_clock_id( ' Phys_driver_term: COSP: Termination', & grain=CLOCK_MODULE_DRIVER ) aerosol_term_clock = & mpp_clock_id( ' Phys_driver_term: Aerosol: Termination', & grain=CLOCK_MODULE_DRIVER ) grey_radiation_term_clock = & mpp_clock_id( ' Phys_driver_term: Grey Radiation: Termination', & grain=CLOCK_MODULE_DRIVER ) radiative_gases_term_clock = & mpp_clock_id( ' Phys_driver_term: Radiative gases: Termination', & grain=CLOCK_MODULE_DRIVER ) radiation_term_clock = & mpp_clock_id( ' Phys_driver_term: Radiation: Termination', & grain=CLOCK_MODULE_DRIVER ) tracer_term_clock = & mpp_clock_id( ' Phys_driver_term: Tracer: Termination', & grain=CLOCK_MODULE_DRIVER ) !--------------------------------------------------------------------- ! verify that the module is initialized. !--------------------------------------------------------------------- if ( .not. module_is_initialized) then call error_mesg ('physics_driver_mod', & 'module has not been initialized', FATAL) endif call physics_driver_netcdf !-------------------------------------------------------------------- ! call the destructor routines for those modules who were initial- ! ized from this module. !-------------------------------------------------------------------- call mpp_clock_begin ( turb_term_clock ) call vert_turb_driver_end call mpp_clock_end ( turb_term_clock ) call mpp_clock_begin ( diff_term_clock ) call vert_diff_driver_end call mpp_clock_end ( diff_term_clock ) if (do_radiation) then call mpp_clock_begin ( radiation_term_clock ) call radiation_driver_end call mpp_clock_end ( radiation_term_clock ) call mpp_clock_begin ( radiative_gases_term_clock ) call radiative_gases_end call mpp_clock_end ( radiative_gases_term_clock ) call mpp_clock_begin ( cloud_spec_term_clock ) call cloud_spec_end call mpp_clock_end ( cloud_spec_term_clock ) call mpp_clock_begin ( aerosol_term_clock ) call aerosol_end call mpp_clock_end ( aerosol_term_clock ) endif call mpp_clock_begin ( grey_radiation_term_clock ) if(do_grey_radiation) call grey_radiation_end call mpp_clock_end ( grey_radiation_term_clock ) call mpp_clock_begin ( moist_processes_term_clock ) call moist_processes_end call mpp_clock_end ( moist_processes_term_clock ) call mpp_clock_begin ( tracer_term_clock ) call atmos_tracer_driver_end call mpp_clock_end ( tracer_term_clock ) call mpp_clock_begin ( damping_term_clock ) call damping_driver_end call mpp_clock_end ( damping_term_clock ) call mpp_clock_begin ( cosp_term_clock ) if (do_cosp) then call cosp_driver_end endif call mpp_clock_end ( cosp_term_clock ) !--------------------------------------------------------------------- ! deallocate the module variables. !--------------------------------------------------------------------- deallocate (diff_cu_mo, diff_t, diff_m, pbltop, cush, cbmf, convect, & radturbten, lw_tendency) if (doing_donner) then deallocate (cell_cld_frac, cell_liq_amt, cell_liq_size, & cell_ice_amt, cell_ice_size, cell_droplet_number, & meso_cld_frac, meso_liq_amt, meso_liq_size, & meso_ice_amt, meso_ice_size, meso_droplet_number, & nsum_out) endif if (doing_uw_conv) then deallocate (shallow_cloud_area, shallow_liquid, shallow_ice, & shallow_droplet_number) endif deallocate (id_tracer_phys_vdif_dn) deallocate (id_tracer_phys_vdif_up) deallocate (id_tracer_phys_turb) deallocate (id_tracer_phys_moist) if (do_cosp .or. do_modis_yim) then deallocate (stoch_cloud_type, tau_stoch, lwem_stoch, & stoch_conc_drop, stoch_conc_ice, stoch_size_drop, & stoch_size_ice, tsurf_save) endif !--------------------------------------------------------------------- ! mark the module as uninitialized. !--------------------------------------------------------------------- module_is_initialized = .false. !----------------------------------------------------------------------- end subroutine physics_driver_end !####################################################################### ! ! ! ! write out restart file. ! Arguments: ! timestamp (optional, intent(in)) : A character string that represents the model time, ! used for writing restart. timestamp will append to ! the any restart file name as a prefix. ! ! subroutine physics_driver_restart(timestamp) character(len=*), intent(in), optional :: timestamp integer :: unit if(do_netcdf_restart) then if (mpp_pe() == mpp_root_pe() ) then call error_mesg('physics_driver_mod', 'Writing netCDF formatted restart file: RESTART/physics_driver.res.nc', NOTE) endif call physics_driver_netcdf(timestamp) call vert_turb_driver_restart(timestamp) if (do_radiation) then call radiation_driver_restart(timestamp) call radiative_gases_restart(timestamp) endif ! call moist_processes_restart(timestamp) call damping_driver_restart(timestamp) else call error_mesg('physics_driver_mod', & 'Native intermediate restart files are not supported.', FATAL) endif end subroutine physics_driver_restart ! NAME="physics_driver_restart" ! ! ! ! Write out restart file for physics driver. ! This routine is needed so that physics_driver_restart and physics_driver_end ! can call a routine which will not result in multiple copies of restart files ! being written by the destructor routines. ! Arguments: ! timestamp (optional, intent(in)) : A character string that represents the model time, ! used for writing restart. timestamp will append to ! the any restart file name as a prefix. ! ! subroutine physics_driver_netcdf(timestamp) character(len=*), intent(in), optional :: timestamp r_convect = 0. where(convect) r_convect = 1.0 end where call save_restart(Phy_restart, timestamp) if(in_different_file) call save_restart(Til_restart, timestamp) end subroutine physics_driver_netcdf ! NAME="physics_driver_netcdf" !####################################################################### ! ! ! do_moist_in_phys_up returns the value of do_moist_processes ! ! ! do_moist_in_phys_up returns the value of do_moist_processes ! ! ! ! function do_moist_in_phys_up() !-------------------------------------------------------------------- ! do_moist_in_phys_up returns the value of do_moist_processes !---------------------------------------------------------------------- logical :: do_moist_in_phys_up !--------------------------------------------------------------------- ! verify that the module is initialized. !--------------------------------------------------------------------- if ( .not. module_is_initialized) then call error_mesg ('do_moist_in_phys_up', & 'module has not been initialized', FATAL) endif !------------------------------------------------------------------- ! define output variable. !------------------------------------------------------------------- do_moist_in_phys_up = do_moist_processes end function do_moist_in_phys_up !##################################################################### ! ! ! returns the values of array diff_t ! ! ! returns the values of array diff_t ! ! ! ! !##################################################################### function get_diff_t() result(diff_t_out) real, dimension(size(diff_t,1),size(diff_t,2),size(diff_t,3)) :: diff_t_out if ( .not. module_is_initialized) then call error_mesg ('get_diff_t','module has not been initialized', FATAL) endif diff_t_out = diff_t end function get_diff_t !##################################################################### ! ! ! returns the values of array radturbten ! ! ! returns the values of array radturbten ! ! ! ! !##################################################################### function get_radturbten() result(radturbten_out) real, dimension(size(radturbten,1),size(radturbten,2),size(radturbten,3)) :: radturbten_out if ( .not. module_is_initialized) then call error_mesg ('get_radturbten','module has not been initialized', FATAL) endif radturbten_out = radturbten end function get_radturbten !##################################################################### ! ! ! sets all values of array radturbten to zero ! ! ! sets all values of array radturbten to zero ! ! ! ! !##################################################################### subroutine zero_radturbten() if ( .not. module_is_initialized) then call error_mesg ('zero_radturbten','module has not been initialized', FATAL) endif radturbten = 0.0 end subroutine zero_radturbten !##################################################################### !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! PRIVATE SUBROUTINES ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% !##################################################################### ! ! ! physics_driver_register_restart will register restart field when do_netcdf file ! is true. ! subroutine physics_driver_register_restart character(len=64) :: fname, fname2 integer :: id_restart if(doing_strat()) then now_doing_strat = 1 else now_doing_strat = 0 endif if(doing_edt) then now_doing_edt = 1 else now_doing_edt = 0 endif if(doing_entrain) then now_doing_entrain = 1 else now_doing_entrain = 0 endif fname = 'physics_driver.res.nc' call get_mosaic_tile_file(fname, fname2, .false. ) allocate(Phy_restart) if(trim(fname2) == trim(fname)) then Til_restart => Phy_restart in_different_file = .false. else in_different_file = .true. allocate(Til_restart) endif id_restart = register_restart_field(Phy_restart, fname, 'vers', vers) id_restart = register_restart_field(Phy_restart, fname, 'doing_strat', now_doing_strat) id_restart = register_restart_field(Phy_restart, fname, 'doing_edt', now_doing_edt) id_restart = register_restart_field(Phy_restart, fname, 'doing_entrain', now_doing_entrain) id_restart = register_restart_field(Til_restart, fname, 'diff_cu_mo', diff_cu_mo) id_restart = register_restart_field(Til_restart, fname, 'pbltop', pbltop) id_restart = register_restart_field(Til_restart, fname, 'cush', cush) id_restart = register_restart_field(Til_restart, fname, 'cbmf', cbmf) id_restart = register_restart_field(Til_restart, fname, 'diff_t', diff_t) id_restart = register_restart_field(Til_restart, fname, 'diff_m', diff_m) id_restart = register_restart_field(Til_restart, fname, 'convect', r_convect) if (doing_strat()) then id_restart = register_restart_field(Til_restart, fname, 'radturbten', radturbten) endif if (doing_edt .or. doing_entrain) then id_restart = register_restart_field(Til_restart, fname, 'lw_tendency', lw_tendency) endif if (doing_donner) then id_restart = register_restart_field(Til_restart, fname, 'cell_cloud_frac', cell_cld_frac) id_restart = register_restart_field(Til_restart, fname, 'cell_liquid_amt', cell_liq_amt) id_restart = register_restart_field(Til_restart, fname, 'cell_liquid_size', cell_liq_size) id_restart = register_restart_field(Til_restart, fname, 'cell_ice_amt', cell_ice_amt) id_restart = register_restart_field(Til_restart, fname, 'cell_ice_size', cell_ice_size) id_restart = register_restart_field(Til_restart, fname, 'meso_cloud_frac', meso_cld_frac) id_restart = register_restart_field(Til_restart, fname, 'meso_liquid_amt', meso_liq_amt) id_restart = register_restart_field(Til_restart, fname, 'meso_liquid_size', meso_liq_size) id_restart = register_restart_field(Til_restart, fname, 'meso_ice_amt', meso_ice_amt) id_restart = register_restart_field(Til_restart, fname, 'meso_ice_size', meso_ice_size) id_restart = register_restart_field(Til_restart, fname, 'nsum', nsum_out) endif if (doing_uw_conv) then id_restart = register_restart_field(Til_restart, fname, 'shallow_cloud_area', shallow_cloud_area) id_restart = register_restart_field(Til_restart, fname, 'shallow_liquid', shallow_liquid) id_restart = register_restart_field(Til_restart, fname, 'shallow_ice', shallow_ice) id_restart = register_restart_field(Til_restart, fname, 'shallow_droplet_number', shallow_droplet_number) endif id_restart = register_restart_field(Til_restart, fname, 'lsc_cloud_area', lsc_cloud_area) id_restart = register_restart_field(Til_restart, fname, 'lsc_liquid', lsc_liquid ) id_restart = register_restart_field(Til_restart, fname, 'lsc_ice', lsc_ice ) id_restart = register_restart_field(Til_restart, fname, 'lsc_droplet_number', & lsc_droplet_number) end subroutine physics_driver_register_restart ! !##################################################################### ! ! ! read_restart_file will read the physics_driver.res file and process ! its contents. if no restart data can be found, the module variables ! are initialized to flag values. ! ! ! read_restart_file will read the physics_driver.res file and process ! its contents. if no restart data can be found, the module variables ! are initialized to flag values. ! ! ! ! subroutine read_restart_file !--------------------------------------------------------------------- ! read_restart_file will read the physics_driver.res file and process ! its contents. if no restart data can be found, the module variables ! are initialized to flag values. !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: integer :: io, unit integer :: vers2 character(len=8) :: chvers logical :: was_doing_strat, was_doing_edt, was_doing_entrain logical :: was_doing_donner logical :: was_doing_uw_conv logical :: success = .false. !-------------------------------------------------------------------- ! local variables: ! ! ierr error code ! io error status returned from i/o operation ! unit io unit number for reading restart file ! vers restart version number if that is contained in ! file; otherwise the first word of first data ! record of file ! vers2 second word of first data record of file ! was_doing_strat logical indicating if strat_cloud_mod was ! active in job which wrote restart file ! was_doing_edt logical indicating if edt_mod was active ! in job which wrote restart file ! was_doing_entrain logical indicating if entrain_mod was active ! in job which wrote restart file ! success logical indicating that restart data has been ! processed ! !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! obtain values for radturbten, either from physics_driver.res, if ! reading a newer version of the file which contains it, or from ! strat_cloud.res when an older version of physics_driver.res is ! being read. !-------------------------------------------------------------------- if(mpp_pe() == mpp_root_pe()) call mpp_error ('physics_driver_mod', & 'Reading native formatted restart file.', NOTE) if (file_exist('INPUT/physics_driver.res')) then unit = open_restart_file ('INPUT/physics_driver.res', 'read') !-------------------------------------------------------------------- ! read restart file version number. !-------------------------------------------------------------------- read (unit) vers if ( .not. any(vers ==restart_versions) ) then write (chvers, '(i4)') vers call error_mesg ('physics_driver_mod', & 'restart version ' //chvers// ' cannot be read by this'//& 'module version', FATAL) endif !-------------------------------------------------------------------- ! starting with v8, native mode files are no longer supported. !-------------------------------------------------------------------- if (vers >=8 ) then call error_mesg ('physics_driver_mod, read_restart_file', & ' native mode restart files are not supported after & &version 7', FATAL) endif !-------------------------------------------------------------------- ! starting with v5, logicals are written indicating which variables ! are present. !-------------------------------------------------------------------- if (vers >= 5 ) then read (unit) was_doing_strat, was_doing_edt, was_doing_entrain endif if (vers >= 6 ) then read (unit) was_doing_donner endif if (vers >= 7 ) then read (unit) was_doing_uw_conv endif !--------------------------------------------------------------------- ! read the contribution to diffusion coefficient from cumulus ! momentum transport. !--------------------------------------------------------------------- call read_data (unit, diff_cu_mo) !--------------------------------------------------------------------- ! pbl top is present in file versions 2 and up. if not present, ! set a flag. !--------------------------------------------------------------------- if (vers >= 2) then call read_data (unit, pbltop) else pbltop = -999.0 endif !--------------------------------------------------------------------- ! cush and cbmf are present in file versions 7 and up. if not ! present, set a flag. !--------------------------------------------------------------------- if (vers >= 7) then call read_data (unit, cush) !miz call read_data (unit, cbmf) !miz else cush = -1. !miz cbmf = 0.0 !miz endif !--------------------------------------------------------------------- ! the temperature and momentum diffusion coefficients are present ! beginning with v3. if not prsent, set to 0.0. !--------------------------------------------------------------------- if (vers >= 3) then call read_data (unit, diff_t) call read_data (unit, diff_m) else diff_t = 0.0 diff_m = 0.0 end if !--------------------------------------------------------------------- ! a flag indicating columns in which convection is occurring is ! present beginning with v4. if not present, set it to .false. !--------------------------------------------------------------------- if (vers >= 4) then call read_data (unit, convect) else convect = .false. end if !--------------------------------------------------------------------- ! radturbten may be present in versions 5 onward, if strat_cloud_mod ! was active in the job writing the .res file. !--------------------------------------------------------------------- if (vers >= 5) then !-------------------------------------------------------------------- ! if radturbten was written, read it. !-------------------------------------------------------------------- if (was_doing_strat) then call read_data (unit, radturbten) !--------------------------------------------------------------------- ! if strat_cloud_mod was not active in the job which wrote the ! restart file but it is active in the current job, initialize ! radturbten to 0.0 and put a message in the output file. !--------------------------------------------------------------------- else if (doing_strat()) then radturbten = 0.0 call error_mesg ('physics_driver_mod', & ' initializing radturbten to 0.0, since it not present'//& ' in physics_driver.res file', NOTE) endif endif !-------------------------------------------------------------------- ! if lw_tendency was written, read it. !-------------------------------------------------------------------- if (was_doing_edt .or. was_doing_entrain) then call read_data (unit, lw_tendency) !--------------------------------------------------------------------- ! if edt_mod or entrain_mod was not active in the job which wrote the ! restart file but it is active in the current job, initialize ! lw_tendency to 0.0 and put a message in the output file. !--------------------------------------------------------------------- else if (doing_edt .or. doing_entrain) then lw_tendency = 0.0 call error_mesg ('physics_driver_mod', & ' initializing lw_tendency to 0.0, since it not present'//& ' in physics_driver.res file', NOTE) endif endif !--------------------------------------------------------------------- ! close the io unit associated with physics_driver.res. set flag ! to indicate that the restart data has been processed. !--------------------------------------------------------------------- call close_file (unit) success = .true. endif ! (vers >=5) if (doing_donner) then if (vers >= 6) then if (was_doing_donner) then call read_data (unit , cell_cld_frac) call read_data (unit , cell_liq_amt ) call read_data (unit , cell_liq_size) call read_data (unit , cell_ice_amt ) call read_data (unit , cell_ice_size) call read_data (unit , meso_cld_frac) call read_data (unit , meso_liq_amt ) call read_data (unit , meso_liq_size) call read_data (unit , meso_ice_amt ) call read_data (unit , meso_ice_size) call read_data (unit , nsum_out) else ! (was_doing_donner) cell_cld_frac = 0. cell_liq_amt = 0. cell_liq_size = 0. cell_ice_amt = 0. cell_ice_size = 0. meso_cld_frac = 0. meso_liq_amt = 0. meso_liq_size = 0. meso_ice_amt = 0. meso_ice_size = 0. nsum_out = 1 endif ! (was_doing_donner) else ! (vers >= 6) cell_cld_frac = 0. cell_liq_amt = 0. cell_liq_size = 0. cell_ice_amt = 0. cell_ice_size = 0. meso_cld_frac = 0. meso_liq_amt = 0. meso_liq_size = 0. meso_ice_amt = 0. meso_ice_size = 0. nsum_out = 1 endif ! (vers >= 6) endif ! (doing_donner) if (doing_uw_conv) then if (vers >= 7) then if (was_doing_uw_conv) then call read_data (unit , shallow_cloud_area) call read_data (unit , shallow_liquid ) call read_data (unit , shallow_ice ) call read_data (unit , shallow_droplet_number) else ! (was_doing_uw_conv) shallow_cloud_area = 0. shallow_liquid = 0. shallow_ice = 0. shallow_droplet_number = 0. endif ! (was_doing_uw_conv) else ! (vers >= 7) shallow_cloud_area = 0. shallow_liquid = 0. shallow_ice = 0. shallow_droplet_number = 0. endif ! (vers >= 7) endif ! (doing_uw_conv) !--------------------------------------------------------------------- ! if there is no physics_driver.res, set the remaining module ! variables to 0.0 !--------------------------------------------------------------------- else diff_t = 0.0 diff_m = 0.0 diff_cu_mo = 0.0 pbltop = -999.0 cush = -1. !miz cbmf = 0.0 !miz convect = .false. if (doing_donner) then cell_cld_frac = 0. cell_liq_amt = 0. cell_liq_size = 0. cell_ice_amt = 0. cell_ice_size = 0. meso_cld_frac = 0. meso_liq_amt = 0. meso_liq_size = 0. meso_ice_amt = 0. meso_ice_size = 0. nsum_out = 1 endif ! (doing_donner) if (doing_uw_conv) then shallow_cloud_area = 0. shallow_liquid = 0. shallow_ice = 0. shallow_droplet_number = 0. endif ! (doing_uw_conv) endif ! present(.res) !-------------------------------------------------------------------- ! if a version of physics_driver.res containing the needed data is ! not present, check for the presence of the radturbten data in ! strat_cloud.res. !-------------------------------------------------------------------- if ( .not. success) then if (doing_strat()) then if (file_exist('INPUT/strat_cloud.res')) then unit = open_restart_file ('INPUT/strat_cloud.res', 'read') read (unit, iostat=io, err=142) vers, vers2 !---------------------------------------------------------------------- ! if an i/o error does not occur, then the strat_cloud.res file ! contains the variable radturbten. rewind and read. close file upon ! completion. !---------------------------------------------------------------------- 142 continue if (io == 0) then call error_mesg ('physics_driver_mod', & 'reading pre-version number strat_cloud.res file, '//& 'reading radturbten', NOTE) rewind (unit) call read_data (unit, radturbten) call close_file (unit) !--------------------------------------------------------------------- ! if the eor was reached (io /= 0), then the strat_cloud.res file ! does not contain the radturbten data. set values to 0.0 and ! put a note in the output file. !--------------------------------------------------------------------- else radturbten = 0.0 call error_mesg ('physics_driver_mod', & 'neither strat_cloud.res nor physics_driver.res '//& 'contain the radturbten data, setting it to 0.0', & NOTE) endif !---------------------------------------------------------------------- ! if strat_cloud.res is not present, set radturbten to 0.0. !---------------------------------------------------------------------- else radturbten = 0.0 call error_mesg ('physics_driver_mod', & 'setting radturbten to zero, no strat_cloud.res '//& 'file present, data not in physics_driver.res', NOTE) endif endif !-------------------------------------------------------------------- ! check if the lw_tendency data is in edt.res. !-------------------------------------------------------------------- if (doing_edt) then if (file_exist('INPUT/edt.res')) Then unit = open_restart_file ('INPUT/edt.res', 'read') read (unit, iostat=io, err=143) vers, vers2 !---------------------------------------------------------------------- ! if an i/o error does not occur, then the edt.res file ! contains the variable lw_tendency. rewind and read. close file ! upon completion. !---------------------------------------------------------------------- 143 continue if (io == 0) then call error_mesg ('physics_driver_mod', & 'reading pre-version number edt.res file, & &reading lw_tendency', NOTE) rewind (unit) call read_data (unit, lw_tendency) call close_file (unit) !--------------------------------------------------------------------- ! if the eor was reached (io /= 0), then the edt.res file ! does not contain the lw_tendency data. set values to 0.0 and ! put a note in the output file. !--------------------------------------------------------------------- else lw_tendency = 0.0 call error_mesg ('physics_driver_mod', & 'neither edt.res nor physics_driver.res & &contain the lw_tendency data, setting it to 0.0', & NOTE) endif !---------------------------------------------------------------------- ! if edt.res is not present, set lw_tendency to 0.0. !---------------------------------------------------------------------- else lw_tendency = 0.0 call error_mesg ('physics_driver_mod', & 'setting lw_tendency to zero, no edt.res & &file present, data not in physics_driver.res', NOTE) endif endif !-------------------------------------------------------------------- ! check if the lw_tendency data is in entrain.res. only 1 form of ! entrain.res has ever existed, containing only the lw_tendency ! variable, so it can be read without further checking. !-------------------------------------------------------------------- if (doing_entrain) then if (file_exist('INPUT/entrain.res')) Then unit = open_restart_file ('INPUT/entrain.res', 'read') call read_data (unit, lw_tendency) call close_file (unit) !---------------------------------------------------------------------- ! if entrain.res is not present, set lw_tendency to 0.0. !---------------------------------------------------------------------- else lw_tendency = 0.0 call error_mesg ('physics_driver_mod', & 'setting lw_tendency to zero, no entrain.res & &file present, data not in physics_driver.res', NOTE) endif endif endif ! (.not. success) !---------------------------------------------------------------------- end subroutine read_restart_file !##################################################################### ! ! ! read_restart_nc will read the physics_driver.res file and process ! its contents. if no restart data can be found, the module variables ! are initialized to flag values. ! ! ! read_restart_nc will read the physics_driver.res file and process ! its contents. if no restart data can be found, the module variables ! are initialized to flag values. ! ! ! ! subroutine read_restart_nc !--------------------------------------------------------------------- ! read_restart_file will read the physics_driver.res file and process ! its contents. if no restart data can be found, the module variables ! are initialized to flag values. !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! local variables: real :: was_doing_strat=0., was_doing_edt=0., was_doing_entrain=0. logical :: field_found integer, dimension(4) :: siz character(len=64) :: fname = 'INPUT/physics_driver.res.nc' real, dimension(size(convect,1), size(convect,2)) :: r_convect !-------------------------------------------------------------------- ! local variables: ! ! vers restart version number if that is contained in ! file; otherwise the first word of first data ! record of file ! was_doing_strat logical indicating if strat_cloud_mod was ! active in job which wrote restart file ! was_doing_edt logical indicating if edt_mod was active ! in job which wrote restart file ! was_doing_entrain logical indicating if entrain_mod was active ! in job which wrote restart file ! !--------------------------------------------------------------------- if(file_exist(fname)) then if(mpp_pe() == mpp_root_pe()) call mpp_error ('physics_driver_mod', & 'Reading NetCDF formatted restart file: INPUT/physics_driver.res.nc', NOTE) call read_data(fname, 'vers', vers, no_domain=.true.) call read_data(fname, 'doing_strat', was_doing_strat, no_domain=.true.) call read_data(fname, 'doing_edt', was_doing_edt, no_domain=.true.) call read_data(fname, 'doing_entrain', was_doing_entrain, no_domain=.true.) !--------------------------------------------------------------------- ! read the contribution to diffusion coefficient from cumulus ! momentum transport. !--------------------------------------------------------------------- call read_data (fname, 'diff_cu_mo', diff_cu_mo) !--------------------------------------------------------------------- ! pbl top is present in file versions 2 and up. if not present, ! set a flag. !--------------------------------------------------------------------- call read_data (fname, 'pbltop', pbltop) call field_size (fname, 'cush', siz, field_found = field_found) if (field_found) then call read_data (fname, 'cush', cush) !miz call read_data (fname, 'cbmf', cbmf) !miz else cush = -1. !miz cbmf = 0.0 !miz endif !--------------------------------------------------------------------- ! the temperature and momentum diffusion coefficients are present ! beginning with v3. if not prsent, set to 0.0. !--------------------------------------------------------------------- call read_data (fname, 'diff_t', diff_t) call read_data (fname, 'diff_m', diff_m) !--------------------------------------------------------------------- ! a flag indicating columns in which convection is occurring is ! present beginning with v4. if not present, set it to .false. !--------------------------------------------------------------------- convect = .false. r_convect = 0. call read_data (fname, 'convect', r_convect) where(r_convect .GT. 0.) convect = .true. end where !--------------------------------------------------------------------- ! donner_deep cell and meso cloud variables may be present in ! versions 6 onward, if donner_deep_mod ! was active in the job writing the .res file. !--------------------------------------------------------------------- if (doing_donner) then call field_size (fname, 'cell_cloud_frac', siz, & field_found = field_found) if (field_found) then call read_data (fname, 'cell_cloud_frac', cell_cld_frac) call read_data (fname, 'cell_liquid_amt', cell_liq_amt ) call read_data (fname, 'cell_liquid_size', cell_liq_size) call read_data (fname, 'cell_ice_amt', cell_ice_amt ) call read_data (fname, 'cell_ice_size', cell_ice_size) call read_data (fname, 'meso_cloud_frac', meso_cld_frac) call read_data (fname, 'meso_liquid_amt', meso_liq_amt ) call read_data (fname, 'meso_liquid_size', meso_liq_size) call read_data (fname, 'meso_ice_amt', meso_ice_amt ) call read_data (fname, 'meso_ice_size', meso_ice_size) call read_data (fname, 'nsum', nsum_out) !--------------------------------------------------------------------- ! if donner_deep_mod was not active in the job which wrote the ! restart file but it is active in the current job, initialize ! these variables and put a message in the output file. !--------------------------------------------------------------------- else cell_cld_frac = 0. cell_liq_amt = 0. cell_liq_size = 0. cell_ice_amt = 0. cell_ice_size = 0. meso_cld_frac = 0. meso_liq_amt = 0. meso_liq_size = 0. meso_ice_amt = 0. meso_ice_size = 0. nsum_out = 1 call error_mesg ('physics_driver_mod', & ' initializing donner cloud variables, since they are not present'//& ' in physics_driver.res.nc file', NOTE) endif ! (field_found) endif ! (doing_donner) !--------------------------------------------------------------------- ! lsc cloud variables will be present in versions 8 onward. !--------------------------------------------------------------------- call field_size (fname, 'lsc_cloud_area', siz, & field_found = field_found) if (field_found) then call read_data (fname, 'lsc_cloud_area', lsc_cloud_area) call read_data (fname, 'lsc_liquid', lsc_liquid ) call read_data (fname, 'lsc_ice', lsc_ice ) call read_data (fname, 'lsc_droplet_number', lsc_droplet_number) !--------------------------------------------------------------------- ! if fields are not present, set a flag so that values from the ! tracer array are supplied to the radiation package, and ! put a message in the output file. !--------------------------------------------------------------------- else lsc_cloud_area = -99. lsc_liquid = -99. lsc_ice = -99. lsc_droplet_number = -99. call error_mesg ('physics_driver_mod', & ' initial radiation call will use lsc tracer fields; & &thus the lsc cloud area field may not be compatible & &with the areas assigned to convective clouds', NOTE) endif ! (field_found) !--------------------------------------------------------------------- ! uw_conv cloud variables may be present in ! versions 7 onward, if uw_conv_mod ! was active in the job writing the .res file. !--------------------------------------------------------------------- if (doing_uw_conv) then call field_size (fname, 'shallow_cloud_area', siz, & field_found = field_found) if (field_found) then call read_data (fname, 'shallow_cloud_area', shallow_cloud_area) call read_data (fname, 'shallow_liquid', shallow_liquid ) call read_data (fname, 'shallow_ice', shallow_ice ) call read_data (fname, 'shallow_droplet_number', shallow_droplet_number) !--------------------------------------------------------------------- ! if uw_conv_mod was not active in the job which wrote the ! restart file but it is active in the current job, initialize ! these variables and put a message in the output file. !--------------------------------------------------------------------- else shallow_cloud_area = 0. shallow_liquid = 0. shallow_ice = 0. shallow_droplet_number = 0. call error_mesg ('physics_driver_mod', & ' initializing uw_conv cloud variables, since they are not present'//& ' in physics_driver.res.nc file', NOTE) endif ! (field_found) endif ! (doing_uw_conv) !--------------------------------------------------------------------- ! radturbten may be present in versions 5 onward, if strat_cloud_mod ! was active in the job writing the .res file. !--------------------------------------------------------------------- !-------------------------------------------------------------------- ! if radturbten was written, read it. !-------------------------------------------------------------------- if (was_doing_strat .GT. 0.) then call read_data (fname, 'radturbten', radturbten) !--------------------------------------------------------------------- ! if strat_cloud_mod was not active in the job which wrote the ! restart file but it is active in the current job, initialize ! radturbten to 0.0 and put a message in the output file. !--------------------------------------------------------------------- else if (doing_strat()) then radturbten = 0.0 call error_mesg ('physics_driver_mod', & ' initializing radturbten to 0.0, since it not present'//& ' in physics_driver.res.nc file', NOTE) endif endif !-------------------------------------------------------------------- ! if lw_tendency was written, read it. !-------------------------------------------------------------------- if (was_doing_edt .GT. 0. .or. was_doing_entrain .GT. 0.) then call read_data (fname, 'lw_tendency', lw_tendency) !--------------------------------------------------------------------- ! if edt_mod or entrain_mod was not active in the job which wrote the ! restart file but it is active in the current job, initialize ! lw_tendency to 0.0 and put a message in the output file. !--------------------------------------------------------------------- else if (doing_edt .or. doing_entrain ) then lw_tendency = 0.0 call error_mesg ('physics_driver_mod', & ' initializing lw_tendency to 0.0, since it not present'//& ' in physics_driver.res.nc file', NOTE) endif endif endif !---------------------------------------------------------------------- end subroutine read_restart_nc !##################################################################### ! ! ! check_args determines if the input arrays to physics_driver_down ! are of a consistent size. ! ! ! check_args determines if the input arrays to physics_driver_down ! are of a consistent size. ! ! ! ! array of model latitudes at model points [radians] ! ! ! array of model longitudes at model points [radians] ! ! ! grid box area - current not used ! ! ! pressure at model interface levels (offset from t,q,u,v,r) ! ! ! pressure at full levels ! ! ! height at model interface levels ! ! ! height at full levels ! ! ! zonal wind at current time step ! ! ! meridional wind at current time step ! ! ! temperature at current time step ! ! ! specific humidity at current time step ! ! ! multiple 3d tracer fields at current time step ! ! ! zonal wind at previous time step ! ! ! meridional wind at previous time step ! ! ! temperature at previous time step ! ! ! specific humidity at previous time step ! ! ! multiple 3d tracer fields at previous time step ! ! ! zonal wind tendency ! ! ! meridional wind tendency ! ! ! temperature tendency ! ! ! moisture tracer tendencies ! ! ! multiple tracer tendencies ! ! ! OPTIONAL: present when running eta vertical coordinate, ! index of lowest model level above ground ! ! ! OPTIONAL: present when running eta vertical coordinate, ! mask to remove points below ground ! ! ! subroutine check_args (lat, lon, area, p_half, p_full, z_half, z_full,& u, v, t, q, r, um, vm, tm, qm, rm, & udt, vdt, tdt, qdt, rdt, mask, kbot) !---------------------------------------------------------------------- ! check_args determines if the input arrays to physics_driver_down ! are of a consistent size. !----------------------------------------------------------------------- real, dimension(:,:), intent(in) :: lat, lon, area real, dimension(:,:,:), intent(in) :: p_half, p_full, & z_half, z_full, & u, v, t, q, um, vm, & tm, qm real, dimension(:,:,:,:),intent(in) :: r, rm real, dimension(:,:,:), intent(in) :: udt, vdt, tdt, qdt real, dimension(:,:,:,:),intent(in) :: rdt real, dimension(:,:,:), intent(in),optional :: mask integer, dimension(:,:), intent(in),optional :: kbot !----------------------------------------------------------------------- ! intent(in) variables: ! ! lat latitude of model points [ radians ] ! lon longitude of model points [ radians ] ! area grid box area - currently not used [ m**2 ] ! p_half pressure at half levels (offset from t,q,u,v,r) ! [ Pa ] ! p_full pressure at full levels [ Pa } ! z_half height at half levels [ m ] ! z_full height at full levels [ m ] ! u zonal wind at current time step [ m / s ] ! v meridional wind at current time step [ m / s ] ! t temperature at current time step [ deg k ] ! q specific humidity at current time step kg / kg ] ! r multiple 3d tracer fields at current time step ! um,vm zonal and meridional wind at previous time step ! tm,qm temperature and specific humidity at previous ! time step ! rm multiple 3d tracer fields at previous time step ! udt zonal wind tendency [ m / s**2 ] ! vdt meridional wind tendency [ m / s**2 ] ! tdt temperature tendency [ deg k / sec ] ! qdt specific humidity tendency ! [ kg vapor / kg air / sec ] ! rdt multiple tracer tendencies [ unit / unit / sec ] ! ! intent(in), optional: ! ! mask mask that designates which levels do not have data ! present (i.e., below ground); 0.=no data, 1.=data ! kbot lowest level which has data ! note: both mask and kbot must be present together. ! !--------------------------------------------------------------------- !---------------------------------------------------------------------- ! local variables: integer :: id, jd, kd ! model dimensions on the processor integer :: ierr ! error flag !-------------------------------------------------------------------- ! define the sizes that the arrays should be. !-------------------------------------------------------------------- id = size(u,1) jd = size(u,2) kd = size(u,3) !-------------------------------------------------------------------- ! check the dimensions of each input array. if they are incompat- ! ible in size with the standard, the error flag is set to so ! indicate. !-------------------------------------------------------------------- ierr = 0 ierr = ierr + check_dim (lat, 'lat', id,jd) ierr = ierr + check_dim (lon, 'lon', id,jd) ierr = ierr + check_dim (area,'area', id,jd) ierr = ierr + check_dim (p_half,'p_half', id,jd,kd+1) ierr = ierr + check_dim (p_full,'p_full', id,jd,kd) ierr = ierr + check_dim (z_half,'z_half', id,jd,kd+1) ierr = ierr + check_dim (z_full,'z_full', id,jd,kd) ierr = ierr + check_dim (u, 'u', id,jd,kd) ierr = ierr + check_dim (v, 'v', id,jd,kd) ierr = ierr + check_dim (t, 't', id,jd,kd) ierr = ierr + check_dim (q, 'q', id,jd,kd) ierr = ierr + check_dim (um,'um', id,jd,kd) ierr = ierr + check_dim (vm,'vm', id,jd,kd) ierr = ierr + check_dim (tm,'tm', id,jd,kd) ierr = ierr + check_dim (qm,'qm', id,jd,kd) ierr = ierr + check_dim (udt,'udt', id,jd,kd) ierr = ierr + check_dim (vdt,'vdt', id,jd,kd) ierr = ierr + check_dim (tdt,'tdt', id,jd,kd) ierr = ierr + check_dim (qdt,'qdt', id,jd,kd) if (nt > 0) then ierr = ierr + check_dim (r, 'r', id,jd,kd,nt) ierr = ierr + check_dim (rm, 'rm', id,jd,kd,nt) endif if (ntp > 0) then ierr = ierr + check_dim (rdt,'rdt', id,jd,kd,ntp) endif !-------------------------------------------------------------------- ! if any problems were detected, exit with an error message. !-------------------------------------------------------------------- if (ierr > 0) then call error_mesg ('physics_driver_mod', 'bad dimensions', FATAL) endif !----------------------------------------------------------------------- end subroutine check_args !####################################################################### ! ! ! check_dim_2d compares the size of two-dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. ! ! ! check_dim_2d compares the size of two-dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. ! ! ! ! array of data to be checked ! ! ! name associated with array to be checked ! ! ! expected i and j dimensions ! ! ! function check_dim_2d (data,name,id,jd) result (ierr) !-------------------------------------------------------------------- ! check_dim_2d compares the size of two-dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. !-------------------------------------------------------------------- real, intent(in), dimension(:,:) :: data character(len=*), intent(in) :: name integer, intent(in) :: id, jd integer :: ierr !--------------------------------------------------------------------- ! intent(in) variables: ! ! data array to be checked ! name name associated with array to be checked ! id, jd expected i and j dimensions ! ! result variable: ! ! ierr set to 0 if ok, otherwise is a count of the number ! of incompatible dimensions ! !-------------------------------------------------------------------- ierr = 0 if (size(data,1) /= id) then call error_mesg ('physics_driver_mod', & 'dimension 1 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif if (size(data,2) /= jd) then call error_mesg ('physics_driver_mod', & 'dimension 2 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif !---------------------------------------------------------------------- end function check_dim_2d !####################################################################### ! ! ! check_dim_3d compares the size of three-dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. ! ! ! check_dim_3d compares the size of three-dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. ! ! ! ! array of data to be checked ! ! ! name associated with array to be checked ! ! ! expected i, j and k dimensions ! ! ! function check_dim_3d (data,name,id,jd,kd) result (ierr) !-------------------------------------------------------------------- ! check_dim_3d compares the size of thr1eedimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. !-------------------------------------------------------------------- real, intent(in), dimension(:,:,:) :: data character(len=*), intent(in) :: name integer, intent(in) :: id, jd, kd integer ierr !--------------------------------------------------------------------- ! intent(in) variables: ! ! data array to be checked ! name name associated with array to be checked ! id, jd,kd expected i, j and k dimensions ! ! result variable: ! ! ierr set to 0 if ok, otherwise is a count of the number ! of incompatible dimensions ! !-------------------------------------------------------------------- ierr = 0 if (size(data,1) /= id) then call error_mesg ('physics_driver_mod', & 'dimension 1 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif if (size(data,2) /= jd) then call error_mesg ('physics_driver_mod', & 'dimension 2 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif if (size(data,3) /= kd) then call error_mesg ('physics_driver_mod', & 'dimension 3 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif !--------------------------------------------------------------------- end function check_dim_3d !####################################################################### ! ! ! check_dim_4d compares the size of four-dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. ! ! ! check_dim_4d compares the size of four-dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. ! ! ! ! array of data to be checked ! ! ! name associated with array to be checked ! ! ! expected i, j, k and 4th dimensions ! ! ! function check_dim_4d (data,name,id,jd,kd,nt) result (ierr) !-------------------------------------------------------------------- ! check_dim_4d compares the size of four dimensional input arrays ! with supplied expected dimensions and returns an error if any ! inconsistency is found. !-------------------------------------------------------------------- real, intent(in), dimension(:,:,:,:) :: data character(len=*), intent(in) :: name integer, intent(in) :: id, jd, kd, nt integer :: ierr !--------------------------------------------------------------------- ! intent(in) variables: ! ! data array to be checked ! name name associated with array to be checked ! id,jd,kd,nt expected i, j and k dimensions ! ! result variable: ! ! ierr set to 0 if ok, otherwise is a count of the number ! of incompatible dimensions ! !-------------------------------------------------------------------- ierr = 0 if (size(data,1) /= id) then call error_mesg ('physics_driver_mod', & 'dimension 1 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif if (size(data,2) /= jd) then call error_mesg ('physics_driver_mod', & 'dimension 2 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif if (size(data,3) /= kd) then call error_mesg ('physics_driver_mod', & 'dimension 3 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif if (size(data,4) /= nt) then call error_mesg ('physics_driver_mod', & 'dimension 4 of argument ' // & name(1:len_trim(name)) // ' has wrong size.', NOTE) ierr = ierr + 1 endif !--------------------------------------------------------------------- end function check_dim_4d !####################################################################### end module physics_driver_mod