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.

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

32-bit physics in FV3_RAP #930

Merged
merged 26 commits into from
Jul 19, 2022
Merged
Show file tree
Hide file tree
Changes from 24 commits
Commits
Show all changes
26 commits
Select commit Hold shift + click to select a range
213adc6
Update .gitmodules and submodule pointer for ccpp-physics for code re…
climbfuji May 22, 2022
a769f64
Interface changes in physics/aer_cloud.F to compile in single precision
climbfuji May 22, 2022
35fdb06
Change working precision in physics/flake.F90 to support compiling ph…
climbfuji May 22, 2022
a35dfda
Interface changes in physics/rrtmgp_lw_cloud_sampling.F90 and physics…
climbfuji May 22, 2022
82250de
Fix argument mismatch in w3nco subroutine calls
DusanJovic-NOAA May 26, 2022
510b51c
All suites can compile 32-bit.
SamuelTrahanNOAA Jun 7, 2022
0afd7d1
Merge commit '99f32c55b66160cfd75f5002d9b5ba7320e443a2' into i_hate_git
SamuelTrahanNOAA Jun 22, 2022
dbf9f51
merge 01e3d6b35c44b1f32abe8b294b414cc29b0ab554 (gsl fork)
SamuelTrahanNOAA Jun 22, 2022
d6978a2
Use max(...,1e-7) in 1-exner comparision for single precision
SamuelTrahanNOAA Jun 22, 2022
a0f46cb
flake gets its types from machine.F
SamuelTrahanNOAA Jun 22, 2022
2c720da
module_mp_fer_hires gets its types from machine.F
SamuelTrahanNOAA Jun 22, 2022
3ef025a
Merge commit '6e58242e1776b96db1297942f0ea6d961e7dde37' into i_hate_git
SamuelTrahanNOAA Jun 22, 2022
ad5a56f
merge 942f9adcef364f463158c7e7a097a97b4ddb76f7 (neptune 32-bit changes)
SamuelTrahanNOAA Jun 22, 2022
a9c97bb
Clean up machine.F and get rid of kind_evod & kind_rad
SamuelTrahanNOAA Jun 22, 2022
02bae89
Merge commit '77bcfb1b39f7e737ccffee842031dae228240227' into i_hate_git
SamuelTrahanNOAA Jun 22, 2022
9d7a3a5
Merge commit '1a9b050c342541b24638053dd7dcd60dd8653c7e' into i_hate_git
SamuelTrahanNOAA Jun 22, 2022
ddd21d3
Merge commit 'f25b5c402490835fe68d2693351d3e42cc3ed3cf' into i_hate_git
SamuelTrahanNOAA Jun 23, 2022
e775045
merge a35dfda1 (hopefully get all suites to compile)
SamuelTrahanNOAA Jun 23, 2022
78caef9
point to sam's rte-rrtmgp
SamuelTrahanNOAA Jun 23, 2022
fe8b228
merge working_32bit
SamuelTrahanNOAA Jun 23, 2022
855bf86
revert physics/aer_cloud.F to working_32bit version
SamuelTrahanNOAA Jun 23, 2022
d7a244f
point to authoritative repository for rte-rrtmgp
SamuelTrahanNOAA Jun 27, 2022
8b21863
Merge remote-tracking branch 'community/main' into sing_prec_from_main
SamuelTrahanNOAA Jul 1, 2022
70cdc31
correct a type mismatch in a call in module_sf_noahmplsm
SamuelTrahanNOAA Jul 1, 2022
18e35c6
better names for new variables in physics/module_sf_noahmplsm.f90
SamuelTrahanNOAA Jul 5, 2022
948471f
merge main and point to top of dtc/ccpp for physics/rte-rrtmgp
SamuelTrahanNOAA Jul 5, 2022
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
8 changes: 8 additions & 0 deletions physics/GFS_suite_interstitial_3.F90
Original file line number Diff line number Diff line change
Expand Up @@ -148,11 +148,19 @@ subroutine GFS_suite_interstitial_3_run (otsptflag, &
do k=1,levs
do i=1,im
kk = max(10,kpbl(i))
#ifdef SINGLE_PREC
if (k < kk) then
tem = rhcbot - (rhcbot-rhcpbl) * (one-prslk(i,k)) / max(one-prslk(i,kk),1e-7)
else
tem = rhcpbl - (rhcpbl-rhctop) * (prslk(i,kk)-prslk(i,k)) / max(prslk(i,kk),1e-7)
endif
#else
if (k < kk) then
tem = rhcbot - (rhcbot-rhcpbl) * (one-prslk(i,k)) / (one-prslk(i,kk))
else
tem = rhcpbl - (rhcpbl-rhctop) * (prslk(i,kk)-prslk(i,k)) / prslk(i,kk)
endif
#endif
tem = rhcmax * work1(i) + tem * work2(i)
rhc(i,k) = max(zero, min(one,tem))
enddo
Expand Down
22 changes: 17 additions & 5 deletions physics/GFS_time_vary_pre.fv3.F90
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr,
nslwr, nhfrad, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, &
kdt, julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg)

