Changes needed for 32-bit physics

CMakeLists.txt

@@ -29,13 +29,6 @@ if(CMAKE_BUILD_TYPE STREQUAL "Debug")
   add_definitions(-DDEBUG)
 endif()
 
-if(CCPP_SINGLE_PREC)
-  message(STATUS "CCPP Single Precision Mode activated.")
-  add_definitions(SINGLE_PREC)
-else(CCPP_SINGLE_PREC)
-  message(STATUS "CCPP Double Precision Mode activated.")
-endif(CCPP_SINGLE_PREC)
-
 #------------------------------------------------------------------------------
 # Request a static build
 option(BUILD_SHARED_LIBS "Build a shared library" OFF)

physics/GFS_rrtmgp_cloud_overlap.F90

@@ -99,7 +99,7 @@ subroutine GFS_rrtmgp_cloud_overlap_run(nCol, nLev, yearlen, doSWrad, doLWrad,
     ! Cloud overlap parameter
     !
     if (iovr == iovr_dcorr .or. iovr == iovr_exp .or. iovr == iovr_exprand) then
-       call get_alpha_exper(nCol, nLev, iovr, iovr_exprand, deltaZc*0.001, de_lgth, cld_frac, cloud_overlap_param)
+       call get_alpha_exper(nCol, nLev, iovr, iovr_exprand, deltaZc*0.001_kind_phys, de_lgth, cld_frac, cloud_overlap_param)
     else
        de_lgth(:)               = 0.
        cloud_overlap_param(:,:) = 0.
@@ -110,7 +110,7 @@ subroutine GFS_rrtmgp_cloud_overlap_run(nCol, nLev, yearlen, doSWrad, doLWrad,
     !
     if (imfdeepcnv == imfdeepcnv_samf .or. imfdeepcnv == imfdeepcnv_gf) then
        if (iovr_convcld == iovr_dcorr .or. iovr_convcld == iovr_exp .or. iovr_convcld == iovr_exprand) then
-          call get_alpha_exper(nCol, nLev, iovr_convcld, iovr_exprand, deltaZc*0.001, de_lgth, cld_cnv_frac, cnv_cloud_overlap_param)
+          call get_alpha_exper(nCol, nLev, iovr_convcld, iovr_exprand, deltaZc*0.001_kind_phys, de_lgth, cld_cnv_frac, cnv_cloud_overlap_param)
        else
           de_lgth(:)                   = 0.
           cnv_cloud_overlap_param(:,:) = 0.

physics/GFS_suite_interstitial_4.F90

@@ -224,7 +224,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr
                     qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k)) / (one-spechum(i,k))
                     !> - Convert number concentration from moist to dry
                     nc_mp(i,k) = gq0(i,k,ntlnc) / (one-spechum(i,k))
-                    nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
+                    nc_mp(i,k) = max(zero, nc_mp(i,k) + make_DropletNumber(real(qc_mp(i,k) * rho), real(nwfa(i,k)*rho)) * orho)
                     !> - Convert number concentrations from dry to moist
                     gq0(i,k,ntlnc) = nc_mp(i,k) / (one+qv_mp(i,k))
                   endif
@@ -233,7 +233,7 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr
                     qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k)) / (one-spechum(i,k))
                     !> - Convert number concentration from moist to dry
                     ni_mp(i,k) = gq0(i,k,ntinc) / (one-spechum(i,k)) 
-                    ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
+                    ni_mp(i,k) = max(zero, ni_mp(i,k) + make_IceNumber(real(qi_mp(i,k) * rho), real(save_tcp(i,k)) * orho))
                     !> - Convert number concentrations from dry to moist
                     gq0(i,k,ntinc) = ni_mp(i,k) / (one+qv_mp(i,k))
                   endif
@@ -249,13 +249,13 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr
                     !> - Update cloud water mixing ratio
                     qc_mp(i,k) = (clw(i,k,2)-save_qc(i,k))
                     !> - Update cloud water number concentration
-                    gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber(qc_mp(i,k) * rho, nwfa(i,k)*rho) * orho)
+                    gq0(i,k,ntlnc) = max(zero, gq0(i,k,ntlnc) + make_DropletNumber(real(qc_mp(i,k) * rho), real(nwfa(i,k)*rho)) * orho)
                   endif
                   if (ntinc>0) then
                     !> - Update cloud ice mixing ratio
                     qi_mp(i,k) = (clw(i,k,1)-save_qi(i,k))
                     !> - Update cloud ice number concentration
