Skip to content

Commit

Permalink
Fixed allocation for RRTMGP aerosol/cloudy optical property DDT. Adju…
Browse files Browse the repository at this point in the history 
…sted SW aerosol band ordering in GFS_rrtmgp_pre.F90.
  • Loading branch information
@dustinswales
dustinswales committed May 2, 2019
1 parent d14dba3 commit 6c55b93
Show file tree
Hide file tree
Showing 3 changed files with 30 additions and 35 deletions.
16 changes: 10 additions & 6 deletions physics/GFS_rrtmgp_pre.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -540,14 +540,18 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Sfcprop, Statein, & ! input
Model%lsswr, Model%lslwr, &
faersw, faerlw, aerodp) ! --- outputs

! CCPP
do j = 1,NBDSW

! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the
! band ordering was [nIR -> UV -> IR(band)]
faersw1(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,NBDSW,1)
faersw2(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,NBDSW,2)
faersw3(1:IM,1:LMK,1) = faersw(1:IM,1:LMK,NBDSW,3)
do j = 2,NBDSW
do k = 1, LMK
do i = 1, IM
! NF_AESW = 3
faersw1(i,k,j) = faersw(i,k,j,1)
faersw2(i,k,j) = faersw(i,k,j,2)
faersw3(i,k,j) = faersw(i,k,j,3)
faersw1(i,k,j) = faersw(i,k,j-1,1)
faersw2(i,k,j) = faersw(i,k,j-1,2)
faersw3(i,k,j) = faersw(i,k,j-1,3)
enddo
enddo
enddo
Expand Down
32 changes: 12 additions & 20 deletions physics/rrtmgp_lw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -232,9 +232,6 @@ subroutine rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
! How are we handling cloud-optics?
rrtmgp_lw_cld_phys = Model%rrtmgp_cld_phys

! HACK. If using RRTMG cloud_optics w/ RRTMGP, we need to be able to define
if (Model%rrtmgp_cld_phys .eq. 0) rrtmgp_lw_cld_phys=1

! Filenames are set in the gfs_physics_nml (scm/src/GFS_typedefs.F90)
kdist_file = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_gas)
kdist_cldy_file = trim(Model%rrtmgp_root)//trim(Model%kdist_lw_file_clouds)
Expand Down Expand Up @@ -724,9 +721,6 @@ subroutine rrtmgp_lw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice))
endif

! HACK!
rrtmgp_lw_cld_phys = Model%rrtmgp_cld_phys

end subroutine rrtmgp_lw_init

! #########################################################################################
Expand Down Expand Up @@ -1002,20 +996,18 @@ subroutine rrtmgp_lw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr
! #######################################################################################
! Call RRTMGP
! #######################################################################################
! Allocate space for source functions and gas optical properties
call check_error_msg(sources%alloc( ncol, nlay, kdist_lw))
call check_error_msg(optical_props_clr%alloc_1scl( ncol, nlay, kdist_lw))
call check_error_msg(optical_props_mcica%alloc_1scl(ncol, nlay, kdist_lw))
! DJS_asks_RP
! Need to use kdist_lw_cldy here, otherewise if we use kdist_lw, optical_props_cldy gets
! allocated with nBands != nGpts, which then fails when calling kdist_lw_cldy%cloud_optics
call check_error_msg(optical_props_cldy%alloc_1scl( ncol, nlay, kdist_lw_cldy))
! We have also have aerosol information by band, so need to allocate just like for
! clouds, where nbands = ngpts = 16. This is problematic when not using RRTMGP cloud_optics(),
! as kdist_lw_cldy only gets loaded, so this breaks when using rrtmg cloud_optics with rrtmgp.
call check_error_msg(optical_props_aer%alloc_1scl( ncol, nlay, kdist_lw_cldy))

! Initialize RRTMGP files
! Allocate space for source functions and gas optical properties [ncol,nlay,ngpts]
call check_error_msg(sources%alloc( nCol, nLay, kdist_lw))
call check_error_msg(optical_props_clr%alloc_1scl( nCol, nLay, kdist_lw))
call check_error_msg(optical_props_mcica%alloc_1scl(nCol, nLay, kdist_lw))
! Cloud optics [nCol,nLay,nBands]
call check_error_msg(optical_props_cldy%init(optical_props_clr%get_band_lims_wavenumber()))
call check_error_msg(optical_props_cldy%alloc_1scl(ncol,nlay))
! Aerosol optics [Ccol,nLay,nBands]
call check_error_msg(optical_props_aer%init(optical_props_clr%get_band_lims_wavenumber()))
call check_error_msg(optical_props_aer%alloc_1scl(ncol,nlay))

! Initialize RRTMGP files
fluxAllSky%flux_up => flux_up_allSky
fluxAllsky%flux_dn => flux_dn_allSky
fluxClrSky%flux_up => flux_up_clrSky
Expand Down
17 changes: 8 additions & 9 deletions physics/rrtmgp_sw_main.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -226,9 +226,6 @@ subroutine rrtmgp_sw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
! How are we handling cloud-optics?
rrtmgp_sw_cld_phys = Model%rrtmgp_cld_phys

! HACK. If using RRTMG cloud_optics w/ RRTMGP, we need to be able to define
if (Model%rrtmgp_cld_phys .eq. 0) rrtmgp_sw_cld_phys=1

! Filenames are set in the gfs_physics_nml (scm/src/GFS_typedefs.F90)
kdist_file = trim(Model%rrtmgp_root)//trim(Model%kdist_sw_file_gas)
kdist_cldy_file = trim(Model%rrtmgp_root)//trim(Model%kdist_sw_file_clouds)
Expand Down Expand Up @@ -720,9 +717,6 @@ subroutine rrtmgp_sw_init(Model,mpicomm, mpirank, mpiroot, errmsg, errflg)
pade_sizereg_extice_sw, pade_sizereg_ssaice_sw, pade_sizereg_asyice_sw))
endif

! HACK
rrtmgp_sw_cld_phys = Model%rrtmgp_cld_phys

end subroutine rrtmgp_sw_init
! #########################################################################################
! RRTMGP_SW_RUN
Expand Down Expand Up @@ -1073,11 +1067,16 @@ subroutine rrtmgp_sw_run(p_lay, p_lev, t_lay, t_lev, q_lay, o3_lay, vmr_co2, vmr
! #######################################################################################
if (nDay .gt. 0) then

! Allocate space for source functions and gas optical properties
! Allocate space for gas optical properties
! Clear-sky
call check_error_msg(optical_props_clr%alloc_2str( nday, nlay, kdist_sw))
call check_error_msg(optical_props_aer%alloc_2str( nday, nlay, kdist_sw_cldy))
call check_error_msg(optical_props_cldy%alloc_2str( nday, nlay, kdist_sw_cldy))
call check_error_msg(optical_props_mcica%alloc_2str(nday, nlay, kdist_sw))
! Cloud optics [nCol,nLay,nBands]
call check_error_msg(optical_props_cldy%init(optical_props_clr%get_band_lims_wavenumber()))
call check_error_msg(optical_props_cldy%alloc_2str(ncol,nlay))
! Aerosol optics [Ccol,nLay,nBands]
call check_error_msg(optical_props_aer%init(optical_props_clr%get_band_lims_wavenumber()))
call check_error_msg(optical_props_aer%alloc_2str(ncol,nlay))

! Initialize RRTMGP files
fluxAllSky%flux_up => flux_up_allSky
Expand Down

0 comments on commit 6c55b93

Please sign in to comment.