#include "cosp_defs.H" module cosp_driver_mod ! (c) British Crown Copyright 2008, the Met Office. ! All rights reserved. ! ! Redistribution and use in source and binary forms, with or without modification, are permitted ! provided that the following conditions are met: ! ! * Redistributions of source code must retain the above copyright notice, this list ! of conditions and the following disclaimer. ! * Redistributions in binary form must reproduce the above copyright notice, this list ! of conditions and the following disclaimer in the documentation and/or other materials ! provided with the distribution. ! * Neither the name of the Met Office nor the names of its contributors may be used ! to endorse or promote products derived from this software without specific prior written ! permission. ! ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR ! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR ! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER ! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. use mpp_mod, only: input_nml_file use fms_mod, only: open_namelist_file, open_file, & close_file, error_mesg, FATAL, & file_exist, mpp_pe, mpp_root_pe, & check_nml_error, write_version_number, & stdlog use sat_vapor_pres_mod, only: compute_qs use time_manager_mod, only: set_date, time_type, operator (+), & operator(-), operator(<), & operator(>), operator(<=), & operator(>=), get_date, print_date, & get_calendar_type, NOLEAP, & assignment(=), set_time USE MOD_COSP_TYPES, only: cosp_config, cosp_gridbox, & cosp_subgrid, cosp_sgradar, & cosp_sglidar, cosp_isccp, & #ifdef RTTOV cosp_rttov, & #endif cosp_vgrid, cosp_radarstats, & cosp_lidarstats, & cosp_sghydro, cosp_misr, & construct_cosp_gridbox, & construct_cosp_misr, & construct_cosp_vgrid, & construct_cosp_subgrid, & construct_cosp_sghydro, & construct_cosp_sgradar, & construct_cosp_radarstats, & construct_cosp_sglidar, & construct_cosp_lidarstats, & construct_cosp_isccp, & #ifdef RTTOV construct_cosp_rttov, & free_cosp_rttov, & #endif free_cosp_gridbox, & free_cosp_misr, & free_cosp_vgrid, & free_cosp_subgrid, & free_cosp_sghydro, & free_cosp_sgradar, & free_cosp_radarstats, & free_cosp_sglidar, & free_cosp_lidarstats, & free_cosp_isccp USE MOD_COSP, only: cosp USE MOD_COSP_IO, only: read_cosp_output_nl, & map_ll_to_point, map_point_to_ll use MOD_COSP_CONSTANTS, only: PARASOL_NREFL, I_LSCLIQ, I_LSCICE, & I_CVCLIQ, I_CVCICE, I_LSGRPL, & I_LSRAIN, I_LSSNOW, I_CVRAIN, I_CVSNOW,& N_HYDRO, RTTOV_MAX_CHANNELS use MOD_COSP_Modis_Simulator, only: COSP_MODIS, FREE_COSP_MODIS, & CONSTRUCT_COSP_MODIS use cosp_diagnostics_mod, only: cosp_diagnostics_init, & cosp_diagnostics_time_vary, & output_cosp_fields, & cosp_diagnostics_endts, & cosp_diagnostics_end use mod_cosp_utils, only: flip_vert_index IMPLICIT NONE public cosp_driver, cosp_driver_init, cosp_driver_end, cosp_driver_endts, & cosp_driver_time_vary !--------------------------------------------------------------------- !----------- version number for this module -------------------------- character(len=128) :: version = '$Id: cosp_driver.F90,v 20.0 2013/12/13 23:15:41 fms Exp $' character(len=128) :: tagname = '$Name: tikal $' !--------------------------------------------------------------------- !namelist variables character(len=512) :: finput ! Input file name, not used in FMS character(len=512) :: cmor_nl = ' ' ! not used in FMS integer :: overlap = 3 ! overlap type: 1=max, 2=rand, 3=max/rand integer :: isccp_topheight = 1 ! 1 = adjust top height using both a computed ! infrared brightness temperature and the visible ! optical depth to adjust cloud top pressure. Note ! that this calculation is most appropriate to ! compare to ISCCP data during sunlit hours. ! 2 = do not adjust top height, that is cloud top ! pressure is the actual cloud top pressure ! in the model ! 3 = adjust top height using only the computed ! infrared brightness temperature. Note that this ! calculation is most appropriate to compare to ! ISCCP IR only algortihm (i.e. you can compare to ! nighttime ISCCP data with this option) integer :: isccp_topheight_direction = 2 ! direction for finding atmosphere pressure level ! with interpolated temperature equal to the ! radiance determined cloud-top temperature ! 1 = find the *lowest* altitude (highest pressure) ! level with interpolated temperature equal to the ! radiance determined cloud-top temperature ! 2 = find the *highest* altitude (lowest pressure) ! level with interpolated temperature equal to the ! radiance determined cloud-top temperature ! ONLY APPLICABLE IF top_height EQUALS 1 or 3 integer :: Nlr = 40 ! Number of levels in statistical outputs integer :: Npoints_it = 20000 ! Max number of gridpoints to be processed in ! one iteration real :: radar_freq = 94. ! CloudSat radar frequency (GHz) real :: k2= -1. ! |K|^2, -1=use frequency dependent default integer :: surface_radar = 0 ! surface=1, spaceborne=0 integer :: use_mie_tables = 0 ! use a precomputed lookup table? yes=1,no=0 integer :: use_gas_abs = 1 ! include gaseous absorption? yes=1,no=0 integer :: do_ray = 0 ! calculate/output Rayleigh refl=1, not=0 integer :: melt_lay = 0 ! melting layer model off=0, on=1 integer :: Nprmts_max_hydro = 12 ! Max number of parameters for hydrometeor ! size distributions integer :: Naero = 1 ! Number of aerosol species (Not used) integer :: Nprmts_max_aero = 1 ! Max number of parameters for aerosol ! size distributions (Not used) integer :: lidar_ice_type = 0 ! Ice particle shape in lidar calculations ! (0=ice-spheres ; 1=ice-non-spherical) logical :: use_vgrid = .true. ! Use fixed vertical grid for outputs? ! (if .true. then you need to define number ! of levels with Nlr) logical :: csat_vgrid =.true. ! CloudSat vertical? ! (if .true. then the CloudSat standard grid ! is used for the outputs. logical :: use_precipitation_fluxes =.true. ! True if precipitation fluxes are input ! to the algorithm logical :: use_reff =.true. ! True if you want effective radius to be ! used by radar simulator (always used ! by lidar) logical :: use_input_file = .false. logical :: produce_cmor_output_fields = .false. real :: emsfc_lw_nml=0.94 logical :: use_rh_wrt_liq = .true. !------------------------------------------------------------------------- !-------------- RTTOV inputs !------------------------------------------------------------------------- integer :: platform = 1 ! satellite platform integer :: satellite = 15 ! satellite integer :: Instrument = 0 ! instrument integer :: Nchannels = 8 ! Number of channels to be computed real :: ZenAng = 50. ! Satellite Zenith Angle real :: co2 = 5.241e-04 ! mixing ratio of trace gas real :: ch4 = 9.139e-07 ! mixing ratio of trace gas real :: n2o = 4.665e-07 ! mixing ratio of trace gas real :: co = 2.098e-07 ! mixing ratio of trace gas integer,dimension(RTTOV_MAX_CHANNELS) :: Channels = 0 ! Channel numbers (please be sure that ! you supply Nchannels) real,dimension(RTTOV_MAX_CHANNELS) :: Surfem = 0.0 ! Surface emissivity (please be sure that ! you supply Nchannels) namelist/COSP_INPUT/cmor_nl,overlap,isccp_topheight, & isccp_topheight_direction, & use_vgrid,nlr,csat_vgrid, & npoints_it,finput, & radar_freq,surface_radar,use_mie_tables, & use_input_file, produce_cmor_output_fields, & emsfc_lw_nml, use_rh_wrt_liq, & use_gas_abs,do_ray,melt_lay,k2,Nprmts_max_hydro, & Naero,Nprmts_max_aero,lidar_ice_type, & use_precipitation_fluxes,use_reff, & platform,satellite,Instrument,Nchannels, & Channels,Surfem,ZenAng,co2,ch4,n2o,co ! Local variables character(len=64) :: cosp_output_nl='cosp_output_nl.txt' integer :: Ncolumns ! Number of subcolumns in SCOPS integer :: Nlevels ! Number of levels type(cosp_config) :: cfg ! Configuration options integer :: geomode real :: emsfc_lw double precision :: time=1.D0 double precision :: time_bnds(2)= (0.5D0, 1.5D0) !---------------- End of declaration of variables -------------- contains !###################################################################### subroutine cosp_driver_init (lonb, latb, Time_diag, axes, kd_in, ncol_in) real, dimension(:,:), intent(in) :: lonb, latb type(time_type), intent(in) :: Time_diag integer, dimension(4), intent(in) :: axes integer, intent(in) :: kd_in, ncol_in integer :: io, unit, ierr, logunit integer :: imax, jmax #ifdef INTERNAL_FILE_NML read (input_nml_file, nml=cosp_input, iostat=io) ierr = check_nml_error(io,"cosp_input") #else !--------------------------------------------------------------------- ! read namelist. !--------------------------------------------------------------------- if ( file_exist('input.nml')) then unit = open_namelist_file () ierr=1; do while (ierr /= 0) read (unit, nml=cosp_input, iostat=io, end=10) ierr = check_nml_error(io,'cosp_input') enddo 10 call close_file (unit) endif #endif !--------------------------------------------------------------------- ! write namelist to logfile. !--------------------------------------------------------------------- call write_version_number(version, tagname) logunit = stdlog() if (mpp_pe() == mpp_root_pe() ) & write (logunit, nml=cosp_input) if (use_mie_tables /= 0) then call error_mesg ('cosp_driver', & 'use_mie_tables must be set to 0 currently', FATAL) endif nlevels = kd_in ncolumns = ncol_in imax = size(lonb,1) - 1 jmax = size(lonb,2) - 1 call read_cosp_output_nl(cosp_output_nl,cfg) call cosp_diagnostics_init & (imax, jmax, Time_diag, axes, nlevels, ncolumns, cfg, & use_vgrid, csat_vgrid, nlr) !--------------------------------------------------------------------- ! COSP takes a single, spacially independent value for surface ! emissivity. it may be supplied via namelist. !--------------------------------------------------------------------- emsfc_lw = emsfc_lw_nml !-------------------------------------------------------------------- ! variable geomode indicates that the grid (i,j) => (lon,lat) !-------------------------------------------------------------------- geomode = 2 end subroutine cosp_driver_init !###################################################################### subroutine cosp_driver_time_vary (Time_diag) type(time_type), intent(in) :: Time_diag call cosp_diagnostics_time_vary (Time_diag) end subroutine cosp_driver_time_vary !###################################################################### subroutine cosp_driver_endts call cosp_diagnostics_endts end subroutine cosp_driver_endts !#################################################################### subroutine cosp_driver & (lat_in, lon_in, daytime_in, phalf_plus, p_full_in, zhalf_plus,& z_full_in, u_wind_in, v_wind_in, mr_ozone_in, & T_in, sh_in, tca_in, cca_in, lsliq_in, lsice_in, ccliq_in, & ccice_in, fl_lsrain_in, fl_lssnow_in, fl_lsgrpl_in, & fl_ccrain_in, & fl_ccsnow_in, reff_lsclliq_in, reff_lsclice_in, & reff_lsprliq_in, reff_lsprice_in, reff_ccclliq_in, & reff_ccclice_in, reff_ccprliq_in, reff_ccprice_in, & skt_in, land_in, Time_diag, is, js, stoch_mr_liq_in, & stoch_mr_ice_in, stoch_size_liq_in, stoch_size_frz_in, & tau_stoch_in, lwem_stoch_in, stoch_cloud_type_in) !-------------------------------------------------------------------- ! subroutine cosp_driver is the interface between the cosp simulator ! code and the AM model. !-------------------------------------------------------------------- real, dimension(:,:), intent(in) :: lat_in, lon_in, skt_in, land_in, & u_wind_in, v_wind_in real, dimension(:,:), intent(in) :: daytime_in real, dimension(:,:,:), intent(in) :: phalf_plus, p_full_in, & zhalf_plus, z_full_in, T_in, sh_in, & tca_in, cca_in, lsliq_in, lsice_in, ccliq_in, ccice_in, & fl_lsrain_in, fl_lssnow_in, fl_lsgrpl_in, fl_ccrain_in, & fl_ccsnow_in, mr_ozone_in, & reff_lsclliq_in, reff_lsclice_in, reff_lsprliq_in, & reff_lsprice_in, reff_ccclliq_in, reff_ccclice_in, & reff_ccprliq_in, reff_ccprice_in real, dimension(:,:,:,:), intent(in), optional :: & tau_stoch_in, lwem_stoch_in, stoch_cloud_type_in, & stoch_mr_liq_in, stoch_mr_ice_in, stoch_size_liq_in, & stoch_size_frz_in type(time_type), intent(in) :: Time_diag !local variables: integer, intent(in) :: is, js real, dimension(size(T_in,1)*size(T_in,2), size(T_in,3), & ncolumns) :: y3, y3a, y4, y5, y6, y7, y8 integer :: i, j, n, l integer :: k type(cosp_gridbox) :: gbx ! Gridbox information. Input for COSP type(cosp_subgrid) :: sgx ! Subgrid outputs type(cosp_sghydro) :: sghydro ! Subgrid condensate type(cosp_sgradar) :: sgradar ! Output from radar simulator type(cosp_sglidar) :: sglidar ! Output from lidar simulator type(cosp_isccp) :: isccp ! Output from ISCCP simulator type(cosp_modis) :: modis ! Output from MODIS simulator type(cosp_misr) :: misr ! Output from MISR simulator #ifdef RTTOV type(cosp_rttov) :: rttov ! Output from RTTOV #endif type(cosp_vgrid) :: vgrid ! Information on vertical grid of stats type(cosp_radarstats) :: stradar ! Summary statistics from radar simulator type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator real, dimension ( size(T_in,1)*size(T_in,2), size(T_in,3)) :: & fl_lsrain, & fl_lssnow, fl_lsgrpl, fl_ccrain, fl_ccsnow real, dimension ( size(T_in,1)*size(T_in,2), & Ncolumns, size(T_in,3)) :: & cloud_type real, dimension ( size(T_in,1),size(T_in,2), size(T_in,3)) :: & p_half_in, z_half_in integer :: nlon,nlat,npoints !---------------- End of declaration of variables -------------- nlon = size(T_in,1) nlat = size(T_in,2) npoints = nlon*nlat p_half_in(:,:,1:size(T_in,3)) = phalf_plus(:,:,2:size(T_in,3)+1) z_half_in(:,:,1:size(T_in,3)) = zhalf_plus(:,:,2:size(T_in,3)+1) if (present (tau_stoch_in) .and. & present (lwem_stoch_in) .and. & present (stoch_cloud_type_in) .and. & present (stoch_mr_liq_in) .and. & present (stoch_mr_ice_in) .and. & present (stoch_size_liq_in) .and. & present (stoch_size_frz_in) ) then sgx%cols_input_from_model = .true. else sgx%cols_input_from_model = .false. endif call construct_cosp_gridbox & (time, time_bnds, radar_freq, surface_radar, use_mie_tables, & use_gas_abs, do_ray, melt_lay, k2, Npoints, Nlevels, & Ncolumns, N_HYDRO, Nprmts_max_hydro, Naero, Nprmts_max_aero, & Npoints_it, lidar_ice_type, isccp_topheight, & isccp_topheight_direction,overlap, emsfc_lw, & use_precipitation_fluxes, use_reff, & Platform, Satellite, Instrument, Nchannels, ZenAng, & channels(1:Nchannels), surfem(1:Nchannels), co2, ch4, n2o, co,& gbx) call produce_cosp_input_fields ( Npoints, Nlevels, N_hydro, & lon_in, lat_in, daytime_in, p_half_in, p_full_in, z_half_in, & z_full_in, u_wind_in, v_wind_in, mr_ozone_in, T_in, & sh_in, tca_in, & cca_in, lsliq_in, lsice_in, ccliq_in, ccice_in, & fl_lsrain_in, & fl_lssnow_in, fl_lsgrpl_in, fl_ccrain_in, fl_ccsnow_in, & reff_lsclliq_in, reff_lsclice_in, reff_lsprliq_in, & reff_lsprice_in, reff_ccclliq_in, reff_ccclice_in, & reff_ccprliq_in, reff_ccprice_in, tau_stoch_in, & lwem_stoch_in, stoch_cloud_type_in, skt_in, land_in, & cloud_type, gbx) !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Define new vertical grid !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ call construct_cosp_vgrid(gbx,Nlr,use_vgrid,csat_vgrid,vgrid) !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Allocate memory for other types !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ call construct_cosp_subgrid(Npoints, Ncolumns, Nlevels, sgx) call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,N_hydro,sghydro) if (sgx%cols_input_from_model) then !--------------------------------------------------------------------- ! convert the stochastic column inputs from lon-lat to npoints, then ! save the column values, reversing the vertical indices, into the ! cosp_subgrid_type variables. !--------------------------------------------------------------------- call map_ll_to_point(nlon,nlat,npoints, & x4= stoch_mr_liq_in, y3= y3 ) call map_ll_to_point(nlon,nlat,npoints, & x4= stoch_mr_ice_in (:,:,:,:), y3= y4 ) call map_ll_to_point(nlon,nlat,npoints, & x4= stoch_size_liq_in, y3= y5 ) call map_ll_to_point(nlon,nlat,npoints, & x4= stoch_size_frz_in, y3= y6 ) call map_ll_to_point(nlon,nlat,npoints, & x4= tau_stoch_in, y3= y7 ) call map_ll_to_point(nlon,nlat,npoints, & x4= lwem_stoch_in, y3= y8 ) call map_ll_to_point(nlon,nlat,npoints, & x4= stoch_cloud_type_in(:,:,:,:), y3= y3a ) do l=1, NCOLUMNS do k=1,nlevels do n=1,npoints if (y3a(n,k,l) == 1.0) then sghydro%mr_hydro(n,l,nlevels-k+1,I_LSCLIQ) = y3(n,k,l) sghydro%mr_hydro(n,l,nlevels+1-k,I_LSCICE) = y4(n,k,l) if ( sghydro%mr_hydro(n,l,nlevels-k+1,I_LSCLIQ) > 0.0) then sghydro%Reff(n,l,nlevels-k+1,I_LSCLIQ) = y5(n,k,l) else sghydro%Reff(n,l,nlevels+1-k,I_LSCLIQ) = 0.0 endif if (sghydro%mr_hydro(n,l,nlevels+1-k,I_LSCICE) > 0.0) then sghydro%Reff(n,l,nlevels+1-k,I_LSCICE) = y6(n,k,l) else sghydro%Reff(n,l,nlevels+1-k,I_LSCICE) = 0.0 endif else sghydro%mr_hydro(n,l,nlevels+1-k,I_LSCLIQ) = 0.0 sghydro%mr_hydro(n,l,nlevels+1-k,I_LSCICE) = 0.0 sghydro%Reff(n,l,nlevels+1-k,I_LSCLIQ) = 0.0 sghydro%Reff(n,l,nlevels+1-k,I_LSCICE) = 0.0 endif if (y3a(n,k,l) == 2.0) then sghydro%mr_hydro(n,l,nlevels+1-k,I_CVCLIQ) = y3(n,k,l) sghydro%mr_hydro(n,l,nlevels+1-k,I_CVCICE) = y4(n,k,l) if (sghydro%mr_hydro(n,l,nlevels+1-k,I_CVCLIQ) > 0.0) then sghydro%Reff(n,l,nlevels+1-k,I_CVCLIQ) = y5(n,k,l) else sghydro%Reff(n,l,nlevels+1-k,I_CVCLIQ) = 0.0 endif if (sghydro%mr_hydro(n,l,nlevels+1-k,I_CVCICE) > 0.0) then sghydro%Reff(n,l,nlevels+1-k,I_CVCICE) = y6(n,k,l) else sghydro%Reff(n,l,nlevels+1-k,I_CVCICE) = 0.0 endif else sghydro%mr_hydro(n,l,nlevels+1-k,I_CVCLIQ) = 0.0 sghydro%mr_hydro(n,l,nlevels+1-k,I_CVCICE) = 0.0 sghydro%Reff(n,l,nlevels+1-k,I_CVCLIQ) = 0.0 sghydro%Reff(n,l,nlevels+1-k,I_CVCICE) = 0.0 endif sgx%dtau_col(n,l,k) = y7(n,k,l) sgx%dem_col(n,l,k) = y8(n,k,l) end do end do end do endif call construct_cosp_sgradar & (cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,sgradar) call construct_cosp_radarstats & (cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar) call construct_cosp_sglidar & (cfg,Npoints,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar) call construct_cosp_lidarstats & (cfg,Npoints,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar) call construct_cosp_isccp & (cfg,Npoints,Ncolumns,Nlevels,isccp) call construct_cosp_modis & (cfg,Npoints,Ncolumns,modis) call construct_cosp_misr & (cfg,Npoints,misr) #ifdef RTTOV call construct_cosp_rttov & (Npoints,Nchannels,rttov) #endif !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Call simulator !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ if (Ncolumns == 1) then if (gbx%use_precipitation_fluxes) then call error_mesg ('cosp_driver:cosp_driver', & 'Use of precipitation fluxes not supported in& & CRM mode (Ncolumns=1)', FATAL) endif if ((maxval(gbx%dtau_c) > 0.0).or.(maxval(gbx%dem_c) > 0.0)) then call error_mesg ('cosp_driver:cosp_driver', & ' dtau_c > 0.0 or dem_c > 0.0. In CRM mode (Ncolumns=1) & &the optical depth (emmisivity) of all clouds must be & &passed through dtau_s (dem_s)', FATAL) endif endif !------------------------------------------------------------------------- ! save the grid-box mean of these fields for diagnostic output. The gbx% ! arrays will be changed to sub-column values in subroutine cosp. !------------------------------------------------------------------------ fl_lsrain = gbx%rain_ls fl_lssnow = gbx%snow_ls fl_lsgrpl = gbx%grpl_ls fl_ccrain = gbx%rain_cv fl_ccsnow = gbx%snow_cv #ifdef RTTOV call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar, & isccp,misr,modis,rttov,stradar,stlidar, sghydro, cloud_type) #else call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar, & isccp,misr,modis,stradar,stlidar, sghydro, cloud_type) #endif !------------------------------------------------------------------------- ! define the effective size of precipitation particles in the gridbox. ! each subcolumn with precip type will have the same size. !------------------------------------------------------------------------- gbx%Reff(:,:,I_LSRAIN) = 0. gbx%Reff(:,:,I_LSSNOW) = 0. gbx%Reff(:,:,I_LSGRPL) = 0. gbx%Reff(:,:,I_CVRAIN) = 0. gbx%Reff(:,:,I_CVSNOW) = 0. do l=1,Ncolumns gbx%Reff(:,:,I_LSRAIN) = & Max(sghydro%reff(:,l,:,I_LSRAIN), gbx%Reff(:,:,I_LSRAIN)) gbx%Reff(:,:,I_LSSNOW) = & Max(sghydro%reff(:,l,:,I_LSSNOW), gbx%Reff(:,:,I_LSSNOW)) gbx%Reff(:,:,I_LSGRPL) = & Max(sghydro%reff(:,l,:,I_LSGRPL), gbx%Reff(:,:,I_LSGRPL)) gbx%Reff(:,:,I_CVRAIN) = & Max(sghydro%reff(:,l,:,I_CVRAIN), gbx%Reff(:,:,I_CVRAIN)) gbx%Reff(:,:,I_CVSNOW) = & Max(sghydro%reff(:,l,:,I_CVSNOW), gbx%Reff(:,:,I_CVSNOW)) end do !------------------------------------------------------------------------- ! return these fields to grid-box mean values for diagnostic ! output purposes. !------------------------------------------------------------------------- gbx%rain_ls = fl_lsrain gbx%snow_ls = fl_lssnow gbx%grpl_ls = fl_lsgrpl gbx%rain_cv = fl_ccrain gbx%snow_cv = fl_ccsnow !------------------------------------------------------------------------- ! call output_cosp_fields to produce netcdf output of desired COSP fields. !------------------------------------------------------------------------- call output_cosp_fields (nlon, nlat, npoints, geomode, stlidar, & stradar, isccp, modis, misr, sgradar, & sglidar, sgx, Time_diag, is, js, & cloud_type, gbx, cfg, phalf_plus, zhalf_plus) !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Deallocate memory in derived types !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ call free_cosp_gridbox(gbx) call free_cosp_subgrid(sgx) call free_cosp_sghydro(sghydro) call free_cosp_sgradar(sgradar) call free_cosp_radarstats(stradar) call free_cosp_sglidar(sglidar) call free_cosp_lidarstats(stlidar) call free_cosp_isccp(isccp) call free_cosp_misr(misr) call free_cosp_modis(modis) #ifdef RTTOV call free_cosp_rttov(rttov) #endif call free_cosp_vgrid(vgrid) end subroutine cosp_driver !##################################################################### subroutine cosp_driver_end call cosp_diagnostics_end end subroutine cosp_driver_end !##################################################################### subroutine produce_cosp_input_fields & (Npnts, Nl, N_hydro, lon_in, lat_in, daytime_in, p_half_in, & p_full_in, z_half_in, z_full_in, u_wind_in, v_wind_in, & mr_ozone_in, T_in, sh_in, tca_in, cca_in, lsliq_in, & lsice_in, ccliq_in, ccice_in, fl_lsrain_in, fl_lssnow_in, & fl_lsgrpl_in, fl_ccrain_in, fl_ccsnow_in, reff_lsclliq_in, & reff_lsclice_in, reff_lsprliq_in, reff_lsprice_in, & reff_ccclliq_in, reff_ccclice_in, reff_ccprliq_in, & reff_ccprice_in, tau_stoch_in, lwem_stoch_in, & stoch_cloud_type_in, skt_in, land_in, cloud_type, gbx) !-------------------------------------------------------------------- ! subroutine produce_cosp_input_fields converts inputs from AM3 ! to the form needed by COSP. !-------------------------------------------------------------------- integer, intent(in) :: Npnts, Nl, N_hydro real,dimension(:,:), intent(in) :: lon_in,lat_in, skt_in, land_in,& u_wind_in, v_wind_in real, dimension(:,:), intent(in) :: daytime_in real,dimension(:,:,:), intent(in) :: & p_half_in, p_full_in, z_half_in, z_full_in, T_in, sh_in, & tca_in, cca_in, lsliq_in, lsice_in, ccliq_in, ccice_in, & fl_lsrain_in, fl_lssnow_in, fl_lsgrpl_in, fl_ccrain_in, & fl_ccsnow_in, mr_ozone_in, & reff_lsclliq_in, reff_lsclice_in, reff_lsprliq_in, & reff_lsprice_in, reff_ccclliq_in, reff_ccclice_in, & reff_ccprliq_in, reff_ccprice_in real,dimension(:,:,:,:),intent(in) :: tau_stoch_in, lwem_stoch_in, & stoch_cloud_type_in real,dimension(Npnts,Ncolumns,Nl), intent(out) :: cloud_type type(cosp_gridbox), intent(out) :: gbx ! Gridbox information. Input for COSP ! local variables: real,dimension(Npnts,Nl) :: y2 real,dimension(Npnts,Nl,Ncolumns) :: y3,y3a real, dimension(Npnts,Nl) :: qs real, dimension(size(T_in,1), size(T_in,2), size(T_in,3)) :: & qs_in, tau_stoch_mean, lwem_stoch_mean, tau_s_in, & tau_c_in, lwem_s_in, lwem_c_in integer :: nxdir, nydir, npts integer :: n, i, j, k real :: sum_s1, sum_s2, sum_c1, sum_c2 integer :: ctr_s, ctr_c !-------------------------------------------------------------------- ! define array dimensions; verify consistency. !-------------------------------------------------------------------- nxdir = size(lat_in,1) nydir = size(lat_in, 2) npts = nxdir*nydir if (npts /= Npnts) then call error_mesg ('cosp_driver/produce_cosp_input_fields', & 'ERROR -- i*j /= npts', FATAL) endif !--------------------------------------------------------------------- ! map the 2d lon-lat arrays to 1D (npoints). !--------------------------------------------------------------------- call map_ll_to_point(nxdir,nydir,npts,x2=daytime_in, y1=gbx%sunlit) call map_ll_to_point(nxdir,nydir,npts,x2=lat_in, y1=gbx%latitude) call map_ll_to_point(nxdir,nydir,npts,x2=lon_in, y1=gbx%longitude) call map_ll_to_point(nxdir,nydir,npts,x2=skt_in, y1=gbx%skt) call map_ll_to_point(nxdir,nydir,npts,x2=land_in, y1=gbx%land) call map_ll_to_point(nxdir,nydir,npts,x2=u_wind_in, y1=gbx%u_wind) call map_ll_to_point(nxdir,nydir,npts,x2=v_wind_in, y1=gbx%v_wind) !--------------------------------------------------------------------- ! map the 3d lon-lat-k arrays to 2D (npoints,k), and flip their ! vertical indices (index 1 nearest ground in COSP). !--------------------------------------------------------------------- call map_ll_to_point(nxdir,nydir,npts,x3=p_full_in, y2=y2) call flip_vert_index (y2, nl,gbx%p ) call map_ll_to_point(nxdir,nydir,npts,x3=p_half_in, y2=y2) call flip_vert_index (y2, nl,gbx%ph ) gbx%psfc = gbx%ph(:,1) call map_ll_to_point(nxdir,nydir,npts,x3=z_full_in, y2=y2) call flip_vert_index (y2, nl,gbx%zlev ) call map_ll_to_point(nxdir,nydir,npts,x3=z_half_in, y2=y2) call flip_vert_index (y2, nl,gbx%zlev_half ) call map_ll_to_point(nxdir,nydir,npts,x3=mr_ozone_in, y2=y2) call flip_vert_index (y2, nl,gbx%mr_ozone ) call map_ll_to_point(nxdir,nydir,npts,x3=T_in, y2=y2) call flip_vert_index (y2, nl,gbx%T ) call map_ll_to_point(nxdir,nydir,npts,x3=sh_in, y2=y2) call flip_vert_index (y2, nl,gbx%sh ) !--------------------------------------------------------------------- ! define surface height !--------------------------------------------------------------------- gbx%sfc_height(:) = gbx%zlev_half(:,1) !-------------------------------------------------------------------- ! compute qs and then the relative humidity. ! a limit my be imposed (nml control) to account for slightly inexact ! values near saturation. !-------------------------------------------------------------------- if (use_rh_wrt_liq) then call compute_qs (T_in, p_full_in, qs_in, q=sh_in, & es_over_liq = use_rh_wrt_liq) else call compute_qs (T_in, p_full_in, qs_in, q=sh_in) endif call map_ll_to_point(nxdir,nydir,npts,x3=qs_in, y2=y2) call flip_vert_index (y2, nl,qs ) gbx%q = gbx%sh/qs call map_ll_to_point(nxdir,nydir,npts,x3=tca_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%tca) call map_ll_to_point(nxdir,nydir,npts,x3=cca_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%cca) call map_ll_to_point(nxdir,nydir,npts,x3=lsliq_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%mr_hydro(:,:,I_LSCLIQ) ) call map_ll_to_point(nxdir,nydir,npts,x3=lsice_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%mr_hydro(:,:,I_LSCICE) ) call map_ll_to_point(nxdir,nydir,npts,x3=ccliq_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%mr_hydro(:,:,I_CVCLIQ) ) call map_ll_to_point(nxdir,nydir,npts,x3=ccice_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%mr_hydro(:,:,I_CVCICE) ) call map_ll_to_point(nxdir,nydir,npts,x3=fl_lsrain_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%rain_ls) call map_ll_to_point(nxdir,nydir,npts,x3=fl_lssnow_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%snow_ls) call map_ll_to_point(nxdir,nydir,npts,x3=fl_lsgrpl_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%grpl_ls) call map_ll_to_point(nxdir,nydir,npts,x3=fl_ccrain_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%rain_cv) call map_ll_to_point(nxdir,nydir,npts,x3=fl_ccsnow_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%snow_cv) call map_ll_to_point(nxdir,nydir,npts,x3=reff_lsclliq_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_lscliq )) call map_ll_to_point(nxdir,nydir,npts,x3=reff_lsclice_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_lscice )) call map_ll_to_point(nxdir,nydir,npts,x3=reff_lsprliq_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_lsrain )) call map_ll_to_point(nxdir,nydir,npts,x3=reff_lsprice_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_lssnow )) call map_ll_to_point(nxdir,nydir,npts,x3=reff_ccclliq_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_cvcliq )) call map_ll_to_point(nxdir,nydir,npts,x3=reff_ccclice_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_cvcice )) call map_ll_to_point(nxdir,nydir,npts,x3=reff_ccprliq_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_cvrain )) call map_ll_to_point(nxdir,nydir,npts,x3=reff_ccprice_in, y2=y2 ) call flip_vert_index (y2, nl,gbx%reff(:,:,i_cvsnow )) gbx%reff(:,:,i_lsgrpl) = 0.0 !--------------------------------------------------------------------- ! the values of tau and lwem are passed in for each stochastic column. ! here grid box mean values are obtained for the convective and ! large-scale components !--------------------------------------------------------------------- do k=1, size(tau_stoch_in,3) do j=1, size(tau_stoch_in,2) do i=1, size(tau_stoch_in,1) ctr_s = 0 ctr_c = 0 sum_s1 = 0. sum_c1 = 0. sum_s2 = 0. sum_c2 = 0. do n=1, size(tau_stoch_in,4) if (stoch_cloud_type_in(i,j,k,n) == 1. ) then ctr_s = ctr_s + 1 sum_s1 = sum_s1 + tau_stoch_in(i,j,k,n) sum_s2 = sum_s2 + lwem_stoch_in(i,j,k,n) else if(stoch_cloud_type_in(i,j,k,n) == 2. ) then ctr_c = ctr_c + 1 sum_c1 = sum_c1 + tau_stoch_in(i,j,k,n) sum_c2 = sum_c2 + lwem_stoch_in(i,j,k,n) endif end do if (ctr_s > 0) then tau_s_in(i,j,k) = sum_s1/ctr_s lwem_s_in(i,j,k) = sum_s2/ctr_s else tau_s_in(i,j,k) = 0. lwem_s_in(i,j,k) = 0. endif if (ctr_c > 0) then tau_c_in(i,j,k) = sum_c1/ctr_c lwem_c_in(i,j,k) = sum_c2/ctr_c else tau_c_in(i,j,k) = 0. lwem_c_in(i,j,k) = 0. endif end do end do end do call map_ll_to_point(nxdir,nydir,npts,x3=tau_s_in(:,:,:), y2=y2) call flip_vert_index (y2, nl,gbx%dtau_s ) call map_ll_to_point(nxdir,nydir,npts,x3=tau_c_in(:,:,:), y2=y2) call flip_vert_index (y2, nl,gbx%dtau_c ) call map_ll_to_point(nxdir,nydir,npts,x3=lwem_s_in(:,:,:), y2=y2) call flip_vert_index (y2, nl,gbx%dem_s) call map_ll_to_point(nxdir,nydir,npts,x3=lwem_c_in(:,:,:), y2=y2) call flip_vert_index (y2, nl,gbx%dem_c) !---------------------------------------------------------------------- ! stoch_cloud_type is not flipped here; it will be used in subroutine ! cosp where it is needed with index 1 being TOA. however the ! column and vertical indices do need to be reversed. !---------------------------------------------------------------------- call map_ll_to_point(nxdir,nydir,npts, & x4=stoch_cloud_type_in(:,:,:,:), y3=y3 ) do j=1,nl do i=1,Ncolumns cloud_type(:,i,j) = y3 (:,j,i) end do end do !######################################################################## end subroutine produce_cosp_input_fields !##################################################################### end module cosp_driver_mod