use machine, only: kind_phys
use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec

implicit none

Expand All @@ -92,8 +92,10 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr,

real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys
real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys
real(kind=kind_phys) :: rinc(5)
real(kind=kind_sngl_prec) :: rinc4(5)
real(kind=kind_dbl_prec) :: rinc8(5)

integer :: w3kindreal,w3kindint
integer :: iw3jdn
integer :: jd0, jd1
real :: fjd
Expand All @@ -111,9 +113,19 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr,

!--- jdat is being updated directly inside of FV3GFS_cap.F90
!--- update calendars and triggers
rinc(1:5) = 0
call w3difdat(jdat,idat,4,rinc)
sec = rinc(4)
call w3kind(w3kindreal,w3kindint)
if (w3kindreal == 8) then
rinc8(1:5) = 0
call w3difdat(jdat,idat,4,rinc8)
sec = rinc8(4)
else if (w3kindreal == 4) then
rinc4(1:5) = 0
call w3difdat(jdat,idat,4,rinc4)
sec = rinc4(4)
else
write(0,*)' FATAL ERROR: Invalid w3kindreal'
call abort
endif
phour = sec/con_hr
!--- set current bucket hour
zhour = phour
Expand Down
24 changes: 18 additions & 6 deletions physics/GFS_time_vary_pre.scm.F90
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, &
nslwr, idate, debug, me, master, nscyc, sec, phour, zhour, fhour, kdt, &
julian, yearlen, ipt, lprnt, lssav, lsswr, lslwr, solhr, errmsg, errflg)

use machine, only: kind_phys
use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec

implicit none

Expand All @@ -91,8 +91,10 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, &

real(kind=kind_phys), parameter :: con_24 = 24.0_kind_phys
real(kind=kind_phys), parameter :: con_hr = 3600.0_kind_phys
real(kind=kind_phys) :: rinc(5)

real(kind=kind_sngl_prec) :: rinc4(5)
real(kind=kind_dbl_prec) :: rinc8(5)