-                    gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber(qi_mp(i,k) * rho, save_tcp(i,k)) * orho)
+                    gq0(i,k,ntinc) = max(zero, gq0(i,k,ntinc) + make_IceNumber(real(qi_mp(i,k) * rho), real(save_tcp(i,k))) * orho)
                   endif
                 enddo
               enddo
@@ -290,4 +290,4 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, tracers_total, ntr
 
     end subroutine GFS_suite_interstitial_4_run
 
-  end module GFS_suite_interstitial_4
+  end module GFS_suite_interstitial_4

physics/calpreciptype.f90

@@ -509,7 +509,14 @@ subroutine calwxt_ramer(lm,lp1,t,q,pmid,rh,td,pint,ptyp)
       real(kind=kind_phys)    rhmax,twmax,ptop,dpdrh,twtop,rhtop,wgt1,wgt2,    &
               rhavg,dtavg,dpk,ptw,pbot
 !     real(kind=kind_phys) b,qtmp,rate,qc
-!     real(kind=kind_phys),external :: xmytw  (now inside the module)
+!
+      interface
+         function xmytw(t,td,p)
+           use machine , only : kind_phys
+           implicit none
+           real(kind=kind_phys)   t, td, p, xmytw
+         end function xmytw
+      end interface
 !
 !  initialize.
       icefrac = -9999.

physics/machine.F

@@ -33,7 +33,7 @@ module machine
 # endif
      &,                     kind_rad  = 4                               &
      &,                     kind_phys = 4     ,kind_taum=4              &
-     &,                     kind_grid = 4                               &
+     &,                     kind_grid = 8                               &! atmos_cubed_sphere requres kind_grid=8
      &,                     kind_REAL = 4                               &! used in cmp_comm
      &,                     kind_LOGICAL = 4                            &
      &,                     kind_INTEGER = 4                             ! -,,-

physics/maximum_hourly_diagnostics.F90

@@ -144,11 +144,11 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k)
       real (kind=kind_phys), intent(in) :: grav
       real (kind=kind_phys), intent(in),dimension(:,:)  :: phil,ref3D,tk
       integer               :: i,k,ll,ipt,kpt
-      real :: dbz1avg,zmidp1,zmidloc,refl,fact
-      real, dimension(im,levs) :: z
-      real, dimension(im) :: zintsfc
-      real, dimension(:), intent(inout) :: refd,refd263k
-      REAL :: dbz1(2),dbzk,dbzk1
+      real(kind_phys) :: dbz1avg,zmidp1,zmidloc,refl,fact
+      real(kind_phys), dimension(im,levs) :: z
+      real(kind_phys), dimension(im) :: zintsfc
+      real(kind_phys), dimension(:), intent(inout) :: refd,refd263k
+      REAL(kind_phys) :: dbz1(2),dbzk,dbzk1
       logical :: counter
       do i=1,im
          do k=1,levs
@@ -185,7 +185,7 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k)
          dbz1avg=dbz1(2)+(dbz1(2)-dbz1(1))*fact
 !-- Convert to dBZ (10*logZ) as the last step
          if (dbz1avg>0.01) then
-           dbz1avg=10.*alog10(dbz1avg)
+           dbz1avg=10.*log10(dbz1avg)
          else
            dbz1avg=-35.
          endif
@@ -214,7 +214,7 @@ subroutine max_fields(phil,ref3D,grav,im,levs,refd,tk,refd263k)
          dbz1avg=maxval(dbz1)
 !-- Convert to dBZ (10*logZ) as the last step
          if (dbz1avg>0.01) then
-           dbz1avg=10.*alog10(dbz1avg)
+           dbz1avg=10.*log10(dbz1avg)
          else
            dbz1avg=-35.
          endif

physics/mersenne_twister.f

@@ -160,6 +160,7 @@
 !
 !$$$
       module mersenne_twister
+        use machine, only: kind_dbl_prec
         private
 !  Public declarations
         public random_stat
@@ -188,7 +189,7 @@ module mersenne_twister
           integer:: mti=n+1
           integer:: mt(0:n-1)
           integer:: iset
