!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! ! Module pour remplir la variable "cospIN", calculs des proprietes optiques subcolumn ! pour les differents simulateurs ! !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% MODULE LMDZ_COSP_SUBSAMPLE_AND_OPTICS_MOD use cosp_kinds, only: wp USE MOD_COSP_CONFIG USE mod_quickbeam_optics, only: size_distribution,quickbeam_optics,gases use quickbeam, only: radar_cfg use MOD_COSP, only: cosp_optical_inputs,cosp_column_inputs USE mod_rng, ONLY: rng_state, init_rng USE mod_scops, ONLY: scops USE mod_prec_scops, ONLY: prec_scops USE MOD_COSP_UTILS, ONLY: cosp_precip_mxratio use cosp_optics, ONLY: cosp_simulator_optics,lidar_optics,modis_optics, & modis_optics_partition use mod_cosp_stats, ONLY: COSP_CHANGE_VERTICAL_GRID use lmdz_cosp_read_outputkeys, ONLY: cosp_config implicit none ! Indices to address arrays of LS and CONV hydrometeors integer,parameter :: & I_LSCLIQ = 1, & ! Large-scale (stratiform) liquid I_LSCICE = 2, & ! Large-scale (stratiform) ice I_LSRAIN = 3, & ! Large-scale (stratiform) rain I_LSSNOW = 4, & ! Large-scale (stratiform) snow I_CVCLIQ = 5, & ! Convective liquid I_CVCICE = 6, & ! Convective ice I_CVRAIN = 7, & ! Convective rain I_CVSNOW = 8, & ! Convective snow I_LSGRPL = 9 ! Large-scale (stratiform) groupel ! Stratiform and convective clouds in frac_out. integer, parameter :: & I_LSC = 1, & ! Large-scale clouds I_CVC = 2 ! Convective clouds ! Microphysical settings for the precipitation flux to mixing ratio conversion real(wp),parameter,dimension(N_HYDRO) :: & ! LSL LSI LSR LSS CVL CVI CVR CVS LSG N_ax = (/-1., -1., 8.e6, 3.e6, -1., -1., 8.e6, 3.e6, 4.e6/),& N_bx = (/-1., -1., 0.0, 0.0, -1., -1., 0.0, 0.0, 0.0/),& alpha_x = (/-1., -1., 0.0, 0.0, -1., -1., 0.0, 0.0, 0.0/),& c_x = (/-1., -1., 842.0, 4.84, -1., -1., 842.0, 4.84, 94.5/),& d_x = (/-1., -1., 0.8, 0.25, -1., -1., 0.8, 0.25, 0.5/),& g_x = (/-1., -1., 0.5, 0.5, -1., -1., 0.5, 0.5, 0.5/),& a_x = (/-1., -1., 524.0, 52.36, -1., -1., 524.0, 52.36, 209.44/),& b_x = (/-1., -1., 3.0, 3.0, -1., -1., 3.0, 3.0, 3.0/),& gamma_1 = (/-1., -1., 17.83725, 8.284701, -1., -1., 17.83725, 8.284701, 11.63230/),& gamma_2 = (/-1., -1., 6.0, 6.0, -1., -1., 6.0, 6.0, 6.0/),& gamma_3 = (/-1., -1., 2.0, 2.0, -1., -1., 2.0, 2.0, 2.0/),& gamma_4 = (/-1., -1., 6.0, 6.0, -1., -1., 6.0, 6.0, 6.0/) contains !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! SUBROUTINE subsample_and_optics !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% subroutine subsample_and_optics(cfg, nPoints, nLevels, nColumns, nHydro, overlap, & use_precipitation_fluxes, lidar_ice_type, sd, tca, cca, fl_lsrainIN, fl_lssnowIN, & fl_lsgrplIN, fl_ccrainIN, fl_ccsnowIN, mr_lsliq, mr_lsice, mr_ccliq, mr_ccice, & reffIN, dtau_c, dtau_s, dem_c, dem_s, cospstateIN, cospIN) ! Inputs integer,intent(in) :: nPoints, nLevels, nColumns, nHydro, overlap, lidar_ice_type real(wp),intent(in),dimension(nPoints,nLevels) :: tca,cca,mr_lsliq,mr_lsice,mr_ccliq, & mr_ccice,dtau_c,dtau_s,dem_c,dem_s,fl_lsrainIN,fl_lssnowIN,fl_lsgrplIN,fl_ccrainIN,& fl_ccsnowIN real(wp),intent(in),dimension(nPoints,nLevels,nHydro) :: reffIN logical,intent(in) :: use_precipitation_fluxes type(size_distribution),intent(inout) :: sd type(cosp_config),intent(in) :: cfg ! Configuration options ! Outputs type(cosp_optical_inputs),intent(inout) :: cospIN type(cosp_column_inputs),intent(inout) :: cospstateIN type(rng_state),allocatable,dimension(:) :: rngs ! Seeds for random number generator integer,dimension(:),allocatable :: seed integer,dimension(:),allocatable :: cloudsat_preclvl_index !PREC_BUG integer :: i,j,k real(wp),dimension(:,:), allocatable :: & ls_p_rate, cv_p_rate, frac_ls, frac_cv, prec_ls, prec_cv,g_vol real(wp),dimension(:,:,:), allocatable :: & frac_prec, MODIS_cloudWater, MODIS_cloudIce, fracPrecipIce, fracPrecipIce_statGrid,& MODIS_watersize,MODIS_iceSize, MODIS_opticalThicknessLiq,MODIS_opticalThicknessIce real(wp),dimension(:,:,:,:),allocatable :: & mr_hydro, Reff, Np real(wp),dimension(nPoints,nLevels) :: & column_frac_out, column_prec_out, fl_lsrain, fl_lssnow, fl_lsgrpl, fl_ccrain, fl_ccsnow ! real(wp),dimension(nPoints,nColumns,Nlvgrid_local) :: tempOut logical :: cmpGases=.true. if (Ncolumns .gt. 1) then !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! RNG used for subcolumn generation allocate(rngs(nPoints),seed(nPoints)) seed(:)=0 seed = int(cospstateIN%phalf(:,Nlevels+1)) ! In case of NPoints=1 ! *NOTE* Chunking will change the seed if (NPoints .gt. 1) seed=int((cospstateIN%phalf(:,Nlevels+1)-minval(cospstateIN%phalf(:,Nlevels+1)))/ & (maxval(cospstateIN%phalf(:,Nlevels+1))-minval(cospstateIN%phalf(:,Nlevels+1)))*100000) + 1 call init_rng(rngs, seed) ! Call scops call scops(NPoints,Nlevels,Ncolumns,rngs,tca,cca,overlap,cospIN%frac_out,0) deallocate(seed,rngs) ! Sum up precipitation rates allocate(ls_p_rate(nPoints,nLevels),cv_p_rate(nPoints,Nlevels)) if(use_precipitation_fluxes) then ls_p_rate(:,1:nLevels) = fl_lsrainIN + fl_lssnowIN + fl_lsgrplIN cv_p_rate(:,1:nLevels) = fl_ccrainIN + fl_ccsnowIN else ls_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) + mixing_ratio (groupel) cv_p_rate(:,1:nLevels) = 0 ! mixing_ratio(rain) + mixing_ratio(snow) endif ! Call PREC_SCOPS allocate(frac_prec(nPoints,nColumns,nLevels)) call prec_scops(nPoints,nLevels,nColumns,ls_p_rate,cv_p_rate,cospIN%frac_out,frac_prec) deallocate(ls_p_rate,cv_p_rate) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Compute fraction in each gridbox for precipitation and cloud type. !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Allocate allocate(frac_ls(nPoints,nLevels),prec_ls(nPoints,nLevels), & frac_cv(nPoints,nLevels),prec_cv(nPoints,nLevels)) ! Initialize frac_ls(1:nPoints,1:nLevels) = 0._wp prec_ls(1:nPoints,1:nLevels) = 0._wp frac_cv(1:nPoints,1:nLevels) = 0._wp prec_cv(1:nPoints,1:nLevels) = 0._wp do j=1,nPoints do k=1,nLevels do i=1,nColumns if (cospIN%frac_out(j,i,k) .eq. 1) frac_ls(j,k) = frac_ls(j,k)+1._wp if (cospIN%frac_out(j,i,k) .eq. 2) frac_cv(j,k) = frac_cv(j,k)+1._wp if (frac_prec(j,i,k) .eq. 1) prec_ls(j,k) = prec_ls(j,k)+1._wp if (frac_prec(j,i,k) .eq. 2) prec_cv(j,k) = prec_cv(j,k)+1._wp if (frac_prec(j,i,k) .eq. 3) prec_cv(j,k) = prec_cv(j,k)+1._wp if (frac_prec(j,i,k) .eq. 3) prec_ls(j,k) = prec_ls(j,k)+1._wp enddo frac_ls(j,k)=frac_ls(j,k)/nColumns frac_cv(j,k)=frac_cv(j,k)/nColumns prec_ls(j,k)=prec_ls(j,k)/nColumns prec_cv(j,k)=prec_cv(j,k)/nColumns enddo enddo !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Assign gridmean mixing-ratios (mr_XXXXX), effective radius (ReffIN) and number ! concentration (not defined) to appropriate sub-column. Here we are using scops. !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% allocate(mr_hydro(nPoints,nColumns,nLevels,nHydro), & Reff(nPoints,nColumns,nLevels,nHydro), & Np(nPoints,nColumns,nLevels,nHydro)) ! Initialize mr_hydro(:,:,:,:) = 0._wp Reff(:,:,:,:) = 0._wp Np(:,:,:,:) = 0._wp do k=1,nColumns ! Subcolumn cloud fraction column_frac_out = cospIN%frac_out(:,k,:) ! LS clouds where (column_frac_out == I_LSC) mr_hydro(:,k,:,I_LSCLIQ) = mr_lsliq mr_hydro(:,k,:,I_LSCICE) = mr_lsice Reff(:,k,:,I_LSCLIQ) = ReffIN(:,:,I_LSCLIQ) Reff(:,k,:,I_LSCICE) = ReffIN(:,:,I_LSCICE) ! CONV clouds elsewhere (column_frac_out == I_CVC) mr_hydro(:,k,:,I_CVCLIQ) = mr_ccliq mr_hydro(:,k,:,I_CVCICE) = mr_ccice Reff(:,k,:,I_CVCLIQ) = ReffIN(:,:,I_CVCLIQ) Reff(:,k,:,I_CVCICE) = ReffIN(:,:,I_CVCICE) end where ! Subcolumn precipitation column_prec_out = frac_prec(:,k,:) ! LS Precipitation where ((column_prec_out == 1) .or. (column_prec_out == 3) ) Reff(:,k,:,I_LSRAIN) = ReffIN(:,:,I_LSRAIN) Reff(:,k,:,I_LSSNOW) = ReffIN(:,:,I_LSSNOW) Reff(:,k,:,I_LSGRPL) = ReffIN(:,:,I_LSGRPL) ! CONV precipitation elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3)) Reff(:,k,:,I_CVRAIN) = ReffIN(:,:,I_CVRAIN) Reff(:,k,:,I_CVSNOW) = ReffIN(:,:,I_CVSNOW) end where enddo !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Convert the subcolumn mixing ratio and precipitation fluxes from gridbox mean ! values to fraction-based values. !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Initialize fl_lsrain(:,:) = 0._wp fl_lssnow(:,:) = 0._wp fl_lsgrpl(:,:) = 0._wp fl_ccrain(:,:) = 0._wp fl_ccsnow(:,:) = 0._wp do k=1,nLevels do j=1,nPoints ! In-cloud mixing ratios. if (frac_ls(j,k) .ne. 0.) then mr_hydro(j,:,k,I_LSCLIQ) = mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k) mr_hydro(j,:,k,I_LSCICE) = mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k) endif if (frac_cv(j,k) .ne. 0.) then mr_hydro(j,:,k,I_CVCLIQ) = mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k) mr_hydro(j,:,k,I_CVCICE) = mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k) endif ! Precipitation if (use_precipitation_fluxes) then if (prec_ls(j,k) .ne. 0.) then fl_lsrain(j,k) = fl_lsrainIN(j,k)/prec_ls(j,k) fl_lssnow(j,k) = fl_lssnowIN(j,k)/prec_ls(j,k) fl_lsgrpl(j,k) = fl_lsgrplIN(j,k)/prec_ls(j,k) endif if (prec_cv(j,k) .ne. 0.) then fl_ccrain(j,k) = fl_ccrainIN(j,k)/prec_cv(j,k) fl_ccsnow(j,k) = fl_ccsnowIN(j,k)/prec_cv(j,k) endif else if (prec_ls(j,k) .ne. 0.) then mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k) mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k) mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k) endif if (prec_cv(j,k) .ne. 0.) then mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k) mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k) endif endif enddo enddo deallocate(frac_ls,prec_ls,frac_cv,prec_cv) !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! Convert precipitation fluxes to mixing ratios !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (use_precipitation_fluxes) then ! LS rain call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSRAIN), n_bx(I_LSRAIN), & alpha_x(I_LSRAIN), c_x(I_LSRAIN), d_x(I_LSRAIN), g_x(I_LSRAIN), & a_x(I_LSRAIN), b_x(I_LSRAIN), gamma_1(I_LSRAIN), gamma_2(I_LSRAIN), & gamma_3(I_LSRAIN), gamma_4(I_LSRAIN), fl_lsrain, & mr_hydro(:,:,:,I_LSRAIN), Reff(:,:,:,I_LSRAIN)) ! LS snow call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSSNOW), n_bx(I_LSSNOW), & alpha_x(I_LSSNOW), c_x(I_LSSNOW), d_x(I_LSSNOW), g_x(I_LSSNOW), & a_x(I_LSSNOW), b_x(I_LSSNOW), gamma_1(I_LSSNOW), gamma_2(I_LSSNOW), & gamma_3(I_LSSNOW), gamma_4(I_LSSNOW), fl_lssnow, & mr_hydro(:,:,:,I_LSSNOW), Reff(:,:,:,I_LSSNOW)) ! CV rain call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVRAIN), n_bx(I_CVRAIN), & alpha_x(I_CVRAIN), c_x(I_CVRAIN), d_x(I_CVRAIN), g_x(I_CVRAIN), & a_x(I_CVRAIN), b_x(I_CVRAIN), gamma_1(I_CVRAIN), gamma_2(I_CVRAIN), & gamma_3(I_CVRAIN), gamma_4(I_CVRAIN), fl_ccrain, & mr_hydro(:,:,:,I_CVRAIN), Reff(:,:,:,I_CVRAIN)) ! CV snow call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & cospstateIN%at, frac_prec, 2._wp, n_ax(I_CVSNOW), n_bx(I_CVSNOW), & alpha_x(I_CVSNOW), c_x(I_CVSNOW), d_x(I_CVSNOW), g_x(I_CVSNOW), & a_x(I_CVSNOW), b_x(I_CVSNOW), gamma_1(I_CVSNOW), gamma_2(I_CVSNOW), & gamma_3(I_CVSNOW), gamma_4(I_CVSNOW), fl_ccsnow, & mr_hydro(:,:,:,I_CVSNOW), Reff(:,:,:,I_CVSNOW)) ! LS groupel. call cosp_precip_mxratio(nPoints, nLevels, nColumns, cospstateIN%pfull, & cospstateIN%at, frac_prec, 1._wp, n_ax(I_LSGRPL), n_bx(I_LSGRPL), & alpha_x(I_LSGRPL), c_x(I_LSGRPL), d_x(I_LSGRPL), g_x(I_LSGRPL), & a_x(I_LSGRPL), b_x(I_LSGRPL), gamma_1(I_LSGRPL), gamma_2(I_LSGRPL), & gamma_3(I_LSGRPL), gamma_4(I_LSGRPL), fl_lsgrpl, & mr_hydro(:,:,:,I_LSGRPL), Reff(:,:,:,I_LSGRPL)) deallocate(frac_prec) endif else cospIN%frac_out(:,:,:) = 1 allocate(mr_hydro(nPoints,1,nLevels,nHydro),Reff(nPoints,1,nLevels,nHydro), & Np(nPoints,1,nLevels,nHydro)) mr_hydro(:,1,:,I_LSCLIQ) = mr_lsliq mr_hydro(:,1,:,I_LSCICE) = mr_lsice mr_hydro(:,1,:,I_CVCLIQ) = mr_ccliq mr_hydro(:,1,:,I_CVCICE) = mr_ccice Reff(:,1,:,:) = ReffIN endif !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! 11 micron emissivity !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (cfg%Lisccp) then call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out,dem_c,dem_s, & cospIN%emiss_11) endif !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! 0.67 micron optical depth !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (cfg%Lisccp .or. cfg%Lmisr .or. cfg%Lmodis) then call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out,dtau_c,dtau_s, & cospIN%tau_067) endif !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! LIDAR Polarized optics !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (cfg%Lcalipso) then call lidar_optics(nPoints, nColumns, nLevels, 4, lidar_ice_type, 532, .false., & mr_hydro(:,:,:,I_LSCLIQ), mr_hydro(:,:,:,I_LSCICE), mr_hydro(:,:,:,I_CVCLIQ), & mr_hydro(:,:,:,I_CVCICE), ReffIN(:,:,I_LSCLIQ), ReffIN(:,:,I_LSCICE), & ReffIN(:,:,I_CVCLIQ), ReffIN(:,:,I_CVCICE), cospstateIN%pfull, & cospstateIN%phalf, cospstateIN%at, cospIN%beta_mol_calipso, & cospIN%betatot_calipso, cospIN%tau_mol_calipso, cospIN%tautot_calipso, & cospIN%tautot_S_liq, cospIN%tautot_S_ice, cospIN%betatot_ice_calipso, & cospIN%betatot_liq_calipso, cospIN%tautot_ice_calipso, cospIN%tautot_liq_calipso) endif if (cfg%LgrLidar532) then call lidar_optics(nPoints, nColumns, nLevels, 4, lidar_ice_type, 532, .true., & mr_hydro(:,:,:,I_LSCLIQ), mr_hydro(:,:,:,I_LSCICE), mr_hydro(:,:,:,I_CVCLIQ), & mr_hydro(:,:,:,I_CVCICE), ReffIN(:,:,I_LSCLIQ), ReffIN(:,:,I_LSCICE), & ReffIN(:,:,I_CVCLIQ), ReffIN(:,:,I_CVCICE), cospstateIN%pfull, & cospstateIN%phalf, cospstateIN%at, cospIN%beta_mol_grLidar532, & cospIN%betatot_grLidar532, cospIN%tau_mol_grLidar532, cospIN%tautot_grLidar532) endif if (cfg%Latlid) then call lidar_optics(nPoints, nColumns, nLevels, 4, lidar_ice_type, 355, .false., & mr_hydro(:,:,:,I_LSCLIQ), mr_hydro(:,:,:,I_LSCICE), mr_hydro(:,:,:,I_CVCLIQ), & mr_hydro(:,:,:,I_CVCICE), ReffIN(:,:,I_LSCLIQ), ReffIN(:,:,I_LSCICE), & ReffIN(:,:,I_CVCLIQ), ReffIN(:,:,I_CVCICE), cospstateIN%pfull, & cospstateIN%phalf, cospstateIN%at, cospIN%beta_mol_atlid, cospIN%betatot_atlid,& cospIN%tau_mol_atlid, cospIN%tautot_atlid) endif !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! CLOUDSAT RADAR OPTICS !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (cfg%Lcloudsat) then ! Compute gaseous absorption (assume identical for each subcolun) allocate(g_vol(nPoints,nLevels)) g_vol(:,:)=0._wp do i=1,nPoints do j=1,nLevels if (cospIN%rcfg_cloudsat%use_gas_abs == 1 .or. (cospIN%rcfg_cloudsat%use_gas_abs == 2 .and. j .eq. 1)) then g_vol(i,j) = gases(cospstateIN%pfull(i,j), cospstateIN%at(i,j),cospstateIN%qv(i,j),cospIN%rcfg_cloudsat%freq) endif cospIN%g_vol_cloudsat(i,:,j)=g_vol(i,j) end do end do ! Loop over all subcolumns allocate(fracPrecipIce(nPoints,nColumns,nLevels)) fracPrecipIce(:,:,:) = 0._wp do k=1,nColumns call quickbeam_optics(sd, cospIN%rcfg_cloudsat, nPoints, nLevels, R_UNDEF, & mr_hydro(:,k,:,1:nHydro)*1000._wp, Reff(:,k,:,1:nHydro)*1.e6_wp,& Np(:,k,:,1:nHydro), cospstateIN%pfull, cospstateIN%at, & cospstateIN%qv, cospIN%z_vol_cloudsat(1:nPoints,k,:), & cospIN%kr_vol_cloudsat(1:nPoints,k,:)) ! At each model level, what fraction of the precipitation is frozen? where(mr_hydro(:,k,:,I_LSRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_LSSNOW) .gt. 0 .or. & mr_hydro(:,k,:,I_CVRAIN) .gt. 0 .or. mr_hydro(:,k,:,I_CVSNOW) .gt. 0 .or. & mr_hydro(:,k,:,I_LSGRPL) .gt. 0) fracPrecipIce(:,k,:) = (mr_hydro(:,k,:,I_LSSNOW) + mr_hydro(:,k,:,I_CVSNOW) + & mr_hydro(:,k,:,I_LSGRPL)) / & (mr_hydro(:,k,:,I_LSSNOW) + mr_hydro(:,k,:,I_CVSNOW) + mr_hydro(:,k,:,I_LSGRPL) + & mr_hydro(:,k,:,I_LSRAIN) + mr_hydro(:,k,:,I_CVRAIN)) elsewhere fracPrecipIce(:,k,:) = 0._wp endwhere enddo ! Regrid frozen fraction to Cloudsat/Calipso statistical grid allocate(fracPrecipIce_statGrid(nPoints,nColumns,Nlvgrid)) fracPrecipIce_statGrid(:,:,:) = 0._wp call cosp_change_vertical_grid(Npoints, Ncolumns, Nlevels, cospstateIN%hgt_matrix(:,Nlevels:1:-1), & cospstateIN%hgt_matrix_half(:,Nlevels:1:-1), fracPrecipIce(:,:,Nlevels:1:-1), Nlvgrid, & ! vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), fracPrecipIce_statGrid) !!! ORIGINAL vgrid_zl(Nlvgrid:1:-1), vgrid_zu(Nlvgrid:1:-1), fracPrecipIce_statGrid(:,:,Nlvgrid:1:-1)) !DEBUG fracPrecipIce_statGrid ! Find proper layer to compute precip flags in Cloudsat/Calipso statistical grid !PREC_BUG allocate(cloudsat_preclvl_index(nPoints)) !PREC_BUG cloudsat_preclvl_index(:) = 0._wp !PREC_BUG ! Computing altitude index for precip flags calculation (2nd layer above surfelev) !PREC_BUG cloudsat_preclvl_index(:) = 39 - floor( cospstateIN%surfelev(:)/480. ) !PREC_BUG ! For near-surface diagnostics, we only need the frozen fraction at one layer. do i=1,nPoints !PREC_BUG cospIN%fracPrecipIce(i,:) = fracPrecipIce_statGrid(i,:,cloudsat_preclvl_index(i)) !PREC_BUG enddo !PREC_BUG ! cospIN%fracPrecipIce(:,:) = fracPrecipIce_statGrid(:,:,cloudsat_preclvl) !!! ORIGINAL ! cospIN%fracPrecipIce(:,:) = fracPrecipIce_statGrid(:,:,2) !!! TEST ARTEM endif !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% ! MODIS optics !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% if (cfg%Lmodis) then allocate(MODIS_cloudWater(nPoints,nColumns,nLevels), & MODIS_cloudIce(nPoints,nColumns,nLevels), & MODIS_waterSize(nPoints,nColumns,nLevels), & MODIS_iceSize(nPoints,nColumns,nLevels), & MODIS_opticalThicknessLiq(nPoints,nColumns,nLevels), & MODIS_opticalThicknessIce(nPoints,nColumns,nLevels)) ! Cloud water call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & mr_hydro(:,:,:,I_CVCLIQ),mr_hydro(:,:,:,I_LSCLIQ),MODIS_cloudWater) ! Cloud ice call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & mr_hydro(:,:,:,I_CVCICE),mr_hydro(:,:,:,I_LSCICE),MODIS_cloudIce) ! Water droplet size call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & Reff(:,:,:,I_CVCLIQ),Reff(:,:,:,I_LSCLIQ),MODIS_waterSize) ! Ice crystal size call cosp_simulator_optics(nPoints,nColumns,nLevels,cospIN%frac_out, & Reff(:,:,:,I_CVCICE),Reff(:,:,:,I_LSCICE),MODIS_iceSize) ! Partition optical thickness into liquid and ice parts call modis_optics_partition(nPoints, nLevels, nColumns, MODIS_cloudWater, & MODIS_cloudIce, MODIS_waterSize, MODIS_iceSize, cospIN%tau_067, & MODIS_opticalThicknessLiq, MODIS_opticalThicknessIce) ! Compute assymetry parameter and single scattering albedo call modis_optics(nPoints, nLevels, nColumns, MODIS_opticalThicknessLiq, & MODIS_waterSize*1.0e6_wp, MODIS_opticalThicknessIce, & MODIS_iceSize*1.0e6_wp, cospIN%fracLiq, cospIN%asym, cospIN%ss_alb) ! Deallocate memory deallocate(MODIS_cloudWater,MODIS_cloudIce,MODIS_WaterSize,MODIS_iceSize, & MODIS_opticalThicknessLiq,MODIS_opticalThicknessIce,mr_hydro, & Np,Reff) endif end subroutine subsample_and_optics END MODULE LMDZ_COSP_SUBSAMPLE_AND_OPTICS_MOD