integer :: w3kindreal,w3kindint
integer :: iw3jdn
integer :: jd0, jd1
real :: fjd
Expand All @@ -112,9 +114,19 @@ subroutine GFS_time_vary_pre_timestep_init (jdat, idat, dtp, nsswr, &
!--- jdat is being updated directly inside of the time integration
!--- loop of scm.F90
!--- update calendars and triggers
rinc(1:5) = 0
call w3difdat(jdat,idat,4,rinc)
sec = rinc(4)
call w3kind(w3kindreal,w3kindint)
if (w3kindreal == 8) then
rinc8(1:5) = 0
call w3difdat(jdat,idat,4,rinc8)
sec = rinc8(4)
else if (w3kindreal == 4) then
rinc4(1:5) = 0
call w3difdat(jdat,idat,4,rinc4)
sec = rina4c(4)
else
write(0,*)' FATAL ERROR: Invalid w3kindreal'
call abort
endif
phour = sec/con_hr
!--- set current bucket hour
zhour = phour
Expand Down
5 changes: 3 additions & 2 deletions physics/aer_cloud.F
Original file line number Diff line number Diff line change
Expand Up @@ -3477,7 +3477,8 @@ SUBROUTINE EMPIRICAL_PARAM_PHILLIPS(SI, SIW, SW, D_grid_dust,
& D_grid_bio, n_grid_bio, ijstop_bio, A_solo, n_iw, DSH,
& Nhet_dep,Nhet_dhf,fdust_dep,P_ice, T_ice)
implicit none
real, intent(IN):: SI, SIW, SW, A_solo,P_ice, T_ice
real, intent(IN):: SI, SIW, SW, A_solo
real*8, intent(IN):: P_ice, T_ice
real, dimension(:), intent(IN):: D_grid_dust, n_grid_dust,
& D_grid_soot, n_grid_soot, D_grid_bio, n_grid_bio
integer, intent(IN):: ijstop_dust, ijstop_soot, ijstop_bio
Expand All @@ -3488,7 +3489,7 @@ SUBROUTINE EMPIRICAL_PARAM_PHILLIPS(SI, SIW, SW, D_grid_dust,
& num_ic_solo_imm

real, intent (inout) :: DSH, n_iw
real, intent (out) :: Nhet_dep,Nhet_dhf,fdust_dep
real*8, intent (out) :: Nhet_dep,Nhet_dhf,fdust_dep

real :: dn_in_dust, dn_in_soot, dn_in_bio, dn_in_solo, dNall,
& dNaux, naux, SS_w, dH_frac_dust, dH_frac_soot, dH_frac_solo, aux,
Expand Down
6 changes: 4 additions & 2 deletions physics/aerinterp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,8 @@ SUBROUTINE read_aerdataf ( me, master, iflip, idate, FHOUR, errmsg, errflg)
integer :: i, j, k, n, ii, imon, klev, n1, n2
logical :: file_exist
integer IDAT(8),JDAT(8)
real(kind=kind_phys) RINC(5), rjday
real(kind=kind_phys) rjday
real(8) RINC(5)
integer jdow, jdoy, jday
real(4) rinc4(5)
integer w3kindreal,w3kindint
Expand Down Expand Up @@ -244,8 +245,9 @@ SUBROUTINE aerinterpol( me,master,nthrds,npts,IDATE,FHOUR,iflip, jindx1,jindx2,
real(kind=kind_phys) aerout(npts,lev,ntrcaer)
real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer)
real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer)
real(kind=kind_phys) RINC(5), rjday
real(kind=kind_phys) rjday
integer jdow, jdoy, jday
real(8) RINC(5)
real(4) rinc4(5)
integer w3kindreal,w3kindint

Expand Down
3 changes: 2 additions & 1 deletion physics/cires_tauamf_data.F90
Original file line number Diff line number Diff line change
Expand Up @@ -176,8 +176,9 @@ subroutine gfs_idate_calendar(idate, fhour, ddd, fddd)
!
!locals
!
real(kind=kind_phys) :: rinc(5), rjday
real(kind=kind_phys) :: rjday
integer :: jdow, jdoy, jday
real(8) :: rinc(5)
real(4) :: rinc4(5)
integer :: w3kindreal, w3kindint

Expand Down
10 changes: 5 additions & 5 deletions physics/date_def.f
Original file line number Diff line number Diff line change
@@ -1,13 +1,13 @@
module date_def
use machine, ONLY: kind_evod
use machine, ONLY: kind_phys
implicit none

!jw integer idate(4)
!jw real(kind=kind_evod) fhour,shour,thour,z00
real(kind=kind_evod) shour,thour,z00
real(kind=kind_evod),target :: fhour, zhour
!jw real(kind=kind_phys) fhour,shour,thour,z00
real(kind=kind_phys) shour,thour,z00
real(kind=kind_phys),target :: fhour, zhour
integer,target :: idate(4),idate7(7)
!
REAL(KIND=KIND_EVOD) ,ALLOCATABLE :: spdmax(:)
REAL(KIND=KIND_PHYS) ,ALLOCATABLE :: spdmax(:)

end module date_def
18 changes: 2 additions & 16 deletions physics/flake.F90
Original file line number Diff line number Diff line change
Expand Up @@ -35,23 +35,9 @@ MODULE data_parameters
!
! Description:
! Global parameters for the program are defined.
! Actually, scratch that. We'll import them from machine.F instead.
!

IMPLICIT NONE

!=======================================================================
! Global (i.e. public) Declarations:
! Parameters for the Program:

INTEGER, PARAMETER :: &
ireals = SELECTED_REAL_KIND (12,200), &
! number of desired significant digits for
! real variables
! corresponds to 8 byte real variables

iintegers = KIND (1)
! kind-type parameter of the integer values
! corresponds to the default integers
use machine, only: ireals=>kind_phys, iintegers=>kind_INTEGER

!=======================================================================

Expand Down
3 changes: 2 additions & 1 deletion physics/h2ointerp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -144,8 +144,9 @@ subroutine h2ointerpol(me,npts,idate,fhour,jindx1,jindx2,h2oplout,ddy)
!
real(kind=kind_phys) ddy(npts)
real(kind=kind_phys) h2oplout(npts,levh2o,h2o_coeff)
real(kind=kind_phys) rinc(5), rjday
real(kind=kind_phys) rjday
integer jdow, jdoy, jday
real(8) rinc(5)
real(4) rinc4(5)
integer w3kindreal, w3kindint
!
Expand Down
3 changes: 2 additions & 1 deletion physics/iccninterp.F90
Original file line number Diff line number Diff line change
Expand Up @@ -143,8 +143,9 @@ SUBROUTINE ciinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ddy, &
real(kind=kind_phys) ciplout(npts,lev),cipm(npts,kcipl)
real(kind=kind_phys) ccnout(npts,lev),ccnpm(npts,kcipl)
real(kind=kind_phys) cipres(npts,kcipl), prsl(npts,lev)
real(kind=kind_phys) RINC(5), rjday
real(kind=kind_phys) rjday
integer jdow, jdoy, jday
real(8) RINC(5)
real(4) rinc4(5)
integer w3kindreal,w3kindint
!
Expand Down
2 changes: 1 addition & 1 deletion physics/m_micro.meta
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
[ccpp-table-properties]
name = m_micro
type = scheme
dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,machine.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,physcons.F90,wv_saturation.F
dependencies = aer_cloud.F,aerclm_def.F,cldmacro.F,cldwat2m_micro.F,machine.F,micro_mg_utils.F90,micro_mg2_0.F90,micro_mg3_0.F90,physcons.F90,wv_saturation.F,machine.F

########################################################################
[ccpp-arg-table]
Expand Down
42 changes: 24 additions & 18 deletions physics/machine.F
Original file line number Diff line number Diff line change
Expand Up @@ -5,32 +5,38 @@ module machine
!!

implicit none

integer, parameter :: kind_io4 = 4, kind_io8 = 8 , kind_ior = 8 &
&, kind_evod = 8, kind_dbl_prec = 8 &
&, kind_sngl_prec = 4, kind_INTEGER = 4 &
&, kind_LOGICAL = 4

#ifdef SINGLE_PREC
integer, parameter :: kind_rad = kind_sngl_prec &
&, kind_phys = kind_sngl_prec &
&, kind_grid = kind_dbl_prec &! atmos_cubed_sphere requres kind_grid=8
&, kind_REAL = kind_sngl_prec ! used in cmp_comm
integer, parameter :: kind_sngl_prec = 4 &
&, kind_dbl_prec = 8 &
# ifdef __PGI
&, kind_qdt_prec = 8 &
# else
&, kind_qdt_prec = 16 &
# endif
&, kind_integer = 4 &
&, kind_logical = 4
&, kind_io4 = kind_sngl_prec &
&, kind_ior = kind_dbl_prec &
&, kind_grid = kind_dbl_prec

! Physics single precision flag
#ifndef SINGLE_PREC
integer, parameter :: kind_phys = kind_dbl_prec
#else
integer, parameter :: kind_rad = kind_dbl_prec &
&, kind_phys = kind_dbl_prec &
&, kind_grid = kind_dbl_prec &! atmos_cubed_sphere requres kind_grid=8
&, kind_REAL = kind_dbl_prec ! used in cmp_comm
integer, parameter :: kind_phys = kind_sngl_prec
#endif

integer, parameter :: kind_io8 = kind_phys &! Note kind_io8 is not always 8 bytes

! Dynamics single precision flag
#ifdef OVERLOAD_R4
integer, parameter :: kind_dyn = 4
integer, parameter :: kind_dyn = kind_sngl_prec
#else
integer, parameter :: kind_dyn = 8
integer, parameter :: kind_dyn = kind_dbl_prec
#endif

!
real(kind=kind_evod), parameter :: mprec = 1.e-12 ! machine precision to restrict dep
real(kind=kind_evod), parameter :: grib_undef = 9.99e20 ! grib undefine value
real(kind=kind_phys), parameter :: mprec = 1.e-12 ! machine precision to restrict dep
real(kind=kind_phys), parameter :: grib_undef = 9.99e20 ! grib undefine value
!
end module machine
3 changes: 2 additions & 1 deletion physics/module_MP_FER_HIRES.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2249,9 +2249,10 @@ REAL FUNCTION DEPOSIT (PP,Tdum,WVdum,RHgrd,I,J,L) !-- Debug 20120111
!--- Also uses the Asai (1965) algorithm, but uses a different target
! vapor pressure for the adjustment
!
use machine, only: HIGH_PRES => kind_dbl_prec
IMPLICIT NONE
!
INTEGER, PARAMETER :: HIGH_PRES=Selected_Real_Kind(15)
!INTEGER, PARAMETER :: HIGH_PRES=Selected_Real_Kind(15)
REAL (KIND=HIGH_PRES), PARAMETER :: RHLIMIT=.001, &
& RHLIMIT1=-RHLIMIT
REAL (KIND=HIGH_PRES) :: DEP, SSAT
Expand Down
3 changes: 1 addition & 2 deletions physics/module_nst_parameters.f90
Original file line number Diff line number Diff line change
Expand Up @@ -9,8 +9,7 @@
!! history:
!! 20210305: X.Li, reduce z_w_max from 30 m to 20 m
module module_nst_parameters
use machine, only : kind_phys &
,kind_rad ! for astronomy (date) calculations
use machine, only : kind_phys
!
! air constants and coefficients from the atmospehric model
use physcons, only: &
Expand Down
13 changes: 10 additions & 3 deletions physics/module_sf_noahmplsm.f90
Original file line number Diff line number Diff line change
Expand Up @@ -10823,6 +10823,7 @@ real*8 function zolri(ri,za,z0,zt,zol1,psi_opt)
real (kind=kind_phys) :: x1,x2,fx1,fx2
integer :: n
integer, parameter :: nmax = 20
real(kind=kind_phys) rphys_temp
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@SamuelTrahanNOAA for clarity, can you change this to something like rphys_dummy or rphys_temporary? at first, I was trying to figure out how this was a temperature.

it might be even more clear to name this variable zolri_iteration and the one below as zolrib_iteration or something similar.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Much better names. I just made that change.

!real, dimension(nmax):: zlhux
! real :: zolri2

Expand Down Expand Up @@ -10855,7 +10856,9 @@ real*8 function zolri(ri,za,z0,zt,zol1,psi_opt)

if (n==nmax .and. abs(x1 - x2) >= 0.01) then
!if convergence fails, use approximate values:
call li_etal_2010(zolri, ri, za/z0, z0/zt)
rphys_temp = zolri
call li_etal_2010(rphys_temp, ri, za/z0, z0/zt)
zolri = rphys_temp
!zlhux(n)=zolri
!print*,"iter fail, n=",n," ri=",ri," z0=",z0
else
Expand Down Expand Up @@ -10921,7 +10924,7 @@ real*8 function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt)
integer :: n
integer, parameter :: nmax = 20
real (kind=kind_phys), dimension(nmax):: zlhux
real (kind=kind_phys) :: psit2,psix2
real (kind=kind_phys) :: psit2,psix2,phys_temp

