Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update array sizes used in YOG parameterisation #50

Merged
merged 2 commits into from
Nov 22, 2024
Merged

Update array sizes used in YOG parameterisation #50

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
f76b9cd
Update CAM interface to YOG to use ncol to pass appropriate array sli…
jatkinson1000 Nov 20, 2024
52c0834
Tidying of the YOG code.
jatkinson1000 Nov 21, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions src/physics/cam/nn_cf_net.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
72 changes: 32 additions & 40 deletions src/physics/cam/nn_convection_flux.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
! ---------------------
Expand Down Expand Up @@ -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
Expand All @@ -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.
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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))
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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, &
Expand All @@ -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, &
Expand All @@ -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
Expand All @@ -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, &
Expand All @@ -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

Expand Down
Loading