Update code to use 'constantsR4_mod' module

driver/fvGFS/atmosphere.F90

@@ -146,7 +146,11 @@ module atmosphere_mod
 ! FMS modules:
 !-----------------
 use block_control_mod,      only: block_control_type
+#ifdef OVERLOAD_R4
+use constantsR4_mod,          only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks
+#else
 use constants_mod,          only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks
+#endif
 use time_manager_mod,       only: time_type, get_time, set_time, operator(+), &
                                   operator(-), operator(/), time_type_to_real
 use fms_mod,                only: error_mesg, FATAL,                 &

driver/fvGFS/fv_nggps_diag.F90

@@ -63,7 +63,11 @@ module fv_nggps_diags_mod
 ! </table>
 
  use mpp_mod,            only: mpp_pe, mpp_root_pe,FATAL,mpp_error
+#ifdef OVERLOAD_R4
+ use constantsR4_mod,      only: grav, rdgas
+#else
  use constants_mod,      only: grav, rdgas
+#endif
  use time_manager_mod,   only: time_type, get_time
  use diag_manager_mod,   only: register_diag_field, send_data
  use diag_axis_mod,      only: get_axis_global_length, get_diag_axis, get_diag_axis_name

model/fv_dynamics.F90

@@ -120,7 +120,11 @@ module fv_dynamics_mod
 !   </tr>
 ! </table>
 
+#ifdef OVERLOAD_R4
+   use constantsR4_mod,       only: grav, pi=>pi_8, radius, hlv, rdgas, omega, rvgas, cp_vapor
+#else
    use constants_mod,       only: grav, pi=>pi_8, radius, hlv, rdgas, omega, rvgas, cp_vapor
+#endif
    use dyn_core_mod,        only: dyn_core, del2_cubed, init_ijk_mem
    use fv_mapz_mod,         only: compute_total_energy, Lagrangian_to_Eulerian, moist_cv, moist_cp
    use fv_tracer2d_mod,     only: tracer_2d, tracer_2d_1L, tracer_2d_nested

model/fv_nesting.F90

@@ -118,7 +118,11 @@ module fv_nesting_mod
    use fv_arrays_mod,       only: allocate_fv_nest_BC_type, fv_atmos_type, fv_grid_bounds_type, deallocate_fv_nest_BC_type
    use fv_grid_utils_mod,   only: ptop_min, g_sum, cubed_to_latlon, f_p
    use init_hydro_mod,      only: p_var
+#ifdef OVERLOAD_R4
+   use constantsR4_mod,       only: grav, pi=>pi_8, radius, hlv, rdgas, cp_air, rvgas, cp_vapor, kappa
+#else
    use constants_mod,       only: grav, pi=>pi_8, radius, hlv, rdgas, cp_air, rvgas, cp_vapor, kappa
+#endif
    use fv_mapz_mod,         only: mappm, remap_2d
    use fv_timing_mod,       only: timing_on, timing_off
    use fv_mp_mod,           only: is_master

model/fv_update_phys.F90

@@ -89,7 +89,11 @@ module fv_update_phys_mod
 !   </tr>
 ! </table>
 
+#ifdef OVERLOAD_R4
+  use constantsR4_mod,      only: kappa, rdgas, rvgas, grav, cp_air, cp_vapor, pi=>pi_8, radius, TFREEZE
+#else
   use constants_mod,      only: kappa, rdgas, rvgas, grav, cp_air, cp_vapor, pi=>pi_8, radius, TFREEZE
+#endif
   use field_manager_mod,  only: MODEL_ATMOS
   use mpp_domains_mod,    only: mpp_update_domains, domain2d
   use mpp_parameter_mod,  only: AGRID_PARAM=>AGRID

model/nh_core.F90

@@ -45,7 +45,11 @@ module nh_core_mod
 !   </tr>
 ! </table>
 
+#ifdef OVERLOAD_R4
+   use constantsR4_mod,     only: rdgas, cp_air, grav
+#else
    use constants_mod,     only: rdgas, cp_air, grav
+#endif
    use tp_core_mod,       only: fv_tp_2d
    use nh_utils_mod,      only: update_dz_c, update_dz_d, nh_bc
    use nh_utils_mod,      only: sim_solver, sim1_solver, sim3_solver

model/nh_utils.F90

@@ -49,7 +49,11 @@ module nh_utils_mod
 !   </tr>
 ! </table>
 
+#ifdef OVERLOAD_R4
+   use constantsR4_mod,     only: rdgas, cp_air, grav
+#else
    use constants_mod,     only: rdgas, cp_air, grav
+#endif
    use tp_core_mod,       only: fv_tp_2d
    use sw_core_mod,       only: fill_4corners, del6_vt_flux
    use fv_arrays_mod,     only: fv_grid_bounds_type, fv_grid_type,fv_nest_BC_type_3d

tools/coarse_grained_diagnostics.F90

@@ -1,6 +1,10 @@
 module coarse_grained_diagnostics_mod
 
+#ifdef OVERLOAD_R4
+  use constantsR4_mod, only: rdgas, grav, pi=>pi_8
+#else
   use constants_mod, only: rdgas, grav, pi=>pi_8
