From 63bab8ea6e150ed43495e8961fa365bbf3d0540b Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 26 Mar 2024 18:05:56 -0600 Subject: [PATCH 01/23] commit initial dadadj mods for SIMA --- dadadj/dadadj.F90 | 197 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 197 insertions(+) create mode 100644 dadadj/dadadj.F90 diff --git a/dadadj/dadadj.F90 b/dadadj/dadadj.F90 new file mode 100644 index 00000000..c882793c --- /dev/null +++ b/dadadj/dadadj.F90 @@ -0,0 +1,197 @@ +module dadadj + !======================================================================= + ! GFDL style dry adiabatic adjustment + ! + ! Method: + ! if stratification is unstable, adjustment to the dry adiabatic lapse + ! rate is forced subject to the condition that enthalpy is conserved. + !======================================================================= + + use ccpp_kinds, only: kind_phys + + implicit none + private + save + + public :: dadadj_init ! init routine + public :: dadadj_run ! main routine + + integer :: nlvdry ! number of layers from top of model to apply the adjustment + integer :: niter ! number of iterations for convergence + +CONTAINS + + !> \section arg_table_dadadj_init Argument Table + !! \htmlinclude dadadj_init.html + subroutine dadadj_init(dadadj_nlvdry, dadadj_ninter, vertical_layer_dimension, errmsg, errflg) + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + integer, intent(in) :: dadadj_nlvdry + integer, intent(in) :: dadadj_ninter + integer, intent(in) :: vertical_layer_dimension + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + errmsg = '' + errflg = 0 + + if (dadadj_nlvdry >= vertical_layer_dimension .or. dadadj_nlvdry < 0) then + errflg = 1 + write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ' + end if + + nlvdry = dadadj_nlvdry + niter = dadadj_ninter + + end subroutine dadadj_init + + !> \section arg_table_dadadj_run Argument Table + !! \htmlinclude dadadj_run.html + subroutine dadadj_run( & + horizontal_loop_extent, dt, pmid, pint, pdel, state_t, state_q, cappav, tend_t, & + tend_q, dadpdf, scheme_name, errmsg, errflg) + + !------------------------------------------------ + ! Input / output parameters + !------------------------------------------------ + integer, intent(in) :: horizontal_loop_extent ! number of atmospheric columns + real(kind_phys), intent(in) :: dt ! physics timestep + real(kind_phys), intent(in) :: pmid(:,:) ! pressure at model levels + real(kind_phys), intent(in) :: pint(:,:) ! pressure at model interfaces + real(kind_phys), intent(in) :: pdel(:,:) ! vertical delta-p + real(kind_phys), intent(in) :: cappav(:,:) ! variable Kappa + real(kind_phys), intent(in) :: state_t(:,:) ! temperature (K) + real(kind_phys), intent(in) :: state_q(:,:) ! specific humidity + real(kind_phys), intent(out), TARGET :: tend_t(:,:) ! temperature tendency + real(kind_phys), intent(out), TARGET :: tend_q(:,:) ! specific humidity tendency + real(kind_phys), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened + + character(len=64), intent(out) :: scheme_name + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errflg + + !------------------------------------------------ + ! Local variables + !------------------------------------------------ + + integer :: i,k ! longitude, level indices + integer :: jiter ! iteration index + real(kind_phys), allocatable :: c1dad(:) ! intermediate constant + real(kind_phys), allocatable :: c2dad(:) ! intermediate constant + real(kind_phys), allocatable :: c3dad(:) ! intermediate constant + real(kind_phys), allocatable :: c4dad(:) ! intermediate constant + real(kind_phys) :: gammad ! dry adiabatic lapse rate (deg/Pa) + real(kind_phys) :: zeps ! convergence criterion (deg/Pa) + real(kind_phys) :: rdenom ! reciprocal of denominator of expression + real(kind_phys) :: dtdp ! delta-t/delta-p + real(kind_phys) :: zepsdp ! zeps*delta-p + real(kind_phys) :: zgamma ! intermediate constant + real(kind_phys) :: qave ! mean q between levels + real(kind_phys) :: cappa ! Kappa at level intefaces + real(kind_phys), pointer :: t(:,:) + real(kind_phys), pointer :: q(:,:) + + logical :: ilconv ! .TRUE. ==> convergence was attained + logical :: dodad(horizontal_loop_extent) ! .TRUE. ==> do dry adjustment + + !----------------------------------------------------------------------- + + zeps = 2.0e-5_kind_phys ! set convergence criteria + errmsg = '' + errflg = 0 + scheme_name = 'DADADJ' + + allocate(c1dad(nlvdry), c2dad(nlvdry), c3dad(nlvdry), c4dad(nlvdry)) + + ! tend_t and tend_q used as workspace until needed to calculate tendencies + t => tend_t + q => tend_q + + t = state_t + q = state_q + + ! Find gridpoints with unstable stratification + + do i = 1, horizontal_loop_extent + cappa = 0.5_kind_phys*(cappav(i,2) + cappav(i,1)) + gammad = cappa*0.5_kind_phys*(t(i,2) + t(i,1))/pint(i,2) + dtdp = (t(i,2) - t(i,1))/(pmid(i,2) - pmid(i,1)) + dodad(i) = (dtdp + zeps) .gt. gammad + end do + + dadpdf(:horizontal_loop_extent,:) = 0._kind_phys + do k= 2, nlvdry + do i = 1, horizontal_loop_extent + cappa = 0.5_kind_phys*(cappav(i,k+1) + cappav(i,k)) + gammad = cappa*0.5_kind_phys*(t(i,k+1) + t(i,k))/pint(i,k+1) + dtdp = (t(i,k+1) - t(i,k))/(pmid(i,k+1) - pmid(i,k)) + dodad(i) = dodad(i) .or. (dtdp + zeps).gt.gammad + if ((dtdp + zeps).gt.gammad) then + dadpdf(i,k) = 1._kind_phys + end if + end do + end do + + ! Make a dry adiabatic adjustment + ! Note: nlvdry ****MUST**** be < pver + + i=1 + do while(errflg==0 .and. i <= horizontal_loop_extent) + if (dodad(i)) then + do k = 1, nlvdry + c1dad(k) = cappa*0.5_kind_phys*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) + c2dad(k) = (1._kind_phys - c1dad(k))/(1._kind_phys + c1dad(k)) + rdenom = 1._kind_phys/(pdel(i,k)*c2dad(k) + pdel(i,k+1)) + c3dad(k) = rdenom*pdel(i,k) + c4dad(k) = rdenom*pdel(i,k+1) + end do + + jiter = 1 + ilconv = .false. + do while (.not. ilconv .and. zeps <= 1.e-4_kind_phys) + + if (jiter == 1) ilconv = .true. + + do k = 1, nlvdry + zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) + zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) + + if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then + ilconv = .false. + t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) + t(i,k) = c2dad(k)*t(i,k+1) + qave = (pdel(i,k+1)*q(i,k+1) + pdel(i,k)*q(i,k))/(pdel(i,k+1)+ pdel(i,k)) + q(i,k+1) = qave + q(i,k) = qave + end if + end do + + ! if reach niter double convergence criterion + if (jiter == niter ) then + zeps = zeps + zeps + jiter = 1 + else + jiter = jiter + 1 + end if + + end do + + if (zeps > 1.e-4_kind_phys) then + errflg = i + write(errmsg,*) 'dadadj_run: No convergence in column ',i + exit + end if + + end if + i=i+1 + end do + + deallocate(c1dad, c2dad, c3dad, c4dad) + + tend_t = (t - state_t)/dt + tend_q = (q - state_q)/dt + + end subroutine dadadj_run + +end module dadadj From 9c8ed80d5cbee81806fcbc7e16f7b1d8b309b798 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 29 Mar 2024 23:19:31 -0600 Subject: [PATCH 02/23] dadadj ccpp mods --- dadadj/dadadj.F90 | 54 +++++++-------- dadadj/dadadj.meta | 134 +++++++++++++++++++++++++++++++++++++ dadadj/dadadj_namelist.xml | 108 ++++++++++++++++++++++++++++++ suite_dadadj.xml | 10 +++ 4 files changed, 279 insertions(+), 27 deletions(-) create mode 100644 dadadj/dadadj.meta create mode 100644 dadadj/dadadj_namelist.xml create mode 100644 suite_dadadj.xml diff --git a/dadadj/dadadj.F90 b/dadadj/dadadj.F90 index c882793c..d25f0412 100644 --- a/dadadj/dadadj.F90 +++ b/dadadj/dadadj.F90 @@ -23,48 +23,48 @@ module dadadj !> \section arg_table_dadadj_init Argument Table !! \htmlinclude dadadj_init.html - subroutine dadadj_init(dadadj_nlvdry, dadadj_ninter, vertical_layer_dimension, errmsg, errflg) + subroutine dadadj_init(dadadj_nlvdry, dadadj_niter, nz, errmsg, errflg) !------------------------------------------------ ! Input / output parameters !------------------------------------------------ integer, intent(in) :: dadadj_nlvdry - integer, intent(in) :: dadadj_ninter - integer, intent(in) :: vertical_layer_dimension + integer, intent(in) :: dadadj_niter + integer, intent(in) :: nz character(len=512), intent(out) :: errmsg integer, intent(out) :: errflg errmsg = '' errflg = 0 - if (dadadj_nlvdry >= vertical_layer_dimension .or. dadadj_nlvdry < 0) then + if (dadadj_nlvdry >= nz .or. dadadj_nlvdry < 0) then errflg = 1 write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ' end if nlvdry = dadadj_nlvdry - niter = dadadj_ninter + niter = dadadj_niter end subroutine dadadj_init !> \section arg_table_dadadj_run Argument Table !! \htmlinclude dadadj_run.html subroutine dadadj_run( & - horizontal_loop_extent, dt, pmid, pint, pdel, state_t, state_q, cappav, tend_t, & - tend_q, dadpdf, scheme_name, errmsg, errflg) + ncol, dt, pmid, pint, pdel, state_t, state_q, cappa, t_tend, & + q_tend, dadpdf, scheme_name, errmsg, errflg) !------------------------------------------------ ! Input / output parameters !------------------------------------------------ - integer, intent(in) :: horizontal_loop_extent ! number of atmospheric columns + integer, intent(in) :: ncol ! number of atmospheric columns real(kind_phys), intent(in) :: dt ! physics timestep real(kind_phys), intent(in) :: pmid(:,:) ! pressure at model levels real(kind_phys), intent(in) :: pint(:,:) ! pressure at model interfaces real(kind_phys), intent(in) :: pdel(:,:) ! vertical delta-p - real(kind_phys), intent(in) :: cappav(:,:) ! variable Kappa + real(kind_phys), intent(in) :: cappa(:,:) ! variable Kappa real(kind_phys), intent(in) :: state_t(:,:) ! temperature (K) real(kind_phys), intent(in) :: state_q(:,:) ! specific humidity - real(kind_phys), intent(out), TARGET :: tend_t(:,:) ! temperature tendency - real(kind_phys), intent(out), TARGET :: tend_q(:,:) ! specific humidity tendency + real(kind_phys), intent(out), TARGET :: t_tend(:,:) ! temperature tendency + real(kind_phys), intent(out), TARGET :: q_tend(:,:) ! specific humidity tendency real(kind_phys), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened character(len=64), intent(out) :: scheme_name @@ -88,12 +88,12 @@ subroutine dadadj_run( & real(kind_phys) :: zepsdp ! zeps*delta-p real(kind_phys) :: zgamma ! intermediate constant real(kind_phys) :: qave ! mean q between levels - real(kind_phys) :: cappa ! Kappa at level intefaces + real(kind_phys) :: cappaint ! Kappa at level intefaces real(kind_phys), pointer :: t(:,:) real(kind_phys), pointer :: q(:,:) logical :: ilconv ! .TRUE. ==> convergence was attained - logical :: dodad(horizontal_loop_extent) ! .TRUE. ==> do dry adjustment + logical :: dodad(ncol) ! .TRUE. ==> do dry adjustment !----------------------------------------------------------------------- @@ -104,27 +104,27 @@ subroutine dadadj_run( & allocate(c1dad(nlvdry), c2dad(nlvdry), c3dad(nlvdry), c4dad(nlvdry)) - ! tend_t and tend_q used as workspace until needed to calculate tendencies - t => tend_t - q => tend_q + ! t_tend< and tend_dtdq used as workspace until needed to calculate tendencies + t => t_tend + q => q_tend t = state_t q = state_q ! Find gridpoints with unstable stratification - do i = 1, horizontal_loop_extent - cappa = 0.5_kind_phys*(cappav(i,2) + cappav(i,1)) - gammad = cappa*0.5_kind_phys*(t(i,2) + t(i,1))/pint(i,2) + do i = 1, ncol + cappaint = 0.5_kind_phys*(cappa(i,2) + cappa(i,1)) + gammad = cappaint*0.5_kind_phys*(t(i,2) + t(i,1))/pint(i,2) dtdp = (t(i,2) - t(i,1))/(pmid(i,2) - pmid(i,1)) dodad(i) = (dtdp + zeps) .gt. gammad end do - dadpdf(:horizontal_loop_extent,:) = 0._kind_phys + dadpdf(:ncol,:) = 0._kind_phys do k= 2, nlvdry - do i = 1, horizontal_loop_extent - cappa = 0.5_kind_phys*(cappav(i,k+1) + cappav(i,k)) - gammad = cappa*0.5_kind_phys*(t(i,k+1) + t(i,k))/pint(i,k+1) + do i = 1, ncol + cappaint = 0.5_kind_phys*(cappa(i,k+1) + cappa(i,k)) + gammad = cappaint*0.5_kind_phys*(t(i,k+1) + t(i,k))/pint(i,k+1) dtdp = (t(i,k+1) - t(i,k))/(pmid(i,k+1) - pmid(i,k)) dodad(i) = dodad(i) .or. (dtdp + zeps).gt.gammad if ((dtdp + zeps).gt.gammad) then @@ -137,10 +137,10 @@ subroutine dadadj_run( & ! Note: nlvdry ****MUST**** be < pver i=1 - do while(errflg==0 .and. i <= horizontal_loop_extent) + do while(errflg==0 .and. i <= ncol) if (dodad(i)) then do k = 1, nlvdry - c1dad(k) = cappa*0.5_kind_phys*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) + c1dad(k) = cappaint*0.5_kind_phys*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) c2dad(k) = (1._kind_phys - c1dad(k))/(1._kind_phys + c1dad(k)) rdenom = 1._kind_phys/(pdel(i,k)*c2dad(k) + pdel(i,k+1)) c3dad(k) = rdenom*pdel(i,k) @@ -189,8 +189,8 @@ subroutine dadadj_run( & deallocate(c1dad, c2dad, c3dad, c4dad) - tend_t = (t - state_t)/dt - tend_q = (q - state_q)/dt + t_tend = (t - state_t)/dt + q_tend = (q - state_q)/dt end subroutine dadadj_run diff --git a/dadadj/dadadj.meta b/dadadj/dadadj.meta new file mode 100644 index 00000000..acbb7932 --- /dev/null +++ b/dadadj/dadadj.meta @@ -0,0 +1,134 @@ +[ccpp-table-properties] + name = dadadj + type = scheme + +[ccpp-arg-table] + name = dadadj_init + type = scheme +[ dadadj_nlvdry ] + standard_name = number_of_vertical_levels_from_model_top_where_dry_adiabatic_adjustment_occurs + units = count + type = integer + dimensions = () + intent = in +[ dadadj_niter ] + standard_name = number_of_iterations_for_dry_adiabatic_adjustment_algorithm_convergence + units = count + type = integer + dimensions = () + intent = in +[ nz ] + standard_name = vertical_layer_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_flag + long_name = Error flag for error handling in CCPP + units = flag + type = integer + dimensions = () + intent = out + +[ccpp-arg-table] + name = dadadj_run + type = scheme +[ ncol ] + standard_name = horizontal_loop_extent + long_name = number of columns + units = count + dimensions = () + type = integer + intent = in +[ dt ] + standard_name = timestep_for_physics + long_name = time step + units = s + dimensions = () + type = real | kind = kind_phys + intent = in +[ pmid ] + standard_name = air_pressure + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ pint ] + standard_name = air_pressure_at_interface + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + intent = in +[ pdel ] + standard_name = air_pressure_thickness + units = Pa + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + intent = in +[ state_t ] + standard_name = air_temperature + type = real | kind = kind_phys + units = K + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = in +[ state_q ] + standard_name = water_vapor_mixing_ratio_wrt_dry_air + long_name = mass mixing ratio of water vapor / dry air + advected = True + units = kg kg-1 + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + type = real | kind = kind_phys + intent = in +[ cappa ] + standard_name = composition_dependent_ratio_of_dry_air_gas_constant_to_specific_heat_of_dry_air_at_constant_pressure + units = 1 + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + type = real | kind = kind_phys + intent = in +[ t_tend ] + standard_name = tendency_of_air_temperature + units = K s-1 + dimensions = (horizontal_dimension, vertical_layer_dimension) + type = real | kind = kind_phys + intent = out +[ q_tend ] + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ dadpdf ] + standard_name = indicator_for_dry_adiabatic_adjusted_grid_cell + units = 1 + type = real | kind = kind_phys + dimensions = (horizontal_dimension, vertical_layer_dimension) + intent = out +[ scheme_name ] + standard_name = scheme_name + units = none + type = character | kind = len=64 + dimensions = () + intent = out +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errflg ] + standard_name = ccpp_error_flag + long_name = Error flag for error handling in CCPP + units = flag + type = integer + dimensions = () + intent = out diff --git a/dadadj/dadadj_namelist.xml b/dadadj/dadadj_namelist.xml new file mode 100644 index 00000000..c5d54b5c --- /dev/null +++ b/dadadj/dadadj_namelist.xml @@ -0,0 +1,108 @@ + + + + + + + + + + + integer + dry_conv_adj + dadadj_nl + number_of_vertical_levels_from_model_top_where_dry_adiabatic_adjustment_occurs + count + + Number of layers from the top of the model over which to do dry convective adjustment. + Must be less than plev (the number of vertical levels). + + + 3 + + + + integer + dry_conv_adj + dadadj_nl + number_of_iterations_for_dry_adiabatic_adjustment_algorithm_convergence + count + + The maximum number of iterations to achieve convergence in dry adiabatic adjustment. + For WACCM-X it can be advantageous to use a number which is much higher than the CAM + + + 15 + + + diff --git a/suite_dadadj.xml b/suite_dadadj.xml new file mode 100644 index 00000000..1e9172a3 --- /dev/null +++ b/suite_dadadj.xml @@ -0,0 +1,10 @@ + + + + + dadadj + apply_tendency_of_air_temperature + qneg + geopotential_temp + + From 54dc02fe36c8d9eb5443fcbfe3b31fc9b9625f7f Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 4 Apr 2024 13:06:27 -0600 Subject: [PATCH 03/23] bug fix in loop rewrite --- dadadj/dadadj.F90 | 46 ++++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 22 deletions(-) diff --git a/dadadj/dadadj.F90 b/dadadj/dadadj.F90 index d25f0412..9dd8273c 100644 --- a/dadadj/dadadj.F90 +++ b/dadadj/dadadj.F90 @@ -89,8 +89,8 @@ subroutine dadadj_run( & real(kind_phys) :: zgamma ! intermediate constant real(kind_phys) :: qave ! mean q between levels real(kind_phys) :: cappaint ! Kappa at level intefaces - real(kind_phys), pointer :: t(:,:) - real(kind_phys), pointer :: q(:,:) + real(kind_phys), pointer :: t(:,:) + real(kind_phys), pointer :: q(:,:) logical :: ilconv ! .TRUE. ==> convergence was attained logical :: dodad(ncol) ! .TRUE. ==> do dry adjustment @@ -107,7 +107,7 @@ subroutine dadadj_run( & ! t_tend< and tend_dtdq used as workspace until needed to calculate tendencies t => t_tend q => q_tend - + t = state_t q = state_q @@ -136,10 +136,14 @@ subroutine dadadj_run( & ! Make a dry adiabatic adjustment ! Note: nlvdry ****MUST**** be < pver - i=1 - do while(errflg==0 .and. i <= ncol) + COL: do i = 1, ncol + if (dodad(i)) then + + zeps = 2.0e-5_kind_phys + do k = 1, nlvdry + cappaint = 0.5_kind_phys*(cappa(i,k+1) + cappa(i,k)) c1dad(k) = cappaint*0.5_kind_phys*(pmid(i,k+1)-pmid(i,k))/pint(i,k+1) c2dad(k) = (1._kind_phys - c1dad(k))/(1._kind_phys + c1dad(k)) rdenom = 1._kind_phys/(pdel(i,k)*c2dad(k) + pdel(i,k+1)) @@ -147,11 +151,11 @@ subroutine dadadj_run( & c4dad(k) = rdenom*pdel(i,k+1) end do - jiter = 1 ilconv = .false. - do while (.not. ilconv .and. zeps <= 1.e-4_kind_phys) + jiter = 1 - if (jiter == 1) ilconv = .true. + do while (.not. ilconv .and. jiter <= niter) + ilconv = .true. do k = 1, nlvdry zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) @@ -165,27 +169,25 @@ subroutine dadadj_run( & q(i,k+1) = qave q(i,k) = qave end if - end do - ! if reach niter double convergence criterion - if (jiter == niter ) then - zeps = zeps + zeps - jiter = 1 - else - jiter = jiter + 1 - end if + end do + jiter = jiter + 1 end do - if (zeps > 1.e-4_kind_phys) then - errflg = i - write(errmsg,*) 'dadadj_run: No convergence in column ',i - exit + if (.not. ilconv) then + zeps = zeps + zeps + if (zeps > 1.e-4_kind_phys) then + errflg = i + return ! error return + else + cycle COL + end if end if end if - i=i+1 - end do + + end do COL deallocate(c1dad, c2dad, c3dad, c4dad) From ec51f8c9db33ec72c0cecea941c101904a3ef861 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 12 Apr 2024 20:54:13 -0600 Subject: [PATCH 04/23] update main loop in dadadj to get rid of goto statement --- dadadj/dadadj.F90 | 48 +++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/dadadj/dadadj.F90 b/dadadj/dadadj.F90 index 9dd8273c..fd6d1940 100644 --- a/dadadj/dadadj.F90 +++ b/dadadj/dadadj.F90 @@ -152,38 +152,38 @@ subroutine dadadj_run( & end do ilconv = .false. - jiter = 1 - - do while (.not. ilconv .and. jiter <= niter) - ilconv = .true. - - do k = 1, nlvdry - zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) - zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) - - if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then - ilconv = .false. - t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) - t(i,k) = c2dad(k)*t(i,k+1) - qave = (pdel(i,k+1)*q(i,k+1) + pdel(i,k)*q(i,k))/(pdel(i,k+1)+ pdel(i,k)) - q(i,k+1) = qave - q(i,k) = qave - end if + + DBLZEP: do while (.not. ilconv) + + do jiter = 1, niter + ilconv = .true. + + do k = 1, nlvdry + zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) + zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) + + if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then + write(6,*)'adjusting t and q at i,k=',i,k + ilconv = .false. + t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) + t(i,k) = c2dad(k)*t(i,k+1) + qave = (pdel(i,k+1)*q(i,k+1) + pdel(i,k)*q(i,k))/(pdel(i,k+1)+ pdel(i,k)) + q(i,k+1) = qave + q(i,k) = qave + end if + + end do + + if (ilconv) cycle COL ! convergence => next longitude end do - jiter = jiter + 1 - end do - - if (.not. ilconv) then zeps = zeps + zeps if (zeps > 1.e-4_kind_phys) then errflg = i return ! error return - else - cycle COL end if - end if + end do DBLZEP end if From 8ad3e20a40126349e8e1ebccc794f90a323cf246 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 2 May 2024 17:17:03 -0600 Subject: [PATCH 05/23] update doc/ChangeLog --- doc/ChangeLog | 46 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index 062c93e3..001fbc38 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,6 +1,52 @@ =============================================================== +Tag name: atmos_phys0_02_xxx +Originator(s): jet +Date: May 3, 2024 +One-line Summary: dadadj CCPP mods +Github PR URL: hhttps://github.com/ESCOMP/atmospheric_physics/pull/ + +This PR fixes the following NCAR/atmospheric_physics Github issues: + - Creates the CCPP interface for the dadadj routine + - dadadj.F90 routine was slightly refactored to update the logic and syntax + +Code reviewed by: + +List all existing files that have been added (A), modified (M), or deleted (D), +and describe the changes: + +A dadadj/dadadj.F90 - minor refactor to the cam routine - ccpp'ize +A dadadj/dadadj.meta +A dadadj/dadadj_namelist.xml +M doc/ChangeLog +A suite_dadadj.xml - CCPP suite file + + +List and Describe any test failures: + - Tested in CAM + Because dadadj doesn't normally get tripped I modified the Temp + profile to create an instability where the code would be exercized. + The snapshot files continain this instability. The modification adds + 60 degrees to the layer 2 temperature. + + --- /project/amp/jet/collections/cam6_3_160_dryadj.042924.1856/src/dynamics/se/dyn_comp.F90 2024-05-02 16:56:49.746341064 -0600 + +++ SourceMods/src.cam/dyn_comp.F90 2024-05-02 16:37:13.171433366 -0600 + @@ -1429,6 +1429,7 @@ + do j = 1, np + do i = 1, np + elem(ie)%state%T(i,j,:,1) = dbuf3(indx,:,ie) ++ elem(ie)%state%T(i,j,2,1) = dbuf3(indx,2,ie) + 60._r8 + indx = indx + 1 + end do + end do + +Summarize any changes to answers: + - none: base code includes the same mod above to exercise code. + +=============================================================== +=============================================================== + Tag name: atmos_phys0_02_006 Originator(s): cacraig Date: April 16, 2024 From 9fd523012f7585de35c03208ea4b083c277a4239 Mon Sep 17 00:00:00 2001 From: jtruesdal Date: Tue, 28 May 2024 08:22:38 -0600 Subject: [PATCH 06/23] Update dadadj/dadadj.F90 Co-authored-by: Jesse Nusbaumer --- dadadj/dadadj.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/dadadj/dadadj.F90 b/dadadj/dadadj.F90 index fd6d1940..baeb9383 100644 --- a/dadadj/dadadj.F90 +++ b/dadadj/dadadj.F90 @@ -38,7 +38,8 @@ subroutine dadadj_init(dadadj_nlvdry, dadadj_niter, nz, errmsg, errflg) if (dadadj_nlvdry >= nz .or. dadadj_nlvdry < 0) then errflg = 1 - write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ' + write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ',& + '(',nz,'), and must be a positive integer.` end if nlvdry = dadadj_nlvdry From 75568fa0eaad6ec129bf194a7853ed0f1126422c Mon Sep 17 00:00:00 2001 From: jtruesdal Date: Tue, 28 May 2024 08:22:55 -0600 Subject: [PATCH 07/23] Update dadadj/dadadj.F90 Co-authored-by: Jesse Nusbaumer --- dadadj/dadadj.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/dadadj/dadadj.F90 b/dadadj/dadadj.F90 index baeb9383..cacd4e61 100644 --- a/dadadj/dadadj.F90 +++ b/dadadj/dadadj.F90 @@ -64,8 +64,8 @@ subroutine dadadj_run( & real(kind_phys), intent(in) :: cappa(:,:) ! variable Kappa real(kind_phys), intent(in) :: state_t(:,:) ! temperature (K) real(kind_phys), intent(in) :: state_q(:,:) ! specific humidity - real(kind_phys), intent(out), TARGET :: t_tend(:,:) ! temperature tendency - real(kind_phys), intent(out), TARGET :: q_tend(:,:) ! specific humidity tendency + real(kind_phys), intent(out), target :: t_tend(:,:) ! temperature tendency + real(kind_phys), intent(out), target :: q_tend(:,:) ! specific humidity tendency real(kind_phys), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened character(len=64), intent(out) :: scheme_name From ff9c0001995d72f0d77eaa5e1b944bf5478e8f2d Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 28 May 2024 14:49:13 -0600 Subject: [PATCH 08/23] PR mods --- doc/ChangeLog | 2 +- {dadadj => dry_adiabatic_adjust}/dadadj.F90 | 49 ++++++++++++++----- {dadadj => dry_adiabatic_adjust}/dadadj.meta | 26 +++++----- .../dadadj_namelist.xml | 4 +- suite_cam7.xml | 10 ++++ test/test_sdfs/suite_dadadj.xml | 10 ++++ 6 files changed, 73 insertions(+), 28 deletions(-) rename {dadadj => dry_adiabatic_adjust}/dadadj.F90 (83%) rename {dadadj => dry_adiabatic_adjust}/dadadj.meta (83%) rename {dadadj => dry_adiabatic_adjust}/dadadj_namelist.xml (98%) create mode 100644 suite_cam7.xml create mode 100644 test/test_sdfs/suite_dadadj.xml diff --git a/doc/ChangeLog b/doc/ChangeLog index 001fbc38..5d8cb98f 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== -Tag name: atmos_phys0_02_xxx +Tag name: atmos_phys0_0x_000 Originator(s): jet Date: May 3, 2024 One-line Summary: dadadj CCPP mods diff --git a/dadadj/dadadj.F90 b/dry_adiabatic_adjust/dadadj.F90 similarity index 83% rename from dadadj/dadadj.F90 rename to dry_adiabatic_adjust/dadadj.F90 index fd6d1940..eab3bd33 100644 --- a/dadadj/dadadj.F90 +++ b/dry_adiabatic_adjust/dadadj.F90 @@ -38,7 +38,8 @@ subroutine dadadj_init(dadadj_nlvdry, dadadj_niter, nz, errmsg, errflg) if (dadadj_nlvdry >= nz .or. dadadj_nlvdry < 0) then errflg = 1 - write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ' + write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ',& + '(',nz,'), and must be a positive integer.` end if nlvdry = dadadj_nlvdry @@ -63,8 +64,8 @@ subroutine dadadj_run( & real(kind_phys), intent(in) :: cappa(:,:) ! variable Kappa real(kind_phys), intent(in) :: state_t(:,:) ! temperature (K) real(kind_phys), intent(in) :: state_q(:,:) ! specific humidity - real(kind_phys), intent(out), TARGET :: t_tend(:,:) ! temperature tendency - real(kind_phys), intent(out), TARGET :: q_tend(:,:) ! specific humidity tendency + real(kind_phys), intent(out), target :: t_tend(:,:) ! temperature tendency + real(kind_phys), intent(out), target :: q_tend(:,:) ! specific humidity tendency real(kind_phys), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened character(len=64), intent(out) :: scheme_name @@ -102,7 +103,30 @@ subroutine dadadj_run( & errflg = 0 scheme_name = 'DADADJ' - allocate(c1dad(nlvdry), c2dad(nlvdry), c3dad(nlvdry), c4dad(nlvdry)) + allocate(c1dad(nlvdry), stat=ierr) + if (ierr /= 0) then + errcode = ierr + errmsg = trim(scheme_name)//': Allocate of c1dad(nlvdry) failed' + return + end if + allocate(c2dad(nlvdry), stat=ierr) + if (ierr /= 0) then + errcode = ierr + errmsg = trim(scheme_name)//': Allocate of c2dad(nlvdry) failed' + return + end if + allocate(c3dad(nlvdry), stat=ierr) + if (ierr /= 0) then + errcode = ierr + errmsg = trim(scheme_name)//': Allocate of c3dad(nlvdry) failed' + return + end if + allocate(c4dad(nlvdry), stat=ierr) + if (ierr /= 0) then + errcode = ierr + errmsg = trim(scheme_name)//': Allocate of c4dad(nlvdry) failed' + return + end if ! t_tend< and tend_dtdq used as workspace until needed to calculate tendencies t => t_tend @@ -117,7 +141,7 @@ subroutine dadadj_run( & cappaint = 0.5_kind_phys*(cappa(i,2) + cappa(i,1)) gammad = cappaint*0.5_kind_phys*(t(i,2) + t(i,1))/pint(i,2) dtdp = (t(i,2) - t(i,1))/(pmid(i,2) - pmid(i,1)) - dodad(i) = (dtdp + zeps) .gt. gammad + dodad(i) = (dtdp + zeps) > gammad end do dadpdf(:ncol,:) = 0._kind_phys @@ -126,8 +150,8 @@ subroutine dadadj_run( & cappaint = 0.5_kind_phys*(cappa(i,k+1) + cappa(i,k)) gammad = cappaint*0.5_kind_phys*(t(i,k+1) + t(i,k))/pint(i,k+1) dtdp = (t(i,k+1) - t(i,k))/(pmid(i,k+1) - pmid(i,k)) - dodad(i) = dodad(i) .or. (dtdp + zeps).gt.gammad - if ((dtdp + zeps).gt.gammad) then + dodad(i) = dodad(i) .or. (dtdp + zeps) > gammad + if ((dtdp + zeps) > gammad) then dadpdf(i,k) = 1._kind_phys end if end do @@ -152,18 +176,17 @@ subroutine dadadj_run( & end do ilconv = .false. - + DBLZEP: do while (.not. ilconv) - + do jiter = 1, niter ilconv = .true. do k = 1, nlvdry zepsdp = zeps*(pmid(i,k+1) - pmid(i,k)) zgamma = c1dad(k)*(t(i,k) + t(i,k+1)) - + if ((t(i,k+1)-t(i,k)) >= (zgamma+zepsdp)) then - write(6,*)'adjusting t and q at i,k=',i,k ilconv = .false. t(i,k+1) = t(i,k)*c3dad(k) + t(i,k+1)*c4dad(k) t(i,k) = c2dad(k)*t(i,k+1) @@ -171,7 +194,7 @@ subroutine dadadj_run( & q(i,k+1) = qave q(i,k) = qave end if - + end do if (ilconv) cycle COL ! convergence => next longitude @@ -181,6 +204,8 @@ subroutine dadadj_run( & zeps = zeps + zeps if (zeps > 1.e-4_kind_phys) then errflg = i + write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ',& + errmsg = trim(scheme_name)//': Convergence failure, zeps > 1.e-4' return ! error return end if end do DBLZEP diff --git a/dadadj/dadadj.meta b/dry_adiabatic_adjust/dadadj.meta similarity index 83% rename from dadadj/dadadj.meta rename to dry_adiabatic_adjust/dadadj.meta index acbb7932..0d5ec8ac 100644 --- a/dadadj/dadadj.meta +++ b/dry_adiabatic_adjust/dadadj.meta @@ -32,9 +32,9 @@ dimensions = () intent = out [ errflg ] - standard_name = ccpp_error_flag - long_name = Error flag for error handling in CCPP - units = flag + standard_name = ccpp_error_code + long_name = Error code for error handling in CCPP + units = 1 type = integer dimensions = () intent = out @@ -78,10 +78,10 @@ standard_name = air_temperature type = real | kind = kind_phys units = K - dimensions = (horizontal_dimension, vertical_layer_dimension) + dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = in [ state_q ] - standard_name = water_vapor_mixing_ratio_wrt_dry_air + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water long_name = mass mixing ratio of water vapor / dry air advected = True units = kg kg-1 @@ -97,20 +97,20 @@ [ t_tend ] standard_name = tendency_of_air_temperature units = K s-1 - dimensions = (horizontal_dimension, vertical_layer_dimension) + dimensions = (horizontal_loop_extent, vertical_layer_dimension) type = real | kind = kind_phys intent = out [ q_tend ] standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water units = kg kg-1 s-1 type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) + dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ dadpdf ] - standard_name = indicator_for_dry_adiabatic_adjusted_grid_cell - units = 1 + standard_name = binary_indicator_for_dry_adiabatic_adjusted_grid_cell + units = fraction type = real | kind = kind_phys - dimensions = (horizontal_dimension, vertical_layer_dimension) + dimensions = (horizontal_loop_extent, vertical_layer_dimension) intent = out [ scheme_name ] standard_name = scheme_name @@ -126,9 +126,9 @@ dimensions = () intent = out [ errflg ] - standard_name = ccpp_error_flag - long_name = Error flag for error handling in CCPP - units = flag + standard_name = ccpp_error_code + long_name = Error code for error handling in CCPP + units = 1 type = integer dimensions = () intent = out diff --git a/dadadj/dadadj_namelist.xml b/dry_adiabatic_adjust/dadadj_namelist.xml similarity index 98% rename from dadadj/dadadj_namelist.xml rename to dry_adiabatic_adjust/dadadj_namelist.xml index c5d54b5c..27504b75 100644 --- a/dadadj/dadadj_namelist.xml +++ b/dry_adiabatic_adjust/dadadj_namelist.xml @@ -84,7 +84,7 @@ number_of_vertical_levels_from_model_top_where_dry_adiabatic_adjustment_occurs count - Number of layers from the top of the model over which to do dry convective adjustment. + Number of layers from the top of the model over which to do dry adiabatic adjustment. Must be less than plev (the number of vertical levels). @@ -99,7 +99,7 @@ count The maximum number of iterations to achieve convergence in dry adiabatic adjustment. - For WACCM-X it can be advantageous to use a number which is much higher than the CAM + For WACCM-X it can be advantageous to use a number which is much higher than the default CAM value. 15 diff --git a/suite_cam7.xml b/suite_cam7.xml new file mode 100644 index 00000000..1e9172a3 --- /dev/null +++ b/suite_cam7.xml @@ -0,0 +1,10 @@ + + + + + dadadj + apply_tendency_of_air_temperature + qneg + geopotential_temp + + diff --git a/test/test_sdfs/suite_dadadj.xml b/test/test_sdfs/suite_dadadj.xml new file mode 100644 index 00000000..1e9172a3 --- /dev/null +++ b/test/test_sdfs/suite_dadadj.xml @@ -0,0 +1,10 @@ + + + + + dadadj + apply_tendency_of_air_temperature + qneg + geopotential_temp + + From ffd527a2f34d36245590fa6f11f14f64bf12aa4f Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 28 May 2024 15:03:37 -0600 Subject: [PATCH 09/23] rename dadadj dry_adiabatic_adjust --- {dadadj => dry_adiabatic_adjust}/dadadj.F90 | 0 {dadadj => dry_adiabatic_adjust}/dadadj.meta | 0 {dadadj => dry_adiabatic_adjust}/dadadj_namelist.xml | 0 3 files changed, 0 insertions(+), 0 deletions(-) rename {dadadj => dry_adiabatic_adjust}/dadadj.F90 (100%) rename {dadadj => dry_adiabatic_adjust}/dadadj.meta (100%) rename {dadadj => dry_adiabatic_adjust}/dadadj_namelist.xml (100%) diff --git a/dadadj/dadadj.F90 b/dry_adiabatic_adjust/dadadj.F90 similarity index 100% rename from dadadj/dadadj.F90 rename to dry_adiabatic_adjust/dadadj.F90 diff --git a/dadadj/dadadj.meta b/dry_adiabatic_adjust/dadadj.meta similarity index 100% rename from dadadj/dadadj.meta rename to dry_adiabatic_adjust/dadadj.meta diff --git a/dadadj/dadadj_namelist.xml b/dry_adiabatic_adjust/dadadj_namelist.xml similarity index 100% rename from dadadj/dadadj_namelist.xml rename to dry_adiabatic_adjust/dadadj_namelist.xml From 6ebbcd64fd9e65ddee0f798eb9e8eeb02bda6bff Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 28 May 2024 15:25:16 -0600 Subject: [PATCH 10/23] PR updates --- dry_adiabatic_adjust/dadadj.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/dry_adiabatic_adjust/dadadj.F90 b/dry_adiabatic_adjust/dadadj.F90 index eab3bd33..4431f96c 100644 --- a/dry_adiabatic_adjust/dadadj.F90 +++ b/dry_adiabatic_adjust/dadadj.F90 @@ -204,7 +204,6 @@ subroutine dadadj_run( & zeps = zeps + zeps if (zeps > 1.e-4_kind_phys) then errflg = i - write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ',& errmsg = trim(scheme_name)//': Convergence failure, zeps > 1.e-4' return ! error return end if From e4ccb3e0e891cdacc936e2eae2bd58a223a1dd20 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 30 May 2024 16:14:03 -0600 Subject: [PATCH 11/23] PR updates - rename dadadj to dry_adiabatic_adjustment --- dry_adiabatic_adjust/dadadj.F90 | 22 ++++++++----------- ...dadj.xml => suite_dry_adiabatic_adjust.xml | 2 +- 2 files changed, 10 insertions(+), 14 deletions(-) rename suite_dadadj.xml => suite_dry_adiabatic_adjust.xml (83%) diff --git a/dry_adiabatic_adjust/dadadj.F90 b/dry_adiabatic_adjust/dadadj.F90 index 4431f96c..4828bbaf 100644 --- a/dry_adiabatic_adjust/dadadj.F90 +++ b/dry_adiabatic_adjust/dadadj.F90 @@ -39,7 +39,7 @@ subroutine dadadj_init(dadadj_nlvdry, dadadj_niter, nz, errmsg, errflg) if (dadadj_nlvdry >= nz .or. dadadj_nlvdry < 0) then errflg = 1 write(errmsg,*) 'dadadj_init: dadadj_nlvdry=',dadadj_nlvdry,' but must be less than the number of vertical levels ',& - '(',nz,'), and must be a positive integer.` + '(',nz,'), and must be a positive integer.' end if nlvdry = dadadj_nlvdry @@ -103,27 +103,23 @@ subroutine dadadj_run( & errflg = 0 scheme_name = 'DADADJ' - allocate(c1dad(nlvdry), stat=ierr) - if (ierr /= 0) then - errcode = ierr + allocate(c1dad(nlvdry), stat=errflg) + if (errflg /= 0) then errmsg = trim(scheme_name)//': Allocate of c1dad(nlvdry) failed' return end if - allocate(c2dad(nlvdry), stat=ierr) - if (ierr /= 0) then - errcode = ierr + allocate(c2dad(nlvdry), stat=errflg) + if (errflg /= 0) then errmsg = trim(scheme_name)//': Allocate of c2dad(nlvdry) failed' return end if - allocate(c3dad(nlvdry), stat=ierr) - if (ierr /= 0) then - errcode = ierr + allocate(c3dad(nlvdry), stat=errflg) + if (errflg /= 0) then errmsg = trim(scheme_name)//': Allocate of c3dad(nlvdry) failed' return end if - allocate(c4dad(nlvdry), stat=ierr) - if (ierr /= 0) then - errcode = ierr + allocate(c4dad(nlvdry), stat=errflg) + if (errflg /= 0) then errmsg = trim(scheme_name)//': Allocate of c4dad(nlvdry) failed' return end if diff --git a/suite_dadadj.xml b/suite_dry_adiabatic_adjust.xml similarity index 83% rename from suite_dadadj.xml rename to suite_dry_adiabatic_adjust.xml index 1e9172a3..15c2b110 100644 --- a/suite_dadadj.xml +++ b/suite_dry_adiabatic_adjust.xml @@ -1,6 +1,6 @@ - + dadadj apply_tendency_of_air_temperature From eb6c8862df0ac37f79b4420fef553d5c3c19250a Mon Sep 17 00:00:00 2001 From: jtruesdal Date: Thu, 30 May 2024 16:18:12 -0600 Subject: [PATCH 12/23] Update suite_cam7.xml Co-authored-by: Jesse Nusbaumer --- suite_cam7.xml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/suite_cam7.xml b/suite_cam7.xml index 1e9172a3..9f36da24 100644 --- a/suite_cam7.xml +++ b/suite_cam7.xml @@ -1,6 +1,6 @@ - + dadadj apply_tendency_of_air_temperature From 5c1c3fbdefdd8551c0ef801e9711b9b197c42174 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 30 May 2024 16:46:12 -0600 Subject: [PATCH 13/23] more PR updates --- doc/NamesNotInDictionary.txt | 158 +++++++++++++++++++++++++++++++- suite_cam7.xml | 1 + suite_dry_adiabatic_adjust.xml | 1 + test/test_sdfs/suite_dadadj.xml | 10 -- 4 files changed, 159 insertions(+), 11 deletions(-) delete mode 100644 test/test_sdfs/suite_dadadj.xml diff --git a/doc/NamesNotInDictionary.txt b/doc/NamesNotInDictionary.txt index 4b463313..c112ce59 100644 --- a/doc/NamesNotInDictionary.txt +++ b/doc/NamesNotInDictionary.txt @@ -1 +1,157 @@ -All standard names are in the dictionary! + +####################### +Date/time of when script was run: +2024-05-30 16:40:13.525104 +####################### + +Non-dictionary standard names found in the following metadata files: + +-------------------------- + +/project/amp/jet/collections/CAM-SIMA_ESCOMP.043024/src/physics/ncar_ccpp/utilities/geopotential_temp.meta + + - air_pressure_at_interface + - ln_air_pressure_at_interface + +-------------------------- + +/project/amp/jet/collections/CAM-SIMA_ESCOMP.043024/src/physics/ncar_ccpp/zhang_mcfarlane/zm_conv_convtran.meta + + - atmosphere_detrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_downdraft_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_downdraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - current_timestep_number + - flag_for_zhang_mcfarlane_deep_convective_transport? + - fraction_of_water_insoluble_convectively_transported_species + - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns + - maximum_number_of_grid_cells_with_deep_convection? + - minimum_number_of_grid_cells_with_deep_convection? + - pressure_thickness_for_deep_convection_for_convective_columns + - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns + - pressure_thickness_of_dry_air_for_deep_convection_for_convective_columns? + - tendency_of_ccpp_constituents? + - vertical_index_at_top_of_deep_convection_for_convective_columns + - vertical_index_of_deep_conveciton_launch_level_for_convective_columns + +-------------------------- + +/project/amp/jet/collections/CAM-SIMA_ESCOMP.043024/src/physics/ncar_ccpp/zhang_mcfarlane/zm_conv_evap.meta + + - + - cloud_area_fraction + - flag_for_zhang_mcfarlane_convective_organization_parameterization? + - freezing_point_of_water? + - frozen_precipitation_mass_flux_at_interface_due_to_deep_convection? + - heating_rate + - latent_heat_of_fusion_of_water_at_0c? + - latent_heat_of_vaporization_of_water_at_0c? + - lwe_frozen_precipitation_rate_at_surface_due_to_deep_convection + - lwe_precipitation_rate_at_surface_due_to_deep_convection + - precipitation_mass_flux_at_interface_due_to_deep_convection? + - pressure_thickness + - specific_heat_of_dry_air_at_constant_pressure? + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_melt? + - tendency_of_dry_air_enthalpy_at_constant_pressure_due_to_frozen_precipitation_production_in_deep_convection? + - tendency_of_frozen_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection? + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection? + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection_excluding_subcloud_evaporation + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air and_condensed_water? + - tunable_evaporation_efficiency_for_land_in_zhang_mcfarlane_deep_convection_scheme? + - tunable_evaporation_efficiency_in_zhang_mcfarlane_deep_convection_scheme? + +-------------------------- + +/project/amp/jet/collections/CAM-SIMA_ESCOMP.043024/src/physics/ncar_ccpp/zhang_mcfarlane/zm_conv_momtran.meta + + - atmosphere_detrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_downdraft_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_downdraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - current_timestep_number + - eastward_and_northward_winds_in_deep_convective_downdrafts? + - enter_name + - flag_for_zhang_mcfarlane_deep_momentum_transport? + - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns + - maximum_number_of_grid_cells_with_deep_convection? + - minimum_number_of_grid_cells_with_deep_convection? + - momentum_downward_transport_parameter_for_zhang_mcfarlane? + - momentum_upward_transport_parameter_for_zhang_mcfarlane? + - pressure_thickness_for_deep_convection_for_convective_columns + - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns + - tendency_of_eastward_wind_due_to_zhang_mcfarlane_deep_convective_downdraft_pressure_gradient_term + - tendency_of_eastward_wind_due_to_zhang_mcfarlane_deep_convective_updraft_pressure_gradient_term + - tendency_of_northward_wind_due_to_zhang_mcfarlane_deep_convective_downdraft_pressure_gradient_term + - tendency_of_northward_wind_due_to_zhang_mcfarlane_deep_convective_updraft_pressure_gradient_term + - vertical_index_at_top_of_deep_convection_for_convective_columns + - vertical_index_of_deep_conveciton_launch_level_for_convective_columns + +-------------------------- + +/project/amp/jet/collections/CAM-SIMA_ESCOMP.043024/src/physics/ncar_ccpp/zhang_mcfarlane/zm_convr.meta + + - air_pressure_at_interface + - atmosphere_convective_mass_flux_due_to all_convection? + - atmosphere_detrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_downdraft_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_downdraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_updraft_convective_mass_flux_for_deep_convection_for_convective_columns + - atmosphere_updraft_entrainment_convective_mass_flux_for_deep_convection_for_convective_columns + - condensate_to_precipitation_autoconversion_coefficient_over_land_for_zhang_mcfarlane? + - condensate_to_precipitation_autoconversion_coefficient_over_ocean_for_zhang_mcfarlane? + - convective_available_potential_energy? + - convective_temperature_perturbation_due_to_pbl_eddies + - deep_convection_triggering_cape_threshold_for_zhang_mcfarlane? + - deep_convective_adjustment_timescale_for_zhang_mcfarlane? + - deep_convective_entrainment_rate_for_zhang_mcfarlane? + - deep_convective_organization_amount? + - deep_convective_organization_amount_at_single_vertical_layer_spread_over_whole_column? + - deep_convective_organization_amount_for_zhang_mcfarlane? + - detrained_cloud_droplet_number_concentration_from_deep_convection? + - detrained_cloud_ice_crystal_number_concentration_from_deep_convection? + - detrainment_mass_flux_due_to_deep_convection + - detrainment_of_cloud_ice_due_to_deep_convection + - detrainment_of_cloud_liquid_due_to_deep_convection + - enter_name + - flag_for_no_deep_convection_in_pbl? + - freezing_point_of_water? + - gas_constant_of_water_vapor? + - horizontal_index_of_convective_columns_for_deep_convection_for_convective_columns + - in_cloud_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_deep_convection + - initial_parcel_property_as_function_of_well-mixed_pbl_for_zhang_mcfarlane? + - latent_heat_of_fusion_of_water_at_0c? + - latent_heat_of_vaporization_of_water_at_0c? + - lwe_precipitation_rate_at_surface_due_to_deep_convection + - momentum_downward_transport_parameter_for_zhang_mcfarlane? + - momentum_upward_transport_parameter_for_zhang_mcfarlane? + - number_of_negative_buoyancy_regions_allowed_before_convection_top_for_zhang_mcfarlane? + - parcel_temperature_perturbation_for_zhang_mcfarlane? + - pressure_thickness_for_deep_convection_for_convective_columns + - pressure_thickness_for_subcloud_layer_for_deep_convection_for_convective_columns + - ratio_of_h2o_to_dry_air_molecular_weights? + - specific_heat_of_water_vapor_at_constant_pressure? + - tendency_of_deep_convective_organization_amount? + - tendency_of_precipitation_wrt_moist_air_and_condensed_water_due_to_deep_convection_excluding_subcloud_evaporation + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water_due_to_cloud_condensation_minus_precipitation_evaporation_in_deep_convection? + - tunable_evaporation_efficiency_for_land_in zhang_mcfarlane_deep_convection_scheme? + - tunable_evaporation_efficiency_in_zhang_mcfarlane_deep_convection_scheme? + - vertical_index_at_top_of_deep_convection_for_convective_columns + - vertical_index_of_deep_convection_launch_level_for_convective_columns + - vertical_interface_index_of_deep_convection_height_limit? + - vertically_integrated_cloud_ice_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + - vertically_integrated_cloud_liquid_tendency_due_to_all_convection_to_be_applied_later_in_time_loop + +-------------------------- + +/project/amp/jet/collections/CAM-SIMA_ESCOMP.043024/src/physics/ncar_ccpp/dry_adiabatic_adjust/dadadj.meta + + - air_pressure_at_interface + - binary_indicator_for_dry_adiabatic_adjusted_grid_cell + - number_of_iterations_for_dry_adiabatic_adjustment_algorithm_convergence + - number_of_vertical_levels_from_model_top_where_dry_adiabatic_adjustment_occurs + - tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + +####################### diff --git a/suite_cam7.xml b/suite_cam7.xml index 9f36da24..86b41a74 100644 --- a/suite_cam7.xml +++ b/suite_cam7.xml @@ -2,6 +2,7 @@ + dadadj apply_tendency_of_air_temperature qneg diff --git a/suite_dry_adiabatic_adjust.xml b/suite_dry_adiabatic_adjust.xml index 15c2b110..1ac83bac 100644 --- a/suite_dry_adiabatic_adjust.xml +++ b/suite_dry_adiabatic_adjust.xml @@ -2,6 +2,7 @@ + dadadj apply_tendency_of_air_temperature qneg diff --git a/test/test_sdfs/suite_dadadj.xml b/test/test_sdfs/suite_dadadj.xml deleted file mode 100644 index 1e9172a3..00000000 --- a/test/test_sdfs/suite_dadadj.xml +++ /dev/null @@ -1,10 +0,0 @@ - - - - - dadadj - apply_tendency_of_air_temperature - qneg - geopotential_temp - - From 31744260a964f51cacbeb6c110b7d8fed4b38751 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 30 May 2024 16:53:58 -0600 Subject: [PATCH 14/23] forgot to add test/test_sdfs directory with dry_adiabatic_adjust suite --- test/test_sdfs/suite_dry_adiabatic_adjust.xml | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 test/test_sdfs/suite_dry_adiabatic_adjust.xml diff --git a/test/test_sdfs/suite_dry_adiabatic_adjust.xml b/test/test_sdfs/suite_dry_adiabatic_adjust.xml new file mode 100644 index 00000000..1ac83bac --- /dev/null +++ b/test/test_sdfs/suite_dry_adiabatic_adjust.xml @@ -0,0 +1,11 @@ + + + + + + dadadj + apply_tendency_of_air_temperature + qneg + geopotential_temp + + From 724f30c8cc62747fefdd57d640e6e559a6873dd1 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Tue, 4 Jun 2024 12:41:54 -0600 Subject: [PATCH 15/23] PR errmsg update to indicate what column index failed to converge --- dry_adiabatic_adjust/dadadj.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/dry_adiabatic_adjust/dadadj.F90 b/dry_adiabatic_adjust/dadadj.F90 index 4828bbaf..a4e27ced 100644 --- a/dry_adiabatic_adjust/dadadj.F90 +++ b/dry_adiabatic_adjust/dadadj.F90 @@ -200,7 +200,8 @@ subroutine dadadj_run( & zeps = zeps + zeps if (zeps > 1.e-4_kind_phys) then errflg = i - errmsg = trim(scheme_name)//': Convergence failure, zeps > 1.e-4' + write(errmsg,*) trim(scheme_name)//': Convergence failure at column ',i,' zeps > 1.e-4 '// & + '(errflg set to failing column index)' return ! error return end if end do DBLZEP From 4c0f72356afa6c5453b4b21a9fb041b3a3ac155c Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 20 Jun 2024 14:41:50 -0600 Subject: [PATCH 16/23] PR updates to Changelog --- doc/ChangeLog | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index 5d8cb98f..b7e8b136 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -16,9 +16,9 @@ Code reviewed by: List all existing files that have been added (A), modified (M), or deleted (D), and describe the changes: -A dadadj/dadadj.F90 - minor refactor to the cam routine - ccpp'ize -A dadadj/dadadj.meta -A dadadj/dadadj_namelist.xml +A dry_adiabatic_adjust/dadadj.F90 - minor refactor to the cam routine - ccpp'ize +A dry_adiabatic_adjust/dadadj.meta +A dry_adiabatic_adjust/dadadj_namelist.xml M doc/ChangeLog A suite_dadadj.xml - CCPP suite file @@ -26,11 +26,12 @@ A suite_dadadj.xml - CCPP suite file List and Describe any test failures: - Tested in CAM Because dadadj doesn't normally get tripped I modified the Temp - profile to create an instability where the code would be exercized. - The snapshot files continain this instability. The modification adds + profile to create an instability where the code would be exercised. + The snapshot files contain this instability. The modification adds 60 degrees to the layer 2 temperature. - --- /project/amp/jet/collections/cam6_3_160_dryadj.042924.1856/src/dynamics/se/dyn_comp.F90 2024-05-02 16:56:49.746341064 -0600 + --- /project/amp/jet/collections/cam6_3_160_dryadj.042924.1856/src/dynamics/se/dyn_comp.F90 + 2024-05-02 16:56:49.746341064 -0600 +++ SourceMods/src.cam/dyn_comp.F90 2024-05-02 16:37:13.171433366 -0600 @@ -1429,6 +1429,7 @@ do j = 1, np From c98d6acaab123519b933e6cbc3233aaccc66af7e Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Wed, 10 Jul 2024 16:26:30 -0600 Subject: [PATCH 17/23] fix constituent update - add new update routine until standard one is available, fix roundoff err --- dry_adiabatic_adjust/dadadj.F90 | 22 +++++----- dry_adiabatic_adjust/dadadj.meta | 21 ++++++++-- .../dadadj_apply_qv_tendency.F90 | 33 +++++++++++++++ .../dadadj_apply_qv_tendency.meta | 42 +++++++++++++++++++ suite_cam7.xml | 3 +- suite_dry_adiabatic_adjust.xml | 3 +- 6 files changed, 106 insertions(+), 18 deletions(-) create mode 100644 dry_adiabatic_adjust/dadadj_apply_qv_tendency.F90 create mode 100644 dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta diff --git a/dry_adiabatic_adjust/dadadj.F90 b/dry_adiabatic_adjust/dadadj.F90 index a4e27ced..cb0baf0e 100644 --- a/dry_adiabatic_adjust/dadadj.F90 +++ b/dry_adiabatic_adjust/dadadj.F90 @@ -50,22 +50,24 @@ end subroutine dadadj_init !> \section arg_table_dadadj_run Argument Table !! \htmlinclude dadadj_run.html subroutine dadadj_run( & - ncol, dt, pmid, pint, pdel, state_t, state_q, cappa, t_tend, & + ncol, nz, dt, pmid, pint, pdel, state_t, state_q, cappa, cpair, s_tend, & q_tend, dadpdf, scheme_name, errmsg, errflg) !------------------------------------------------ ! Input / output parameters !------------------------------------------------ integer, intent(in) :: ncol ! number of atmospheric columns + integer, intent(in) :: nz ! number of atmospheric levels real(kind_phys), intent(in) :: dt ! physics timestep real(kind_phys), intent(in) :: pmid(:,:) ! pressure at model levels real(kind_phys), intent(in) :: pint(:,:) ! pressure at model interfaces real(kind_phys), intent(in) :: pdel(:,:) ! vertical delta-p real(kind_phys), intent(in) :: cappa(:,:) ! variable Kappa + real(kind_phys), intent(in) :: cpair(:,:) ! heat capacity of air real(kind_phys), intent(in) :: state_t(:,:) ! temperature (K) real(kind_phys), intent(in) :: state_q(:,:) ! specific humidity - real(kind_phys), intent(out), target :: t_tend(:,:) ! temperature tendency - real(kind_phys), intent(out), target :: q_tend(:,:) ! specific humidity tendency + real(kind_phys), intent(out) :: s_tend(:,:) ! temperature tendency + real(kind_phys), intent(out) :: q_tend(:,:) ! specific humidity tendency real(kind_phys), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened character(len=64), intent(out) :: scheme_name @@ -90,8 +92,8 @@ subroutine dadadj_run( & real(kind_phys) :: zgamma ! intermediate constant real(kind_phys) :: qave ! mean q between levels real(kind_phys) :: cappaint ! Kappa at level intefaces - real(kind_phys), pointer :: t(:,:) - real(kind_phys), pointer :: q(:,:) + real(kind_phys) :: t(ncol,nz) + real(kind_phys) :: q(ncol,nz) logical :: ilconv ! .TRUE. ==> convergence was attained logical :: dodad(ncol) ! .TRUE. ==> do dry adjustment @@ -124,10 +126,6 @@ subroutine dadadj_run( & return end if - ! t_tend< and tend_dtdq used as workspace until needed to calculate tendencies - t => t_tend - q => q_tend - t = state_t q = state_q @@ -210,11 +208,11 @@ subroutine dadadj_run( & end do COL - deallocate(c1dad, c2dad, c3dad, c4dad) - - t_tend = (t - state_t)/dt + s_tend = (t - state_t)/dt*cpair q_tend = (q - state_q)/dt + deallocate(c1dad, c2dad, c3dad, c4dad) + end subroutine dadadj_run end module dadadj diff --git a/dry_adiabatic_adjust/dadadj.meta b/dry_adiabatic_adjust/dadadj.meta index 0d5ec8ac..ee423db0 100644 --- a/dry_adiabatic_adjust/dadadj.meta +++ b/dry_adiabatic_adjust/dadadj.meta @@ -1,7 +1,6 @@ [ccpp-table-properties] name = dadadj type = scheme - [ccpp-arg-table] name = dadadj_init type = scheme @@ -39,6 +38,7 @@ dimensions = () intent = out +######################################################### [ccpp-arg-table] name = dadadj_run type = scheme @@ -49,6 +49,13 @@ dimensions = () type = integer intent = in +[ nz ] + standard_name = vertical_layer_dimension + long_name = number of vertical layers + units = count + dimensions = () + type = integer + intent = in [ dt ] standard_name = timestep_for_physics long_name = time step @@ -94,11 +101,17 @@ dimensions = (horizontal_loop_extent, vertical_layer_dimension) type = real | kind = kind_phys intent = in -[ t_tend ] - standard_name = tendency_of_air_temperature - units = K s-1 +[ cpair ] + standard_name = composition_dependent_specific_heat_of_dry_air_at_constant_pressure + units = J kg-1 K-1 dimensions = (horizontal_loop_extent, vertical_layer_dimension) type = real | kind = kind_phys + intent = in +[ s_tend ] + standard_name = tendency_of_dry_air_enthalpy_at_constant_pressure + units = J kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent,vertical_layer_dimension) intent = out [ q_tend ] standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water diff --git a/dry_adiabatic_adjust/dadadj_apply_qv_tendency.F90 b/dry_adiabatic_adjust/dadadj_apply_qv_tendency.F90 new file mode 100644 index 00000000..5987e313 --- /dev/null +++ b/dry_adiabatic_adjust/dadadj_apply_qv_tendency.F90 @@ -0,0 +1,33 @@ +module dadadj_apply_qv_tendency + + use ccpp_kinds, only: kind_phys + + implicit none + private + + public :: dadadj_apply_qv_tendency_run + +CONTAINS + + !> \section arg_table_dadadj_apply_qv_tendency_run Argument Table + !! \htmlinclude dadadj_apply_qv_tendency_run.html + subroutine dadadj_apply_qv_tendency_run(q_tend, state_q, dt, errmsg, errcode) + + ! update the constituent state. + ! Replace this with standard constitutent update function. + + ! Dummy arguments + real(kind_phys), intent(in) :: q_tend(:,:) ! water vapor tendency + real(kind_phys), intent(inout) :: state_q(:,:) ! water vapor + real(kind_phys), intent(in) :: dt ! physics time step + character(len=512), intent(out) :: errmsg + integer, intent(out) :: errcode + + errcode = 0 + errmsg = '' + + state_q = state_q + (q_tend * dt) + + end subroutine dadadj_apply_qv_tendency_run + +end module dadadj_apply_qv_tendency diff --git a/dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta b/dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta new file mode 100644 index 00000000..a9dec3ea --- /dev/null +++ b/dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta @@ -0,0 +1,42 @@ +[ccpp-table-properties] + name = dadadj_apply_qv_tendency + type = scheme +######################################################### +[ccpp-arg-table] + name = dadadj_apply_qv_tendency_run + type = scheme +[ q_tend ] + standard_name = tendency_of_water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + units = kg kg-1 s-1 + type = real | kind = kind_phys + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + intent = in +[ state_q ] + standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water + long_name = mass mixing ratio of water vapor / dry air + advected = True + units = kg kg-1 + dimensions = (horizontal_loop_extent, vertical_layer_dimension) + type = real | kind = kind_phys + intent = inout +[ dt ] + standard_name = timestep_for_physics + long_name = time step + units = s + dimensions = () + type = real | kind = kind_phys + intent = in +[ errmsg ] + standard_name = ccpp_error_message + long_name = Error message for error handling in CCPP + units = none + type = character | kind = len=512 + dimensions = () + intent = out +[ errcode ] + standard_name = ccpp_error_code + long_name = Error flag for error handling in CCPP + units = 1 + type = integer + dimensions = () + intent = out diff --git a/suite_cam7.xml b/suite_cam7.xml index 86b41a74..1cb64eb3 100644 --- a/suite_cam7.xml +++ b/suite_cam7.xml @@ -4,7 +4,8 @@ dadadj - apply_tendency_of_air_temperature + dadadj_apply_qv_tendency + apply_heating_rate qneg geopotential_temp diff --git a/suite_dry_adiabatic_adjust.xml b/suite_dry_adiabatic_adjust.xml index 1ac83bac..5bcb11a2 100644 --- a/suite_dry_adiabatic_adjust.xml +++ b/suite_dry_adiabatic_adjust.xml @@ -4,7 +4,8 @@ dadadj - apply_tendency_of_air_temperature + dadadj_apply_qv_tendency + apply_heating_rate qneg geopotential_temp From 26591e18a42d1b535d097fc45b720e61129025ef Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Thu, 11 Jul 2024 11:42:32 -0600 Subject: [PATCH 18/23] dry adiabatic suite moved to test_sdfs subdirectory, cam7 suite will contain new ccpp parameterizations. dadadj is first one --- suite_dry_adiabatic_adjust.xml | 12 ------------ test/test_sdfs/suite_dry_adiabatic_adjust.xml | 3 ++- 2 files changed, 2 insertions(+), 13 deletions(-) delete mode 100644 suite_dry_adiabatic_adjust.xml diff --git a/suite_dry_adiabatic_adjust.xml b/suite_dry_adiabatic_adjust.xml deleted file mode 100644 index 5bcb11a2..00000000 --- a/suite_dry_adiabatic_adjust.xml +++ /dev/null @@ -1,12 +0,0 @@ - - - - - - dadadj - dadadj_apply_qv_tendency - apply_heating_rate - qneg - geopotential_temp - - diff --git a/test/test_sdfs/suite_dry_adiabatic_adjust.xml b/test/test_sdfs/suite_dry_adiabatic_adjust.xml index 1ac83bac..5bcb11a2 100644 --- a/test/test_sdfs/suite_dry_adiabatic_adjust.xml +++ b/test/test_sdfs/suite_dry_adiabatic_adjust.xml @@ -4,7 +4,8 @@ dadadj - apply_tendency_of_air_temperature + dadadj_apply_qv_tendency + apply_heating_rate qneg geopotential_temp From 4a27c3d54447b787c05d6b4f22115fa4d4632141 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 12 Jul 2024 11:03:09 -0600 Subject: [PATCH 19/23] ChangeLog update --- doc/ChangeLog | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index b7e8b136..1003d9d2 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -16,12 +16,15 @@ Code reviewed by: List all existing files that have been added (A), modified (M), or deleted (D), and describe the changes: +A dadadj_apply_qv_tendency.F90 - temp file to update constituent tendency +A dadadj_apply_qv_tendency.meta A dry_adiabatic_adjust/dadadj.F90 - minor refactor to the cam routine - ccpp'ize A dry_adiabatic_adjust/dadadj.meta A dry_adiabatic_adjust/dadadj_namelist.xml M doc/ChangeLog -A suite_dadadj.xml - CCPP suite file - +A test/test_sdfs/suite_dry_adiabatic_adjust.xml - CCPP suite file for testing +M suite_cam7.xml - added dry adiabatic adjust to cam7 CCPP suite file +M NamesNotInDictionary.txt - updated with current set of names List and Describe any test failures: - Tested in CAM From 23d7e14a4766be0c038b6e6f56a11bd8ccbdbd42 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 12 Jul 2024 11:18:09 -0600 Subject: [PATCH 20/23] ChangeLog update --- doc/ChangeLog | 99 ++++++++++++++++++++++++++------------------------- 1 file changed, 50 insertions(+), 49 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index a7151a29..abe4368d 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,5 +1,55 @@ =============================================================== +Tag name: atmos_phys0_0x_xxx +Originator(s): jet +Date: May 3, 2024 +One-line Summary: dadadj CCPP mods +Github PR URL: hhttps://github.com/ESCOMP/atmospheric_physics/pull/ + +This PR fixes the following NCAR/atmospheric_physics Github issues: + - Creates the CCPP interface for the dadadj routine + - dadadj.F90 routine was slightly refactored to update the logic and syntax + +Code reviewed by: + +List all existing files that have been added (A), modified (M), or deleted (D), +and describe the changes: + +A dadadj_apply_qv_tendency.F90 - temp file to update constituent tendency +A dadadj_apply_qv_tendency.meta +A dry_adiabatic_adjust/dadadj.F90 - minor refactor to the cam routine - ccpp'ize +A dry_adiabatic_adjust/dadadj.meta +A dry_adiabatic_adjust/dadadj_namelist.xml +M doc/ChangeLog +A test/test_sdfs/suite_dry_adiabatic_adjust.xml - CCPP suite file for testing +M suite_cam7.xml - added dry adiabatic adjust to cam7 CCPP suite file +M NamesNotInDictionary.txt - updated with current set of names + +List and Describe any test failures: + - Tested in CAM + Because dadadj doesn't normally get tripped I modified the Temp + profile to create an instability where the code would be exercised. + The snapshot files contain this instability. The modification adds + 60 degrees to the layer 2 temperature. + + --- /project/amp/jet/collections/cam6_3_160_dryadj.042924.1856/src/dynamics/se/dyn_comp.F90 + 2024-05-02 16:56:49.746341064 -0600 + +++ SourceMods/src.cam/dyn_comp.F90 2024-05-02 16:37:13.171433366 -0600 + @@ -1429,6 +1429,7 @@ + do j = 1, np + do i = 1, np + elem(ie)%state%T(i,j,:,1) = dbuf3(indx,:,ie) ++ elem(ie)%state%T(i,j,2,1) = dbuf3(indx,2,ie) + 60._r8 + indx = indx + 1 + end do + end do + +Summarize any changes to answers: + - none: base code includes the same mod above to exercise code. + +=============================================================== +=============================================================== + Tag name: atmos_phys0_03_00 Originator(s): mwaxmonsky Date: June 18, 2024 @@ -61,55 +111,6 @@ water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water ********** End Physics Check Data Results ********** -=============================================================== - -Tag name: atmos_phys0_0x_000 -Originator(s): jet -Date: May 3, 2024 -One-line Summary: dadadj CCPP mods -Github PR URL: hhttps://github.com/ESCOMP/atmospheric_physics/pull/ - -This PR fixes the following NCAR/atmospheric_physics Github issues: - - Creates the CCPP interface for the dadadj routine - - dadadj.F90 routine was slightly refactored to update the logic and syntax - -Code reviewed by: - -List all existing files that have been added (A), modified (M), or deleted (D), -and describe the changes: - -A dadadj_apply_qv_tendency.F90 - temp file to update constituent tendency -A dadadj_apply_qv_tendency.meta -A dry_adiabatic_adjust/dadadj.F90 - minor refactor to the cam routine - ccpp'ize -A dry_adiabatic_adjust/dadadj.meta -A dry_adiabatic_adjust/dadadj_namelist.xml -M doc/ChangeLog -A test/test_sdfs/suite_dry_adiabatic_adjust.xml - CCPP suite file for testing -M suite_cam7.xml - added dry adiabatic adjust to cam7 CCPP suite file -M NamesNotInDictionary.txt - updated with current set of names - -List and Describe any test failures: - - Tested in CAM - Because dadadj doesn't normally get tripped I modified the Temp - profile to create an instability where the code would be exercised. - The snapshot files contain this instability. The modification adds - 60 degrees to the layer 2 temperature. - - --- /project/amp/jet/collections/cam6_3_160_dryadj.042924.1856/src/dynamics/se/dyn_comp.F90 - 2024-05-02 16:56:49.746341064 -0600 - +++ SourceMods/src.cam/dyn_comp.F90 2024-05-02 16:37:13.171433366 -0600 - @@ -1429,6 +1429,7 @@ - do j = 1, np - do i = 1, np - elem(ie)%state%T(i,j,:,1) = dbuf3(indx,:,ie) -+ elem(ie)%state%T(i,j,2,1) = dbuf3(indx,2,ie) + 60._r8 - indx = indx + 1 - end do - end do - -Summarize any changes to answers: - - none: base code includes the same mod above to exercise code. - =============================================================== =============================================================== From 01a0dc2d84f25304dabd2ace98eb94c397cbe540 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 12 Jul 2024 11:22:38 -0600 Subject: [PATCH 21/23] ChangeLog corr --- doc/ChangeLog | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index abe4368d..cffc6e89 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -15,8 +15,8 @@ Code reviewed by: List all existing files that have been added (A), modified (M), or deleted (D), and describe the changes: -A dadadj_apply_qv_tendency.F90 - temp file to update constituent tendency -A dadadj_apply_qv_tendency.meta +A dry_adiabatic_adjust/dadadj_apply_qv_tendency.F90 - temp file to update constituent tendency +A dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta A dry_adiabatic_adjust/dadadj.F90 - minor refactor to the cam routine - ccpp'ize A dry_adiabatic_adjust/dadadj.meta A dry_adiabatic_adjust/dadadj_namelist.xml From 9a44dbff8093e9c836ab6b6f107f074cb84a6967 Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Fri, 12 Jul 2024 11:29:45 -0600 Subject: [PATCH 22/23] ChangeLog corr --- doc/ChangeLog | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index cffc6e89..e5e7d5cb 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -16,9 +16,9 @@ List all existing files that have been added (A), modified (M), or deleted (D), and describe the changes: A dry_adiabatic_adjust/dadadj_apply_qv_tendency.F90 - temp file to update constituent tendency -A dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta -A dry_adiabatic_adjust/dadadj.F90 - minor refactor to the cam routine - ccpp'ize -A dry_adiabatic_adjust/dadadj.meta +A dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta - SIMA meta file for F90 routine +A dry_adiabatic_adjust/dadadj.F90 - minor refactor to the cam routine - CCPP'ize +A dry_adiabatic_adjust/dadadj.meta - SIMA meta file for F90 routine A dry_adiabatic_adjust/dadadj_namelist.xml M doc/ChangeLog A test/test_sdfs/suite_dry_adiabatic_adjust.xml - CCPP suite file for testing From 1e70ee7aa09a08a6c1375c9077118662d174b5ae Mon Sep 17 00:00:00 2001 From: John Truesdale Date: Mon, 15 Jul 2024 12:26:30 -0600 Subject: [PATCH 23/23] minor PR updates to comments, ChangeLog and meta data --- doc/ChangeLog | 12 +++++++++--- dry_adiabatic_adjust/dadadj.F90 | 2 +- dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta | 2 +- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index e5e7d5cb..3f7a758e 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,16 +1,22 @@ =============================================================== -Tag name: atmos_phys0_0x_xxx +Tag name: atmos_phys0_04_000 Originator(s): jet Date: May 3, 2024 One-line Summary: dadadj CCPP mods -Github PR URL: hhttps://github.com/ESCOMP/atmospheric_physics/pull/ +Github PR URL: https://github.com/ESCOMP/atmospheric_physics/pull/91 This PR fixes the following NCAR/atmospheric_physics Github issues: - Creates the CCPP interface for the dadadj routine - dadadj.F90 routine was slightly refactored to update the logic and syntax -Code reviewed by: +Additionally it was discovered that the temporary variable for cappa interface was + not set properly each time through the loop that makes the dry adiabatic adjustment. + This bug was fixed as part of this PR with the following line. + + cappaint = 0.5_kind_phys*(cappa(i,k+1) + cappa(i,k)) + +Code reviewed by: nusbaume, cacraigucar List all existing files that have been added (A), modified (M), or deleted (D), and describe the changes: diff --git a/dry_adiabatic_adjust/dadadj.F90 b/dry_adiabatic_adjust/dadadj.F90 index cb0baf0e..18d0a0a3 100644 --- a/dry_adiabatic_adjust/dadadj.F90 +++ b/dry_adiabatic_adjust/dadadj.F90 @@ -66,7 +66,7 @@ subroutine dadadj_run( & real(kind_phys), intent(in) :: cpair(:,:) ! heat capacity of air real(kind_phys), intent(in) :: state_t(:,:) ! temperature (K) real(kind_phys), intent(in) :: state_q(:,:) ! specific humidity - real(kind_phys), intent(out) :: s_tend(:,:) ! temperature tendency + real(kind_phys), intent(out) :: s_tend(:,:) ! dry air enthalpy tendency real(kind_phys), intent(out) :: q_tend(:,:) ! specific humidity tendency real(kind_phys), intent(out) :: dadpdf(:,:) ! PDF of where adjustments happened diff --git a/dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta b/dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta index a9dec3ea..7b2b2f59 100644 --- a/dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta +++ b/dry_adiabatic_adjust/dadadj_apply_qv_tendency.meta @@ -13,7 +13,7 @@ intent = in [ state_q ] standard_name = water_vapor_mixing_ratio_wrt_moist_air_and_condensed_water - long_name = mass mixing ratio of water vapor / dry air + long_name = mass mixing ratio of water vapor / moist air and condensed water advected = True units = kg kg-1 dimensions = (horizontal_loop_extent, vertical_layer_dimension)