diff --git a/physics/radlw_main.f b/physics/radlw_main.f index 963372526..9cc7c0a28 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -1039,6 +1039,8 @@ subroutine rrtmg_lw_run & & cldfmc, taucld & & ) + taucld(2,:) = taucld(1,:) + ! --- ... save computed layer cloud optical depth for output ! rrtm band-7 is apprx 10mu channel (or use spectral mean of bands 6-8) diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 58f3eb9dd..7a86c2918 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -110,7 +110,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) ! Read dimensions for k-distribution fields (only on master processor(0)) - if (mpirank .eq. mpiroot) then +! if (mpirank .eq. mpiroot) then if(nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid_lw_clds) == NF90_NOERR) then status = nf90_inq_dimid(ncid_lw_clds, 'nband', dimid) status = nf90_inquire_dimension(ncid_lw_clds, dimid, len=nbandLWcldy) @@ -137,28 +137,28 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d if (nrghice .gt. nrghice_lw) then errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed' endif - endif +! endif ! Broadcast dimensions to all processors -#ifdef MPI - call MPI_BCAST(nbandSWcldy_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - if (cld_optics_scheme .eq. 1) then - call MPI_BARRIER(mpicomm, ierr) - call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsize_liq_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsize_ice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BARRIER(mpicomm, ierr) - endif - if (cld_optics_scheme .eq. 2) then - call MPI_BARRIER(mpicomm, ierr) - call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsizereg_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncoeff_ext_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncoeff_ssa_g_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nbound_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BARRIER(mpicomm, ierr) - endif -#endif +!#ifdef MPI +! call MPI_BCAST(nbandSWcldy_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! if (cld_optics_scheme .eq. 1) then +! call MPI_BARRIER(mpicomm, ierr) +! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nsize_liq_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nsize_ice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BARRIER(mpicomm, ierr) +! endif +! if (cld_optics_scheme .eq. 2) then +! call MPI_BARRIER(mpicomm, ierr) +! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nsizereg_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(ncoeff_ext_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(ncoeff_ssa_g_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nbound_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BARRIER(mpicomm, ierr) +! endif +!#endif if (Cld_optics_scheme .eq. 1) then allocate(lut_extliq(nsize_liq, nBandLWcldy)) @@ -186,7 +186,7 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d endif ! On master processor, allocate space, read in fields, broadcast to all processors - if (mpirank .eq. mpiroot) then +! if (mpirank .eq. mpiroot) then if (Cld_optics_scheme .eq. 1) then write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' if(nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid_lw_clds) == NF90_NOERR) then @@ -264,79 +264,79 @@ subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_close(ncid_lw_clds) endif endif - endif +! endif ! Broadcast arrays to all processors -#ifdef MPI - if (cld_optics_scheme .eq. 1) then - if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (LUT) ... ' - call MPI_BARRIER(mpicomm, ierr) -#ifndef SINGLE_PREC - call MPI_BCAST(radliq_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extice, size(lut_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -#else - call MPI_BCAST(radliq_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extice, size(lut_extice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr) -#endif - call MPI_BARRIER(mpicomm, ierr) - endif - if (cld_optics_scheme .eq. 2) then - if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (PADE) ... ' - call MPI_BARRIER(mpicomm, ierr) -#ifndef SINGLE_PREC - call MPI_BCAST(pade_extliq, size(pade_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_extice, size(pade_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -#else - call MPI_BCAST(pade_extliq, size(pade_extliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_extice, size(pade_extice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr) -#endif - call MPI_BARRIER(mpicomm, ierr) - endif -#endif +!#ifdef MPI +! if (cld_optics_scheme .eq. 1) then +! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (LUT) ... ' +! call MPI_BARRIER(mpicomm, ierr) +!#ifndef SINGLE_PREC +! call MPI_BCAST(radliq_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_lwr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_upr, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_fac, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extice, size(lut_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +!#else +! call MPI_BCAST(radliq_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_lwr, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_upr, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_fac, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extliq, size(lut_extliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaliq, size(lut_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyliq, size(lut_asyliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extice, size(lut_extice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaice, size(lut_ssaice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyice, size(lut_asyice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr) +!#endif +! call MPI_BARRIER(mpicomm, ierr) +! endif +! if (cld_optics_scheme .eq. 2) then +! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (PADE) ... ' +! call MPI_BARRIER(mpicomm, ierr) +!#ifndef SINGLE_PREC +! call MPI_BCAST(pade_extliq, size(pade_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_extice, size(pade_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +!#else +! call MPI_BCAST(pade_extliq, size(pade_extliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaliq, size(pade_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyliq, size(pade_asyliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_extice, size(pade_extice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaice, size(pade_ssaice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyice, size(pade_asyice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extliq, size(pade_sizereg_extliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaliq, size(pade_sizereg_ssaliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyliq, size(pade_sizereg_asyliq), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extice, size(pade_sizereg_extice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaice, size(pade_sizereg_ssaice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyice, size(pade_sizereg_asyice), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy, size(band_lims_cldy), MPI_REAL, mpiroot, mpicomm, ierr) +!#endif +! call MPI_BARRIER(mpicomm, ierr) +! endif +!#endif ! Load tables data for RRTMGP cloud-optics if (cld_optics_scheme .eq. 1) then @@ -423,6 +423,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr ! Cloud optics [nCol,nLev,nBands] call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. if (rrtmgp_cld_optics .gt. 0) then @@ -447,8 +448,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & cld_frac, tau_cld) endif - endif - lw_optical_props_cloudsByBand%tau = tau_cld + lw_optical_props_cloudsByBand%tau = tau_cld + endif write(47,*) "In rrtmgp_lw_cloud_optics: " write(47,*),"nCol: ",nCol @@ -460,6 +461,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr enddo enddo + lw_optical_props_cloudsByBand%tau(:,:,2) = lw_optical_props_cloudsByBand%tau(:,:,1) + ! All-sky LW optical depth ~10microns cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 377425a48..ab0ad497b 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -104,7 +104,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) ! Read dimensions for k-distribution fields (only on master processor(0)) - if (mpirank .eq. mpiroot) then +! if (mpirank .eq. mpiroot) then if(nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid_sw_clds) == NF90_NOERR) then status = nf90_inq_dimid(ncid_sw_clds, 'nband', dimid) status = nf90_inquire_dimension(ncid_sw_clds, dimid, len=nbandSWcldy_sw) @@ -130,28 +130,28 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d if (nrghice .gt. nrghice_sw) then errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed' endif - endif +! endif ! Broadcast dimensions to all processors -#ifdef MPI - call MPI_BCAST(nbandSWcldy_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - if (cld_optics_scheme .eq. 1) then - call MPI_BARRIER(mpicomm, ierr) - call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsize_liq_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsize_ice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BARRIER(mpicomm, ierr) - endif - if (cld_optics_scheme .eq. 2) then - call MPI_BARRIER(mpicomm, ierr) - call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nsizereg_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncoeff_ext_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(ncoeff_ssa_g_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BCAST(nbound_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) - call MPI_BARRIER(mpicomm, ierr) - endif -#endif +!#ifdef MPI +! call MPI_BCAST(nbandSWcldy_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! if (cld_optics_scheme .eq. 1) then +! call MPI_BARRIER(mpicomm, ierr) +! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nsize_liq_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nsize_ice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BARRIER(mpicomm, ierr) +! endif +! if (cld_optics_scheme .eq. 2) then +! call MPI_BARRIER(mpicomm, ierr) +! call MPI_BCAST(nrghice_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nsizereg_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(ncoeff_ext_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(ncoeff_ssa_g_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BCAST(nbound_sw, 1, MPI_INTEGER, mpiroot, mpicomm, ierr) +! call MPI_BARRIER(mpicomm, ierr) +! endif +!#endif if (cld_optics_scheme .eq. 1) then allocate(lut_extliq_sw(nsize_liq_sw, nBandSWcldy_sw)) @@ -178,7 +178,7 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d allocate(band_lims_cldy_sw(2,nbandSWcldy_sw)) ! On master processor, allocate space, read in fields, broadcast to all processors - if (mpirank .eq. mpiroot) then +! if (mpirank .eq. mpiroot) then if (cld_optics_scheme .eq. 1) then write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' if(nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid_sw_clds) == NF90_NOERR) then @@ -256,79 +256,79 @@ subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_d status = nf90_close(ncid_sw_clds) endif endif - endif +! endif ! Broadcast arrays to all processors -#ifdef MPI - if (cld_optics_scheme .eq. 1) then - if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (LUT) ... ' - call MPI_BARRIER(mpicomm, ierr) -#ifndef SINGLE_PREC - call MPI_BCAST(radliq_lwr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_upr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_fac_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_lwr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_upr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_fac_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extliq_sw, size(lut_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaliq_sw, size(lut_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyliq_sw, size(lut_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extice_sw, size(lut_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaice_sw, size(lut_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyice_sw, size(lut_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -#else - call MPI_BCAST(radliq_lwr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_upr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radliq_fac_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_lwr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_upr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(radice_fac_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extliq_sw, size(lut_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaliq_sw, size(lut_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyliq_sw, size(lut_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_extice_sw, size(lut_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_ssaice_sw, size(lut_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(lut_asyice_sw, size(lut_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_REAL, mpiroot, mpicomm, ierr) -#endif - call MPI_BARRIER(mpicomm, ierr) - endif - if (cld_optics_scheme .eq. 2) then - if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (PADE) ... ' - call MPI_BARRIER(mpicomm, ierr) -#ifndef SINGLE_PREC - call MPI_BCAST(pade_extliq_sw, size(pade_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaliq_sw, size(pade_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyliq_sw, size(pade_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_extice_sw, size(pade_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaice_sw, size(pade_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyice_sw, size(pade_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extliq_sw, size(pade_sizereg_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaliq_sw, size(pade_sizereg_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyliq_sw, size(pade_sizereg_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extice_sw, size(pade_sizereg_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaice_sw, size(pade_sizereg_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyice_sw, size(pade_sizereg_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) -#else - call MPI_BCAST(pade_extliq_sw, size(pade_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaliq_sw, size(pade_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyliq_sw, size(pade_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_extice_sw, size(pade_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_ssaice_sw, size(pade_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_asyice_sw, size(pade_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extliq_sw, size(pade_sizereg_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaliq_sw, size(pade_sizereg_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyliq_sw, size(pade_sizereg_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_extice_sw, size(pade_sizereg_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_ssaice_sw, size(pade_sizereg_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(pade_sizereg_asyice_sw, size(pade_sizereg_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) - call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_REAL, mpiroot, mpicomm, ierr) -#endif - call MPI_BARRIER(mpicomm, ierr) - endif -#endif +!#ifdef MPI +! if (cld_optics_scheme .eq. 1) then +! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (LUT) ... ' +! call MPI_BARRIER(mpicomm, ierr) +!#ifndef SINGLE_PREC +! call MPI_BCAST(radliq_lwr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_upr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_fac_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_lwr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_upr_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_fac_sw, 1, MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extliq_sw, size(lut_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaliq_sw, size(lut_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyliq_sw, size(lut_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extice_sw, size(lut_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaice_sw, size(lut_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyice_sw, size(lut_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +!#else +! call MPI_BCAST(radliq_lwr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_upr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radliq_fac_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_lwr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_upr_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(radice_fac_sw, 1, MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extliq_sw, size(lut_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaliq_sw, size(lut_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyliq_sw, size(lut_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_extice_sw, size(lut_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_ssaice_sw, size(lut_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(lut_asyice_sw, size(lut_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_REAL, mpiroot, mpicomm, ierr) +!#endif +! call MPI_BARRIER(mpicomm, ierr) +! endif +! if (cld_optics_scheme .eq. 2) then +! if (mpirank==mpiroot) write (*,*) 'Broadcasting RRTMGP shortwave cloud data (PADE) ... ' +! call MPI_BARRIER(mpicomm, ierr) +!#ifndef SINGLE_PREC +! call MPI_BCAST(pade_extliq_sw, size(pade_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaliq_sw, size(pade_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyliq_sw, size(pade_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_extice_sw, size(pade_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaice_sw, size(pade_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyice_sw, size(pade_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extliq_sw, size(pade_sizereg_extliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaliq_sw, size(pade_sizereg_ssaliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyliq_sw, size(pade_sizereg_asyliq_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extice_sw, size(pade_sizereg_extice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaice_sw, size(pade_sizereg_ssaice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyice_sw, size(pade_sizereg_asyice_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_DOUBLE_PRECISION, mpiroot, mpicomm, ierr) +!#else +! call MPI_BCAST(pade_extliq_sw, size(pade_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaliq_sw, size(pade_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyliq_sw, size(pade_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_extice_sw, size(pade_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_ssaice_sw, size(pade_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_asyice_sw, size(pade_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extliq_sw, size(pade_sizereg_extliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaliq_sw, size(pade_sizereg_ssaliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyliq_sw, size(pade_sizereg_asyliq_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_extice_sw, size(pade_sizereg_extice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_ssaice_sw, size(pade_sizereg_ssaice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(pade_sizereg_asyice_sw, size(pade_sizereg_asyice_sw), MPI_REAL, mpiroot, mpicomm, ierr) +! call MPI_BCAST(band_lims_cldy_sw, size(band_lims_cldy_sw), MPI_REAL, mpiroot, mpicomm, ierr) +!#endif +! call MPI_BARRIER(mpicomm, ierr) +! endif +!#endif ! Load tables data for RRTMGP cloud-optics if (cld_optics_scheme .eq. 1) then @@ -415,7 +415,10 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice ! Cloud optics [nday,nLev,nBands] call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& nday, nLev, sw_gas_props%get_band_lims_wavenumber())) - + sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + ! Compute cloud-optics for RTE. if (cld_optics_scheme .gt. 0) then ! RRTMGP cloud-optics. @@ -435,9 +438,6 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice else ! RRTMG cloud-optics if (any(cld_frac .gt. 0)) then - sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys - sw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys - sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), &