-          real:: gset
+          real(kind_dbl_prec):: gset
         end type
 !  Saved data
         type(random_stat),save:: sstat
@@ -300,8 +301,8 @@ subroutine random_setseed_t(inseed,stat)
 !> This function generates random numbers in functional mode.
         function random_number_f() result(harvest)
           implicit none
-          real:: harvest
-          real h(1)
+          real(kind_dbl_prec):: harvest
+          real(kind_dbl_prec) :: h(1)
           if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat)
           call random_number_t(h,sstat)
           harvest=h(1)
@@ -310,7 +311,7 @@ function random_number_f() result(harvest)
 !> This subroutine generates random numbers in interactive mode.
         subroutine random_number_i(harvest,inseed)
           implicit none
-          real,intent(out):: harvest(:)
+          real(kind_dbl_prec),intent(out):: harvest(:)
           integer,intent(in):: inseed
           type(random_stat) stat
           call random_setseed_t(inseed,stat)
@@ -320,15 +321,15 @@ subroutine random_number_i(harvest,inseed)
 !> This subroutine generates random numbers in saved mode; overloads Fortran 90 standard.
         subroutine random_number_s(harvest)
           implicit none
-          real,intent(out):: harvest(:)
+          real(kind_dbl_prec),intent(out):: harvest(:)
           if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat)
           call random_number_t(harvest,sstat)
         end subroutine
 !  Subprogram random_number_t
 !> This subroutine generates random numbers in thread-safe mode.
         subroutine random_number_t(harvest,stat)
           implicit none
-          real,intent(out):: harvest(:)
+          real(kind_dbl_prec),intent(out):: harvest(:)
           type(random_stat),intent(inout):: stat
           integer j,kk,y
           integer tshftu,tshfts,tshftt,tshftl
@@ -359,9 +360,12 @@ subroutine random_number_t(harvest,stat)
             y=ieor(y,iand(tshftt(y),tmaskc))
             y=ieor(y,tshftl(y))
             if(y.lt.0) then
-              harvest(j)=(real(y)+2.0**32)/(2.0**32-1.0)
+              harvest(j)=(real(y,kind=kind_dbl_prec)+                   &
+     &              2.0_kind_dbl_prec**32)/                             &
+     &              (2.0_kind_dbl_prec**32-1.0_kind_dbl_prec)
             else
-              harvest(j)=real(y)/(2.0**32-1.0)
+              harvest(j)=real(y)/(2.0_kind_dbl_prec**32-                &
+     &              1.0_kind_dbl_prec)
             endif
             stat%mti=stat%mti+1
           enddo
@@ -370,8 +374,8 @@ subroutine random_number_t(harvest,stat)
 !> This subrouitne generates Gaussian random numbers in functional mode.
         function random_gauss_f() result(harvest)
           implicit none
-          real:: harvest
-          real h(1)
+          real(kind_dbl_prec):: harvest
+          real(kind_dbl_prec) :: h(1)
           if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat)
           call random_gauss_t(h,sstat)
           harvest=h(1)
@@ -380,7 +384,7 @@ function random_gauss_f() result(harvest)
 !> This subrouitne generates Gaussian random numbers in interactive mode.
         subroutine random_gauss_i(harvest,inseed)
           implicit none
-          real,intent(out):: harvest(:)
+          real(kind_dbl_prec),intent(out):: harvest(:)
           integer,intent(in):: inseed
           type(random_stat) stat
           call random_setseed_t(inseed,stat)
@@ -390,18 +394,18 @@ subroutine random_gauss_i(harvest,inseed)
 !> This subroutine generates Gaussian random numbers in saved mode.
         subroutine random_gauss_s(harvest)
           implicit none
-          real,intent(out):: harvest(:)
+          real(kind_dbl_prec),intent(out):: harvest(:)
           if(sstat%mti.eq.n+1) call random_setseed_t(iseed,sstat)
           call random_gauss_t(harvest,sstat)
         end subroutine
 !  Subprogram random_gauss_t
 !> This subroutine generates Gaussian random numbers in thread-safe mode.
         subroutine random_gauss_t(harvest,stat)
           implicit none
-          real,intent(out):: harvest(:)
+          real(kind_dbl_prec),intent(out):: harvest(:)
           type(random_stat),intent(inout):: stat
           integer mx,my,mz,j
