From c9a5c5b86c13eb5616c479d773e51bc6216916fe Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 23 Feb 2018 22:17:40 -0700 Subject: [PATCH 1/2] Radiation arguments: provide all gasvmr arguments to both sw and lw radiation; check for presence of optional cloud fields, depending on cloud method used --- ...{GFS_RRTMG_post.F90 => GFS_rrtmg_post.F90} | 0 .../{GFS_RRTMG_pre.F90 => GFS_rrtmg_pre.F90} | 0 physics/radlw_main.f | 39 ++++++++++-- physics/radsw_main.f | 61 ++++++++++++++++--- .../{GFS_radlw_post.F90 => rrtmg_lw_post.F90} | 0 .../{GFS_radlw_pre.F90 => rrtmg_lw_pre.F90} | 0 .../{GFS_radsw_post.F90 => rrtmg_sw_post.F90} | 0 .../{GFS_radsw_pre.F90 => rrtmg_sw_pre.F90} | 0 8 files changed, 87 insertions(+), 13 deletions(-) rename physics/{GFS_RRTMG_post.F90 => GFS_rrtmg_post.F90} (100%) rename physics/{GFS_RRTMG_pre.F90 => GFS_rrtmg_pre.F90} (100%) rename physics/{GFS_radlw_post.F90 => rrtmg_lw_post.F90} (100%) rename physics/{GFS_radlw_pre.F90 => rrtmg_lw_pre.F90} (100%) rename physics/{GFS_radsw_post.F90 => rrtmg_sw_post.F90} (100%) rename physics/{GFS_radsw_pre.F90 => rrtmg_sw_pre.F90} (100%) diff --git a/physics/GFS_RRTMG_post.F90 b/physics/GFS_rrtmg_post.F90 similarity index 100% rename from physics/GFS_RRTMG_post.F90 rename to physics/GFS_rrtmg_post.F90 diff --git a/physics/GFS_RRTMG_pre.F90 b/physics/GFS_rrtmg_pre.F90 similarity index 100% rename from physics/GFS_RRTMG_pre.F90 rename to physics/GFS_rrtmg_pre.F90 diff --git a/physics/radlw_main.f b/physics/radlw_main.f index fd97914a5..ab40bbadb 100644 --- a/physics/radlw_main.f +++ b/physics/radlw_main.f @@ -701,9 +701,9 @@ subroutine rrtmg_lw_run & real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, cld_od - + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_od real (kind=kind_phys), dimension(npts), intent(in) :: sfemis, & & sfgtmp @@ -779,9 +779,40 @@ subroutine rrtmg_lw_run & lhlw0 = present ( hlw0 ) lflxprf= present ( flxprf ) - colamt(:,:) = f_zero +!! --- check for optional input arguments, depending on cloud method + if (ilwcliq > 0) then ! use prognostic cloud method + if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & + & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & + & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & + & .not.present(cld_swp) .or. .not.present(cld_ref_snow)) then + write(0,*) 'Logic error: ilwcliq>0 requires the following', & + & ' optional arguments to be present:', & + & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & + & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' + ! DH* this would be the place to set the exit/error flag and return - not yet implemented; + ! instead, sleep for 2s to allow all processes to write output to stdout, then abort + !ierr = 1 + !return + call sleep(2) + stop + ! *DH + end if + else ! use diagnostic cloud method + if ( .not.present(cld_od) ) then + write(0,*) 'Logic error: ilwcliq<=0 requires the following', & + & ' optional argument to be present: cld_od' + ! DH* this would be the place to set the exit/error flag and return - not yet implemented; + ! instead, sleep for 2s to allow all processes to write output to stdout, then abort + !ierr = 1 + !return + call sleep(2) + stop + ! *DH + end if + endif ! end if_ilwcliq + !> -# Change random number seed value for each radiation invocation !! (isubclw =1 or 2). diff --git a/physics/radsw_main.f b/physics/radsw_main.f index 7ddedf7c9..318c23e28 100644 --- a/physics/radsw_main.f +++ b/physics/radsw_main.f @@ -597,6 +597,11 @@ end subroutine rrtmg_sw_init !! | gasvmr_n2o | volume_mixing_ratio_n2o | volume mixing ratio no2 | kg kg-1 | 2 | real | kind_phys | in | F | !! | gasvmr_ch4 | volume_mixing_ratio_ch4 | volume mixing ratio ch4 | kg kg-1 | 2 | real | kind_phys | in | F | !! | gasvmr_o2 | volume_mixing_ratio_o2 | volume mixing ratio o2 | kg kg-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_co | volume_mixing_ratio_co | volume mixing ratio co | kg kg-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_cfc11 | volume_mixing_ratio_cfc11 | volume mixing ratio cfc11 | kg kg-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_cfc12 | volume_mixing_ratio_cfc12 | volume mixing ratio cfc12 | kg kg-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_cfc22 | volume_mixing_ratio_cfc22 | volume mixing ratio cfc22 | kg kg-1 | 2 | real | kind_phys | in | F | +!! | gasvmr_ccl4 | volume_mixing_ratio_ccl4 | volume mixing ratio ccl4 | kg kg-1 | 2 | real | kind_phys | in | F | !! | icseed | seed_random_numbers_sw | seed for random number generation for shortwave radiation | none | 1 | integer | | in | F | !! | aeraod | aerosol_optical_depth_for_shortwave_bands_01-16 | aerosol optical depth for shortwave bands 01-16 | none | 3 | real | kind_phys | in | F | !! | aerssa | aerosol_single_scattering_albedo_for_shortwave_bands_01-16 | aerosol single scattering albedo for shortwave bands 01-16 | frac | 3 | real | kind_phys | in | F | @@ -639,9 +644,8 @@ end subroutine rrtmg_sw_init !----------------------------------- subroutine rrtmg_sw_run & & ( plyr,plvl,tlyr,tlvl,qlyr,olyr, & - & gasvmr_co2, & - & gasvmr_n2o, gasvmr_ch4, & - & gasvmr_o2, & ! --- inputs + & gasvmr_co2,gasvmr_n2o,gasvmr_ch4,gasvmr_o2,gasvmr_co, & + & gasvmr_cfc11,gasvmr_cfc12,gasvmr_cfc22,gasvmr_ccl4, & ! --- inputs & icseed, aeraod, aerssa, aerasy, & & sfcalb_nir_dir, sfcalb_nir_dif, & & sfcalb_uvis_dir, sfcalb_uvis_dif, & @@ -847,15 +851,20 @@ subroutine rrtmg_sw_run & real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dir& real (kind=kind_phys),dimension(npts),intent(in):: sfcalb_uvis_dif& - real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2 - real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_n2o - real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 - real (kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co2 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_n2o + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ch4 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_o2 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_co + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc11 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc12 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_cfc22 + real(kind=kind_phys),dimension(npts,nlay),intent(in)::gasvmr_ccl4 real (kind=kind_phys), dimension(npts,nlay),intent(in):: cld_cf real (kind=kind_phys), dimension(npts,nlay),intent(in),optional:: & - & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & - & cld_rwp,cld_ref_rain, cld_swp, cld_ref_snow, & + & cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice, & + & cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, & & cld_od, cld_ssa, cld_asy real(kind=kind_phys),dimension(npts,nlay,nbdsw),intent(in)::aeraod @@ -957,6 +966,40 @@ subroutine rrtmg_sw_run & hswb(:,:,:) = f_zero endif +!! --- check for optional input arguments, depending on cloud method + if (iswcliq > 0) then ! use prognostic cloud method + if ( .not.present(cld_lwp) .or. .not.present(cld_ref_liq) .or. & + & .not.present(cld_iwp) .or. .not.present(cld_ref_ice) .or. & + & .not.present(cld_rwp) .or. .not.present(cld_ref_rain) .or. & + & .not.present(cld_swp) .or. .not.present(cld_ref_snow)) then + write(0,*) 'Logic error: ilwcliq>0 requires the following', & + & ' optional arguments to be present:', & + & ' cld_lwp, cld_ref_liq, cld_iwp, cld_ref_ice,', & + & ' cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow' + ! DH* this would be the place to set the exit/error flag and return - not yet implemented; + ! instead, sleep for 2s to allow all processes to write output to stdout, then abort + !ierr = 1 + !return + call sleep(2) + stop + ! *DH + end if + else ! use diagnostic cloud method + if ( .not.present(cld_od) .or. .not.present(cld_ssa) .or. & + & .not.present(cld_asy)) then + write(0,*) 'Logic error: iswcliq<=0 requires the following', & + & ' optional arguments to be present:', & + & ' cld_od, cld_ssa, cld_asy' + ! DH* this would be the place to set the exit/error flag and return - not yet implemented; + ! instead, sleep for 2s to allow all processes to write output to stdout, then abort + !ierr = 1 + !return + call sleep(2) + stop + ! *DH + end if + endif ! end if_iswcliq + !> -# Change random number seed value for each radiation invocation !! (isubcsw =1 or 2). diff --git a/physics/GFS_radlw_post.F90 b/physics/rrtmg_lw_post.F90 similarity index 100% rename from physics/GFS_radlw_post.F90 rename to physics/rrtmg_lw_post.F90 diff --git a/physics/GFS_radlw_pre.F90 b/physics/rrtmg_lw_pre.F90 similarity index 100% rename from physics/GFS_radlw_pre.F90 rename to physics/rrtmg_lw_pre.F90 diff --git a/physics/GFS_radsw_post.F90 b/physics/rrtmg_sw_post.F90 similarity index 100% rename from physics/GFS_radsw_post.F90 rename to physics/rrtmg_sw_post.F90 diff --git a/physics/GFS_radsw_pre.F90 b/physics/rrtmg_sw_pre.F90 similarity index 100% rename from physics/GFS_radsw_pre.F90 rename to physics/rrtmg_sw_pre.F90 From 6da1180298357f209d3f40218f1610188f587680 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 23 Feb 2018 22:18:12 -0700 Subject: [PATCH 2/2] Rename pre/post interstitial routines for rrtmg sw and lw radiation --- GFS_layer/GFS_radiation_driver.F90 | 74 +++++++++++++++--------------- makefile | 12 ++--- physics/GFS_rrtmg_post.F90 | 26 +++++------ physics/GFS_rrtmg_pre.F90 | 51 +++++++------------- physics/rrtmg_lw_post.F90 | 26 +++++------ physics/rrtmg_lw_pre.F90 | 26 +++++------ physics/rrtmg_sw_post.F90 | 26 +++++------ physics/rrtmg_sw_pre.F90 | 54 ++++++++++++++-------- 8 files changed, 147 insertions(+), 148 deletions(-) diff --git a/GFS_layer/GFS_radiation_driver.F90 b/GFS_layer/GFS_radiation_driver.F90 index d70c7c166..aa6ab57d9 100644 --- a/GFS_layer/GFS_radiation_driver.F90 +++ b/GFS_layer/GFS_radiation_driver.F90 @@ -329,12 +329,12 @@ module module_radiation_driver ! & profsw_type,cmpfsw_type,NBDSW use rrtmg_sw, only: rswinit, rrtmg_sw_run - use GFS_RRTMG_pre, only: GFS_RRTMG_pre_run - use GFS_RRTMG_post, only: GFS_RRTMG_post_run - use GFS_radsw_pre, only: GFS_radsw_pre_run - use GFS_radsw_post, only: GFS_radsw_post_run - use GFS_radlw_pre, only: GFS_radlw_pre_run - use GFS_radlw_post, only: GFS_radlw_post_run + use GFS_rrtmg_pre, only: GFS_rrtmg_pre_run + use GFS_rrtmg_post, only: GFS_rrtmg_post_run + use rrtmg_sw_pre, only: rrtmg_sw_pre_run + use rrtmg_sw_post, only: rrtmg_sw_post_run + use rrtmg_lw_pre, only: rrtmg_lw_pre_run + use rrtmg_lw_post, only: rrtmg_lw_post_run use module_radlw_parameters, only: topflw_type, sfcflw_type, & & proflw_type, NBDLW use rrtmg_lw, only: rlwinit, rrtmg_lw_run @@ -1209,10 +1209,10 @@ subroutine GFS_radiation_driver & type (cmpfsw_type), dimension(size(Grid%xlon,1)) :: scmpsw ! CCPP: L1211-1577 - call GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input + call GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, & lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output - tlvl, tlyr, tsfg, tsfa, qlyr,nday, idxday, olyr, & + tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), gasvmr(:,:,10), & @@ -1228,9 +1228,9 @@ subroutine GFS_radiation_driver & ! Grid, Tbd, Cldprop, Radtend, Diag) ! *DH ! CCPP: L1582-1596 - call GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & - tsfg, tsfa, sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), & - sfcalb(:,4) ) + call rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & + nday, idxday, tsfg, tsfa, sfcalb(:,1), sfcalb(:,2), & + sfcalb(:,3), sfcalb(:,4) ) ! DH* !call GFS_diagtoscreen_run(Model, Statein, Stateout, Sfcprop, Coupling, & @@ -1238,25 +1238,27 @@ subroutine GFS_radiation_driver & ! *DH ! CCPP: L1598-1618 call rrtmg_sw_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! input - gasvmr(:, :, 1), & - gasvmr(:, :, 2), gasvmr(:, :, 3), gasvmr(:, :, 4), & - Tbd%icsdsw, faersw(:, :, :, 1), faersw(:, :, :, 2), & - faersw(:, :, :, 3), sfcalb(:,1), sfcalb(:,2),sfcalb(:,3), & - sfcalb(:,4),Radtend%coszen, Model%solcon, nday, idxday, im, & + gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & + gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & + gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), & + Tbd%icsdsw, & + faersw(:,:,:,1), faersw(:,:,:,2), faersw(:,:,:,3), & + sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), sfcalb(:,4), & + Radtend%coszen, Model%solcon, nday, idxday, im, & lmk, lmp, Model%lprnt, clouds(:,:,1), Model%lsswr, & - htswc, Diag%topfsw, Radtend%sfcfsw, & ! outputs - hsw0=htsw0, fdncmp=scmpsw, & ! optional outputs - cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! Optional input - cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & - cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & - cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) + htswc, Diag%topfsw, Radtend%sfcfsw, & ! output + hsw0=htsw0, fdncmp=scmpsw, & ! optional output + cld_lwp=clouds(:,:,2), cld_ref_liq=clouds(:,:,3), & ! optional input + cld_iwp=clouds(:,:,4), cld_ref_ice=clouds(:,:,5), & + cld_rwp=clouds(:,:,6), cld_ref_rain=clouds(:,:,7), & + cld_swp=clouds(:,:,8), cld_ref_snow=clouds(:,:,9)) ! DH* !call GFS_diagtoscreen_run(Model, Statein, Stateout, Sfcprop, Coupling, & ! Grid, Tbd, Cldprop, Radtend, Diag) ! *DH !CCPP: L1620-1686 - call GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & + call rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & LTP, nday, lm, kd, htswc, htsw0, & sfcalb(:,1), sfcalb(:,2), sfcalb(:,3), sfcalb(:,4), scmpsw) @@ -1265,30 +1267,30 @@ subroutine GFS_radiation_driver & ! Grid, Tbd, Cldprop, Radtend, Diag) ! *DH !CCPP: L1689-1698 - call GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, & + call rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, & im, tsfg, tsfa) !CCPP: L1703-1714 - call rrtmg_lw_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! inputs - gasvmr(:, :, 1), gasvmr(:, :, 2), gasvmr(:, :, 3), & - gasvmr(:, :, 4), gasvmr(:, :, 5), gasvmr(:, :, 6), & - gasvmr(:, :, 7), gasvmr(:, :, 8), gasvmr(:, :, 9), & + call rrtmg_lw_run (plyr, plvl, tlyr, tlvl, qlyr, olyr, & ! input + gasvmr(:,:,1), gasvmr(:,:,2), gasvmr(:,:,3), & + gasvmr(:,:,4), gasvmr(:,:,5), gasvmr(:,:,6), & + gasvmr(:,:,7), gasvmr(:,:,8), gasvmr(:,:,9), & Tbd%icsdlw, faerlw(:,:,:,1), faerlw(:,:,:,2), Radtend%semis, & - tsfg, im, lmk, lmp, Model%lprnt, clouds(:, :, 1), & + tsfg, im, lmk, lmp, Model%lprnt, clouds(:,:,1), & Model%lslwr, & - htlwc, Diag%topflw, Radtend%sfcflw, & ! outputs + htlwc, Diag%topflw, Radtend%sfcflw, & ! output hlw0=htlw0, & ! optional output - cld_lwp=clouds(:, :, 2), cld_ref_liq=clouds(:, :, 3), & ! optional input - cld_iwp=clouds(:, :, 4), cld_ref_ice=clouds(:, :, 5), & - cld_rwp=clouds(:, :, 6), cld_ref_rain=clouds(:, :, 7), & - cld_swp=clouds(:, :, 8), cld_ref_snow=clouds(:, :, 9)) + cld_lwp=clouds(:,:,2), cld_ref_liq=clouds(:,:,3), & ! optional input + cld_iwp=clouds(:,:,4), cld_ref_ice=clouds(:,:,5), & + cld_rwp=clouds(:,:,6), cld_ref_rain=clouds(:,:,7), & + cld_swp=clouds(:,:,8), cld_ref_snow=clouds(:,:,9)) !CCPP: L1718-1747 - call GFS_radlw_post_run (Model, Grid, Radtend, Coupling, & + call rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & LTP, lm, kd, tsfa, htlwc, htlw0) !CCPP: L1757-1841 - call GFS_RRTMG_post_run (Model, Grid, Diag, Radtend, Statein, & + call GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling, scmpsw, im, lm, LTP, kt, kb, kd, raddt, aerodp, & cldsa, mtopa, mbota, clouds(:,:,1)) diff --git a/makefile b/makefile index 001c14cff..629876e6e 100644 --- a/makefile +++ b/makefile @@ -181,12 +181,12 @@ SRCS_F90 = \ ./GFS_layer/GFS_abstraction_layer.F90 \ ./GFS_layer/GFS_diagnostics.F90 \ ./GFS_layer/GFS_driver.F90 \ - ./physics/GFS_RRTMG_pre.F90 \ - ./physics/GFS_RRTMG_post.F90 \ - ./physics/GFS_radsw_pre.F90 \ - ./physics/GFS_radsw_post.F90 \ - ./physics/GFS_radlw_pre.F90 \ - ./physics/GFS_radlw_post.F90 \ + ./physics/GFS_rrtmg_pre.F90 \ + ./physics/GFS_rrtmg_post.F90 \ + ./physics/rrtmg_sw_pre.F90 \ + ./physics/rrtmg_sw_post.F90 \ + ./physics/rrtmg_lw_pre.F90 \ + ./physics/rrtmg_lw_post.F90 \ $(GFS_PHYSICS_DRIVER) \ $(GFS_RADIATION_DRIVER) \ ./GFS_layer/GFS_restart.F90 \ diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index b4e85a7c3..6039953fa 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -1,16 +1,16 @@ -!>\file GFS_RRTMG_post.f90 +!>\file GFS_rrtmg_post.f90 !! This file contains - module GFS_RRTMG_post + module GFS_rrtmg_post contains -!>\defgroup GFS_RRTMG_post GFS RRTMG Scheme Post +!>\defgroup GFS_rrtmg_post GFS RRTMG Scheme Post !! @{ -!> \section arg_table_GFS_RRTMG_post_init Argument Table +!> \section arg_table_GFS_rrtmg_post_init Argument Table !! - subroutine GFS_RRTMG_post_init () - end subroutine GFS_RRTMG_post_init + subroutine GFS_rrtmg_post_init () + end subroutine GFS_rrtmg_post_init -!> \section arg_table_GFS_RRTMG_post_run Argument Table +!> \section arg_table_GFS_rrtmg_post_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-------------------|---------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -33,7 +33,7 @@ end subroutine GFS_RRTMG_post_init !! | mbota | model_layer_number_at_cloud_base | vertical indices for low, middle and high cloud bases | index | 2 | integer | | in | F | !! | clouds1 | total_cloud_fraction | layer total cloud fraction | frac | 2 | real | kind_phys | in | F | !! - subroutine GFS_RRTMG_post_run (Model, Grid, Diag, Radtend, Statein, & + subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & Coupling, scmpsw, im, lm, ltp, kt, kb, kd, raddt, aerodp, & cldsa, mtopa, mbota, clouds1) @@ -160,12 +160,12 @@ subroutine GFS_RRTMG_post_run (Model, Grid, Diag, Radtend, Statein, & endif endif ! end_if_lssav ! - end subroutine GFS_RRTMG_post_run + end subroutine GFS_rrtmg_post_run -!> \section arg_table_GFS_RRTMG_post_finalize Argument Table +!> \section arg_table_GFS_rrtmg_post_finalize Argument Table !! - subroutine GFS_RRTMG_post_finalize () - end subroutine GFS_RRTMG_post_finalize + subroutine GFS_rrtmg_post_finalize () + end subroutine GFS_rrtmg_post_finalize !! @} - end module GFS_RRTMG_post + end module GFS_rrtmg_post diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 0bab717ea..5aa7bcbd3 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -1,19 +1,19 @@ -!> \file GFS_RRTMG_pre.f90 +!> \file GFS_rrtmg_pre.f90 !! This file contains - module GFS_RRTMG_pre + module GFS_rrtmg_pre - public GFS_RRTMG_pre_run + public GFS_rrtmg_pre_run contains -!> \defgroup GFS_RRTMG_pre GFS RRTMG Scheme Pre +!> \defgroup GFS_rrtmg_pre GFS RRTMG Scheme Pre !! @{ -!! \section arg_table_GFS_RRTMG_pre_init Argument Table +!! \section arg_table_GFS_rrtmg_pre_init Argument Table !! - subroutine GFS_RRTMG_pre_init () - end subroutine GFS_RRTMG_pre_init + subroutine GFS_rrtmg_pre_init () + end subroutine GFS_rrtmg_pre_init -!> \section arg_table_GFS_RRTMG_pre_run Argument Table +!> \section arg_table_GFS_rrtmg_pre_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-------------------|---------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -38,8 +38,6 @@ end subroutine GFS_RRTMG_pre_init !! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | out | F | !! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | out | F | !! | qlyr | water_vapor_specific_humidity_at_layer_for_radiation | water vapor specific humidity at vertical layer for radiation calculation | kg kg-1 | 2 | real | kind_phys | out | F | -!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | -!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | !! | olyr | ozone_concentration_at_layer_for_radiation | ozone concentration | kg kg-1 | 2 | real | kind_phys | out | F | !! | gasvmr_co2 | volume_mixing_ratio_co2 | CO2 volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | !! | gasvmr_n2o | volume_mixing_ratio_n2o | N2O volume mixing ratio | kg kg-1 | 2 | real | kind_phys | out | F | @@ -74,10 +72,10 @@ end subroutine GFS_RRTMG_pre_init ! DH* Attention - the output arguments lm, im, lmk, lmp should not be set ! here in the CCPP version - they are defined in the interstitial_create routine *DH ! DH* TODO add intent information for each variable (be careful with intent(out))! - subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input + subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input Tbd, Cldprop, Radtend, & lm, im, lmk, lmp, kd, kt, kb, raddt, plvl, plyr, & ! output - tlvl, tlyr, tsfg, tsfa, qlyr, nday, idxday, olyr, & + tlvl, tlyr, tsfg, tsfa, qlyr, olyr, & gasvmr_co2, gasvmr_n2o, gasvmr_ch4, gasvmr_o2, & gasvmr_co, gasvmr_cfc11, gasvmr_cfc12, & gasvmr_cfc22, gasvmr_ccl4, gasvmr_cfc113, & @@ -131,16 +129,13 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input #ifdef CCPP integer, intent(in) :: im, lm, lmk, lmp integer :: me, nfxr, ntrac - ! nday is intent(out) - integer :: i, j, k, k1, lv, itop, ibtc, nday, LP1, kd, & + integer :: i, j, k, k1, lv, itop, ibtc, LP1, kd, & lla, llb, lya, lyb, kt, kb #else integer :: me, im, lm, nfxr, ntrac - ! nday is intent(out) - integer :: i, j, k, k1, lv, itop, ibtc, nday, LP1, LMK, LMP, kd, & + integer :: i, j, k, k1, lv, itop, ibtc, LP1, LMK, LMP, kd, & lla, llb, lya, lyb, kt, kb #endif - integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday integer, dimension(size(Grid%xlon,1),3) :: mbota, mtopa !--- REAL VARIABLES @@ -424,18 +419,6 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input endif ! end_if_ivflip -!> - Check for daytime points for SW radiation. - - nday = 0 - idxday = 0 - do i = 1, IM - if (Radtend%coszen(i) >= 0.0001) then - nday = nday + 1 - idxday(nday) = i - endif - enddo - - !> - Call module_radiation_aerosols::setaer(),to setup aerosols !! property profile for radiation. @@ -615,14 +598,14 @@ subroutine GFS_RRTMG_pre_run (Model, Grid, Sfcprop, Statein, & ! input enddo enddo - end subroutine GFS_RRTMG_pre_run + end subroutine GFS_rrtmg_pre_run -!> \section arg_table_GFS_RRTMG_pre_finalize Argument Table +!> \section arg_table_GFS_rrtmg_pre_finalize Argument Table !! - subroutine GFS_RRTMG_pre_finalize () - end subroutine GFS_RRTMG_pre_finalize + subroutine GFS_rrtmg_pre_finalize () + end subroutine GFS_rrtmg_pre_finalize !! @} - end module GFS_RRTMG_pre + end module GFS_rrtmg_pre diff --git a/physics/rrtmg_lw_post.F90 b/physics/rrtmg_lw_post.F90 index 367d35256..21bd31462 100644 --- a/physics/rrtmg_lw_post.F90 +++ b/physics/rrtmg_lw_post.F90 @@ -1,18 +1,18 @@ -!>\file GFS_radlw_post +!>\file rrtmg_lw_post !!This file contains - module GFS_radlw_post + module rrtmg_lw_post contains -!>\defgroup GFS_radlw_post GFS RRTMG/RADLW Scheme Post +!>\defgroup rrtmg_lw_post GFS RRTMG scheme post !! @{ -!> \section arg_table_GFS_radlw_post_init Argument Table +!> \section arg_table_rrtmg_lw_post_init Argument Table !! - subroutine GFS_radlw_post_init() - end subroutine GFS_radlw_post_init + subroutine rrtmg_lw_post_init() + end subroutine rrtmg_lw_post_init ! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing #ifndef __PGI -!> \section arg_table_GFS_radlw_post_run Argument Table +!> \section arg_table_rrtmg_lw_post_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-------------------|-----------------------------------------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|-----------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -27,7 +27,7 @@ end subroutine GFS_radlw_post_init !! | htlw0 | tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step | clear sky heating rate due to longwave radiation | K s-1 | 2 | real | kind_phys | in | F | !! #endif - subroutine GFS_radlw_post_run (Model, Grid, Radtend, Coupling, & + subroutine rrtmg_lw_post_run (Model, Grid, Radtend, Coupling, & ltp, lm, kd, tsfa, htlwc, htlw0) use machine, only: kind_phys @@ -82,12 +82,12 @@ subroutine GFS_radlw_post_run (Model, Grid, Radtend, Coupling, & endif ! end_if_lslwr - end subroutine GFS_radlw_post_run + end subroutine rrtmg_lw_post_run -!> \section arg_table_GFS_radlw_post_finalize Argument Table +!> \section arg_table_rrtmg_lw_post_finalize Argument Table !! - subroutine GFS_radlw_post_finalize () - end subroutine GFS_radlw_post_finalize + subroutine rrtmg_lw_post_finalize () + end subroutine rrtmg_lw_post_finalize !! @} - end module GFS_radlw_post + end module rrtmg_lw_post diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index b8fc2847d..0cd81497d 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -1,17 +1,17 @@ -!>\file GFS_radlw_pre.f90 +!>\file rrtmg_lw_pre.f90 !! This file contains a call to module_radiation_surface::setemis() to !! setup surface emissivity for LW radiation. - module GFS_radlw_pre + module rrtmg_lw_pre contains -!>\defgroup GFS_radlw_pre GFS RADLW Scheme Pre +!>\defgroup rrtmg_lw_pre GFS RRTMG scheme pre !! @{ -!> \section arg_table_GFS_radlw_pre_init Argument Table +!> \section arg_table_rrtmg_lw_pre_init Argument Table !! - subroutine GFS_radlw_pre_init () - end subroutine GFS_radlw_pre_init + subroutine rrtmg_lw_pre_init () + end subroutine rrtmg_lw_pre_init -!> \section arg_table_GFS_radlw_pre_run Argument Table +!> \section arg_table_rrtmg_lw_pre_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-------------------|-------------------------------------------|----------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -22,7 +22,7 @@ end subroutine GFS_radlw_pre_init !! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | !! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | !! - subroutine GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa) + subroutine rrtmg_lw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa) use machine, only: kind_phys @@ -49,11 +49,11 @@ subroutine GFS_radlw_pre_run (Model, Grid, Sfcprop, Radtend, im, tsfg, tsfa) Radtend%semis) ! --- outputs endif - end subroutine GFS_radlw_pre_run + end subroutine rrtmg_lw_pre_run -!> \section arg_table_GFS_radlw_pre_finalize Argument Table +!> \section arg_table_rrtmg_lw_pre_finalize Argument Table !! - subroutine GFS_radlw_pre_finalize () - end subroutine GFS_radlw_pre_finalize + subroutine rrtmg_lw_pre_finalize () + end subroutine rrtmg_lw_pre_finalize !! @} - end module GFS_radlw_pre + end module rrtmg_lw_pre diff --git a/physics/rrtmg_sw_post.F90 b/physics/rrtmg_sw_post.F90 index 702c0b295..f8a1c5b2f 100644 --- a/physics/rrtmg_sw_post.F90 +++ b/physics/rrtmg_sw_post.F90 @@ -1,17 +1,17 @@ -!>\file GFS_radsw_post +!>\file rrtmg_sw_post !! This file contains - module GFS_radsw_post + module rrtmg_sw_post contains -!>\defgroup GFS_radsw_post GFS RRTMG/RADSW Scheme Post +!>\defgroup rrtmg_sw_post GFS RRTMG scheme post !! @{ -!> \section arg_table_GFS_radsw_post_init Argument Table +!> \section arg_table_rrtmg_sw_post_init Argument Table !! - subroutine GFS_radsw_post_init () - end subroutine GFS_radsw_post_init + subroutine rrtmg_sw_post_init () + end subroutine rrtmg_sw_post_init ! PGI compiler does not accept lines longer than 264 characters, remove during pre-processing #ifndef __PGI -!> \section arg_table_GFS_radsw_post_run Argument Table +!> \section arg_table_rrtmg_sw_post_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |-------------------|------------------------------------------------------------------------------------------------|-------------------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -32,7 +32,7 @@ end subroutine GFS_radsw_post_init !! | scmpsw | components_of_surface_downward_shortwave_fluxes | derived type for special components of surface downward shortwave fluxes | W m-2 | 1 | cmpfsw_type | | inout | F | !! #endif - subroutine GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & + subroutine rrtmg_sw_post_run (Model, Grid, Diag, Radtend, Coupling, & ltp, nday, lm, kd, htswc, htsw0, & ! --input sfcalb1, sfcalb2, sfcalb3, sfcalb4, scmpsw ) @@ -128,11 +128,11 @@ subroutine GFS_radsw_post_run (Model, Grid, Diag, Radtend, Coupling, & endif ! end_if_lsswr - end subroutine GFS_radsw_post_run + end subroutine rrtmg_sw_post_run -!> \section arg_table_GFS_radsw_post_finalize Argument Table +!> \section arg_table_rrtmg_sw_post_finalize Argument Table !! - subroutine GFS_radsw_post_finalize () - end subroutine GFS_radsw_post_finalize + subroutine rrtmg_sw_post_finalize () + end subroutine rrtmg_sw_post_finalize !! @} - end module GFS_radsw_post + end module rrtmg_sw_post diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index f1d701867..ddd184f34 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -1,17 +1,17 @@ -!>\file GFS_radsw_pre.f90 +!>\file rrtmg_sw_pre.f90 !! This file contains a subroutine to module_radiation_surface::setalb() to !! setup surface albedo for SW radiation. - module GFS_radsw_pre + module rrtmg_sw_pre contains -!>\defgroup GFS_radsw_pre GFS RADSW Scheme Pre +!>\defgroup rrtmg_sw_pre GFS RRTMG scheme Pre !! @{ -!> \section arg_table_GFS_radsw_pre_init Argument Table +!> \section arg_table_rrtmg_sw_pre_init Argument Table !! - subroutine GFS_radsw_pre_init () - end subroutine GFS_radsw_pre_init + subroutine rrtmg_sw_pre_init () + end subroutine rrtmg_sw_pre_init -!> \section arg_table_GFS_radsw_pre_run Argument Table +!> \section arg_table_rrtmg_sw_pre_run Argument Table !! | local var name | longname | description | units | rank | type | kind | intent | optional | !! |----------------|-------------------------------------------|----------------------------------------------------------------------|----------|------|-------------------------------|-----------|--------|----------| !! | Model | FV3-GFS_Control_type | Fortran DDT containing FV3-GFS model control parameters | DDT | 0 | GFS_control_type | | in | F | @@ -19,15 +19,17 @@ end subroutine GFS_radsw_pre_init !! | Sfcprop | FV3-GFS_Sfcprop_type | Fortran DDT containing FV3-GFS surface fields | DDT | 0 | GFS_sfcprop_type | | in | F | !! | Radtend | FV3-GFS_Radtend_type | Fortran DDT containing FV3-GFS radiation tendencies | DDT | 0 | GFS_radtend_type | | inout | F | !! | im | horizontal_loop_extent | horizontal loop extent | count | 0 | integer | | in | F | +!! | nday | daytime_points_dimension | daytime points dimension | count | 0 | integer | | out | F | +!! | idxday | daytime_points | daytime points | index | 1 | integer | | out | F | !! | tsfg | surface_ground_temperature_for_radiation | surface ground temperature for radiation | K | 1 | real | kind_phys | in | F | !! | tsfa | surface_air_temperature_for_radiation | lowest model layer air temperature for radiation | K | 1 | real | kind_phys | in | F | -!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | -!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb1 | surface_albedo_due_to_near_IR_direct | surface albedo due to near IR direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb2 | surface_albedo_due_to_near_IR_diffused | surface albedo due to near IR diffused beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb3 | surface_albedo_due_to_UV_and_VIS_direct | surface albedo due to UV+VIS direct beam | frac | 1 | real | kind_phys | out | F | +!! | sfcalb4 | surface_albedo_due_to_UV_and_VIS_diffused | surface albedo due to UV+VIS diffused beam | frac | 1 | real | kind_phys | out | F | !! - subroutine GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & - tsfg, tsfa, sfcalb1,sfcalb2, sfcalb3, sfcalb4 ) + subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & + nday, idxday, tsfg, tsfa, sfcalb1, sfcalb2, sfcalb3, sfcalb4 ) use machine, only: kind_phys @@ -43,12 +45,12 @@ subroutine GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & type(GFS_sfcprop_type), intent(in) :: Sfcprop type(GFS_grid_type), intent(in) :: Grid integer, intent(in) :: im + integer, intent(out) :: nday + integer, dimension(size(Grid%xlon,1)), intent(out) :: idxday real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: tsfa, tsfg real(kind=kind_phys), dimension(size(Grid%xlon,1)), intent(out) :: sfcalb1, sfcalb2, sfcalb3, sfcalb4 ! Local variables integer :: i - ! DH* TODO - instead of passing in sfcalb{1-4} and using sfcalb internally, - ! we can just pass in the sfcalb array? *DH real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb ! --- ... start radiation calculations @@ -56,6 +58,16 @@ subroutine GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & !> -# Start SW radiation calculations if (Model%lsswr) then +!> - Check for daytime points for SW radiation. + nday = 0 + idxday = 0 + do i = 1, IM + if (Radtend%coszen(i) >= 0.0001) then + nday = nday + 1 + idxday(nday) = i + endif + enddo + !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. @@ -70,6 +82,8 @@ subroutine GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & !> -# Approximate mean surface albedo from vis- and nir- diffuse values. Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) else + nday = 0 + idxday = 0 sfcalb = 0.0 endif @@ -80,12 +94,12 @@ subroutine GFS_radsw_pre_run (Model, Grid, Sfcprop, Radtend, im, & sfcalb4(i) = sfcalb(i,4) enddo - end subroutine GFS_radsw_pre_run + end subroutine rrtmg_sw_pre_run -!> \section arg_table_GFS_radsw_pre_finalize Argument Table +!> \section arg_table_rrtmg_sw_pre_finalize Argument Table !! - subroutine GFS_radsw_pre_finalize () - end subroutine GFS_radsw_pre_finalize + subroutine rrtmg_sw_pre_finalize () + end subroutine rrtmg_sw_pre_finalize !! @} - end module GFS_radsw_pre + end module rrtmg_sw_pre