diff --git a/driver/fvGFS/atmosphere.F90 b/driver/fvGFS/atmosphere.F90 index 503eecc11..6fa14008b 100644 --- a/driver/fvGFS/atmosphere.F90 +++ b/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, & diff --git a/driver/fvGFS/fv_nggps_diag.F90 b/driver/fvGFS/fv_nggps_diag.F90 index 8e68b2e44..414d91d8f 100644 --- a/driver/fvGFS/fv_nggps_diag.F90 +++ b/driver/fvGFS/fv_nggps_diag.F90 @@ -63,7 +63,11 @@ module fv_nggps_diags_mod ! 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 diff --git a/model/fv_dynamics.F90 b/model/fv_dynamics.F90 index b4802524d..794207930 100644 --- a/model/fv_dynamics.F90 +++ b/model/fv_dynamics.F90 @@ -120,7 +120,11 @@ module fv_dynamics_mod ! ! +#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 diff --git a/model/fv_nesting.F90 b/model/fv_nesting.F90 index 92124963f..b67623081 100644 --- a/model/fv_nesting.F90 +++ b/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 diff --git a/model/fv_update_phys.F90 b/model/fv_update_phys.F90 index f9979f560..1f5ac25ae 100644 --- a/model/fv_update_phys.F90 +++ b/model/fv_update_phys.F90 @@ -89,7 +89,11 @@ module fv_update_phys_mod ! ! +#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 diff --git a/model/nh_core.F90 b/model/nh_core.F90 index 6f60ab14f..a197f3bf7 100644 --- a/model/nh_core.F90 +++ b/model/nh_core.F90 @@ -45,7 +45,11 @@ module nh_core_mod ! ! +#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 diff --git a/model/nh_utils.F90 b/model/nh_utils.F90 index e29f3a727..5eb1bdc43 100644 --- a/model/nh_utils.F90 +++ b/model/nh_utils.F90 @@ -49,7 +49,11 @@ module nh_utils_mod ! ! +#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 diff --git a/tools/coarse_grained_diagnostics.F90 b/tools/coarse_grained_diagnostics.F90 index 8f910abdd..84d1bae79 100644 --- a/tools/coarse_grained_diagnostics.F90 +++ b/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 diff --git a/tools/external_ic.F90 b/tools/external_ic.F90 index f283e5ab8..a4ad6f2c5 100644 --- a/tools/external_ic.F90 +++ b/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 diff --git a/tools/fv_diagnostics.F90 b/tools/fv_diagnostics.F90 index 893efb09f..2acbc0588 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -112,7 +112,11 @@ module fv_diagnostics_mod ! ! +#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 diff --git a/tools/fv_nudge.F90 b/tools/fv_nudge.F90 index d86c10ac9..9e1d59d5b 100644 --- a/tools/fv_nudge.F90 +++ b/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 diff --git a/tools/fv_restart.F90 b/tools/fv_restart.F90 index bcd6ea13b..573255bd8 100644 --- a/tools/fv_restart.F90 +++ b/tools/fv_restart.F90 @@ -133,7 +133,11 @@ module fv_restart_mod ! +#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, & diff --git a/tools/test_cases.F90 b/tools/test_cases.F90 index 6ef0b7534..7ebbef44d 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -97,7 +97,11 @@ module test_cases_mod ! ! +#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, &