+#endif
   use diag_manager_mod, only: diag_axis_init, register_diag_field, register_static_field, send_data
   use field_manager_mod,  only: MODEL_ATMOS
   use fv_arrays_mod, only: fv_atmos_type, fv_coarse_graining_type

tools/external_ic.F90

@@ -158,8 +158,12 @@ module external_ic_mod
    use tracer_manager_mod, only: get_tracer_names, get_number_tracers, get_tracer_index
    use tracer_manager_mod, only: set_tracer_profile
    use field_manager_mod,  only: MODEL_ATMOS
-
+   use platform_mod,       only: r4_kind, r8_kind
+#ifdef OVERLOAD_R4
+   use constantsR4_mod,     only: pi=>pi_8, omega, grav, kappa, rdgas, rvgas, cp_air
+#else
    use constants_mod,     only: pi=>pi_8, omega, grav, kappa, rdgas, rvgas, cp_air
+#endif
    use fv_arrays_mod,     only: fv_atmos_type, fv_grid_type, fv_grid_bounds_type, R_GRID
    use fv_diagnostics_mod,only: prt_maxmin, prt_gb_nh_sh, prt_height
    use fv_grid_utils_mod, only: ptop_min, g_sum,mid_pt_sphere,get_unit_vect2,get_latlon_vector,inner_prod
@@ -4162,29 +4166,33 @@ subroutine d2a3d(u, v,  ua,   va,  im,  jm, km, lon)
 
   end subroutine d2a3d
 
-
-
   subroutine pmaxmin( qname, a, im, jm, fac )
 
       integer, intent(in):: im, jm
       character(len=*) :: qname
       integer i, j
-      real a(im,jm)
-
-      real qmin(jm), qmax(jm)
-      real pmax, pmin
-      real fac                     ! multiplication factor
-
-      do j=1,jm
-         pmax = a(1,j)
-         pmin = a(1,j)
-         do i=2,im
-            pmax = max(pmax, a(i,j))
-            pmin = min(pmin, a(i,j))
+      class(*) a(im,jm)
+
+      real(r4_kind) qmin(jm), qmax(jm)
+      real(r4_kind)  pmax, pmin
+      class(*)  fac                     ! multiplication factor
+      real(r8_kind) qmin8(jm), qmax8(jm)
+      real(r8_kind)  pmax8, pmin8
+
+      select type (fac)
+      type is (real(kind=r4_kind))
+         select type (a)
+         type is (real(kind=r4_kind))
+         do j=1,jm
+            pmax = a(1,j)
+            pmin = a(1,j)
+            do i=2,im
+               pmax = max(pmax, a(i,j))
+               pmin = min(pmin, a(i,j))
+            enddo
+            qmax(j) = pmax
+            qmin(j) = pmin
          enddo
-         qmax(j) = pmax
-         qmin(j) = pmin
-      enddo
 !
 ! Now find max/min of amax/amin
 !
@@ -4195,11 +4203,39 @@ subroutine pmaxmin( qname, a, im, jm, fac )
             pmin = min(pmin, qmin(j))
          enddo
 
-      write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
+         write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
+         end select
+
+      type is (real(kind=r8_kind))
+         select type (a)
+         type is (real(kind=r8_kind))
+         do j=1,jm
+            pmax8 = a(1,j)
+            pmin8 = a(1,j)
+            do i=2,im
+               pmax8 = max(pmax8, a(i,j))
+               pmin8 = min(pmin8, a(i,j))
+            enddo
+            qmax8(j) = pmax8
+            qmin8(j) = pmin8
+         enddo
+!
+! Now find max/min of amax/amin
+!
+            pmax8 = qmax8(1)
+            pmin8 = qmin8(1)
+         do j=2,jm
+            pmax8 = max(pmax8, qmax8(j))
+            pmin8 = min(pmin8, qmin8(j))
+         enddo
+
+         write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac
+         end select
+      end select
 
  end subroutine pmaxmin
 
-subroutine pmaxmn(qname, q, is, ie, js, je, km, fac, area, domain)
+ subroutine pmaxmn(qname, q, is, ie, js, je, km, fac, area, domain)
       character(len=*), intent(in)::  qname
       integer, intent(in):: is, ie, js, je
       integer, intent(in):: km

tools/fv_diagnostics.F90

@@ -112,7 +112,11 @@ module fv_diagnostics_mod
 !   </tr>
 ! </table>
 
+#ifdef OVERLOAD_R4
+ use constantsR4_mod,      only: grav, rdgas, rvgas, pi=>pi_8, radius, kappa, WTMAIR, WTMCO2, &
+#else
  use constants_mod,      only: grav, rdgas, rvgas, pi=>pi_8, radius, kappa, WTMAIR, WTMCO2, &
+#endif
                                omega, hlv, cp_air, cp_vapor, TFREEZE
  use fms_mod,            only: write_version_number
  use time_manager_mod,   only: time_type, get_date, get_time

tools/fv_nudge.F90

