Skip to content
Permalink

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also or learn more about diff comparisons.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also . Learn more about diff comparisons here.
base repository: ESCOMP/CAM
Failed to load repositories. Confirm that selected base ref is valid, then try again.
Loading
base: main
Choose a base ref
...
head repository: m2lines/CAM-ML
Failed to load repositories. Confirm that selected head ref is valid, then try again.
Loading
compare: CAM-ML
Choose a head ref

There isn’t anything to compare.

ESCOMP:main and m2lines:CAM-ML are entirely different commit histories.

Showing with 58 additions and 70 deletions.
  1. +3 −3 src/physics/cam/nn_cf_net.F90
  2. +32 −40 src/physics/cam/nn_convection_flux.F90
  3. +13 −13 src/physics/cam/nn_interface_cam.F90
  4. +10 −14 src/physics/cam/yog_intr.F90
6 changes: 3 additions & 3 deletions src/physics/cam/nn_cf_net.F90
Original file line number Diff line number Diff line change
@@ -70,22 +70,22 @@ module nn_cf_net_mod

!-----------------------------------------------------------------
! Public Subroutines

subroutine relu(logits)
!! Applies ReLU to a vector.

real(4), dimension(:), intent(inout) :: logits
!! vector to which ReLU will be applied

where (logits .lt. 0.0) logits = 0.0
where (logits < 0.0) logits = 0.0

end subroutine relu


subroutine net_forward(features, logits)
!! Run forward method of the Neural Net.