-          real r2(2),r,g1,g2
+          real(kind_dbl_prec) :: r2(2),r,g1,g2
           mz=size(harvest)
           if(mz.le.0) return
           mx=0
@@ -436,14 +440,14 @@ subroutine random_gauss_t(harvest,stat)
         contains
 !> This subroutine contains numerical Recipes algorithm to generate Gaussian random numbers.
           subroutine rgauss(r1,r2,r,g1,g2)
-            real,intent(in):: r1,r2
-            real,intent(out):: r,g1,g2
-            real v1,v2,fac
-            v1=2.*r1-1.
-            v2=2.*r2-1.
+            real(kind_dbl_prec),intent(in):: r1,r2
+            real(kind_dbl_prec),intent(out):: r,g1,g2
+            real(kind_dbl_prec) :: v1,v2,fac
+            v1=2._kind_dbl_prec*r1-1._kind_dbl_prec
+            v2=2._kind_dbl_prec*r2-1._kind_dbl_prec
             r=v1**2+v2**2
             if(r.lt.1.) then
-              fac=sqrt(-2.*log(r)/r)
+              fac=sqrt(-2._kind_dbl_prec*log(r)/r)
               g1=v1*fac
               g2=v2*fac
             endif
@@ -489,7 +493,7 @@ subroutine random_index_t(imax,iharvest,stat)
           type(random_stat),intent(inout):: stat
           integer,parameter:: mh=n
           integer i1,i2,mz
-          real h(mh)
+          real(kind_dbl_prec) :: h(mh)
           mz=size(iharvest)
           do i1=1,mz,mh
             i2=min((i1-1)+mh,mz)

physics/module_sf_mynn.F90

@@ -2804,8 +2804,8 @@ SUBROUTINE znot_m_v6(uref, znotm)
 ! znotm(meter):   areodynamical roughness scale over water
 !
 
-      REAL(kind=kind_phys), INTENT(IN) :: uref
-      REAL(kind=kind_phys), INTENT(OUT):: znotm
+      REAL, INTENT(IN) :: uref
+      REAL, INTENT(OUT):: znotm
       real(kind=kind_phys), parameter  :: p13 = -1.296521881682694e-02,&
      &      p12 =  2.855780863283819e-01, p11 = -1.597898515251717e+00,&
      &      p10 = -8.396975715683501e+00,                              &

physics/module_sf_noahmplsm.f90

