From 57d9ad3bfed224e1b8f875e4f0f30921cadde297 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 9 Jul 2024 12:23:01 -0400 Subject: [PATCH 1/3] Use constantsR4 mod instead of the constants_mod --- GFDL_tools/fv_ada_nudge.F90 | 4 ++++ GFDL_tools/fv_climate_nudge.F90 | 4 ++++ GFDL_tools/fv_cmip_diag.F90 | 4 ++++ GFDL_tools/read_climate_nudge_data.F90 | 4 ++++ driver/GFDL/atmosphere.F90 | 4 ++++ model/boundary.F90 | 5 ++++- model/dyn_core.F90 | 5 ++++- model/fast_phys.F90 | 5 ++++- model/fv_arrays.F90 | 4 ++++ model/fv_control.F90 | 5 ++++- model/fv_dynamics.F90 | 4 ++++ model/fv_grid_utils.F90 | 4 ++++ model/fv_mapz.F90 | 5 ++++- model/fv_nesting.F90 | 4 ++++ model/fv_regional_bc.F90 | 7 ++++++- model/fv_sg.F90 | 4 ++++ model/fv_update_phys.F90 | 5 ++++- model/intermediate_phys.F90 | 5 ++++- model/nh_core.F90 | 4 ++++ model/nh_utils.F90 | 6 +++++- tools/coarse_grained_diagnostics.F90 | 5 ++++- tools/coarse_grained_restart_files.F90 | 4 ++++ tools/external_aero.F90 | 7 +++++-- tools/external_ic.F90 | 4 ++++ tools/fv_diag_column.F90 | 4 ++++ tools/fv_diagnostics.F90 | 6 +++++- tools/fv_eta.F90 | 4 ++++ tools/fv_grid_tools.F90 | 5 ++++- tools/fv_iau_mod.F90 | 4 ++++ tools/fv_nggps_diag.F90 | 4 ++++ tools/fv_nudge.F90 | 4 ++++ tools/fv_restart.F90 | 5 ++++- tools/fv_surf_map.F90 | 4 ++++ tools/fv_treat_da_inc.F90 | 6 +++++- tools/init_hydro.F90 | 5 ++++- tools/test_cases.F90 | 5 ++++- 36 files changed, 150 insertions(+), 18 deletions(-) diff --git a/GFDL_tools/fv_ada_nudge.F90 b/GFDL_tools/fv_ada_nudge.F90 index 72b04da6c..353a440c2 100644 --- a/GFDL_tools/fv_ada_nudge.F90 +++ b/GFDL_tools/fv_ada_nudge.F90 @@ -37,7 +37,11 @@ module fv_ada_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, grav, rdgas, cp_air, kappa, cnst_radius=>radius, seconds_per_day +#else use constants_mod, only: pi, grav, rdgas, cp_air, kappa, cnst_radius=>radius, seconds_per_day +#endif use fms_mod, only: write_version_number, check_nml_error use mpp_mod, only: mpp_error, FATAL, stdlog, get_unit, mpp_pe, input_nml_file use mpp_mod, only: mpp_root_pe, stdout ! snz diff --git a/GFDL_tools/fv_climate_nudge.F90 b/GFDL_tools/fv_climate_nudge.F90 index 41cfd1134..982c60bd5 100644 --- a/GFDL_tools/fv_climate_nudge.F90 +++ b/GFDL_tools/fv_climate_nudge.F90 @@ -37,7 +37,11 @@ module fv_climate_nudge_mod use time_interp_mod, only: time_interp use get_cal_time_mod, only: get_cal_time use mpp_mod, only: mpp_min, mpp_max +#ifdef OVERLOAD_R4 +use constantsR4_mod, only: RDGAS, RVGAS, PI, KAPPA, CP_AIR +#else use constants_mod, only: RDGAS, RVGAS, PI, KAPPA, CP_AIR +#endif use fv_mapz_mod, only: mappm implicit none private diff --git a/GFDL_tools/fv_cmip_diag.F90 b/GFDL_tools/fv_cmip_diag.F90 index c7fed4de0..60353ae08 100644 --- a/GFDL_tools/fv_cmip_diag.F90 +++ b/GFDL_tools/fv_cmip_diag.F90 @@ -35,7 +35,11 @@ module fv_cmip_diag_mod use diag_data_mod, only: CMOR_MISSING_VALUE, null_axis_id use tracer_manager_mod, only: get_tracer_index use field_manager_mod, only: MODEL_ATMOS +#ifdef OVERLOAD_R4 +use constantsR4_mod, only: GRAV, RDGAS +#else use constants_mod, only: GRAV, RDGAS +#endif use fv_mapz_mod, only: E_Flux use fv_arrays_mod, only: fv_atmos_type diff --git a/GFDL_tools/read_climate_nudge_data.F90 b/GFDL_tools/read_climate_nudge_data.F90 index 8435125b2..129b29382 100644 --- a/GFDL_tools/read_climate_nudge_data.F90 +++ b/GFDL_tools/read_climate_nudge_data.F90 @@ -31,7 +31,11 @@ module read_climate_nudge_data_mod get_time_calendar, read_data, variable_att_exists, & is_dimension_unlimited use mpp_mod, only: input_nml_file, mpp_npes, mpp_get_current_pelist +#ifdef OVERLOAD_R4 +use constantsR4_mod, only: PI, GRAV, RDGAS, RVGAS +#else use constants_mod, only: PI, GRAV, RDGAS, RVGAS +#endif implicit none private diff --git a/driver/GFDL/atmosphere.F90 b/driver/GFDL/atmosphere.F90 index 54047e49c..ac69032ff 100644 --- a/driver/GFDL/atmosphere.F90 +++ b/driver/GFDL/atmosphere.F90 @@ -32,7 +32,11 @@ module atmosphere_mod !----------------- use atmos_co2_mod, only: atmos_co2_rad, co2_radiation_override 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/model/boundary.F90 b/model/boundary.F90 index 668451805..3b5752a41 100644 --- a/model/boundary.F90 +++ b/model/boundary.F90 @@ -22,8 +22,11 @@ module boundary_mod use fv_mp_mod, only: is_master +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav +#else use constants_mod, only: grav - +#endif use mpp_domains_mod, only: mpp_get_compute_domain, mpp_get_data_domain, mpp_get_global_domain use mpp_domains_mod, only: CENTER, CORNER, NORTH, EAST use mpp_domains_mod, only: mpp_global_field, mpp_get_pelist diff --git a/model/dyn_core.F90 b/model/dyn_core.F90 index 525dfc2e1..ea5b73438 100644 --- a/model/dyn_core.F90 +++ b/model/dyn_core.F90 @@ -20,8 +20,11 @@ !*********************************************************************** module dyn_core_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: rdgas, cp_air, pi +#else use constants_mod, only: rdgas, cp_air, pi +#endif use fv_arrays_mod, only: radius ! scaled for small earth use mpp_mod, only: mpp_pe use mpp_domains_mod, only: CGRID_NE, DGRID_NE, mpp_get_boundary, mpp_update_domains, & diff --git a/model/fast_phys.F90 b/model/fast_phys.F90 index 721a47716..a665bb498 100644 --- a/model/fast_phys.F90 +++ b/model/fast_phys.F90 @@ -26,8 +26,11 @@ ! ======================================================================= module fast_phys_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: rdgas, grav +#else use constants_mod, only: rdgas, grav +#endif use fv_grid_utils_mod, only: cubed_to_latlon, update_dwinds_phys use fv_arrays_mod, only: fv_grid_type, fv_grid_bounds_type use mpp_domains_mod, only: domain2d, mpp_update_domains diff --git a/model/fv_arrays.F90 b/model/fv_arrays.F90 index dd1038d67..862528dda 100644 --- a/model/fv_arrays.F90 +++ b/model/fv_arrays.F90 @@ -29,7 +29,11 @@ module fv_arrays_mod use horiz_interp_type_mod, only: horiz_interp_type use mpp_mod, only: mpp_broadcast use platform_mod, only: r8_kind +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: cnst_radius => radius, cnst_omega => omega +#else use constants_mod, only: cnst_radius => radius, cnst_omega => omega +#endif public integer, public, parameter :: R_GRID = r8_kind diff --git a/model/fv_control.F90 b/model/fv_control.F90 index ebace0a44..e52f8a776 100644 --- a/model/fv_control.F90 +++ b/model/fv_control.F90 @@ -25,8 +25,11 @@ !---------------- module fv_control_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: pi=>pi_8, kappa, grav, rdgas +#else use constants_mod, only: pi=>pi_8, kappa, grav, rdgas +#endif use fv_arrays_mod, only: radius ! scaled for small earth use field_manager_mod, only: MODEL_ATMOS use fms_mod, only: write_version_number, check_nml_error diff --git a/model/fv_dynamics.F90 b/model/fv_dynamics.F90 index 57f0623c9..72c7b4511 100644 --- a/model/fv_dynamics.F90 +++ b/model/fv_dynamics.F90 @@ -20,7 +20,11 @@ !*********************************************************************** module fv_dynamics_mod +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav, pi=>pi_8, hlv, rdgas, rvgas, cp_vapor +#else use constants_mod, only: grav, pi=>pi_8, hlv, rdgas, rvgas, cp_vapor +#endif use fv_arrays_mod, only: radius, omega ! scaled for small earth 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 diff --git a/model/fv_grid_utils.F90 b/model/fv_grid_utils.F90 index 8eceae59e..4d4119c51 100644 --- a/model/fv_grid_utils.F90 +++ b/model/fv_grid_utils.F90 @@ -22,7 +22,11 @@ module fv_grid_utils_mod #include +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: pi=>pi_8 +#else use constants_mod, only: pi=>pi_8 +#endif use fv_arrays_mod, only: radius, omega ! scaled for small earth use mpp_mod, only: FATAL, mpp_error, WARNING use external_sst_mod, only: i_sst, j_sst, sst_ncep, sst_anom diff --git a/model/fv_mapz.F90 b/model/fv_mapz.F90 index fa8c468d4..74505130a 100644 --- a/model/fv_mapz.F90 +++ b/model/fv_mapz.F90 @@ -25,8 +25,11 @@ ! Linjiong Zhou: Nov 19, 2019 ! Revise the OpenMP code to avoid crash module fv_mapz_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: pi=>pi_8, rvgas, rdgas, grav, hlv, hlf, cp_air, cp_vapor +#else use constants_mod, only: pi=>pi_8, rvgas, rdgas, grav, hlv, hlf, cp_air, cp_vapor +#endif use fv_arrays_mod, only: radius ! scaled for small earth use tracer_manager_mod,only: get_tracer_index, adjust_mass use field_manager_mod, only: MODEL_ATMOS diff --git a/model/fv_nesting.F90 b/model/fv_nesting.F90 index 309a1cd48..dcd94bbab 100644 --- a/model/fv_nesting.F90 +++ b/model/fv_nesting.F90 @@ -37,7 +37,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, hlv, rdgas, cp_air, rvgas, cp_vapor, kappa +#else use constants_mod, only: grav, pi=>pi_8, hlv, rdgas, cp_air, rvgas, cp_vapor, kappa +#endif use fv_arrays_mod, only: radius ! scaled for small earth use fv_mapz_mod, only: mappm use fv_timing_mod, only: timing_on, timing_off diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index 2fb814ab5..c9074278b 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -47,8 +47,13 @@ module fv_regional_mod use time_manager_mod, only: get_time & ,operator(-),operator(/) & ,time_type,time_type_to_real - use constants_mod, only: cp_air, cp_vapor, grav, kappa & +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: cp_air, cp_vapor, grav, kappa & ,pi=>pi_8,rdgas, rvgas +#else + use constants_mod, only: cp_air, cp_vapor, grav, kappa & + ,pi=>pi_8,rdgas, rvgas +#endif use fv_arrays_mod, only: fv_atmos_type & ,fv_grid_bounds_type & ,fv_regional_bc_bounds_type & diff --git a/model/fv_sg.F90 b/model/fv_sg.F90 index bfee00d50..8b30a66f1 100644 --- a/model/fv_sg.F90 +++ b/model/fv_sg.F90 @@ -24,7 +24,11 @@ module fv_sg_mod !----------------------------------------------------------------------- ! FV sub-grid mixing !----------------------------------------------------------------------- +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: rdgas, rvgas, cp_air, cp_vapor, hlv, hlf, kappa, grav +#else use constants_mod, only: rdgas, rvgas, cp_air, cp_vapor, hlv, hlf, kappa, grav +#endif use tracer_manager_mod, only: get_tracer_index use field_manager_mod, only: MODEL_ATMOS use gfdl_mp_mod, only: wqs, mqs3d, c_liq, c_ice diff --git a/model/fv_update_phys.F90 b/model/fv_update_phys.F90 index 6fadf122f..1ae08041f 100644 --- a/model/fv_update_phys.F90 +++ b/model/fv_update_phys.F90 @@ -20,8 +20,11 @@ !*********************************************************************** module fv_update_phys_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: kappa, rdgas, rvgas, grav, cp_air, cp_vapor, pi=>pi_8, TFREEZE, wtmair, wtmh2o +#else use constants_mod, only: kappa, rdgas, rvgas, grav, cp_air, cp_vapor, pi=>pi_8, TFREEZE, wtmair, wtmh2o +#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/intermediate_phys.F90 b/model/intermediate_phys.F90 index 36c0835a0..9d5e12811 100644 --- a/model/intermediate_phys.F90 +++ b/model/intermediate_phys.F90 @@ -26,8 +26,11 @@ ! ======================================================================= module intermediate_phys_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: rdgas, grav +#else use constants_mod, only: rdgas, grav +#endif use fv_grid_utils_mod, only: cubed_to_latlon, update_dwinds_phys use fv_arrays_mod, only: fv_grid_type, fv_grid_bounds_type, inline_mp_type use mpp_domains_mod, only: domain2d, mpp_update_domains diff --git a/model/nh_core.F90 b/model/nh_core.F90 index c0bf06a83..ad284c41d 100644 --- a/model/nh_core.F90 +++ b/model/nh_core.F90 @@ -24,7 +24,11 @@ module nh_core_mod ! To do list: ! include moisture effect in pt !------------------------------ +#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 2a636eced..38e9a3085 100644 --- a/model/nh_utils.F90 +++ b/model/nh_utils.F90 @@ -24,7 +24,11 @@ module nh_utils_mod ! To do list: ! include moisture effect in pt !------------------------------ - use constants_mod, only: rdgas, cp_air, grav, pi_8 +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: rdgas, cp_air, grav, pi_8 +#else + use constants_mod, only: rdgas, cp_air, grav, pi_8 +#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 432fd79e1..8088fc034 100644 --- a/tools/coarse_grained_diagnostics.F90 +++ b/tools/coarse_grained_diagnostics.F90 @@ -20,8 +20,11 @@ !*********************************************************************** 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/coarse_grained_restart_files.F90 b/tools/coarse_grained_restart_files.F90 index b3aaf9e6a..804925133 100644 --- a/tools/coarse_grained_restart_files.F90 +++ b/tools/coarse_grained_restart_files.F90 @@ -26,7 +26,11 @@ module coarse_grained_restart_files_mod weighted_block_edge_average_x, weighted_block_edge_average_y, & mask_area_weights, block_upsample, remap_edges_along_x, & remap_edges_along_y, vertically_remap_field +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: GRAV, RDGAS, RVGAS +#else use constants_mod, only: GRAV, RDGAS, RVGAS +#endif use field_manager_mod, only: MODEL_ATMOS use fms2_io_mod, only: register_restart_field, write_restart, open_file, close_file, register_variable_attribute, variable_exists use fv_arrays_mod, only: coarse_restart_type, fv_atmos_type diff --git a/tools/external_aero.F90 b/tools/external_aero.F90 index 97dc6c986..7db0f8c05 100644 --- a/tools/external_aero.F90 +++ b/tools/external_aero.F90 @@ -170,8 +170,11 @@ end subroutine load_aero ! read aerosol climatological dataset subroutine read_aero(is, ie, js, je, npz, nq, Time, pe, peln, qa, kord_tr, fill) - - use constants_mod, only: grav +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav +#else + use constants_mod, only: grav +#endif use diag_manager_mod, only: send_data use time_manager_mod, only: get_date, set_date, get_time, operator(-) use tracer_manager_mod, only: get_tracer_index diff --git a/tools/external_ic.F90 b/tools/external_ic.F90 index 4c91a29d2..bc7711396 100644 --- a/tools/external_ic.F90 +++ b/tools/external_ic.F90 @@ -42,7 +42,11 @@ module external_ic_mod use tracer_manager_mod, only: set_tracer_profile use field_manager_mod, only: MODEL_ATMOS +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: pi=>pi_8, grav, kappa, rdgas, rvgas, cp_air +#else use constants_mod, only: pi=>pi_8, grav, kappa, rdgas, rvgas, cp_air +#endif use fv_arrays_mod, only: omega ! scaled for small earth 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_mxm, prt_gb_nh_sh, prt_height diff --git a/tools/fv_diag_column.F90 b/tools/fv_diag_column.F90 index 127df3022..bc88d183b 100644 --- a/tools/fv_diag_column.F90 +++ b/tools/fv_diag_column.F90 @@ -25,7 +25,11 @@ module fv_diag_column_mod R_GRID use fv_grid_utils_mod, only: great_circle_dist use time_manager_mod, only: time_type, get_date, get_time, month_name +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav, rdgas, kappa, cp_air, TFREEZE, pi=>pi_8 +#else use constants_mod, only: grav, rdgas, kappa, cp_air, TFREEZE, pi=>pi_8 +#endif use fms_mod, only: write_version_number, lowercase use mpp_mod, only: mpp_error, FATAL, stdlog, mpp_pe, mpp_root_pe, mpp_sum, & mpp_max, NOTE, input_nml_file, get_unit diff --git a/tools/fv_diagnostics.F90 b/tools/fv_diagnostics.F90 index 40a3d7af9..f3d3d38d5 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -23,9 +23,13 @@ !! complicated and the logic too cumbersome --- lmh 22nov19 module fv_diagnostics_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav, rdgas, rvgas, pi=>pi_8, kappa, WTMAIR, WTMCO2, WTMH2O, & + hlv, cp_air, cp_vapor, TFREEZE +#else use constants_mod, only: grav, rdgas, rvgas, pi=>pi_8, kappa, WTMAIR, WTMCO2, WTMH2O, & hlv, cp_air, cp_vapor, TFREEZE +#endif use fv_arrays_mod, only: radius ! scaled for small earth use fms_mod, only: write_version_number use time_manager_mod, only: time_type, get_date, get_time diff --git a/tools/fv_eta.F90 b/tools/fv_eta.F90 index 4b4a86dca..a72b43da3 100644 --- a/tools/fv_eta.F90 +++ b/tools/fv_eta.F90 @@ -20,7 +20,11 @@ !*********************************************************************** module fv_eta_mod +#ifdef OVERLOAD_R4 + use constantsR4_mod,only: kappa, grav, cp_air, rdgas +#else use constants_mod, only: kappa, grav, cp_air, rdgas +#endif use fv_mp_mod, only: is_master use fms_mod, only: FATAL, error_mesg use fms2_io_mod, only: ascii_read diff --git a/tools/fv_grid_tools.F90 b/tools/fv_grid_tools.F90 index f90e53dd3..9c3ceb749 100644 --- a/tools/fv_grid_tools.F90 +++ b/tools/fv_grid_tools.F90 @@ -20,8 +20,11 @@ !*********************************************************************** module fv_grid_tools_mod - +#ifdef OVERLOAD_R4 use constants_mod, only: grav, pi=>pi_8 +#else + use constantsR4_mod,only: grav, pi=>pi_8 +#endif use fv_arrays_mod, only: radius, omega ! scaled for small earth ! use test_cases_mod, only: small_earth_scale use fv_arrays_mod, only: fv_atmos_type, fv_grid_type, fv_grid_bounds_type, R_GRID diff --git a/tools/fv_iau_mod.F90 b/tools/fv_iau_mod.F90 index 8da52a665..50d429823 100644 --- a/tools/fv_iau_mod.F90 +++ b/tools/fv_iau_mod.F90 @@ -41,7 +41,11 @@ module fv_iau_mod use mpp_mod, only: mpp_error, FATAL, NOTE, mpp_pe use mpp_domains_mod, only: domain2d +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: pi=>pi_8 +#else use constants_mod, only: pi=>pi_8 +#endif use fv_arrays_mod, only: fv_atmos_type, & fv_grid_type, & fv_grid_bounds_type, & diff --git a/tools/fv_nggps_diag.F90 b/tools/fv_nggps_diag.F90 index f87cd0b07..138eb5a8f 100644 --- a/tools/fv_nggps_diag.F90 +++ b/tools/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/tools/fv_nudge.F90 b/tools/fv_nudge.F90 index c8aae969e..e8d134504 100644 --- a/tools/fv_nudge.F90 +++ b/tools/fv_nudge.F90 @@ -29,7 +29,11 @@ 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 diff --git a/tools/fv_restart.F90 b/tools/fv_restart.F90 index 5edb281f9..91bc69c8d 100644 --- a/tools/fv_restart.F90 +++ b/tools/fv_restart.F90 @@ -29,8 +29,11 @@ module fv_restart_mod ! it provides setup and calls routines necessary to provide a complete restart ! for the model. ! - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: kappa, pi=>pi_8, rdgas, grav, rvgas, cp_air +#else use constants_mod, only: kappa, pi=>pi_8, rdgas, grav, rvgas, cp_air +#endif use fv_arrays_mod, only: radius, omega ! scaled for small earth 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, & diff --git a/tools/fv_surf_map.F90 b/tools/fv_surf_map.F90 index 1ffa8d0a3..aab76a75e 100644 --- a/tools/fv_surf_map.F90 +++ b/tools/fv_surf_map.F90 @@ -26,7 +26,11 @@ module fv_surf_map_mod use fms2_io_mod, only: file_exists use mpp_mod, only: get_unit, input_nml_file, mpp_error use mpp_domains_mod, only: mpp_update_domains, domain2d +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav, pi=>pi_8 +#else use constants_mod, only: grav, pi=>pi_8 +#endif use fv_grid_utils_mod, only: great_circle_dist, latlon2xyz, v_prod, normalize_vect use fv_grid_utils_mod, only: g_sum, global_mx, vect_cross diff --git a/tools/fv_treat_da_inc.F90 b/tools/fv_treat_da_inc.F90 index 6e1be2e85..e15634a94 100644 --- a/tools/fv_treat_da_inc.F90 +++ b/tools/fv_treat_da_inc.F90 @@ -46,9 +46,13 @@ module fv_treat_da_inc_mod get_number_tracers, & get_tracer_index use field_manager_mod, only: MODEL_ATMOS - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: pi=>pi_8, grav, kappa, & + rdgas, rvgas, cp_air +#else use constants_mod, only: pi=>pi_8, grav, kappa, & rdgas, rvgas, cp_air +#endif use fv_arrays_mod, only: omega ! scaled for small earth use fv_arrays_mod, only: fv_atmos_type, & fv_grid_type, & diff --git a/tools/init_hydro.F90 b/tools/init_hydro.F90 index 765741879..fe780790f 100644 --- a/tools/init_hydro.F90 +++ b/tools/init_hydro.F90 @@ -20,8 +20,11 @@ !*********************************************************************** module init_hydro_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav, rdgas, rvgas +#else use constants_mod, only: grav, rdgas, rvgas +#endif use fv_grid_utils_mod, only: g_sum use fv_mp_mod, only: is_master use field_manager_mod, only: MODEL_ATMOS diff --git a/tools/test_cases.F90 b/tools/test_cases.F90 index 7973e60b4..6c4c97f11 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -20,8 +20,11 @@ !*********************************************************************** module test_cases_mod - +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: cnst_radius=>radius, pi=>pi_8, cnst_omega=>omega, grav, kappa, rdgas, cp_air, rvgas +#else use constants_mod, only: cnst_radius=>radius, pi=>pi_8, cnst_omega=>omega, grav, kappa, rdgas, cp_air, rvgas +#endif use fv_arrays_mod, only: radius, omega ! scaled for small earth use init_hydro_mod, only: p_var, hydro_eq, hydro_eq_ext use fv_mp_mod, only: is_master, & From 11994f5137b991dc29cbedf606e24eb80daa9e03 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 9 Jul 2024 16:53:37 -0400 Subject: [PATCH 2/3] Add mixed version of atmosphere.F90 --- driver/GFDL/atmosphere.F90 | 289 +++++++-------------------- driver/GFDL/include/atmosphere.inc | 161 +++++++++++++++ driver/GFDL/include/atmosphere_r4.fh | 22 ++ driver/GFDL/include/atmosphere_r8.fh | 22 ++ 4 files changed, 280 insertions(+), 214 deletions(-) create mode 100644 driver/GFDL/include/atmosphere.inc create mode 100644 driver/GFDL/include/atmosphere_r4.fh create mode 100644 driver/GFDL/include/atmosphere_r8.fh diff --git a/driver/GFDL/atmosphere.F90 b/driver/GFDL/atmosphere.F90 index ac69032ff..b071116d4 100644 --- a/driver/GFDL/atmosphere.F90 +++ b/driver/GFDL/atmosphere.F90 @@ -30,6 +30,7 @@ module atmosphere_mod !----------------- ! FMS modules: !----------------- +use platform_mod, only: r8_kind, r4_kind use atmos_co2_mod, only: atmos_co2_rad, co2_radiation_override use block_control_mod, only: block_control_type #ifdef OVERLOAD_R4 @@ -107,6 +108,36 @@ module atmosphere_mod implicit none private +interface atmosphere_boundary + module procedure :: atmosphere_boundary_r4 + module procedure :: atmosphere_boundary_r8 +end interface atmosphere_boundary + +interface atmosphere_pref + module procedure :: atmosphere_pref_r4 + module procedure :: atmosphere_pref_r8 +end interface atmosphere_pref + +interface atmosphere_cell_area + module procedure :: atmosphere_cell_area_r4 + module procedure :: atmosphere_cell_area_r8 +end interface atmosphere_cell_area + +interface get_bottom_mass + module procedure :: get_bottom_mass_r4 + module procedure :: get_bottom_mass_r8 +end interface get_bottom_mass + +interface get_bottom_wind + module procedure :: get_bottom_wind_r4 + module procedure :: get_bottom_wind_r8 +end interface get_bottom_wind + +interface get_stock_pe + module procedure :: get_stock_pe_r4 + module procedure :: get_stock_pe_r8 +end interface get_stock_pe + !--- driver routines public :: atmosphere_init, atmosphere_end, atmosphere_restart, & atmosphere_dynamics, atmosphere_state_update @@ -169,7 +200,6 @@ module atmosphere_mod type(fv_atmos_type), allocatable, target :: Atm(:) real, parameter:: w0_big = 60. ! to prevent negative w-tracer diffusion - !---dynamics tendencies for use in fv_subgrid_z and during fv_update_phys real, allocatable, dimension(:,:,:) :: u_dt, v_dt, t_dt, qv_dt real, allocatable, dimension(:,:,:,:) :: q_dt @@ -186,7 +216,13 @@ module atmosphere_mod contains - +#if defined(OVERLOAD_R4) +#define _DBL_(X) DBLE(X) +#define _RL_(X) REAL(X,KIND=4) +#else +#define _DBL_(X) X +#define _RL_(X) X +#endif subroutine atmosphere_init (Time_init, Time, Time_step, Surf_diff, Grid_box) type (time_type), intent(in) :: Time_init, Time, Time_step @@ -869,14 +905,6 @@ subroutine atmosphere_resolution (i_size, j_size, global) end subroutine atmosphere_resolution - - subroutine atmosphere_pref (p_ref) - real, dimension(:,:), intent(inout) :: p_ref - - p_ref = pref - - end subroutine atmosphere_pref - subroutine atmosphere_control_data (i1, i2, j1, j2, kt, p_hydro, hydro, do_uni_zfull) !miz integer, intent(out) :: i1, i2, j1, j2, kt logical, intent(out), optional :: p_hydro, hydro, do_uni_zfull !miz @@ -892,16 +920,6 @@ subroutine atmosphere_control_data (i1, i2, j1, j2, kt, p_hydro, hydro, do_uni_z end subroutine atmosphere_control_data - - subroutine atmosphere_cell_area (area_out) - real, dimension(:,:), intent(out) :: area_out - - area_out(1:iec-isc+1, 1:jec-jsc+1) = Atm(mygrid)%gridstruct%area (isc:iec,jsc:jec) - - end subroutine atmosphere_cell_area - - - subroutine atmosphere_grid_center (lon, lat) !--------------------------------------------------------------- ! returns the longitude and latitude cell centers @@ -919,33 +937,6 @@ subroutine atmosphere_grid_center (lon, lat) end subroutine atmosphere_grid_center - - - subroutine atmosphere_boundary (blon, blat, global) -!--------------------------------------------------------------- -! returns the longitude and latitude grid box edges -! for either the local PEs grid (default) or the global grid -!--------------------------------------------------------------- - real, intent(out) :: blon(:,:), blat(:,:) ! Unit: radian - logical, intent(in), optional :: global -! Local data: - integer i,j - - if( PRESENT(global) ) then - if (global) call mpp_error(FATAL, '==> global grid is no longer available & - & in the Cubed Sphere') - endif - - do j=jsc,jec+1 - do i=isc,iec+1 - blon(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid(i,j,1) - blat(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid(i,j,2) - enddo - end do - - end subroutine atmosphere_boundary - - subroutine set_atmosphere_pelist () call mpp_set_current_pelist(Atm(mygrid)%pelist, no_sync=.TRUE.) end subroutine set_atmosphere_pelist @@ -974,139 +965,6 @@ subroutine get_atmosphere_axes ( axes ) end subroutine get_atmosphere_axes - - - subroutine get_bottom_mass ( t_bot, tr_bot, p_bot, z_bot, p_surf, slp ) -!-------------------------------------------------------------- -! returns temp, sphum, pres, height at the lowest model level -! and surface pressure -!-------------------------------------------------------------- - real, intent(out), dimension(isc:iec,jsc:jec):: t_bot, p_bot, z_bot, p_surf - real, intent(out), optional, dimension(isc:iec,jsc:jec):: slp - real, intent(out), dimension(isc:iec,jsc:jec,nq):: tr_bot - integer :: i, j, m, k, kr - real :: rrg, sigtop, sigbot - real, dimension(isc:iec,jsc:jec) :: tref - real, parameter :: tlaps = 6.5e-3 - - rrg = rdgas / grav - - do j=jsc,jec - do i=isc,iec - p_surf(i,j) = Atm(mygrid)%ps(i,j) - t_bot(i,j) = Atm(mygrid)%pt(i,j,npz) - p_bot(i,j) = Atm(mygrid)%delp(i,j,npz)/(Atm(mygrid)%peln(i,npz+1,j)-Atm(mygrid)%peln(i,npz,j)) - z_bot(i,j) = rrg*t_bot(i,j)*(1.+zvir*Atm(mygrid)%q(i,j,npz,sphum)) * & - (1. - Atm(mygrid)%pe(i,npz,j)/p_bot(i,j)) - enddo - enddo - - if ( present(slp) ) then - ! determine 0.8 sigma reference level - sigtop = Atm(mygrid)%ak(1)/pstd_mks+Atm(mygrid)%bk(1) - do k = 1, npz - sigbot = Atm(mygrid)%ak(k+1)/pstd_mks+Atm(mygrid)%bk(k+1) - if (sigbot+sigtop > 1.6) then - kr = k - exit - endif - sigtop = sigbot - enddo - do j=jsc,jec - do i=isc,iec - ! sea level pressure - tref(i,j) = Atm(mygrid)%pt(i,j,kr) * (Atm(mygrid)%delp(i,j,kr)/ & - ((Atm(mygrid)%peln(i,kr+1,j)-Atm(mygrid)%peln(i,kr,j))*Atm(mygrid)%ps(i,j)))**(-rrg*tlaps) - slp(i,j) = Atm(mygrid)%ps(i,j)*(1.+tlaps*Atm(mygrid)%phis(i,j)/(tref(i,j)*grav))**(1./(rrg*tlaps)) - enddo - enddo - endif - -! Copy tracers - do m=1,nq - do j=jsc,jec - do i=isc,iec - tr_bot(i,j,m) = Atm(mygrid)%q(i,j,npz,m) - enddo - enddo - enddo - - end subroutine get_bottom_mass - - - subroutine get_bottom_wind ( u_bot, v_bot ) -!----------------------------------------------------------- -! returns u and v on the mass grid at the lowest model level -!----------------------------------------------------------- - real, intent(out), dimension(isc:iec,jsc:jec):: u_bot, v_bot - integer i, j - - do j=jsc,jec - do i=isc,iec - u_bot(i,j) = Atm(mygrid)%u_srf(i,j) - v_bot(i,j) = Atm(mygrid)%v_srf(i,j) - enddo - enddo - - end subroutine get_bottom_wind - - - - subroutine get_stock_pe(index, value) - integer, intent(in) :: index - real, intent(out) :: value - -#ifdef USE_STOCK - include 'stock.inc' -#endif - - real wm(isc:iec,jsc:jec) - integer i,j,k - real, pointer :: area(:,:) - - area => Atm(mygrid)%gridstruct%area - - select case (index) - -#ifdef USE_STOCK - case (ISTOCK_WATER) -#else - case (1) -#endif - -!---------------------- -! Perform vertical sum: -!---------------------- - wm = 0. - do j=jsc,jec - do k=1,npz - do i=isc,iec -! Warning: the following works only with AM2 physics: water vapor; cloud water, cloud ice. - wm(i,j) = wm(i,j) + Atm(mygrid)%delp(i,j,k) * ( Atm(mygrid)%q(i,j,k,sphum) + & - Atm(mygrid)%q(i,j,k,liq_wat) + & - Atm(mygrid)%q(i,j,k,ice_wat) ) - enddo - enddo - enddo - -!---------------------- -! Horizontal sum: -!---------------------- - value = 0. - do j=jsc,jec - do i=isc,iec - value = value + wm(i,j)*area(i,j) - enddo - enddo - value = value/grav - - case default - value = 0.0 - end select - - end subroutine get_stock_pe - - subroutine atmosphere_state_update (Time, Physics_tendency, Physics, Atm_block) type(time_type),intent(in) :: Time type (physics_tendency_type), intent(in) :: Physics_tendency @@ -1491,21 +1349,21 @@ subroutine atmos_physics_driver_inputs (Physics, Atm_block, Physics_tendency) jbs = Atm_block%jbs(nb) jbe = Atm_block%jbe(nb) - Physics%block(nb)%phis = Atm(mygrid)%phis(ibs:ibe,jbs:jbe) - Physics%block(nb)%u = Atm(mygrid)%ua(ibs:ibe,jbs:jbe,:) - Physics%block(nb)%v = Atm(mygrid)%va(ibs:ibe,jbs:jbe,:) - Physics%block(nb)%t = Atm(mygrid)%pt(ibs:ibe,jbs:jbe,:) - Physics%block(nb)%q = Atm(mygrid)%q(ibs:ibe,jbs:jbe,:,:) - Physics%block(nb)%omega= Atm(mygrid)%omga(ibs:ibe,jbs:jbe,:) - Physics%block(nb)%pe = Atm(mygrid)%pe(ibs:ibe,:,jbs:jbe) - Physics%block(nb)%peln = Atm(mygrid)%peln(ibs:ibe,:,jbs:jbe) - Physics%block(nb)%delp = Atm(mygrid)%delp(ibs:ibe,jbs:jbe,:) + Physics%block(nb)%phis = _DBL_(_RL_(Atm(mygrid)%phis(ibs:ibe,jbs:jbe))) + Physics%block(nb)%u = _DBL_(_RL_(Atm(mygrid)%ua(ibs:ibe,jbs:jbe,:))) + Physics%block(nb)%v = _DBL_(_RL_(Atm(mygrid)%va(ibs:ibe,jbs:jbe,:))) + Physics%block(nb)%t = _DBL_(_RL_(Atm(mygrid)%pt(ibs:ibe,jbs:jbe,:))) + Physics%block(nb)%q = _DBL_(_RL_(Atm(mygrid)%q(ibs:ibe,jbs:jbe,:,:))) + Physics%block(nb)%omega= _DBL_(_RL_(Atm(mygrid)%omga(ibs:ibe,jbs:jbe,:))) + Physics%block(nb)%pe = _DBL_(_RL_(Atm(mygrid)%pe(ibs:ibe,:,jbs:jbe))) + Physics%block(nb)%peln = _DBL_(_RL_(Atm(mygrid)%peln(ibs:ibe,:,jbs:jbe))) + Physics%block(nb)%delp = _DBL_(_RL_(Atm(mygrid)%delp(ibs:ibe,jbs:jbe,:))) if (.not.Physics%control%phys_hydrostatic) then - Physics%block(nb)%delz = Atm(mygrid)%delz(ibs:ibe,jbs:jbe,:) - Physics%block(nb)%w = Atm(mygrid)%w(ibs:ibe,jbs:jbe,:) + Physics%block(nb)%delz = _DBL_(_RL_(Atm(mygrid)%delz(ibs:ibe,jbs:jbe,:))) + Physics%block(nb)%w = _DBL_(_RL_(Atm(mygrid)%w(ibs:ibe,jbs:jbe,:))) endif if (_ALLOCATED(Physics%block(nb)%tmp_4d)) & - Physics%block(nb)%tmp_4d = Atm(mygrid)%qdiag(ibs:ibe,jbs:jbe,:,:) + Physics%block(nb)%tmp_4d = _DBL_(_RL_(Atm(mygrid)%qdiag(ibs:ibe,jbs:jbe,:,:))) call fv_compute_p_z (Atm_block%npz, Physics%block(nb)%phis, Physics%block(nb)%pe, & Physics%block(nb)%peln, Physics%block(nb)%delp, Physics%block(nb)%delz, & @@ -1513,9 +1371,9 @@ subroutine atmos_physics_driver_inputs (Physics, Atm_block, Physics_tendency) Physics%block(nb)%p_full, Physics%block(nb)%p_half, & Physics%block(nb)%z_full, Physics%block(nb)%z_half, & #ifdef USE_COND - Atm(mygrid)%q_con(ibs:ibe,jbs:jbe,:), & + _DBL_(_RL_(Atm(mygrid)%q_con(ibs:ibe,jbs:jbe,:))), & #else - Atm(mygrid)%q_con, & + _DBL_(_RL_(Atm(mygrid)%q_con)), & #endif Physics%control%phys_hydrostatic, Physics%control%do_uni_zfull) !miz @@ -1525,11 +1383,11 @@ subroutine atmos_physics_driver_inputs (Physics, Atm_block, Physics_tendency) !--- these values would be zeroed out and accumulated !--- in the atmosphere_state_update - Physics_tendency%block(nb)%u_dt = u_dt(ibs:ibe,jbs:jbe,:) - Physics_tendency%block(nb)%v_dt = v_dt(ibs:ibe,jbs:jbe,:) - Physics_tendency%block(nb)%t_dt = t_dt(ibs:ibe,jbs:jbe,:) - Physics_tendency%block(nb)%q_dt = q_dt(ibs:ibe,jbs:jbe,:,:) - Physics_tendency%block(nb)%qdiag = Atm(mygrid)%qdiag(ibs:ibe,jbs:jbe,:,:) + Physics_tendency%block(nb)%u_dt = _DBL_(_RL_(u_dt(ibs:ibe,jbs:jbe,:))) + Physics_tendency%block(nb)%v_dt = _DBL_(_RL_(v_dt(ibs:ibe,jbs:jbe,:))) + Physics_tendency%block(nb)%t_dt = _DBL_(_RL_(t_dt(ibs:ibe,jbs:jbe,:))) + Physics_tendency%block(nb)%q_dt = _DBL_(_RL_(q_dt(ibs:ibe,jbs:jbe,:,:))) + Physics_tendency%block(nb)%qdiag = _DBL_(_RL_(Atm(mygrid)%qdiag(ibs:ibe,jbs:jbe,:,:))) endif enddo @@ -1553,14 +1411,14 @@ subroutine atmos_radiation_driver_inputs (Time, Radiation, Atm_block) jbs = Atm_block%jbs(nb) jbe = Atm_block%jbe(nb) - Radiation%block(nb)%phis = Atm(mygrid)%phis(ibs:ibe,jbs:jbe) - Radiation%block(nb)%t = Atm(mygrid)%pt(ibs:ibe,jbs:jbe,:) - Radiation%block(nb)%q = Atm(mygrid)%q(ibs:ibe,jbs:jbe,:,:) - Radiation%block(nb)%pe = Atm(mygrid)%pe(ibs:ibe,:,jbs:jbe) - Radiation%block(nb)%peln = Atm(mygrid)%peln(ibs:ibe,:,jbs:jbe) - Radiation%block(nb)%delp = Atm(mygrid)%delp(ibs:ibe,jbs:jbe,:) + Radiation%block(nb)%phis = _DBL_(_RL_(Atm(mygrid)%phis(ibs:ibe,jbs:jbe))) + Radiation%block(nb)%t = _DBL_(_RL_(Atm(mygrid)%pt(ibs:ibe,jbs:jbe,:))) + Radiation%block(nb)%q = _DBL_(_RL_(Atm(mygrid)%q(ibs:ibe,jbs:jbe,:,:))) + Radiation%block(nb)%pe = _DBL_(_RL_(Atm(mygrid)%pe(ibs:ibe,:,jbs:jbe))) + Radiation%block(nb)%peln = _DBL_(_RL_(Atm(mygrid)%peln(ibs:ibe,:,jbs:jbe))) + Radiation%block(nb)%delp = _DBL_(_RL_(Atm(mygrid)%delp(ibs:ibe,jbs:jbe,:))) if (.not.Radiation%control%phys_hydrostatic) & - Radiation%block(nb)%delz = Atm(mygrid)%delz(ibs:ibe,jbs:jbe,:) + Radiation%block(nb)%delz = _DBL_(_RL_(Atm(mygrid)%delz(ibs:ibe,jbs:jbe,:))) call fv_compute_p_z (Atm_block%npz, Radiation%block(nb)%phis, Radiation%block(nb)%pe, & Radiation%block(nb)%peln, Radiation%block(nb)%delp, Radiation%block(nb)%delz, & @@ -1568,9 +1426,9 @@ subroutine atmos_radiation_driver_inputs (Time, Radiation, Atm_block) Radiation%block(nb)%p_full, Radiation%block(nb)%p_half, & Radiation%block(nb)%z_full, Radiation%block(nb)%z_half, & #ifdef USE_COND - Atm(mygrid)%q_con(ibs:ibe,jbs:jbe,:), & + _DBL_(_RL_(Atm(mygrid)%q_con(ibs:ibe,jbs:jbe,:))), & #else - Atm(mygrid)%q_con, & + _DBL_(_RL_(Atm(mygrid)%q_con)), & #endif Radiation%control%phys_hydrostatic, Radiation%control%do_uni_zfull) !miz enddo @@ -1593,17 +1451,17 @@ end subroutine atmos_radiation_driver_inputs subroutine fv_compute_p_z (npz, phis, pe, peln, delp, delz, pt, q_sph, & p_full, p_half, z_full, z_half, q_con, hydrostatic, do_uni_zfull) !miz integer, intent(in) :: npz - real, dimension(:,:), intent(in) :: phis - real, dimension(:,:,:), intent(in) :: pe, peln, delp, delz, q_con, pt, q_sph - real, dimension(:,:,:), intent(out) :: p_full, p_half, z_full, z_half + real(kind=r8_kind), dimension(:,:), intent(in) :: phis + real(kind=r8_kind), dimension(:,:,:), intent(in) :: pe, peln, delp, delz, q_con, pt, q_sph + real(kind=r8_kind), dimension(:,:,:), intent(out) :: p_full, p_half, z_full, z_half logical, intent(in) :: hydrostatic, do_uni_zfull !miz !--- local variables integer i,j,k,isiz,jsiz real tvm - real :: zvir, rrg, ginv + real(kind=r8_kind) :: zvir, rrg, ginv #ifdef USE_COND - real, dimension(size(pe,1),size(pe,3),size(pe,2)):: peg, pelng - real:: dlg + real(kind=r8_kind), dimension(size(pe,1),size(pe,3),size(pe,2)):: peg, pelng + real(kind=r8_kind):: dlg #endif isiz=size(phis,1) @@ -1700,4 +1558,7 @@ subroutine reset_atmos_tracers (Physics, Physics_tendency, Atm_block) end subroutine reset_atmos_tracers +#include "atmosphere_r4.fh" +#include "atmosphere_r8.fh" + end module atmosphere_mod diff --git a/driver/GFDL/include/atmosphere.inc b/driver/GFDL/include/atmosphere.inc new file mode 100644 index 000000000..61045c61e --- /dev/null +++ b/driver/GFDL/include/atmosphere.inc @@ -0,0 +1,161 @@ + subroutine ATMOSPHERE_BOUNDARY_ (blon, blat, global) +!--------------------------------------------------------------- +! returns the longitude and latitude grid box edges +! for either the local PEs grid (default) or the global grid +!--------------------------------------------------------------- + real(ATMOSPHERE_KIND_), intent(out) :: blon(:,:), blat(:,:) ! Unit: radian + logical, intent(in), optional :: global +! Local data: + integer i,j + + if( PRESENT(global) ) then + if (global) call mpp_error(FATAL, '==> global grid is no longer available & + & in the Cubed Sphere') + endif + + do j=jsc,jec+1 + do i=isc,iec+1 + blon(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid(i,j,1) + blat(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid(i,j,2) + enddo + end do + + end subroutine ATMOSPHERE_BOUNDARY_ + + subroutine ATMOSPHERE_PREF_ (p_ref) + real(ATMOSPHERE_KIND_), dimension(:,:), intent(inout) :: p_ref + + p_ref = pref + + end subroutine ATMOSPHERE_PREF_ + + subroutine ATMOSPHERE_CELL_AREA_ (area_out) + real(ATMOSPHERE_KIND_), dimension(:,:), intent(out) :: area_out + + area_out(1:iec-isc+1, 1:jec-jsc+1) = Atm(mygrid)%gridstruct%area (isc:iec,jsc:jec) + + end subroutine ATMOSPHERE_CELL_AREA_ + + subroutine GET_BOTTOM_MASS_ ( t_bot, tr_bot, p_bot, z_bot, p_surf, slp ) + !-------------------------------------------------------------- + ! returns temp, sphum, pres, height at the lowest model level + ! and surface pressure + !-------------------------------------------------------------- + real(ATMOSPHERE_KIND_), intent(out), dimension(isc:iec,jsc:jec):: t_bot, p_bot, z_bot, p_surf + real(ATMOSPHERE_KIND_), intent(out), optional, dimension(isc:iec,jsc:jec):: slp + real(ATMOSPHERE_KIND_), intent(out), dimension(isc:iec,jsc:jec,nq):: tr_bot + integer :: i, j, m, k, kr + real(ATMOSPHERE_KIND_) :: rrg, sigtop, sigbot + real(ATMOSPHERE_KIND_), dimension(isc:iec,jsc:jec) :: tref + real(ATMOSPHERE_KIND_), parameter :: tlaps = 6.5e-3 + + rrg = rdgas / grav + + do j=jsc,jec + do i=isc,iec + p_surf(i,j) = Atm(mygrid)%ps(i,j) + t_bot(i,j) = Atm(mygrid)%pt(i,j,npz) + p_bot(i,j) = Atm(mygrid)%delp(i,j,npz)/(Atm(mygrid)%peln(i,npz+1,j)-Atm(mygrid)%peln(i,npz,j)) + z_bot(i,j) = rrg*t_bot(i,j)*(1.+zvir*Atm(mygrid)%q(i,j,npz,sphum)) * & + (1. - Atm(mygrid)%pe(i,npz,j)/p_bot(i,j)) + enddo + enddo + + if ( present(slp) ) then + ! determine 0.8 sigma reference level + sigtop = Atm(mygrid)%ak(1)/pstd_mks+Atm(mygrid)%bk(1) + do k = 1, npz + sigbot = Atm(mygrid)%ak(k+1)/pstd_mks+Atm(mygrid)%bk(k+1) + if (sigbot+sigtop > 1.6) then + kr = k + exit + endif + sigtop = sigbot + enddo + do j=jsc,jec + do i=isc,iec + ! sea level pressure + tref(i,j) = Atm(mygrid)%pt(i,j,kr) * (Atm(mygrid)%delp(i,j,kr)/ & + ((Atm(mygrid)%peln(i,kr+1,j)-Atm(mygrid)%peln(i,kr,j))*Atm(mygrid)%ps(i,j)))**(-rrg*tlaps) + slp(i,j) = Atm(mygrid)%ps(i,j)*(1.+tlaps*Atm(mygrid)%phis(i,j)/(tref(i,j)*grav))**(1./(rrg*tlaps)) + enddo + enddo + endif + + ! Copy tracers + do m=1,nq + do j=jsc,jec + do i=isc,iec + tr_bot(i,j,m) = Atm(mygrid)%q(i,j,npz,m) + enddo + enddo + enddo + + end subroutine GET_BOTTOM_MASS_ + + subroutine GET_BOTTOM_WIND_ ( u_bot, v_bot ) +!----------------------------------------------------------- +! returns u and v on the mass grid at the lowest model level +!----------------------------------------------------------- + real(ATMOSPHERE_KIND_), intent(out), dimension(isc:iec,jsc:jec):: u_bot, v_bot + integer i, j + + do j=jsc,jec + do i=isc,iec + u_bot(i,j) = Atm(mygrid)%u_srf(i,j) + v_bot(i,j) = Atm(mygrid)%v_srf(i,j) + enddo + enddo + + end subroutine GET_BOTTOM_WIND_ + + subroutine GET_STOCK_PE_(index, value) + integer, intent(in) :: index + real(ATMOSPHERE_KIND_), intent(out) :: value + +#ifdef USE_STOCK + include 'stock.inc' +#endif + + real(ATMOSPHERE_KIND_) wm(isc:iec,jsc:jec) + integer i,j,k + + select case (index) + +#ifdef USE_STOCK + case (ISTOCK_WATER) +#else + case (1) +#endif + +!---------------------- +! Perform vertical sum: +!---------------------- + wm = 0. + do j=jsc,jec + do k=1,npz + do i=isc,iec +! Warning: the following works only with AM2 physics: water vapor; cloud water, cloud ice. + wm(i,j) = wm(i,j) + Atm(mygrid)%delp(i,j,k) * ( Atm(mygrid)%q(i,j,k,sphum) + & + Atm(mygrid)%q(i,j,k,liq_wat) + & + Atm(mygrid)%q(i,j,k,ice_wat) ) + enddo + enddo + enddo + +!---------------------- +! Horizontal sum: +!---------------------- + value = 0. + do j=jsc,jec + do i=isc,iec + value = value + wm(i,j)*Atm(mygrid)%gridstruct%area(i,j) + enddo + enddo + value = value/grav + + case default + value = 0.0 + end select + + end subroutine GET_STOCK_PE_ diff --git a/driver/GFDL/include/atmosphere_r4.fh b/driver/GFDL/include/atmosphere_r4.fh new file mode 100644 index 000000000..98c5ebdd2 --- /dev/null +++ b/driver/GFDL/include/atmosphere_r4.fh @@ -0,0 +1,22 @@ +#undef ATMOSPHERE_KIND_ +#define ATMOSPHERE_KIND_ r4_kind + +#undef ATMOSPHERE_BOUNDARY_ +#define ATMOSPHERE_BOUNDARY_ atmosphere_boundary_r4 + +#undef ATMOSPHERE_PREF_ +#define ATMOSPHERE_PREF_ atmosphere_pref_r4 + +#undef ATMOSPHERE_CELL_AREA_ +#define ATMOSPHERE_CELL_AREA_ atmosphere_cell_area_r4 + +#undef GET_BOTTOM_MASS_ +#define GET_BOTTOM_MASS_ get_bottom_mass_r4 + +#undef GET_BOTTOM_WIND_ +#define GET_BOTTOM_WIND_ get_bottom_wind_r4 + +#undef GET_STOCK_PE_ +#define GET_STOCK_PE_ get_stock_pe_r4 + +#include "atmosphere.inc" \ No newline at end of file diff --git a/driver/GFDL/include/atmosphere_r8.fh b/driver/GFDL/include/atmosphere_r8.fh new file mode 100644 index 000000000..9381f245c --- /dev/null +++ b/driver/GFDL/include/atmosphere_r8.fh @@ -0,0 +1,22 @@ +#undef ATMOSPHERE_KIND_ +#define ATMOSPHERE_KIND_ r8_kind + +#undef ATMOSPHERE_BOUNDARY_ +#define ATMOSPHERE_BOUNDARY_ atmosphere_boundary_r8 + +#undef ATMOSPHERE_PREF_ +#define ATMOSPHERE_PREF_ atmosphere_pref_r8 + +#undef ATMOSPHERE_CELL_AREA_ +#define ATMOSPHERE_CELL_AREA_ atmosphere_cell_area_r8 + +#undef GET_BOTTOM_MASS_ +#define GET_BOTTOM_MASS_ get_bottom_mass_r8 + +#undef GET_BOTTOM_WIND_ +#define GET_BOTTOM_WIND_ get_bottom_wind_r8 + +#undef GET_STOCK_PE_ +#define GET_STOCK_PE_ get_stock_pe_r8 + +#include "atmosphere.inc" \ No newline at end of file From e6261a375a1159321208ade9380245719b1480b3 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Wed, 10 Jul 2024 11:29:45 -0400 Subject: [PATCH 3/3] more robust conversions --- driver/GFDL/include/atmosphere.inc | 44 +++++++++++++++--------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/driver/GFDL/include/atmosphere.inc b/driver/GFDL/include/atmosphere.inc index 61045c61e..2a29465a8 100644 --- a/driver/GFDL/include/atmosphere.inc +++ b/driver/GFDL/include/atmosphere.inc @@ -15,8 +15,8 @@ do j=jsc,jec+1 do i=isc,iec+1 - blon(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid(i,j,1) - blat(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid(i,j,2) + blon(i-isc+1,j-jsc+1) = _DBL_(_RL_(Atm(mygrid)%gridstruct%grid(i,j,1))) + blat(i-isc+1,j-jsc+1) = _DBL_(_RL_(Atm(mygrid)%gridstruct%grid(i,j,2))) enddo end do @@ -25,14 +25,14 @@ subroutine ATMOSPHERE_PREF_ (p_ref) real(ATMOSPHERE_KIND_), dimension(:,:), intent(inout) :: p_ref - p_ref = pref + p_ref = _DBL_(_RL_(pref)) end subroutine ATMOSPHERE_PREF_ subroutine ATMOSPHERE_CELL_AREA_ (area_out) real(ATMOSPHERE_KIND_), dimension(:,:), intent(out) :: area_out - area_out(1:iec-isc+1, 1:jec-jsc+1) = Atm(mygrid)%gridstruct%area (isc:iec,jsc:jec) + area_out(1:iec-isc+1, 1:jec-jsc+1) = _DBL_(_RL_(Atm(mygrid)%gridstruct%area (isc:iec,jsc:jec))) end subroutine ATMOSPHERE_CELL_AREA_ @@ -49,23 +49,23 @@ real(ATMOSPHERE_KIND_), dimension(isc:iec,jsc:jec) :: tref real(ATMOSPHERE_KIND_), parameter :: tlaps = 6.5e-3 - rrg = rdgas / grav + rrg = _DBL_(_RL_(rdgas / grav)) do j=jsc,jec do i=isc,iec - p_surf(i,j) = Atm(mygrid)%ps(i,j) - t_bot(i,j) = Atm(mygrid)%pt(i,j,npz) - p_bot(i,j) = Atm(mygrid)%delp(i,j,npz)/(Atm(mygrid)%peln(i,npz+1,j)-Atm(mygrid)%peln(i,npz,j)) - z_bot(i,j) = rrg*t_bot(i,j)*(1.+zvir*Atm(mygrid)%q(i,j,npz,sphum)) * & - (1. - Atm(mygrid)%pe(i,npz,j)/p_bot(i,j)) + p_surf(i,j) = _DBL_(_RL_(Atm(mygrid)%ps(i,j))) + t_bot(i,j) = _DBL_(_RL_(Atm(mygrid)%pt(i,j,npz))) + p_bot(i,j) = _DBL_(_RL_(Atm(mygrid)%delp(i,j,npz)/(Atm(mygrid)%peln(i,npz+1,j)-Atm(mygrid)%peln(i,npz,j)))) + z_bot(i,j) = rrg*t_bot(i,j)*_DBL_(_RL_(1.+zvir*Atm(mygrid)%q(i,j,npz,sphum))) * & + _DBL_(_RL_(1. - Atm(mygrid)%pe(i,npz,j)/p_bot(i,j))) enddo enddo if ( present(slp) ) then ! determine 0.8 sigma reference level - sigtop = Atm(mygrid)%ak(1)/pstd_mks+Atm(mygrid)%bk(1) + sigtop = _DBL_(_RL_(Atm(mygrid)%ak(1)/pstd_mks+Atm(mygrid)%bk(1))) do k = 1, npz - sigbot = Atm(mygrid)%ak(k+1)/pstd_mks+Atm(mygrid)%bk(k+1) + sigbot = _DBL_(_RL_(Atm(mygrid)%ak(k+1)/pstd_mks+Atm(mygrid)%bk(k+1))) if (sigbot+sigtop > 1.6) then kr = k exit @@ -75,9 +75,9 @@ do j=jsc,jec do i=isc,iec ! sea level pressure - tref(i,j) = Atm(mygrid)%pt(i,j,kr) * (Atm(mygrid)%delp(i,j,kr)/ & - ((Atm(mygrid)%peln(i,kr+1,j)-Atm(mygrid)%peln(i,kr,j))*Atm(mygrid)%ps(i,j)))**(-rrg*tlaps) - slp(i,j) = Atm(mygrid)%ps(i,j)*(1.+tlaps*Atm(mygrid)%phis(i,j)/(tref(i,j)*grav))**(1./(rrg*tlaps)) + tref(i,j) = _DBL_(_RL_(Atm(mygrid)%pt(i,j,kr) * (Atm(mygrid)%delp(i,j,kr)/ & + ((Atm(mygrid)%peln(i,kr+1,j)-Atm(mygrid)%peln(i,kr,j))*Atm(mygrid)%ps(i,j)))**(-rrg*tlaps))) + slp(i,j) = _DBL_(_RL_(Atm(mygrid)%ps(i,j)*(1.+tlaps*Atm(mygrid)%phis(i,j)/(real(tref(i,j))*grav))**(1./(rrg*tlaps)))) enddo enddo endif @@ -86,7 +86,7 @@ do m=1,nq do j=jsc,jec do i=isc,iec - tr_bot(i,j,m) = Atm(mygrid)%q(i,j,npz,m) + tr_bot(i,j,m) = _DBL_(_RL_(Atm(mygrid)%q(i,j,npz,m))) enddo enddo enddo @@ -102,8 +102,8 @@ do j=jsc,jec do i=isc,iec - u_bot(i,j) = Atm(mygrid)%u_srf(i,j) - v_bot(i,j) = Atm(mygrid)%v_srf(i,j) + u_bot(i,j) = _DBL_(_RL_(Atm(mygrid)%u_srf(i,j))) + v_bot(i,j) = _DBL_(_RL_(Atm(mygrid)%v_srf(i,j))) enddo enddo @@ -136,9 +136,9 @@ do k=1,npz do i=isc,iec ! Warning: the following works only with AM2 physics: water vapor; cloud water, cloud ice. - wm(i,j) = wm(i,j) + Atm(mygrid)%delp(i,j,k) * ( Atm(mygrid)%q(i,j,k,sphum) + & + wm(i,j) = wm(i,j) + _DBL_(_RL_(Atm(mygrid)%delp(i,j,k) * ( Atm(mygrid)%q(i,j,k,sphum) + & Atm(mygrid)%q(i,j,k,liq_wat) + & - Atm(mygrid)%q(i,j,k,ice_wat) ) + Atm(mygrid)%q(i,j,k,ice_wat) ))) enddo enddo enddo @@ -149,10 +149,10 @@ value = 0. do j=jsc,jec do i=isc,iec - value = value + wm(i,j)*Atm(mygrid)%gridstruct%area(i,j) + value = value + wm(i,j)*_DBL_(_RL_(Atm(mygrid)%gridstruct%area(i,j))) enddo enddo - value = value/grav + value = value/_DBL_(_RL_(grav)) case default value = 0.0