From 213adc69497543b90eb6cfff4008858722c2a389 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 22 May 2022 11:08:44 -0600 Subject: [PATCH 1/4] Update .gitmodules and submodule pointer for ccpp-physics for code review and testing --- .gitmodules | 6 ++++-- physics/rte-rrtmgp | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 75e5ea836..dc5a31dd7 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,6 @@ [submodule "physics/rte-rrtmgp"] path = physics/rte-rrtmgp - url = https://github.com/earth-system-radiation/rte-rrtmgp - branch = dtc/ccpp + #url = https://github.com/earth-system-radiation/rte-rrtmgp + #branch = dtc/ccpp + url = https://github.com/climbfuji/rte-rrtmgp + branch = feature/single_precision diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index cec1e8e12..c2a8f5751 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit cec1e8e12d969c3c8c76574dbe4f40b366419cc7 +Subproject commit c2a8f57518c2af0789e6d04c37c5415a7c045dfa From a769f64115cd9f5282a6985196fa3c5e2d7858ae Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 22 May 2022 11:10:32 -0600 Subject: [PATCH 2/4] Interface changes in physics/aer_cloud.F to compile in single precision --- physics/aer_cloud.F | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/physics/aer_cloud.F b/physics/aer_cloud.F index 60df592b6..a334428d1 100644 --- a/physics/aer_cloud.F +++ b/physics/aer_cloud.F @@ -3477,7 +3477,8 @@ SUBROUTINE EMPIRICAL_PARAM_PHILLIPS(SI, SIW, SW, D_grid_dust, & D_grid_bio, n_grid_bio, ijstop_bio, A_solo, n_iw, DSH, & Nhet_dep,Nhet_dhf,fdust_dep,P_ice, T_ice) implicit none - real, intent(IN):: SI, SIW, SW, A_solo,P_ice, T_ice + real, intent(IN):: SI, SIW, SW, A_solo + real*8, intent(IN):: P_ice, T_ice real, dimension(:), intent(IN):: D_grid_dust, n_grid_dust, & D_grid_soot, n_grid_soot, D_grid_bio, n_grid_bio integer, intent(IN):: ijstop_dust, ijstop_soot, ijstop_bio @@ -3488,7 +3489,7 @@ SUBROUTINE EMPIRICAL_PARAM_PHILLIPS(SI, SIW, SW, D_grid_dust, & num_ic_solo_imm real, intent (inout) :: DSH, n_iw - real, intent (out) :: Nhet_dep,Nhet_dhf,fdust_dep + real*8, intent (out) :: Nhet_dep,Nhet_dhf,fdust_dep real :: dn_in_dust, dn_in_soot, dn_in_bio, dn_in_solo, dNall, & dNaux, naux, SS_w, dH_frac_dust, dH_frac_soot, dH_frac_solo, aux, From 35fdb06370e9ac61ec270a7e3357215aa0be6e2d Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 22 May 2022 11:11:27 -0600 Subject: [PATCH 3/4] Change working precision in physics/flake.F90 to support compiling physics in single precision --- physics/flake.F90 | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/physics/flake.F90 b/physics/flake.F90 index 2c2e7218c..78eb82632 100644 --- a/physics/flake.F90 +++ b/physics/flake.F90 @@ -36,6 +36,7 @@ MODULE data_parameters ! Description: ! Global parameters for the program are defined. ! + USE, INTRINSIC :: iso_fortran_env IMPLICIT NONE @@ -44,11 +45,11 @@ MODULE data_parameters ! Parameters for the Program: INTEGER, PARAMETER :: & - ireals = SELECTED_REAL_KIND (12,200), & - ! number of desired significant digits for - ! real variables - ! corresponds to 8 byte real variables - +#ifdef SINGLE_PREC + ireals = REAL32, & +#else + ireals = REAL64, & +#endif iintegers = KIND (1) ! kind-type parameter of the integer values ! corresponds to the default integers From a35dfda1762ac4dcc37957a15b076104599a4d87 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sun, 22 May 2022 11:11:54 -0600 Subject: [PATCH 4/4] Interface changes in physics/rrtmgp_lw_cloud_sampling.F90 and physics/rrtmgp_sw_cloud_sampling.F90 to support single precision builds --- physics/rrtmgp_lw_cloud_sampling.F90 | 20 ++++++++++---------- physics/rrtmgp_sw_cloud_sampling.F90 | 18 +++++++++--------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index cb11607dc..cf43bb184 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -1,9 +1,9 @@ module rrtmgp_lw_cloud_sampling - use machine, only: kind_phys + use machine, only: kind_phys, kind_dbl_prec use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples - use mersenne_twister, only: random_setseed, random_number, random_stat + use mersenne_twister, only: random_setseed, random_number, random_stat use radiation_tools, only: check_error_msg use rrtmgp_lw_gas_optics, only: lw_gas_props use netcdf @@ -75,9 +75,9 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr,iov integer :: iCol, iLay, iBand integer,dimension(ncol) :: ipseed_lw type(random_stat) :: rng_stat - real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 - real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D - real(kind_phys), dimension(lw_gas_props%get_ngpt()) :: rng1D + real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D,rng3D2 + real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()*nLev) :: rng2D + real(kind_dbl_prec), dimension(lw_gas_props%get_ngpt()) :: rng1D logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: maskMCICA ! Initialize CCPP error handling variables @@ -127,7 +127,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr,iov ! Cloud-overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then - call sampled_mask(rng3D, cld_frac, maskMCICA) + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac, maskMCICA) endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then @@ -137,14 +137,14 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr,iov call random_number(rng2D,rng_stat) rng3D2(:,:,iCol) = reshape(source = rng2D,shape=[lw_gas_props%get_ngpt(),nLev]) enddo - call sampled_mask(rng3D, cld_frac, maskMCICA, & + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac, maskMCICA, & overlap_param = cloud_overlap_param(:,1:nLev-1), & - randoms2 = rng3D2) + randoms2 = real(rng3D2, kind=kind_phys)) endif ! Exponential or Exponential-random if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac, maskMCICA, & - overlap_param = cloud_overlap_param(:,1:nLev-1)) + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac, maskMCICA, & + overlap_param = cloud_overlap_param(:,1:nLev-1)) endif ! diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index c4a5de4c8..a5b090149 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -1,5 +1,5 @@ module rrtmgp_sw_cloud_sampling - use machine, only: kind_phys + use machine, only: kind_phys, kind_dbl_prec use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples @@ -80,9 +80,9 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, integer,dimension(nday) :: ipseed_sw type(random_stat) :: rng_stat real(kind_phys) :: tauloc,asyloc,ssaloc - real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 - real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng2D - real(kind_phys), dimension(sw_gas_props%get_ngpt()) :: rng1D + real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt(),nLev,nday) :: rng3D,rng3D2 + real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()*nLev) :: rng2D + real(kind_dbl_prec), dimension(sw_gas_props%get_ngpt()) :: rng1D logical, dimension(nday,nLev,sw_gas_props%get_ngpt()) :: maskMCICA ! Initialize CCPP error handling variables @@ -131,7 +131,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, ! Cloud overlap. ! Maximum-random, random, or maximum cloud overlap if (iovr == iovr_maxrand .or. iovr == iovr_max .or. iovr == iovr_rand) then - call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), maskMCICA) + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(idxday(1:nDay),:), maskMCICA) endif ! Decorrelation-length overlap if (iovr == iovr_dcorr) then @@ -140,13 +140,13 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, call random_number(rng2D,rng_stat) rng3D2(:,:,iday) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLev]) enddo - call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), maskMCICA, & - overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1),& - randoms2 = rng3D2) + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(idxday(1:nDay),:), maskMCICA, & + overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1), & + randoms2 = real(rng3D2, kind=kind_phys)) endif ! Exponential or exponential-random cloud overlap if (iovr == iovr_exp .or. iovr == iovr_exprand) then - call sampled_mask(rng3D, cld_frac(idxday(1:nDay),:), maskMCICA, & + call sampled_mask(real(rng3D, kind=kind_phys), cld_frac(idxday(1:nDay),:), maskMCICA, & overlap_param = cloud_overlap_param(idxday(1:nDay),1:nLev-1)) endif