real(4), dimension(:) :: features
real(4), dimension(:), intent(inout) :: features
!! Vector of input features
real(4), dimension(:), intent(out) :: logits
!! Output vector
72 changes: 32 additions & 40 deletions src/physics/cam/nn_convection_flux.F90
Original file line number Diff line number Diff line change
@@ -89,7 +89,7 @@ subroutine nn_convection_flux(tabs_i, q_i, &
!= unit (J / kg) :: t
real(8), intent(inout) :: t(:, :)
!! Liquid Ice static energy (cp*T + g*z − L(qliq + qice) − Lf*qice)

!= unit 1 :: q
real(8), intent(inout) :: q(:, :)
!! total water
@@ -100,15 +100,15 @@ subroutine nn_convection_flux(tabs_i, q_i, &
!= unit (kg / m**3) :: rho
real(8), intent(in) :: rho(:)
!! air density at pressure levels

! != unit mb :: pres
! real(8), intent(in) pres(nzm)
! !! pressure,mb at scalar levels

!= unit 1 :: adz
real(8), intent(in) :: adz(:)
!! ratio of the pressure level grid height spacing [m] to dz (lowest dz spacing)

! ---------------------
! Single value parameters from model/grid
! ---------------------
@@ -138,8 +138,8 @@ subroutine nn_convection_flux(tabs_i, q_i, &
! Local Variables
! -----------------------------------
integer i, k, dim_counter, out_dim_counter
integer nx
!! Number of x points in a subdomain
integer ncol
!! Number of columns in a subdomain
integer nzm
!! Number of z points in a subdomain - 1
! real(8) :: omn
@@ -161,7 +161,7 @@ subroutine nn_convection_flux(tabs_i, q_i, &
real(8), dimension(nrf) :: t_flux_adv, q_flux_adv, q_tend_auto, &
q_sed_flux, t_rad_rest_tend

nx = size(tabs_i, 1)
ncol = size(tabs_i, 1)
nzm = size(tabs_i, 2)

! Check that we have initialised all of the variables.
@@ -174,7 +174,7 @@ subroutine nn_convection_flux(tabs_i, q_i, &
end do

! The NN operates on atmospheric columns which have been flattened into 2D
do i=1,nx
do i=1,ncol
! Initialize variables
features = 0.
dim_counter = 0
@@ -250,21 +250,21 @@ subroutine nn_convection_flux(tabs_i, q_i, &

! total non-precip. water mix. ratio ice-sedimenting flux
q_sed_flux(1:nrf) = outputs(out_dim_counter+1:out_dim_counter+nrf)

!-----------------------------------------------------
! Apply physical constraints and update q and t

! Non-precip. water content must be >= 0, so ensure advective fluxes
! will not reduce it below 0 anywhere
do k=2,nrf
if (q_flux_adv(k).lt.0) then
if (q_flux_adv(k) < 0) then
! If flux is negative ensure we don't lose more than is already present
if ( q(i,k).lt.-q_flux_adv(k)* irhoadzdz(k)) then
if ( q(i,k) < -q_flux_adv(k)* irhoadzdz(k)) then
q_flux_adv(k) = -q(i,k)/irhoadzdz(k)
end if
else
! If flux is positive ensure we don't gain more than is in the box below
if (q(i,k-1).lt.q_flux_adv(k)* irhoadzdz(k)) then
if (q(i,k-1) < q_flux_adv(k)* irhoadzdz(k)) then
q_flux_adv(k) = q(i,k-1)/irhoadzdz(k)
end if
end if
@@ -280,7 +280,7 @@ subroutine nn_convection_flux(tabs_i, q_i, &
q_delta_adv(i,nrf) = - (0.0 - q_flux_adv(nrf)) * irhoadzdz(nrf)
! q must be >= 0 so ensure delta won't reduce it below zero
do k=1,nrf
if (q(i,k) .lt. -q_delta_adv(i,k)) then
if (q(i,k) < -q_delta_adv(i,k)) then
q_delta_adv(i,k) = -q(i,k)
end if
end do
@@ -293,7 +293,7 @@ subroutine nn_convection_flux(tabs_i, q_i, &
do k=1,nrf
omp(k) = max(0.,min(1.,(tabs(i,k)-tprmin)*a_pr))
fac(k) = (fac_cond + fac_fus * (1.0 - omp(k)))
if (q_tend_auto(k).lt.0) then
if (q_tend_auto(k) < 0) then
q_delta_auto(i,k) = - min(-q_tend_auto(k) * dtn, q(i,k))
else
q_delta_auto(i,k) = q_tend_auto(k) * dtn
@@ -307,14 +307,14 @@ subroutine nn_convection_flux(tabs_i, q_i, &

! Ensure sedimenting ice will not reduce q below zero anywhere
do k=2,nrf
if (q_sed_flux(k).lt.0) then
if (q_sed_flux(k) < 0) then
! If flux is negative ensure we don't lose more than is already present
if ( q(i,k).lt.-q_sed_flux(k)* irhoadzdz(k)) then
if ( q(i,k) < -q_sed_flux(k)* irhoadzdz(k)) then
q_sed_flux(k) = -q(i,k)/irhoadzdz(k)
end if
else
! If flux is positive ensure we don't gain more than is in the box below
if (q(i,k-1).lt.q_sed_flux(k)* irhoadzdz(k)) then
if (q(i,k-1) < q_sed_flux(k)* irhoadzdz(k)) then
q_sed_flux(k) = q(i,k-1)/irhoadzdz(k)
end if
end if
@@ -328,7 +328,7 @@ subroutine nn_convection_flux(tabs_i, q_i, &
q_delta_sed(i,nrf) = - (0.0 - q_sed_flux(nrf)) * irhoadzdz(nrf)
! q must be >= 0 so ensure delta won't reduce it below zero
do k=1,nrf
if (q_delta_sed(i,k).lt.0) then
if (q_delta_sed(i,k) < 0) then
q_delta_sed(i,k) = min(-q_delta_sed(i,k), q(i,k))
q_delta_sed(i,k) = -q_delta_sed(i,k)
end if
@@ -350,7 +350,7 @@ subroutine nn_convection_flux(tabs_i, q_i, &
precsfc(i) = precsfc(i) - q_delta_auto(i,k) * rho(k) * adz(k)
end do
precsfc(i) = precsfc(i) * dz

! As a final check enforce q must be >= 0.0
do k = 1,nrf
q(i,k) = max(0.,q(i,k))
@@ -369,9 +369,9 @@ subroutine nn_convection_flux_finalize()

end subroutine nn_convection_flux_finalize


!-----------------------------------------------------------------

subroutine error_mesg (message)
character(len=*), intent(in) :: message
!! message to be written to output (character string)
@@ -398,9 +398,8 @@ end subroutine error_mesg

!= unit mb :: esatw
real(8) function esatw(t)
implicit none
!= unit K :: t
real(8) :: t ! temperature (K)
real(8), intent(in) :: t ! temperature (K)

!= unit :: a0
!= unit :: mb / k :: a1, a2, a3, a4, a5, a6, a7, a8
@@ -422,9 +421,8 @@ end function esatw

!= unit 1 :: rsatw
real(8) function rsatw(t,p)
implicit none
!= unit K :: t
real(8) :: t ! temperature
real(8), intent(in) :: t ! temperature

!= unit mb :: p, esat
real(8) :: p ! pressure
@@ -436,8 +434,7 @@ end function rsatw


real(8) function dtesatw(t)
implicit none
real(8) :: t ! temperature (K)
real(8), intent(in) :: t ! temperature (K)
real(8) :: a0,a1,a2,a3,a4,a5,a6,a7,a8
data a0,a1,a2,a3,a4,a5,a6,a7,a8 /&
0.443956472, 0.285976452e-1, 0.794747212e-3, &
@@ -450,17 +447,15 @@ end function dtesatw


real(8) function dtrsatw(t,p)
implicit none
real(8) :: t ! temperature (K)
real(8) :: p ! pressure (mb)
real(8), intent(in) :: t ! temperature (K)
real(8), intent(in) :: p ! pressure (mb)
dtrsatw=0.622*dtesatw(t)/p
end function dtrsatw


real(8) function esati(t)
implicit none
!= unit K :: t
real(8) :: t ! temperature
real(8), intent(in) :: t ! temperature
real(8) :: a0,a1,a2,a3,a4,a5,a6,a7,a8
data a0,a1,a2,a3,a4,a5,a6,a7,a8 /&
6.11147274, 0.503160820, 0.188439774e-1, &
@@ -474,12 +469,11 @@ end function esati

!= unit 1 :: rsati
real(8) function rsati(t,p)
implicit none
!= unit t :: K
real(8) :: t ! temperature
real(8), intent(in) :: t ! temperature

!= unit mb :: p
real(8) :: p ! pressure
real(8), intent(in) :: p ! pressure

!= unit mb :: esat
real(8) :: esat
@@ -489,8 +483,7 @@ end function rsati


real(8) function dtesati(t)
implicit none
real(8) :: t ! temperature (K)
real(8), intent(in) :: t ! temperature (K)
real(8) :: a0,a1,a2,a3,a4,a5,a6,a7,a8
data a0,a1,a2,a3,a4,a5,a6,a7,a8 / &
0.503223089, 0.377174432e-1,0.126710138e-2, &
@@ -504,9 +497,8 @@ end function dtesati


real(8) function dtrsati(t,p)
implicit none
real(8) :: t ! temperature (K)
real(8) :: p ! pressure (mb)
real(8), intent(in) :: t ! temperature (K)
real(8), intent(in) :: p ! pressure (mb)
dtrsati = 0.622 * dtesati(t) / p
end function dtrsati

26 changes: 13 additions & 13 deletions src/physics/cam/nn_interface_cam.F90
Original file line number Diff line number Diff line change
@@ -128,7 +128,7 @@ subroutine nn_convection_flux_CAM(pres_cam, pres_int_cam, pres_sfc_cam, &
precsfc(:)=0.

!-----------------------------------------------------

! Interpolate CAM variables to the SAM pressure levels
! TODO Interpolate all variables in one call
! Set surface values
@@ -162,7 +162,7 @@ subroutine nn_convection_flux_CAM(pres_cam, pres_int_cam, pres_sfc_cam, &
qv_cam(1:ncol, :), qv_sam, qv_surf)

!-----------------------------------------------------

! Convert CAM Moistures and tabs to SAM q and t
call CAM_var_conversion(qv_sam, qc_sam, qi_sam, r_sam, tabs_sam, t_sam)

@@ -191,7 +191,7 @@ subroutine nn_convection_flux_CAM(pres_cam, pres_int_cam, pres_sfc_cam, &
precsfc = precsfc + precsfc_i

!-----------------------------------------------------

! Formulate the output variables to CAM as required.
call SAM_var_conversion(t_sam, r_sam, tabs_sam, qv_sam, qc_sam, qi_sam)
! Convert precipitation from kg/m^2 to m by dividing by density (1000)
@@ -232,7 +232,7 @@ end subroutine nn_convection_flux_CAM_finalize

!-----------------------------------------------------------------
! Private Subroutines

subroutine interp_to_sam(p_cam, p_surf_cam, var_cam, var_sam, var_cam_surface)
!! Interpolate from the CAM pressure grid to the SAM pressure grid.
!! Uses linear interpolation between nearest grid points on domain (CAM) grid.
@@ -534,7 +534,7 @@ end subroutine sam_sounding_finalize


subroutine CAM_var_conversion(qv, qc, qi, r, tabs, t)
!! Convert CAM moist mixing ratios for species qv, qc, qi to
!! Convert CAM moist mixing ratios for species qv, qc, qi to
!! dry mixing ratio r to used by SAM parameterisation
!! q is total water qv/c/i is cloud vapor/liquid/ice
!! Convert CAM absolute temperature to moist static energy t used by SAM
@@ -593,7 +593,7 @@ subroutine CAM_var_conversion(qv, qc, qi, r, tabs, t)
end do

end subroutine CAM_var_conversion


subroutine SAM_var_conversion(t, r, tabs, qv, qc, qi)
!! Convert SAM t and r to tabs, qv, qc, qi used by CAM
@@ -638,7 +638,7 @@ subroutine SAM_var_conversion(t, r, tabs, qv, qc, qi)
! This code is adapted from cloud.f90 in SAM
do k = 1, nz
do i = 1, ncol

! Enforce r >= 0.0
r_temp=max(0.,r(i,k))

@@ -648,10 +648,10 @@ subroutine SAM_var_conversion(t, r, tabs, qv, qc, qi)

! Set saturation vapour based on cloud type
! Warm cloud:
if(tabs1.ge.tbgmax) then
if(tabs1 >= tbgmax) then
rsat = rsatw(tabs1,pres(k))
! Ice cloud:
elseif(tabs1.le.tbgmin) then
elseif(tabs1 <= tbgmin) then
rsat = rsati(tabs1,pres(k))
! Mixed-phase cloud:
else
@@ -660,19 +660,19 @@ subroutine SAM_var_conversion(t, r, tabs, qv, qc, qi)
endif

! Test if condensation is possible (humidity is above saturation) and iterate:
if(r_temp .gt. rsat) then
if(r_temp > rsat) then
niter=0
dtabs = 100.
do while(abs(dtabs).gt.0.01.and.niter.lt.10)
do while(abs(dtabs) > 0.01 .and. niter < 10)
! Warm cloud regime
if(tabs1.ge.tbgmax) then
if(tabs1 >= tbgmax) then
om=1.
lstarn=fac_cond
dlstarn=0.
rsat=rsatw(tabs1,pres(k))
drsat=dtrsatw(tabs1,pres(k))
! Ice cloud regime
else if(tabs1.le.tbgmin) then
else if(tabs1 <= tbgmin) then
om=0.
lstarn=fac_sub
dlstarn=0.
Loading