Skip to content

Commit

Permalink
Try overwriting cloud optical depth in bands1-2.
Browse files Browse the repository at this point in the history
  • Loading branch information
@dustinswales
dustinswales committed Jan 13, 2020
1 parent 5812151 commit 6c8ecdd
Show file tree
Hide file tree
Showing 3 changed files with 197 additions and 192 deletions.
2 changes: 2 additions & 0 deletions physics/radlw_main.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
193 changes: 98 additions & 95 deletions physics/rrtmgp_lw_cloud_optics.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)

Expand Down
Loading

0 comments on commit 6c8ecdd

Please sign in to comment.