! real :: psim_unstable, psim_stable
! real :: psih_unstable, psih_stable
Expand Down Expand Up @@ -10972,14 +10975,18 @@ real*8 function zolrib(ri,za,z0,zt,logz0,logzt,zol1,psi_opt)
if (n==nmax .and. abs(zolold - zolrib) > 0.01 ) then
!print*,"iter fail, n=",n," ri=",ri," z/l=",zolri
!if convergence fails, use approximate values:
call li_etal_2010(zolrib, ri, za/z0, z0/zt)
phys_temp = zolrib
call li_etal_2010(phys_temp, ri, za/z0, z0/zt)
zolrib = phys_temp
zlhux(n)=zolrib
!print*,"failed, n=",n," ri=",ri," z0=",z0
!print*,"z/l=",zlhux(1:nmax)
else
!if(zolrib*ri .lt. 0.) then
! !print*,"end: wrong quadrants: z/l=",zolrib," ri=",ri
! !phys_temp = zolrib
! !call li_etal_2010(zolrib, ri, za/z0, z0/zt)
! !zolrib = phys_temp
!endif
!print*,"success,n=",n," ri=",ri," z0=",z0
endif
Expand Down
2 changes: 1 addition & 1 deletion physics/mp_nssl.F90
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
!! This module contains the front end to NSSL microphysics scheme.
module mp_nssl

use machine, only : kind_phys, kind_real
use machine, only : kind_phys
use module_mp_nssl_2mom, only : nssl_2mom_init, nssl_2mom_driver

implicit none
Expand Down
3 changes: 2 additions & 1 deletion physics/ozinterp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -147,8 +147,9 @@ SUBROUTINE ozinterpol(me,npts,IDATE,FHOUR,jindx1,jindx2,ozplout,ddy)
!
real(kind=kind_phys) DDY(npts)
real(kind=kind_phys) ozplout(npts,levozp,oz_coeff)
real(kind=kind_phys) RINC(5), rjday
real(kind=kind_phys) rjday
integer jdow, jdoy, jday
real(8) rinc(5)
real(4) rinc4(5)
integer w3kindreal,w3kindint
!
Expand Down
Loading