From 0ae0edf3805472628950b9dc080fd2132abdcc3e Mon Sep 17 00:00:00 2001 From: Lauren Chilutti Date: Fri, 18 Feb 2022 14:54:27 -0500 Subject: [PATCH 1/6] tRevert "revise external_ic.F90 and fv_nudge.F90 (#68)" This reverts commit 32b44d92ad9962551b25d91d900f4db1bb2a9734. --- tools/external_ic.F90 | 78 +++++++++++++++++++++++++++++++--------- tools/fv_nudge.F90 | 82 +++++++++++++++++++++++++++++++++---------- 2 files changed, 125 insertions(+), 35 deletions(-) diff --git a/tools/external_ic.F90 b/tools/external_ic.F90 index 0f9de10fe..7d167253f 100644 --- a/tools/external_ic.F90 +++ b/tools/external_ic.F90 @@ -1497,7 +1497,7 @@ subroutine get_ncep_ic( Atm, fv_domain, nq ) call ncep2fms(im, jm, lon, lat, wk2) if( is_master() ) then write(*,*) 'External_ic_mod: i_sst=', i_sst, ' j_sst=', j_sst - call pmaxmin( 'SST_ncep_fms', real(sst_ncep), i_sst, j_sst, 1.) + call pmaxmin( 'SST_ncep_fms', sst_ncep, i_sst, j_sst, 1.) endif #endif endif !(read_ts) @@ -3912,22 +3912,29 @@ 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), dimension(:), allocatable :: qmin, qmax + real(r4_kind) pmax, pmin + class(*) fac ! multiplication factor + real(r8_kind), dimension(:), allocatable :: qmin8, qmax8 + real(r8_kind) pmax8, pmin8 + + select type (fac) + type is (real(kind=r4_kind)) + select type (a) + type is (real(kind=r4_kind)) + allocate(qmax(jm), qmin(jm)) + 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 ! @@ -3937,8 +3944,45 @@ subroutine pmaxmin( qname, a, im, jm, fac ) pmax = max(pmax, qmax(j)) pmin = min(pmin, qmin(j)) enddo + deallocate(qmax, qmin) - write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac + write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac + class default + call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin') + end select + + type is (real(kind=r8_kind)) + select type (a) + type is (real(kind=r8_kind)) + allocate(qmax8(jm), qmin8(jm)) + 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 + deallocate(qmax8, qmin8) + + write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac + class default + call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin') + end select + class default + call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin') + end select end subroutine pmaxmin diff --git a/tools/fv_nudge.F90 b/tools/fv_nudge.F90 index 834842a70..9056c3d8c 100644 --- a/tools/fv_nudge.F90 +++ b/tools/fv_nudge.F90 @@ -1527,7 +1527,7 @@ subroutine get_ncep_analysis ( ps, u, v, t, q, zvir, ts, nfile, fname, bd ) #ifndef DYCORE_SOLO ! Perform interp to FMS SST format/grid call ncep2fms( wk1 ) - if(master) call pmaxmin( 'SST_ncep', real(sst_ncep), i_sst, j_sst, 1.) + if(master) call pmaxmin( 'SST_ncep', sst_ncep, i_sst, j_sst, 1.) ! if(nfile/=1 .and. master) call pmaxmin( 'SST_anom', sst_anom, i_sst, j_sst, 1.) #endif deallocate ( wk1 ) @@ -3394,27 +3394,36 @@ logical function leap_year(ny) end function leap_year + 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), dimension(:), allocatable :: qmin, qmax + real(r4_kind) pmax, pmin + + real(r8_kind), dimension(:), allocatable :: qmin8, qmax8 + real(r8_kind) pmax8, pmin8 + + select type (fac) + type is (real(kind=r4_kind)) + select type (a) + type is (real(kind=r4_kind)) + allocate(qmax(jmax), qmin(jmax)) + 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 ! @@ -3424,8 +3433,45 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) pmax = max(pmax, qmax(j)) pmin = min(pmin, qmin(j)) enddo - - write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac + deallocate(qmax, qmin) + + write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac + class default + call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin') + end select + + type is (real(kind=r8_kind)) + select type (a) + type is (real(kind=r8_kind)) + allocate(qmax8(jmax), qmin8(jmax)) + 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 + deallocate(qmax8, qmin8) + + write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac + class default + call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin') + end select + class default + call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin') + end select end subroutine pmaxmin From 7e7cd651719b55bcf44f3aa053a65ae28909045b Mon Sep 17 00:00:00 2001 From: Lauren Chilutti Date: Fri, 18 Feb 2022 14:54:40 -0500 Subject: [PATCH 2/6] Revert "fixing call to pmaxmin to no longer get a compilation error when compiling with GNU." This reverts commit 2aa049c7f302dc30684365bb0f6cffb9b5578fcc. --- tools/external_ic.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/tools/external_ic.F90 b/tools/external_ic.F90 index 7d167253f..a2d8e7a3b 100644 --- a/tools/external_ic.F90 +++ b/tools/external_ic.F90 @@ -2467,10 +2467,10 @@ subroutine get_fv_ic( Atm, fv_domain, nq ) ! Share the load if(is_master()) call pmaxmin( 'ZS_data', gz0, im, jm, 1./grav) - if(mpp_pe()==1) call pmaxmin( 'U_data', reshape(u0, (/ im*jm, km /)), im*jm, km, 1.) - if(mpp_pe()==1) call pmaxmin( 'V_data', reshape(v0, (/ im*jm, km /)), im*jm, km, 1.) - if(mpp_pe()==2) call pmaxmin( 'T_data', reshape(t0, (/ im*jm, km /)), im*jm, km, 1.) - if(mpp_pe()==3) call pmaxmin( 'DEL-P', reshape(dp0, (/ im*jm, km /)), im*jm, km, 0.01) + if(mpp_pe()==1) call pmaxmin( 'U_data', u0, im*jm, km, 1.) + if(mpp_pe()==1) call pmaxmin( 'V_data', v0, im*jm, km, 1.) + if(mpp_pe()==2) call pmaxmin( 'T_data', t0, im*jm, km, 1.) + if(mpp_pe()==3) call pmaxmin( 'DEL-P', dp0, im*jm, km, 0.01) call close_file(Latlon_dyn) else @@ -2508,8 +2508,8 @@ subroutine get_fv_ic( Atm, fv_domain, nq ) deallocate ( u0 ) deallocate ( v0 ) - if(mpp_pe()==4) call pmaxmin( 'UA', reshape(ua, (/ im*jm, km /)), im*jm, km, 1.) - if(mpp_pe()==4) call pmaxmin( 'VA', reshape(va, (/ im*jm, km /)), im*jm, km, 1.) + if(mpp_pe()==4) call pmaxmin( 'UA', ua, im*jm, km, 1.) + if(mpp_pe()==4) call pmaxmin( 'VA', va, im*jm, km, 1.) do j=1,jm do i=1,im From 7779ba3feda38d2e717544b96876ec73b749a540 Mon Sep 17 00:00:00 2001 From: Lauren Chilutti Date: Fri, 18 Feb 2022 14:54:50 -0500 Subject: [PATCH 3/6] Revert "Update external_ic.F90 and fv_nudge.F90 to use allocatable arrays (#65)" This reverts commit 44211c00c6c00e7cff29738726e32db88dd3ad28. --- tools/external_ic.F90 | 12 ++++-------- tools/fv_nudge.F90 | 8 ++------ 2 files changed, 6 insertions(+), 14 deletions(-) diff --git a/tools/external_ic.F90 b/tools/external_ic.F90 index a2d8e7a3b..57c5d85f7 100644 --- a/tools/external_ic.F90 +++ b/tools/external_ic.F90 @@ -3914,17 +3914,16 @@ subroutine pmaxmin( qname, a, im, jm, fac ) integer i, j class(*) a(im,jm) - real(r4_kind), dimension(:), allocatable :: qmin, qmax - real(r4_kind) pmax, pmin + real(r4_kind) qmin(jm), qmax(jm) + real(r4_kind) pmax, pmin class(*) fac ! multiplication factor - real(r8_kind), dimension(:), allocatable :: qmin8, qmax8 - real(r8_kind) pmax8, pmin8 + 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)) - allocate(qmax(jm), qmin(jm)) do j=1,jm pmax = a(1,j) pmin = a(1,j) @@ -3944,7 +3943,6 @@ subroutine pmaxmin( qname, a, im, jm, fac ) pmax = max(pmax, qmax(j)) pmin = min(pmin, qmin(j)) enddo - deallocate(qmax, qmin) write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac class default @@ -3954,7 +3952,6 @@ subroutine pmaxmin( qname, a, im, jm, fac ) type is (real(kind=r8_kind)) select type (a) type is (real(kind=r8_kind)) - allocate(qmax8(jm), qmin8(jm)) do j=1,jm pmax8 = a(1,j) pmin8 = a(1,j) @@ -3974,7 +3971,6 @@ subroutine pmaxmin( qname, a, im, jm, fac ) pmax8 = max(pmax8, qmax8(j)) pmin8 = min(pmin8, qmin8(j)) enddo - deallocate(qmax8, qmin8) write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac class default diff --git a/tools/fv_nudge.F90 b/tools/fv_nudge.F90 index 9056c3d8c..38117ba23 100644 --- a/tools/fv_nudge.F90 +++ b/tools/fv_nudge.F90 @@ -3403,17 +3403,16 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) class(*) a(imax,jmax) class(*) fac ! multiplication factor - real(r4_kind), dimension(:), allocatable :: qmin, qmax + real(r4_kind) qmin(jmax), qmax(jmax) real(r4_kind) pmax, pmin - real(r8_kind), dimension(:), allocatable :: qmin8, qmax8 + 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)) - allocate(qmax(jmax), qmin(jmax)) do j=1,jmax pmax = a(1,j) pmin = a(1,j) @@ -3433,7 +3432,6 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) pmax = max(pmax, qmax(j)) pmin = min(pmin, qmin(j)) enddo - deallocate(qmax, qmin) write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac class default @@ -3443,7 +3441,6 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) type is (real(kind=r8_kind)) select type (a) type is (real(kind=r8_kind)) - allocate(qmax8(jmax), qmin8(jmax)) do j=1,jmax pmax8 = a(1,j) pmin8 = a(1,j) @@ -3463,7 +3460,6 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) pmax8 = max(pmax8, qmax8(j)) pmin8 = min(pmin8, qmin8(j)) enddo - deallocate(qmax8, qmin8) write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac class default From abedccdbd1b305657feae67fd3ab2a91bfbe3610 Mon Sep 17 00:00:00 2001 From: Lauren Chilutti Date: Fri, 18 Feb 2022 14:55:04 -0500 Subject: [PATCH 4/6] Revert "update external_ic.F90 and fv_nudge.F90 (#63)" This reverts commit 81b9be03b26bb98ccc4047b980a38d99f3d17f91. --- tools/external_ic.F90 | 6 ------ tools/fv_nudge.F90 | 6 ------ 2 files changed, 12 deletions(-) diff --git a/tools/external_ic.F90 b/tools/external_ic.F90 index 57c5d85f7..eccd28673 100644 --- a/tools/external_ic.F90 +++ b/tools/external_ic.F90 @@ -3945,8 +3945,6 @@ subroutine pmaxmin( qname, a, im, jm, fac ) enddo write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac - class default - call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin') end select type is (real(kind=r8_kind)) @@ -3973,11 +3971,7 @@ subroutine pmaxmin( qname, a, im, jm, fac ) enddo write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac - class default - call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin') end select - class default - call mpp_error(FATAL,'==> Error in external_ic: unsupported types in pmaxmin') end select end subroutine pmaxmin diff --git a/tools/fv_nudge.F90 b/tools/fv_nudge.F90 index 38117ba23..64b87f91a 100644 --- a/tools/fv_nudge.F90 +++ b/tools/fv_nudge.F90 @@ -3434,8 +3434,6 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) enddo write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac - class default - call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin') end select type is (real(kind=r8_kind)) @@ -3462,11 +3460,7 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) enddo write(*,*) qname, ' max = ', pmax8*fac, ' min = ', pmin8*fac - class default - call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin') end select - class default - call mpp_error(FATAL,'==> Error in fv_nudge: unsupported types in pmaxmin') end select end subroutine pmaxmin From 8c7b9358d35cf024c11eef76bb59989ad5903de7 Mon Sep 17 00:00:00 2001 From: Lauren Chilutti Date: Fri, 18 Feb 2022 14:55:13 -0500 Subject: [PATCH 5/6] Revert "Fix OVERLOAD_R4 ifdef block as suggested by @junwang-noaa (#60)" This reverts commit 63a46035d75640cb3922ab98b8b6e1197db73217. --- tools/fv_diagnostics.F90 | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tools/fv_diagnostics.F90 b/tools/fv_diagnostics.F90 index 92a3b7e0d..701d2ddcb 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -25,12 +25,11 @@ module fv_diagnostics_mod #ifdef OVERLOAD_R4 - use constantsR4_mod, only: grav, rdgas, rvgas, pi=>pi_8, radius, kappa, WTMAIR, WTMCO2, & - omega, hlv, cp_air, cp_vapor, TFREEZE + 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, & - omega, hlv, cp_air, cp_vapor, TFREEZE #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 use mpp_domains_mod, only: domain2d, mpp_update_domains, DGRID_NE, NORTH, EAST From 86f4ac6a6149af3daf5bac577bb9e7dd5758e770 Mon Sep 17 00:00:00 2001 From: Lauren Chilutti Date: Fri, 18 Feb 2022 14:55:20 -0500 Subject: [PATCH 6/6] Revert "Update code to use 'constantsR4_mod' module (#59)" This reverts commit 7b8ee4c61620edf825ae5b92a8ec770e5d5c68bc. --- driver/SHiELD/atmosphere.F90 | 4 -- model/fv_dynamics.F90 | 5 -- model/fv_nesting.F90 | 4 -- model/fv_update_phys.F90 | 4 -- model/nh_core.F90 | 5 -- model/nh_utils.F90 | 5 -- tools/coarse_grained_diagnostics.F90 | 4 -- tools/external_ic.F90 | 76 ++++++++-------------------- tools/fv_diagnostics.F90 | 4 -- tools/fv_nggps_diag.F90 | 4 -- tools/fv_nudge.F90 | 72 ++++++-------------------- tools/fv_restart.F90 | 4 -- tools/test_cases.F90 | 4 -- 13 files changed, 36 insertions(+), 159 deletions(-) diff --git a/driver/SHiELD/atmosphere.F90 b/driver/SHiELD/atmosphere.F90 index 3d32c9b10..869bf2cfe 100644 --- a/driver/SHiELD/atmosphere.F90 +++ b/driver/SHiELD/atmosphere.F90 @@ -31,11 +31,7 @@ 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, 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, & diff --git a/model/fv_dynamics.F90 b/model/fv_dynamics.F90 index a145faf15..8a36a96d7 100644 --- a/model/fv_dynamics.F90 +++ b/model/fv_dynamics.F90 @@ -19,12 +19,7 @@ !* If not, see . !*********************************************************************** 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 966839cab..495c39394 100644 --- a/model/fv_nesting.F90 +++ b/model/fv_nesting.F90 @@ -36,11 +36,7 @@ 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 20991baa9..d3672defb 100644 --- a/model/fv_update_phys.F90 +++ b/model/fv_update_phys.F90 @@ -20,11 +20,7 @@ !*********************************************************************** 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 5a38e2f00..9dcd7a302 100644 --- a/model/nh_core.F90 +++ b/model/nh_core.F90 @@ -23,12 +23,7 @@ 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 885fe94ed..0921b1a02 100644 --- a/model/nh_utils.F90 +++ b/model/nh_utils.F90 @@ -23,12 +23,7 @@ module nh_utils_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 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 84d1bae79..8f910abdd 100644 --- a/tools/coarse_grained_diagnostics.F90 +++ b/tools/coarse_grained_diagnostics.F90 @@ -1,10 +1,6 @@ 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 eccd28673..fd68d1fdd 100644 --- a/tools/external_ic.F90 +++ b/tools/external_ic.F90 @@ -41,12 +41,8 @@ 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 @@ -3907,33 +3903,29 @@ 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 - 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 + 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)) enddo + qmax(j) = pmax + qmin(j) = pmin + enddo ! ! Now find max/min of amax/amin ! @@ -3944,39 +3936,11 @@ subroutine pmaxmin( qname, a, im, jm, fac ) pmin = min(pmin, qmin(j)) enddo - 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 + write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac 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 701d2ddcb..ac40d2c88 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -24,11 +24,7 @@ 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_nggps_diag.F90 b/tools/fv_nggps_diag.F90 index 414d91d8f..8e68b2e44 100644 --- a/tools/fv_nggps_diag.F90 +++ b/tools/fv_nggps_diag.F90 @@ -63,11 +63,7 @@ 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 64b87f91a..a00d87f0f 100644 --- a/tools/fv_nudge.F90 +++ b/tools/fv_nudge.F90 @@ -28,17 +28,12 @@ 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 @@ -3400,29 +3395,22 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) character(len=*) qname integer imax, jmax integer 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 + 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)) enddo + qmax(j) = pmax + qmin(j) = pmin + enddo ! ! Now find max/min of amax/amin ! @@ -3433,35 +3421,7 @@ subroutine pmaxmin( qname, a, imax, jmax, fac ) pmin = min(pmin, qmin(j)) enddo - 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 + write(*,*) qname, ' max = ', pmax*fac, ' min = ', pmin*fac end subroutine pmaxmin diff --git a/tools/fv_restart.F90 b/tools/fv_restart.F90 index 2287355a9..73bbd6f4f 100644 --- a/tools/fv_restart.F90 +++ b/tools/fv_restart.F90 @@ -29,11 +29,7 @@ module fv_restart_mod ! for the model. ! -#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 035a53d80..d61d558e1 100644 --- a/tools/test_cases.F90 +++ b/tools/test_cases.F90 @@ -21,11 +21,7 @@ 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, &