@@ -102,12 +102,17 @@ module fv_nwp_nudge_mod
 
  use external_sst_mod,  only: i_sst, j_sst, sst_ncep, sst_anom, forecast_mode
  use diag_manager_mod,  only: register_diag_field, send_data
+#ifdef OVERLOAD_R4
+ use constantsR4_mod,     only: pi=>pi_8, grav, rdgas, cp_air, kappa, cnst_radius =>radius
+#else
  use constants_mod,     only: pi=>pi_8, grav, rdgas, cp_air, kappa, cnst_radius =>radius
+#endif
  use fms_mod,           only: write_version_number, check_nml_error
  use fms2_io_mod,       only: file_exists
  use mpp_mod,           only: mpp_error, FATAL, stdlog, get_unit, mpp_pe, input_nml_file
  use mpp_domains_mod,   only: mpp_update_domains, domain2d
  use time_manager_mod,  only: time_type,  get_time, get_date
+ use platform_mod,      only: r4_kind, r8_kind
 
  use fv_grid_utils_mod, only: great_circle_dist, intp_great_circle
  use fv_grid_utils_mod, only: latlon2xyz, vect_cross, normalize_vect
@@ -3537,22 +3542,29 @@ subroutine pmaxmin( qname, a, imax, jmax, fac )
       character(len=*)  qname
       integer imax, jmax
       integer i, j
-      real a(imax,jmax)
-
-      real qmin(jmax), qmax(jmax)
-      real pmax, pmin
-      real fac                     ! multiplication factor
-
-      do j=1,jmax
-         pmax = a(1,j)
-         pmin = a(1,j)
-         do i=2,imax
-            pmax = max(pmax, a(i,j))
-            pmin = min(pmin, a(i,j))
+      class(*) a(imax,jmax)
+      class(*) fac                     ! multiplication factor
+
+      real(r4_kind) qmin(jmax), qmax(jmax)
+      real(r4_kind) pmax, pmin
+
+      real(r8_kind) qmin8(jmax), qmax8(jmax)
+      real(r8_kind) pmax8, pmin8
+
+      select type (fac)
+      type is (real(kind=r4_kind))
+         select type (a)
+         type is (real(kind=r4_kind))
+         do j=1,jmax
+            pmax = a(1,j)
+            pmin = a(1,j)
+            do i=2,imax
+               pmax = max(pmax, a(i,j))
+               pmin = min(pmin, a(i,j))
+            enddo
+            qmax(j) = pmax
+            qmin(j) = pmin
          enddo
-         qmax(j) = pmax
-         qmin(j) = pmin
-      enddo
 !
 ! Now find max/min of amax/amin
 !
@@ -3563,7 +3575,35 @@ subroutine pmaxmin( qname, a, imax, jmax, fac )
             pmin = min(pmin, qmin(j))
          enddo
 
-      write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
+         write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac
+         end select
+
+      type is (real(kind=r8_kind))
+         select type (a)
+         type is (real(kind=r8_kind))
+         do j=1,jmax
+            pmax8 = a(1,j)
+            pmin8 = a(1,j)
+            do i=2,imax
+               pmax8 = max(pmax8, a(i,j))
+               pmin8 = min(pmin8, a(i,j))
+            enddo
+            qmax8(j) = pmax8
+            qmin8(j) = pmin8
+         enddo
+!
+! Now find max/min of amax/amin
+!
+            pmax8 = qmax8(1)
+            pmin8 = qmin8(1)
+         do j=2,jmax
+            pmax8 = max(pmax8, qmax8(j))
+            pmin8 = min(pmin8, qmin8(j))
+         enddo
+
+         write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac
+         end select
+      end select
 
  end subroutine pmaxmin
 

tools/fv_restart.F90

@@ -133,7 +133,11 @@ module fv_restart_mod
 ! </table>
 
 
+#ifdef OVERLOAD_R4
+  use constantsR4_mod,       only: kappa, pi=>pi_8, omega, rdgas, grav, rvgas, cp_air, radius
+#else
   use constants_mod,       only: kappa, pi=>pi_8, omega, rdgas, grav, rvgas, cp_air, radius
+#endif
   use fv_arrays_mod,       only: fv_atmos_type, fv_nest_type, fv_grid_bounds_type, R_GRID
   use fv_io_mod,           only: fv_io_init, fv_io_read_restart, fv_io_write_restart, &
                                  remap_restart, fv_io_register_nudge_restart, &

tools/test_cases.F90

@@ -97,7 +97,11 @@ module test_cases_mod
 !   </tr>
 ! </table>
 
+#ifdef OVERLOAD_R4
+      use constantsR4_mod,     only: cnst_radius=>radius, pi=>pi_8, omega, grav, kappa, rdgas, cp_air, rvgas
+#else
       use constants_mod,     only: cnst_radius=>radius, pi=>pi_8, omega, grav, kappa, rdgas, cp_air, rvgas
+#endif
       use init_hydro_mod,    only: p_var, hydro_eq
       use fv_mp_mod,         only: is_master,        &
                                    domain_decomp, fill_corners, XDir, YDir, &