Skip to content

Commit

Permalink
Merge pull request #59 from SamuelTrahanNOAA/sing_prec_from_main
Browse files Browse the repository at this point in the history 
32-bit physics with FV3_RAP
  • Loading branch information
@pjpegion
pjpegion authored Jul 19, 2022
2 parents 5232846 + 471baa8 commit 3bfa446
Show file tree
Hide file tree
Showing 14 changed files with 234 additions and 209 deletions.
13 changes: 11 additions & 2 deletions CMakeLists.txt
View file
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
View file
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
View file
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
View file
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
View file
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
View file
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

0 comments on commit 3bfa446

Please sign in to comment.