@@ -681,7 +681,7 @@ subroutine noahmp_sflx (parameters, &
   logical                             :: dveg_active !< flag to run dynamic vegetation
   logical                             :: crop_active !< flag to run crop model
 ! add canopy heat storage (C.He added based on GY Niu's communication)
-  real                                :: canhs ! canopy heat storage change w/m2
+  real (kind=kind_phys)               :: canhs ! canopy heat storage change w/m2
 ! maximum lai/sai used for some parameterizations based on plant growthi  
 
 
@@ -4494,7 +4494,7 @@ subroutine bare_flux (parameters,nsnow   ,nsoil   ,isnow   ,dt      ,sag     , &
         if(opt_sfc == 3) then
           call sfcdif3(parameters,iloc    ,jloc    ,iter    ,sfctmp  ,qair    ,ur      , & !in 
                          zlvl    ,tgb     ,thsfc_loc,prslkix,prsik1x ,prslk1x ,z0m     , & !in 
-                         zpd  ,snowh,shdfac ,garea1  ,.false. ,0.0,ivgtyp ,      & !in 
+                         zpd  ,snowh,shdfac ,garea1  ,.false. ,0.0_kind_phys,ivgtyp ,      & !in 
                          ustarx  ,fm      ,fh      ,fm2     ,fh2     ,                   & !inout 
                          z0h     ,fv      ,csigmaf0,cm      ,ch       )                    !out 
 

physics/module_sf_ruclsm.F90

@@ -7603,10 +7603,11 @@ END SUBROUTINE SOILIN
 !>\ingroup lsm_ruc_group
 !> This function calculates the liquid saturation vapor mixing ratio as 
 !! a function of temperature and pressure (from Thompson scheme).
-      REAL FUNCTION RSLF(P,T)
+      FUNCTION RSLF(P,T)
 
       IMPLICIT NONE
-      REAL, INTENT(IN):: P, T
+      REAL(kind_phys), INTENT(IN):: P, T
+      REAL(kind_phys) :: RSLF
       REAL:: ESL,X
       REAL, PARAMETER:: C0= .611583699E03
       REAL, PARAMETER:: C1= .444606896E02

physics/module_soil_pre.F90

@@ -5,6 +5,8 @@ module module_soil_pre
 
 !tgs Initialize RUC LSM levels, soil temp/moisture
 
+      use machine, only: kind_phys
+
       implicit none
 
       private
@@ -26,8 +28,8 @@ SUBROUTINE init_soil_depth_3 ( zs , dzs , num_soil_levels )
 
       INTEGER, INTENT(IN) :: num_soil_levels
 
-      REAL, DIMENSION(1:num_soil_levels), INTENT(OUT)  ::  zs, dzs
-      REAL, DIMENSION(1:num_soil_levels)  :: zs2
+      REAL(kind_phys), DIMENSION(1:num_soil_levels), INTENT(OUT)  ::  zs, dzs
+      REAL(kind_phys), DIMENSION(1:num_soil_levels)  :: zs2
 
       INTEGER                   ::      l
 
@@ -90,21 +92,21 @@ SUBROUTINE init_soil_3_real ( tsk , tmn , smois , tslb , &
       INTEGER , DIMENSION(1:num_st_levels_input) , INTENT(INOUT) :: st_levels_input
       INTEGER , DIMENSION(1:num_sm_levels_input) , INTENT(INOUT) :: sm_levels_input
 
-      REAL , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
-      REAL , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
-      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
+      REAL(kind_phys) , DIMENSION(ims:ime,1:num_st_levels_alloc,jms:jme) , INTENT(INOUT) :: st_input
+      REAL(kind_phys) , DIMENSION(ims:ime,1:num_sm_levels_alloc,jms:jme) , INTENT(INOUT) :: sm_input
+      REAL(kind_phys) , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: landmask , sst
 
-      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn
-      REAL , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
-      REAL , DIMENSION(num_soil_layers) :: zs , dzs
+      REAL(kind_phys) , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: tmn
+      REAL(kind_phys) , DIMENSION(ims:ime,jms:jme) , INTENT(INOUT) :: tsk
+      REAL(kind_phys) , DIMENSION(num_soil_layers) :: zs , dzs
 
-      REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois
+      REAL(kind_phys) , DIMENSION(ims:ime,num_soil_layers,jms:jme) , INTENT(OUT) :: tslb , smois
 
-      REAL , ALLOCATABLE , DIMENSION(:) :: zhave
+      REAL(kind_phys) , ALLOCATABLE , DIMENSION(:) :: zhave
 
       logical :: debug_print = .false.
       INTEGER :: i , j , l , lout , lin , lwant , lhave, k
-      REAL :: temp
+      REAL(kind_phys) :: temp
 
       !  Allocate the soil layer array used for interpolating.      
 

physics/radiation_gases.f

@@ -371,7 +371,7 @@ subroutine gas_init                                               &
         endif
 
         do k = 1, LOZ
-          pkstr(k) = fpkapx(pstr(k)*100.0)
+          pkstr(k) = fpkapx(pstr(k)*100.0_kind_phys)
         enddo
       endif   ! end if_ioznflg_block
 

physics/radlw_main.meta

@@ -1,7 +1,7 @@
 [ccpp-table-properties]
   name = rrtmg_lw
   type = scheme
-  dependencies = mersenne_twister.f,physcons.F90,physparam.f,radlw_datatb.f,radlw_param.f
+  dependencies = machine.F,mersenne_twister.f,physcons.F90,physparam.f,radlw_datatb.f,radlw_param.f
 
 ########################################################################
 [ccpp-arg-table]

physics/radsw_main.F90

@@ -2040,7 +2040,7 @@ subroutine mcica_subcol                                           &
       real (kind=kind_phys) :: cdfunc(nlay,ngptsw), tem1,               &
      &                                            fac_lcf(nlay),        &
      &       cdfun2(nlay,ngptsw)
-      real (kind=kind_dbl_prec) :: rand2d(nlay*ngptsw), rand1d(ngptsw)
+      real (kind=kind_dbl_prec) :: rand2d(nlay*ngptsw), rand1d(ngptsw) ! must be default real kind to match mersenne twister code
 
       type (random_stat) :: stat          ! for thread safe random generator