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 with FV3_RAP #59

Merged
merged 5 commits into from
Jul 19, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
13 changes: 11 additions & 2 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -1,5 +1,14 @@
if(32BIT)
message ("Force 64 bits in stochastic_physics")
if(CCPP_32BIT)
message(STATUS "Compile stochastic_physics with 32-bit precision to match CCPP slow physics.")
add_definitions(-DCCPP_32BIT)
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -real-size 32")
elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fno-default-real-8 -fdefault-double-8")
endif()
else()
message(STATUS "Compile stochastic_physics with 64-bit precision to match CCPP slow physics.")
remove_definitions(-DCCPP_32BIT)
if(CMAKE_Fortran_COMPILER_ID MATCHES "Intel")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -real-size 64")
elseif(CMAKE_Fortran_COMPILER_ID MATCHES "GNU")
Expand Down
10 changes: 5 additions & 5 deletions cellular_automata_global.F90
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ subroutine cellular_automata_global(kstep,restart,first_time_step,ca1_cpl,ca2_cp
nca,ncells,nlives,nfracseed,nseed,iseed_ca, mytile, &
ca_smooth,nspinup,blocksize,nsmooth,ca_amplitude,mpiroot,mpicomm)

use kinddef, only: kind_dbl_prec
use kinddef, only: kind_dbl_prec, kind_phys
use update_ca, only: update_cells_global,define_ca_domain
use halo_exchange, only: atmosphere_scalar_field_halo
use random_numbers, only: random_01_CB
Expand All @@ -33,10 +33,10 @@ subroutine cellular_automata_global(kstep,restart,first_time_step,ca1_cpl,ca2_cp
integer, intent(in) :: kstep,ncells,nca,nlives,nseed,nspinup,nsmooth,mpiroot,mpicomm
integer(kind=kind_dbl_prec), intent(in) :: iseed_ca
integer, intent(in) :: mytile
real(kind=kind_dbl_prec), intent(in) :: nfracseed,ca_amplitude
real(kind=kind_phys), intent(in) :: nfracseed,ca_amplitude
logical, intent(in) :: ca_smooth,first_time_step, restart
integer, intent(in) :: nblks,isc,iec,jsc,jec,npx,npy,nlev,blocksize
real(kind=kind_dbl_prec), intent(out) :: ca1_cpl(:,:),ca2_cpl(:,:),ca3_cpl(:,:)
real(kind=kind_phys), intent(out) :: ca1_cpl(:,:),ca2_cpl(:,:),ca3_cpl(:,:)
type(domain2D), intent(inout) :: domain_in
type(block_control_type) :: Atm_block
integer :: nlon, nlat, isize,jsize,nf,nn
Expand All @@ -50,8 +50,8 @@ subroutine cellular_automata_global(kstep,restart,first_time_step,ca1_cpl,ca2_cp
integer(8) :: count, count_rate, count_max, count_trunc,nx_full
integer(8) :: iscale = 10000000000
integer, allocatable :: iini_g(:,:,:),ilives_g(:,:)
real(kind=kind_dbl_prec), allocatable :: field_out(:,:,:), field_smooth(:,:)
real(kind=kind_dbl_prec), allocatable :: CA(:,:),CA1(:,:),CA2(:,:),CA3(:,:),CAprime(:,:)
real(kind=kind_phys), allocatable :: field_out(:,:,:), field_smooth(:,:)
real(kind=kind_phys), allocatable :: CA(:,:),CA1(:,:),CA2(:,:),CA3(:,:),CAprime(:,:)
real*8 , allocatable :: noise(:,:,:)
real*8 :: psum,CAmean,sq_diff,CAstdv,inv9
real*8 :: Detmax,Detmin
Expand Down
18 changes: 9 additions & 9 deletions get_stochy_pattern.F90
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
!>@brief The module 'get_stochy_pattern_mod' contains the subroutines to retrieve the random pattern in the cubed-sphere grid
module get_stochy_pattern_mod
use kinddef, only : kind_dbl_prec, kind_evod
use kinddef
use spectral_transforms, only : len_trie_ls, &
len_trio_ls, ls_dim, stochy_la2ga, &
coslat_a, latg, levs, lonf, skeblevs,&
Expand Down Expand Up @@ -102,19 +102,19 @@ subroutine get_random_pattern_vector(rpattern,npatterns,&
type(stochy_internal_state), intent(in) :: gis_stochy
type(random_pattern), intent(inout) :: rpattern(npatterns)

real(kind=kind_evod), dimension(len_trie_ls,2) :: vrtspec_e,divspec_e
real(kind=kind_evod), dimension(len_trio_ls,2) :: vrtspec_o,divspec_o
real(kind=kind_dbl_prec), dimension(len_trie_ls,2) :: vrtspec_e,divspec_e
real(kind=kind_dbl_prec), dimension(len_trio_ls,2) :: vrtspec_o,divspec_o
integer:: npatterns

real(kind=kind_dbl_prec) :: upattern_3d(gis_stochy%nx,gis_stochy%ny,levs)
real(kind=kind_dbl_prec) :: vpattern_3d(gis_stochy%nx,gis_stochy%ny,levs)
real(kind=kind_dbl_prec) :: pattern_1d(gis_stochy%nx)
integer i,j,lat,n,nn,k
real(kind_dbl_prec), dimension(lonf,gis_stochy%lats_node_a,1):: wrk2du,wrk2dv
real(kind_phys), dimension(lonf,gis_stochy%lats_node_a,1):: wrk2du,wrk2dv

! logical lprint

real, allocatable, dimension(:,:) :: workgu,workgv
real(kind_dbl_prec), allocatable, dimension(:,:) :: workgu,workgv
integer kmsk0(lonf,gis_stochy%lats_node_a)
kmsk0 = 0
allocate(workgu(lonf,latg))
Expand Down Expand Up @@ -566,7 +566,7 @@ subroutine write_pattern(rpattern,outlun,lev,np,varid1,varid2,slice_of_3d,iret)
integer, intent(in) :: np,varid1,varid2
logical, intent(in) :: slice_of_3d
integer, intent(out) :: iret
real(kind_dbl_prec), allocatable :: pattern2d(:)
real(kind_phys), allocatable :: pattern2d(:)
integer nm,nn,arrlen,isize,ierr
integer,allocatable :: isave(:)
include 'netcdf.inc'
Expand Down Expand Up @@ -623,16 +623,16 @@ subroutine vrtdivspect_to_uvgrid(&
real(kind=kind_dbl_prec), intent(in) :: trio_di(len_trio_ls,2)
real(kind=kind_dbl_prec), intent(in) :: trie_ze(len_trie_ls,2)
real(kind=kind_dbl_prec), intent(in) :: trio_ze(len_trio_ls,2)
real(kind=kind_dbl_prec), intent(out) :: uug(lonf,gis_stochy%lats_node_a)
real(kind=kind_dbl_prec), intent(out) :: vvg(lonf,gis_stochy%lats_node_a)
real(kind=kind_phys), intent(out) :: uug(lonf,gis_stochy%lats_node_a)
real(kind=kind_phys), intent(out) :: vvg(lonf,gis_stochy%lats_node_a)
! local vars
real(kind=kind_dbl_prec) trie_ls(len_trie_ls,2,2)
real(kind=kind_dbl_prec) trio_ls(len_trio_ls,2,2)
real(kind=kind_dbl_prec) for_gr_a_1(gis_stochy%lon_dim_a,2,gis_stochy%lats_dim_a)
real(kind=kind_dbl_prec) for_gr_a_2(lonf,2,gis_stochy%lats_dim_a)
integer i,k
integer lan,lat
real (kind=kind_dbl_prec) tx1
real (kind=kind_phys) tx1

call dezouv_stochy(trie_di(:,:), trio_ze(:,:), &
trie_ls(:,:,1), trio_ls(:,:,2), gis_stochy%epsedn,gis_stochy%epsodn, &
Expand Down
6 changes: 4 additions & 2 deletions halo_exchange.fv3.F90
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,8 @@ module halo_exchange
use mpp_domains_mod, only: domain2d, mpp_update_domains
use mpp_domains_mod, only: mpp_update_domains

use kinddef, only: kind_phys

implicit none
private

Expand Down Expand Up @@ -34,14 +36,14 @@ subroutine atmosphere_scalar_field_halo (data, halo, isize, jsize, ksize, &
! data_p - optional input field in packed format (ix,k)
!--------------------------------------------------------------------
!--- interface variables ---
real*8, dimension(1:isize,1:jsize,ksize), intent(inout) :: data !< output array to return the field with halo (i,j,k)
real(kind_phys), dimension(1:isize,1:jsize,ksize), intent(inout) :: data !< output array to return the field with halo (i,j,k)
!< optionally input for field already in (i,j,k) form
!< sized to include the halo of the field (+ 2*halo)
integer, intent(in) :: halo !< size of the halo (must be less than 3)
integer, intent(in) :: isize !< horizontal resolution in i-dir with haloes
integer, intent(in) :: jsize !< horizontal resolution in j-dir with haloes
integer, intent(in) :: ksize !< vertical resolution
real*8, dimension(:,:), optional, intent(in) :: data_p !< optional input field in packed format (ix,k)
real(kind_phys), dimension(:,:), optional, intent(in) :: data_p !< optional input field in packed format (ix,k)
integer, intent(in) :: isc, iec, jsc, jec, npx, npy
type(domain2d), intent(inout) :: domain_for_coupler
!--- local variables ---
Expand Down
16 changes: 9 additions & 7 deletions kinddef.F90
Original file line number Diff line number Diff line change
Expand Up @@ -4,17 +4,19 @@ module kinddef

private

public :: kind_evod, kind_phys
public :: kind_phys
public :: kind_dbl_prec, kind_qdt_prec
public :: kind_io4, kind_io8
public :: kind_io8

integer, parameter :: kind_io4 = 4

! DH* TODO - stochastic physics / CA should be using only one of these
integer, parameter :: kind_evod = 8
! kind_phys must match CCPP Physics kind_phys
#ifdef CCPP_32BIT
integer, parameter :: kind_phys = 4
#else
integer, parameter :: kind_phys = 8
#endif

integer, parameter :: kind_dbl_prec = 8
integer, parameter :: kind_io8 = 8
integer, parameter :: kind_io8 = kind_dbl_prec

#ifdef NO_QUAD_PRECISION
integer, parameter :: kind_qdt_prec = 8
Expand Down
68 changes: 34 additions & 34 deletions lndp_apply_perts.F90
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
module lndp_apply_perts_mod

use kinddef, only : kind_dbl_prec
use kinddef, only : kind_dbl_prec, kind_phys
use stochy_namelist_def

implicit none
Expand Down Expand Up @@ -62,27 +62,27 @@ subroutine lndp_apply_perts(blksz, lsm, lsm_noah, lsm_ruc, lsm_noahmp, iopt_dveg
integer, intent(in) :: n_var_lndp, lsoil, kdt, iopt_dveg
integer, intent(in) :: lsm, lsm_noah, lsm_ruc, lsm_noahmp
character(len=3), intent(in) :: lndp_var_list(:)
real(kind=kind_dbl_prec), intent(in) :: lndp_prt_list(:)
real(kind=kind_dbl_prec), intent(in) :: dtf
real(kind=kind_dbl_prec), intent(in) :: sfc_wts(:,:,:)
real(kind=kind_dbl_prec), intent(in) :: xlon(:,:)
real(kind=kind_dbl_prec), intent(in) :: xlat(:,:)
real(kind=kind_phys), intent(in) :: lndp_prt_list(:)
real(kind=kind_phys), intent(in) :: dtf
real(kind=kind_phys), intent(in) :: sfc_wts(:,:,:)
real(kind=kind_phys), intent(in) :: xlon(:,:)
real(kind=kind_phys), intent(in) :: xlat(:,:)
logical, intent(in) :: param_update_flag
! true = parameters have just been updated by global_cycle
integer, intent(in) :: stype(:,:)
real(kind=kind_dbl_prec), intent(in) :: smcmax(:)
real(kind=kind_dbl_prec), intent(in) :: smcmin(:)
real(kind=kind_phys), intent(in) :: smcmax(:)
real(kind=kind_phys), intent(in) :: smcmin(:)

! intent(inout)
real(kind=kind_dbl_prec), intent(inout) :: smc(:,:,:)
real(kind=kind_dbl_prec), intent(inout) :: slc(:,:,:)
real(kind=kind_dbl_prec), intent(inout) :: stc(:,:,:)
real(kind=kind_dbl_prec), intent(inout) :: vfrac(:,:)
real(kind=kind_dbl_prec), intent(inout) :: snoalb(:,:)
real(kind=kind_dbl_prec), intent(inout) :: alnsf(:,:)
real(kind=kind_dbl_prec), intent(inout) :: alnwf(:,:)
real(kind=kind_dbl_prec), intent(inout) :: semis(:,:)
real(kind=kind_dbl_prec), intent(inout) :: zorll(:,:)
real(kind=kind_phys), intent(inout) :: smc(:,:,:)
real(kind=kind_phys), intent(inout) :: slc(:,:,:)
real(kind=kind_phys), intent(inout) :: stc(:,:,:)
real(kind=kind_phys), intent(inout) :: vfrac(:,:)
real(kind=kind_phys), intent(inout) :: snoalb(:,:)
real(kind=kind_phys), intent(inout) :: alnsf(:,:)
real(kind=kind_phys), intent(inout) :: alnwf(:,:)
real(kind=kind_phys), intent(inout) :: semis(:,:)
real(kind=kind_phys), intent(inout) :: zorll(:,:)

! intent(out)
integer, intent(out) :: ierr
Expand All @@ -93,20 +93,20 @@ subroutine lndp_apply_perts(blksz, lsm, lsm_noah, lsm_ruc, lsm_noahmp, iopt_dveg
integer :: this_im, v, k
logical :: print_flag, do_pert_state, do_pert_param

real(kind=kind_dbl_prec) :: p, min_bound, max_bound, pert
real(kind=kind_dbl_prec) :: tmp_smc
real(kind=kind_dbl_prec) :: conv_hr2tstep, tfactor_state, tfactor_param
real(kind=kind_dbl_prec), dimension(lsoil) :: zslayer, smc_vertscale, stc_vertscale
real(kind=kind_phys) :: p, min_bound, max_bound, pert
real(kind=kind_phys) :: tmp_smc
real(kind=kind_phys) :: conv_hr2tstep, tfactor_state, tfactor_param
real(kind=kind_phys), dimension(lsoil) :: zslayer, smc_vertscale, stc_vertscale

! decrease in applied pert with depth
!-- Noah lsm
real(kind=kind_dbl_prec), dimension(4), parameter :: smc_vertscale_noah = (/1.0,0.5,0.25,0.125/)
real(kind=kind_dbl_prec), dimension(4), parameter :: stc_vertscale_noah = (/1.0,0.5,0.25,0.125/)
real(kind=kind_dbl_prec), dimension(4), parameter :: zs_noah = (/0.1, 0.3, 0.6, 1.0/)
real(kind=kind_phys), dimension(4), parameter :: smc_vertscale_noah = (/1.0,0.5,0.25,0.125/)
real(kind=kind_phys), dimension(4), parameter :: stc_vertscale_noah = (/1.0,0.5,0.25,0.125/)
real(kind=kind_phys), dimension(4), parameter :: zs_noah = (/0.1, 0.3, 0.6, 1.0/)
!-- RUC lsm
real(kind=kind_dbl_prec), dimension(9), parameter :: smc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./)
real(kind=kind_dbl_prec), dimension(9), parameter :: stc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./)
real(kind=kind_dbl_prec), dimension(9), parameter :: zs_ruc = (/0.05, 0.15, 0.20, 0.20, 0.40, 0.60, 0.60, 0.80, 1.00/)
real(kind=kind_phys), dimension(9), parameter :: smc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./)
real(kind=kind_phys), dimension(9), parameter :: stc_vertscale_ruc = (/1.0,0.9,0.8,0.6,0.4,0.2,0.1,0.05,0./)
real(kind=kind_phys), dimension(9), parameter :: zs_ruc = (/0.05, 0.15, 0.20, 0.20, 0.40, 0.60, 0.60, 0.80, 1.00/)

ierr = 0

Expand Down Expand Up @@ -330,22 +330,22 @@ subroutine apply_pert(vname,pert,print_flag, state,ierr,p,vmin, vmax)

! intent in
logical, intent(in) :: print_flag
real(kind=kind_dbl_prec), intent(in) :: pert
real(kind=kind_phys), intent(in) :: pert
character(len=*), intent(in) :: vname ! name of variable being perturbed

real(kind=kind_dbl_prec), optional, intent(in) :: p ! flat-top paramater, 0 = no flat-top
real(kind=kind_phys), optional, intent(in) :: p ! flat-top paramater, 0 = no flat-top
! flat-top function is used for bounded variables
! to reduce the magnitude of perturbations near boundaries.
real(kind=kind_dbl_prec), optional, intent(in) :: vmin, vmax ! min,max bounds of variable being perturbed
real(kind=kind_phys), optional, intent(in) :: vmin, vmax ! min,max bounds of variable being perturbed

! intent (inout)
real(kind=kind_dbl_prec), intent(inout) :: state
real(kind=kind_phys), intent(inout) :: state

! intent out
integer :: ierr

!local
real(kind=kind_dbl_prec) :: z
real(kind=kind_phys) :: z

if ( print_flag ) then
write(*,*) 'LNDP - applying lndp to ',vname, ', initial value', state
Expand Down Expand Up @@ -385,8 +385,8 @@ subroutine set_printing_nb_i(blksz,xlon,xlat,print_i,print_nb)

! intent (in)
integer, intent(in) :: blksz(:)
real(kind=kind_dbl_prec), intent(in) :: xlon(:,:)
real(kind=kind_dbl_prec), intent(in) :: xlat(:,:)
real(kind=kind_phys), intent(in) :: xlon(:,:)
real(kind=kind_phys), intent(in) :: xlat(:,:)


! intent (out)
Expand Down
Loading