diff --git a/driver/SHiELDFULL/atmosphere.F90 b/driver/SHiELDFULL/atmosphere.F90 index c0e00f577..47a49eb7b 100644 --- a/driver/SHiELDFULL/atmosphere.F90 +++ b/driver/SHiELDFULL/atmosphere.F90 @@ -31,8 +31,13 @@ module atmosphere_mod !----------------- ! FMS modules: !----------------- +use platform_mod, only: r8_kind, r4_kind use block_control_mod, only: block_control_type -use constants_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks, pi +#ifdef OVERLOAD_R4 +use constantsR4_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks, pi +#else +use constants_mod, only: cp_air, rdgas, grav, rvgas, kappa, pstd_mks, pi +#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, & @@ -94,6 +99,38 @@ module atmosphere_mod implicit none private +interface atmosphere_grid_bdry + module procedure :: atmosphere_grid_bdry_r4 + module procedure :: atmosphere_grid_bdry_r8 +end interface atmosphere_grid_bdry + +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 @@ -158,6 +195,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, Grid_box, area, IAU_Data) @@ -684,15 +728,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, tile_num, & do_inline_mp, do_cosp) integer, intent(out) :: i1, i2, j1, j2, kt @@ -731,32 +766,6 @@ subroutine atmosphere_grid_ctr (lon, lat) end subroutine atmosphere_grid_ctr - - subroutine atmosphere_grid_bdry (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_grid_bdry - - subroutine set_atmosphere_pelist () call mpp_set_current_pelist(Atm(mygrid)%pelist, no_sync=.TRUE.) end subroutine set_atmosphere_pelist @@ -1060,138 +1069,6 @@ end subroutine atmosphere_nggps_diag !rab return !rab end subroutine atmosphere_tracer_postinit - - 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,1)) * & - (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,1) + & - Atm(mygrid)%q(i,j,k,2) + & - Atm(mygrid)%q(i,j,k,3) ) - 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, IPD_Data, IAU_Data, Atm_block) !--- interface variables --- type(time_type), intent(in) :: Time @@ -2060,4 +1937,7 @@ subroutine atmosphere_coarsening_strategy(coarsening_strategy) coarsening_strategy = Atm(mygrid)%coarse_graining%strategy end subroutine atmosphere_coarsening_strategy +#include "atmosphere_r4.fh" +#include "atmosphere_r8.fh" + end module atmosphere_mod diff --git a/driver/SHiELDFULL/include/atmosphere.inc b/driver/SHiELDFULL/include/atmosphere.inc new file mode 100644 index 000000000..2238bc7c5 --- /dev/null +++ b/driver/SHiELDFULL/include/atmosphere.inc @@ -0,0 +1,169 @@ + subroutine ATMOSPHERE_GRID_BDRY_ (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 + + if (ATMOSPHERE_KIND_ .eq. r8_kind) then + do j=jsc,jec+1 + do i=isc,iec+1 + blon(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid_64(i,j,1) + blat(i-isc+1,j-jsc+1) = Atm(mygrid)%gridstruct%grid_64(i,j,2) + enddo + end do + else + 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 + endif + end subroutine ATMOSPHERE_GRID_BDRY_ + + subroutine ATMOSPHERE_PREF_ (p_ref) + real(ATMOSPHERE_KIND_), dimension(:,:), intent(inout) :: p_ref + + 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) = _DBL_(_RL_(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 = _DBL_(_RL_(rdgas / grav)) + + do j=jsc,jec + do i=isc,iec + 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 = _DBL_(_RL_(Atm(mygrid)%ak(1)/pstd_mks+Atm(mygrid)%bk(1))) + do k = 1, npz + sigbot = _DBL_(_RL_(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) = _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 + + ! Copy tracers + do m=1,nq + do j=jsc,jec + do i=isc,iec + tr_bot(i,j,m) = _DBL_(_RL_(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) = _DBL_(_RL_(Atm(mygrid)%u_srf(i,j))) + v_bot(i,j) = _DBL_(_RL_(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) + _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) ))) + enddo + enddo + enddo + +!---------------------- +! Horizontal sum: +!---------------------- + value = 0. + do j=jsc,jec + do i=isc,iec + value = value + wm(i,j)*_DBL_(_RL_(Atm(mygrid)%gridstruct%area(i,j))) + enddo + enddo + value = value/_DBL_(_RL_(grav)) + + case default + value = 0.0 + end select + + end subroutine GET_STOCK_PE_ diff --git a/driver/SHiELDFULL/include/atmosphere_r4.fh b/driver/SHiELDFULL/include/atmosphere_r4.fh new file mode 100644 index 000000000..13e0a98a9 --- /dev/null +++ b/driver/SHiELDFULL/include/atmosphere_r4.fh @@ -0,0 +1,22 @@ +#undef ATMOSPHERE_KIND_ +#define ATMOSPHERE_KIND_ r4_kind + +#undef ATMOSPHERE_GRID_BDRY_ +#define ATMOSPHERE_GRID_BDRY_ atmosphere_grid_bdry_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" diff --git a/driver/SHiELDFULL/include/atmosphere_r8.fh b/driver/SHiELDFULL/include/atmosphere_r8.fh new file mode 100644 index 000000000..9db278316 --- /dev/null +++ b/driver/SHiELDFULL/include/atmosphere_r8.fh @@ -0,0 +1,22 @@ +#undef ATMOSPHERE_KIND_ +#define ATMOSPHERE_KIND_ r8_kind + +#undef ATMOSPHERE_GRID_BDRY_ +#define ATMOSPHERE_GRID_BDRY_ atmosphere_grid_bdry_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" diff --git a/model/boundary.F90 b/model/boundary.F90 index 668451805..28e43afe7 100644 --- a/model/boundary.F90 +++ b/model/boundary.F90 @@ -22,7 +22,11 @@ module boundary_mod use fv_mp_mod, only: is_master - use constants_mod, only: grav +#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 diff --git a/model/dyn_core.F90 b/model/dyn_core.F90 index 525dfc2e1..a2aef966d 100644 --- a/model/dyn_core.F90 +++ b/model/dyn_core.F90 @@ -21,7 +21,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..b66cd38b6 100644 --- a/model/fast_phys.F90 +++ b/model/fast_phys.F90 @@ -27,7 +27,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..c8167015a 100644 --- a/model/fv_control.F90 +++ b/model/fv_control.F90 @@ -26,7 +26,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 3d353d7b2..8c553e0a8 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 d028293f2..cccbe7e2f 100644 --- a/model/fv_mapz.F90 +++ b/model/fv_mapz.F90 @@ -26,7 +26,11 @@ ! 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 4e2ca15fc..43ffc92a5 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..afb9c0039 100644 --- a/model/fv_update_phys.F90 +++ b/model/fv_update_phys.F90 @@ -21,7 +21,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..b262f7b98 100644 --- a/model/intermediate_phys.F90 +++ b/model/intermediate_phys.F90 @@ -27,7 +27,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..957b925c9 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 !------------------------------ +#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 83957ab18..9e39d482a 100644 --- a/tools/coarse_grained_diagnostics.F90 +++ b/tools/coarse_grained_diagnostics.F90 @@ -21,7 +21,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..e0a0b6d1d 100644 --- a/tools/external_aero.F90 +++ b/tools/external_aero.F90 @@ -171,7 +171,12 @@ end subroutine load_aero 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_diagnostics.F90 b/tools/fv_diagnostics.F90 index 395632cc0..758ecdd51 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -24,8 +24,13 @@ 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..e0dd13484 100644 --- a/tools/fv_grid_tools.F90 +++ b/tools/fv_grid_tools.F90 @@ -21,7 +21,11 @@ module fv_grid_tools_mod - use constants_mod, only: grav, pi=>pi_8 +#ifdef OVERLOAD_R4 + use constantsR4_mod, only: grav, pi=>pi_8 +#else + use constants_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..289ef5db5 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 075b0b4a4..3923cfe67 100644 --- a/tools/fv_nudge.F90 +++ b/tools/fv_nudge.F90 @@ -28,7 +28,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, RAD_TO_DEG, cp_air, kappa, cnst_radius =>radius +#else use constants_mod, only: pi=>pi_8, grav, rdgas, RAD_TO_DEG, 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..34ece7132 100644 --- a/tools/fv_restart.F90 +++ b/tools/fv_restart.F90 @@ -30,7 +30,11 @@ module fv_restart_mod ! 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..54c77fcc3 100644 --- a/tools/fv_surf_map.F90 +++ b/tools/fv_surf_map.F90 @@ -26,7 +26,12 @@ 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..fe0fb4fec 100644 --- a/tools/fv_treat_da_inc.F90 +++ b/tools/fv_treat_da_inc.F90 @@ -47,8 +47,13 @@ module fv_treat_da_inc_mod 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..023f3efdd 100644 --- a/tools/init_hydro.F90 +++ b/tools/init_hydro.F90 @@ -21,7 +21,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 6b9bce76d..907186b40 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -21,7 +21,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, &