Changeset 2428 for LMDZ5/trunk/libf/phylmd/cosp/cosp.F90
- Timestamp:
- Jan 27, 2016, 10:42:32 AM (9 years ago)
- File:
-
- 1 edited
-
LMDZ5/trunk/libf/phylmd/cosp/cosp.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/cosp/cosp.F90
r1907 r2428 23 23 ! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 24 24 25 !!#include "cosp_defs.h"25 #include "cosp_defs.h" 26 26 MODULE MOD_COSP 27 27 USE MOD_COSP_TYPES 28 28 USE MOD_COSP_SIMULATOR 29 USE mod_phys_lmdz_para 30 USE mod_grid_phy_lmdz 29 USE MOD_COSP_MODIS_SIMULATOR 31 30 IMPLICIT NONE 32 31 … … 37 36 !--------------------- SUBROUTINE COSP --------------------------- 38 37 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 39 SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 40 38 !#ifdef RTTOV 39 !SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 40 !#else 41 SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 42 !#endif 41 43 ! Arguments 42 44 integer,intent(in) :: overlap ! overlap type in SCOPS: 1=max, 2=rand, 3=max/rand … … 50 52 type(cosp_isccp),intent(inout) :: isccp ! Output from ISCCP simulator 51 53 type(cosp_misr),intent(inout) :: misr ! Output from MISR simulator 54 type(cosp_modis),intent(inout) :: modis ! Output from MODIS simulator 55 !#ifdef RTTOV 56 ! type(cosp_rttov),intent(inout) :: rttov ! Output from RTTOV 57 !#endif 52 58 type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator 53 59 type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator … … 59 65 integer :: Niter ! Number of calls to cosp_simulator 60 66 integer :: i_first,i_last ! First and last gridbox to be processed in each iteration 61 integer :: i, j,k,Ni67 integer :: i,Ni 62 68 integer,dimension(2) :: ix,iy 63 69 logical :: reff_zero 64 real :: minv,maxv65 70 real :: maxp,minp 66 integer,dimension(:), save,allocatable :: & ! Dimensions nPoints71 integer,dimension(:),allocatable :: & ! Dimensions nPoints 67 72 seed ! It is recommended that the seed is set to a different value for each model 68 73 ! gridbox it is called on, as it is possible that the choice of the same 69 74 ! seed value every time may introduce some statistical bias in the results, 70 75 ! particularly for low values of NCOL. 71 !$OMP THREADPRIVATE(seed)72 real,dimension(:),allocatable :: rseed ! It is recommended that the seed is set to a different value for each model73 76 ! Types used in one iteration 74 77 type(cosp_gridbox) :: gbx_it … … 78 81 type(cosp_sglidar) :: sglidar_it 79 82 type(cosp_isccp) :: isccp_it 83 type(cosp_modis) :: modis_it 80 84 type(cosp_misr) :: misr_it 85 !#ifdef RTTOV 86 ! type(cosp_rttov) :: rttov_it 87 !#endif 81 88 type(cosp_radarstats) :: stradar_it 82 89 type(cosp_lidarstats) :: stlidar_it 83 84 logical,save :: first_cosp=.TRUE. 85 !$OMP THREADPRIVATE(first_cosp) 86 87 !++++++++++ Dimensions ++++++++++++ 90 91 !++++++++++ Dimensions ++++++++++++ 88 92 Npoints = gbx%Npoints 89 93 Nlevels = gbx%Nlevels 90 94 Nhydro = gbx%Nhydro 95 96 !++++++++++ Depth of model layers ++++++++++++ 97 do i=1,Nlevels-1 98 gbx%dlev(:,i) = gbx%zlev_half(:,i+1) - gbx%zlev_half(:,i) 99 enddo 100 gbx%dlev(:,Nlevels) = 2.0*(gbx%zlev(:,Nlevels) - gbx%zlev_half(:,Nlevels)) 91 101 92 102 !++++++++++ Apply sanity checks to inputs ++++++++++ … … 129 139 ! and reff_zero == .false. Reff use in lidar and set to 0 for radar 130 140 endif 131 ! if ((gbx%use_reff) .and. (reff_zero)) then ! Inconsistent choice. Want to use Reff but not inputs passed132 ! print *, '---------- COSP ERROR ------------'133 ! print *, ''134 ! print *, 'use_reff==.true. but Reff is always zero'135 ! print *, ''136 ! print *, '----------------------------------'137 ! stop138 ! endif139 141 if ((.not. gbx%use_reff) .and. (reff_zero)) then ! No Reff in radar. Default in lidar 140 142 gbx%Reff = DEFAULT_LIDAR_REFF … … 170 172 endif 171 173 172 if (first_cosp) then173 174 ! We base the seed in the decimal part of the surface pressure. 174 allocate(seed(Npoints)) 175 176 allocate(rseed(klon_glo)) 177 CALL gather(gbx%psfc,rseed) 178 call bcast(rseed) 179 ! seed = int(gbx%psfc) ! This is to avoid division by zero when Npoints = 1 175 allocate(seed(Npoints)) 176 seed = int(gbx%psfc) ! This is to avoid division by zero when Npoints = 1 180 177 ! Roj Oct/2008 ... Note: seed value of 0 caused me some problems + I want to 181 178 ! randomize for each call to COSP even when Npoints ==1 182 minp = minval(rseed) 183 maxp = maxval(rseed) 184 185 if (Npoints .gt. 1) THEN 186 seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1 187 else 188 seed=int(gbx%psfc-minp) 189 endif 190 191 deallocate(rseed) 192 first_cosp=.false. 193 endif 194 179 minp = minval(gbx%psfc) 180 maxp = maxval(gbx%psfc) 181 if (Npoints .gt. 1) seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1 182 ! Below it's how it was done in the original implementation of the ISCCP simulator. 183 ! The one above is better for offline data, when you may have packed data 184 ! that subsamples the decimal fraction of the surface pressure. 185 ! if (Npoints .gt. 1) seed=(gbx%psfc-int(gbx%psfc))*1000000 186 187 195 188 if (gbx%Npoints_it >= gbx%Npoints) then ! One iteration gbx%Npoints 196 call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 189 !#ifdef RTTOV 190 ! call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 191 !#else 192 call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 193 !#endif 197 194 else ! Several iterations to save memory 198 195 Niter = gbx%Npoints/gbx%Npoints_it ! Integer division … … 205 202 if (i == 1) then 206 203 ! Allocate types for all but last iteration 207 call construct_cosp_gridbox(gbx%time,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables,gbx%use_gas_abs, & 208 gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels,Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 204 call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, & 205 gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, & 206 Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 209 207 gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, & 210 208 gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, & … … 219 217 call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it) 220 218 call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it) 219 call construct_cosp_modis(cfg, Ni, modis_it) 221 220 call construct_cosp_misr(cfg,Ni,misr_it) 221 !#ifdef RTTOV 222 ! call construct_cosp_rttov(Ni,gbx%nchan,rttov_it) 223 !#endif 222 224 call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it) 223 225 call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it) … … 229 231 call free_cosp_sglidar(sglidar_it) 230 232 call free_cosp_isccp(isccp_it) 233 call free_cosp_modis(modis_it) 231 234 call free_cosp_misr(misr_it) 235 !#ifdef RTTOV 236 ! call free_cosp_rttov(rttov_it) 237 !#endif 232 238 call free_cosp_radarstats(stradar_it) 233 239 call free_cosp_lidarstats(stlidar_it) 234 240 ! Allocate types for iterations 235 call construct_cosp_gridbox(gbx%time,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables,gbx%use_gas_abs, & 236 gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels,Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 241 call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, & 242 gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, & 243 Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, & 237 244 gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, & 238 245 gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, & … … 250 257 call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it) 251 258 call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it) 259 call construct_cosp_modis(cfg,Ni, modis_it) 252 260 call construct_cosp_misr(cfg,Ni,misr_it) 261 !#ifdef RTTOV 262 ! call construct_cosp_rttov(Ni,gbx%nchan,rttov_it) 263 !#endif 253 264 call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it) 254 265 call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it) … … 263 274 if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar,sglidar_it) 264 275 if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp,isccp_it) 276 if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis,modis_it) 265 277 if (cfg%Lmisr_sim) call cosp_misr_cpsection(ix,iy,misr,misr_it) 278 !#ifdef RTTOV 279 ! if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov,rttov_it) 280 !#endif 266 281 if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar,stradar_it) 267 282 if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar,stlidar_it) 268 print *,'---------ix: ',ix 283 !#ifdef RTTOV 284 ! call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, & 285 ! sglidar_it,isccp_it,misr_it,modis_it,rttov_it,stradar_it,stlidar_it) 286 !#else 269 287 call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, & 270 sglidar_it,isccp_it,misr_it, stradar_it,stlidar_it)271 288 sglidar_it,isccp_it,misr_it,modis_it,stradar_it,stlidar_it) 289 !#endif 272 290 ! --- Copy results to output structures --- 273 ! call cosp_gridbox_cphp(gbx_it,gbx)274 291 ix=(/1,Ni/) 275 292 iy=(/i_first,i_last/) … … 278 295 if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar_it,sglidar) 279 296 if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp_it,isccp) 297 if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis_it,modis) 280 298 if (cfg%Lmisr_sim) call cosp_misr_cpsection(ix,iy,misr_it,misr) 299 !#ifdef RTTOV 300 ! if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov_it,rttov) 301 !#endif 281 302 if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar_it,stradar) 282 303 if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar_it,stlidar) … … 289 310 call free_cosp_sglidar(sglidar_it) 290 311 call free_cosp_isccp(isccp_it) 312 call free_cosp_modis(modis_it) 291 313 call free_cosp_misr(misr_it) 314 !#ifdef RTTOV 315 ! call free_cosp_rttov(rttov_it) 316 !#endif 292 317 call free_cosp_radarstats(stradar_it) 293 318 call free_cosp_lidarstats(stlidar_it) 294 319 endif 320 deallocate(seed) 295 321 296 322 … … 300 326 !--------------------- SUBROUTINE COSP_ITER ---------------------- 301 327 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 302 SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar) 303 328 !#ifdef RTTOV 329 !SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 330 !#else 331 SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 332 !#endif 304 333 ! Arguments 305 334 integer,intent(in) :: overlap ! overlap type in SCOPS: 1=max, 2=rand, 3=max/rand … … 313 342 type(cosp_isccp),intent(inout) :: isccp ! Output from ISCCP simulator 314 343 type(cosp_misr),intent(inout) :: misr ! Output from MISR simulator 344 type(cosp_modis),intent(inout) :: modis ! Output from MODIS simulator 345 !#ifdef RTTOV 346 ! type(cosp_rttov),intent(inout) :: rttov ! Output from RTTOV 347 !#endif 315 348 type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator 316 349 type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator … … 321 354 integer :: Nlevels ! Number of levels 322 355 integer :: Nhydro ! Number of hydrometeors 323 integer :: Niter ! Number of calls to cosp_simulator324 356 integer :: i,j,k 325 integer :: I_HYDRO 357 integer :: I_HYDRO 326 358 real,dimension(:,:),pointer :: column_frac_out ! Array with one column of frac_out 327 integer,parameter :: scops_debug=0 ! set to non-zero value to print out inputs for debugging in SCOPS328 359 real,dimension(:,:),pointer :: column_prec_out ! Array with one column of prec_frac 360 integer :: scops_debug=0 ! set to non-zero value to print out inputs for debugging in SCOPS 329 361 real,dimension(:, :),allocatable :: cca_scops,ls_p_rate,cv_p_rate, & 330 362 tca_scops ! Cloud cover in each model level (HORIZONTAL gridbox fraction) of total cloud. … … 332 364 real,dimension(:,:),allocatable :: frac_ls,prec_ls,frac_cv,prec_cv ! Cloud/Precipitation fraction in each model level 333 365 ! Levels are from SURFACE to TOA 334 real,dimension(:,:),allocatable :: rho ! (Npoints, Nlevels). Atmospheric dens 366 real,dimension(:,:),allocatable :: rho ! (Npoints, Nlevels). Atmospheric density 335 367 type(cosp_sghydro) :: sghydro ! Subgrid info for hydrometeors en each iteration 336 368 … … 342 374 Nhydro = gbx%Nhydro 343 375 344 345 376 !++++++++++ Climate/NWP mode ++++++++++ 346 377 if (Ncolumns > 1) then … … 411 442 ! Deallocate arrays that will no longer be used 412 443 deallocate(tca_scops,cca_scops,ls_p_rate,cv_p_rate) 413 444 414 445 ! Populate the subgrid arrays 415 446 call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro) … … 420 451 sghydro%mr_hydro(:,k,:,I_LSCLIQ) = gbx%mr_hydro(:,:,I_LSCLIQ) 421 452 sghydro%mr_hydro(:,k,:,I_LSCICE) = gbx%mr_hydro(:,:,I_LSCICE) 422 453 423 454 sghydro%Reff(:,k,:,I_LSCLIQ) = gbx%Reff(:,:,I_LSCLIQ) 424 455 sghydro%Reff(:,k,:,I_LSCICE) = gbx%Reff(:,:,I_LSCICE) 425 sghydro%Reff(:,k,:,I_LSRAIN) = gbx%Reff(:,:,I_LSRAIN) 426 sghydro%Reff(:,k,:,I_LSSNOW) = gbx%Reff(:,:,I_LSSNOW) 427 sghydro%Reff(:,k,:,I_LSGRPL) = gbx%Reff(:,:,I_LSGRPL) 456 457 sghydro%Np(:,k,:,I_LSCLIQ) = gbx%Np(:,:,I_LSCLIQ) 458 sghydro%Np(:,k,:,I_LSCICE) = gbx%Np(:,:,I_LSCICE) 459 428 460 elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV clouds ++++++++ 429 sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ) 430 sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE) 431 432 sghydro%Reff(:,k,:,I_CVCLIQ) = gbx%Reff(:,:,I_CVCLIQ) 433 sghydro%Reff(:,k,:,I_CVCICE) = gbx%Reff(:,:,I_CVCICE) 434 sghydro%Reff(:,k,:,I_CVRAIN) = gbx%Reff(:,:,I_CVRAIN) 435 sghydro%Reff(:,k,:,I_CVSNOW) = gbx%Reff(:,:,I_CVSNOW) 436 end where 461 sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ) 462 sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE) 463 464 sghydro%Reff(:,k,:,I_CVCLIQ) = gbx%Reff(:,:,I_CVCLIQ) 465 sghydro%Reff(:,k,:,I_CVCICE) = gbx%Reff(:,:,I_CVCICE) 466 467 sghydro%Np(:,k,:,I_CVCLIQ) = gbx%Np(:,:,I_CVCLIQ) 468 sghydro%Np(:,k,:,I_CVCICE) = gbx%Np(:,:,I_CVCICE) 469 470 end where 471 column_prec_out => sgx%prec_frac(:,k,:) 472 where ((column_prec_out == 1) .or. (column_prec_out == 3) ) !++++ LS precip ++++ 473 sghydro%Reff(:,k,:,I_LSRAIN) = gbx%Reff(:,:,I_LSRAIN) 474 sghydro%Reff(:,k,:,I_LSSNOW) = gbx%Reff(:,:,I_LSSNOW) 475 sghydro%Reff(:,k,:,I_LSGRPL) = gbx%Reff(:,:,I_LSGRPL) 476 477 sghydro%Np(:,k,:,I_LSRAIN) = gbx%Np(:,:,I_LSRAIN) 478 sghydro%Np(:,k,:,I_LSSNOW) = gbx%Np(:,:,I_LSSNOW) 479 sghydro%Np(:,k,:,I_LSGRPL) = gbx%Np(:,:,I_LSGRPL) 480 elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3)) !++++ CONV precip ++++ 481 sghydro%Reff(:,k,:,I_CVRAIN) = gbx%Reff(:,:,I_CVRAIN) 482 sghydro%Reff(:,k,:,I_CVSNOW) = gbx%Reff(:,:,I_CVSNOW) 483 484 sghydro%Np(:,k,:,I_CVRAIN) = gbx%Np(:,:,I_CVRAIN) 485 sghydro%Np(:,k,:,I_CVSNOW) = gbx%Np(:,:,I_CVSNOW) 486 end where 437 487 !--------- Precip ------- 438 488 if (.not. gbx%use_precipitation_fluxes) then … … 442 492 sghydro%mr_hydro(:,k,:,I_LSGRPL) = gbx%mr_hydro(:,:,I_LSGRPL) 443 493 elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV Precipitation ++++++++ 444 sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN) 445 sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW) 494 sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN) 495 sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW) 446 496 end where 447 497 endif … … 486 536 487 537 if (gbx%use_precipitation_fluxes) then 488 ! convert precipitation flux into mixing ratio 489 call pf_to_mr(Npoints,Nlevels,Ncolumns,gbx%rain_ls,gbx%snow_ls,gbx%grpl_ls, & 490 gbx%rain_cv,gbx%snow_cv,sgx%prec_frac,gbx%p,gbx%T, & 491 sghydro%mr_hydro(:,:,:,I_LSRAIN),sghydro%mr_hydro(:,:,:,I_LSSNOW),sghydro%mr_hydro(:,:,:,I_LSGRPL), & 492 sghydro%mr_hydro(:,:,:,I_CVRAIN),sghydro%mr_hydro(:,:,:,I_CVSNOW)) 493 endif 538 539 #ifdef MMF_V3p5_TWO_MOMENT 540 541 write(*,*) 'Precipitation Flux to Mixing Ratio conversion not (yet?) supported ', & 542 'for MMF3.5 Two Moment Microphysics' 543 stop 544 #else 545 ! Density 546 allocate(rho(Npoints,Nlevels)) 547 I_HYDRO = I_LSRAIN 548 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., & 549 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 550 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 551 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 552 gbx%rain_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 553 I_HYDRO = I_LSSNOW 554 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., & 555 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 556 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 557 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 558 gbx%snow_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 559 I_HYDRO = I_CVRAIN 560 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., & 561 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 562 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 563 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 564 gbx%rain_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 565 I_HYDRO = I_CVSNOW 566 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., & 567 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 568 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 569 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 570 gbx%snow_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 571 I_HYDRO = I_LSGRPL 572 call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., & 573 n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), & 574 g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), & 575 gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), & 576 gbx%grpl_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO)) 577 if(allocated(rho)) deallocate(rho) 578 #endif 579 580 endif 494 581 !++++++++++ CRM mode ++++++++++ 495 582 else 583 call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro) 496 584 sghydro%mr_hydro(:,1,:,:) = gbx%mr_hydro 497 585 sghydro%Reff(:,1,:,:) = gbx%Reff 586 sghydro%Np(:,1,:,:) = gbx%Np ! added by Roj with Quickbeam V3.0 587 498 588 !--------- Clouds ------- 499 589 where ((gbx%dtau_s > 0.0)) … … 502 592 endif ! Ncolumns > 1 503 593 504 505 594 !++++++++++ Simulator ++++++++++ 506 call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,stradar,stlidar) 595 !#ifdef RTTOV 596 ! call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar) 597 !#else 598 call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar) 599 !#endif 507 600 508 601 ! Deallocate subgrid arrays
Note: See TracChangeset
for help on using the changeset viewer.
