From 583ec6cabb0615e8ed6e2e6f8c7c644bc64ef0b6 Mon Sep 17 00:00:00 2001 From: Nick Szapiro Date: Fri, 10 Oct 2025 18:18:05 +0000 Subject: [PATCH] Fix intel debug warnings (implicit i,j,k; explicit mpi interface) --- model/fv_arrays.F90 | 2 + model/fv_regional_bc.F90 | 20 ++++---- tools/fv_mp_mod.F90 | 101 ++++++++++++++++++++------------------- 3 files changed, 64 insertions(+), 59 deletions(-) diff --git a/model/fv_arrays.F90 b/model/fv_arrays.F90 index 11ccd3313..82010efb6 100644 --- a/model/fv_arrays.F90 +++ b/model/fv_arrays.F90 @@ -2177,6 +2177,8 @@ subroutine allocate_fv_nest_BC_type_3D(BC,is,ie,js,je,isd,ied,jsd,jed,npx,npy,np integer, intent(IN) :: is, ie, js, je, isd, ied, jsd, jed, npx, npy, npz, ng + integer :: i, j, k + if (BC%allocated) return diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index ba098334d..69b206830 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -6657,7 +6657,7 @@ end subroutine apply_delz_boundary !--------------------------------------------------------------------- subroutine exch_uv(domain, bd, npz, u, v) - use mpi + use mpi_f08 implicit none @@ -6667,9 +6667,15 @@ subroutine exch_uv(domain, bd, npz, u, v) real, intent(inout) :: u (bd%isd:bd%ied ,bd%jsd:bd%jed+1,1:npz) real, intent(inout) :: v (bd%isd:bd%ied+1,bd%jsd:bd%jed ,1:npz) - real, dimension(:), allocatable :: buf1,buf2,buf3,buf4 - integer :: ihandle1,ihandle2,ihandle3,ihandle4 - integer,dimension(MPI_STATUS_SIZE) :: istat +#ifdef OVERLOAD_R4 +#define _DYN_MPI_REAL MPI_REAL + real(kind=4), dimension(:), allocatable :: buf1,buf2,buf3,buf4 +#else +#define _DYN_MPI_REAL MPI_DOUBLE_PRECISION + real(kind=8), dimension(:), allocatable :: buf1,buf2,buf3,buf4 +#endif + type(MPI_Request) :: ihandle1,ihandle2,ihandle3,ihandle4 + type(MPI_Status) :: istat integer :: ic, i, j, k, is, ie, js, je integer :: irecv, isend, ierr @@ -6704,12 +6710,6 @@ subroutine exch_uv(domain, bd, npz, u, v) ! FIXME: MPI_COMM_WORLD -#ifdef OVERLOAD_R4 -#define _DYN_MPI_REAL MPI_REAL -#else -#define _DYN_MPI_REAL MPI_DOUBLE_PRECISION -#endif - ! Receive from north if( north_pe /= NULL_PE )then call MPI_Irecv(buf1,size(buf1),_DYN_MPI_REAL,north_pe,north_pe & diff --git a/tools/fv_mp_mod.F90 b/tools/fv_mp_mod.F90 index bf6b1ede4..afb47d419 100644 --- a/tools/fv_mp_mod.F90 +++ b/tools/fv_mp_mod.F90 @@ -97,6 +97,7 @@ module fv_mp_mod use mpp_mod, only : mpp_get_current_pelist, mpp_set_current_pelist use mpp_domains_mod, only : mpp_get_domain_shift use ensemble_manager_mod, only : get_ensemble_id + use mpi_f08 implicit none private @@ -104,10 +105,10 @@ module fv_mp_mod integer, parameter:: ng = 3 ! Number of ghost zones required integer, parameter :: MAX_NNEST=20, MAX_NTILE=50 -#include "mpif.h" integer, parameter :: XDir=1 integer, parameter :: YDir=2 integer :: commglobal, ierror, npes + type(MPI_COMM) :: commglobal_f08 !need tile as a module variable so that some of the mp_ routines below will work integer::tile @@ -288,9 +289,11 @@ subroutine mp_start(commID, halo_update_type_in) integer :: unit masterproc = mpp_root_pe() - commglobal = MPI_COMM_WORLD + commglobal_f08 = MPI_COMM_WORLD + commglobal = commglobal_f08%mpi_val if( PRESENT(commID) )then commglobal = commID + commglobal_f08%mpi_val = commID end if halo_update_type = halo_update_type_in @@ -310,7 +313,7 @@ subroutine mp_start(commID, halo_update_type_in) master = .false. endif - if (mpp_npes() > 1) call MPI_BARRIER(commglobal, ierror) + if (mpp_npes() > 1) call MPI_BARRIER(commglobal_f08, ierror) end subroutine mp_start ! @@ -341,7 +344,7 @@ end subroutine setup_master !>@brief The subroutine 'mp_barrier' waits for all SPMD processes subroutine mp_barrier() - call MPI_BARRIER(commglobal, ierror) + call MPI_BARRIER(commglobal_f08, ierror) end subroutine mp_barrier ! @@ -353,7 +356,7 @@ end subroutine mp_barrier !>@brief The subroutine 'mp_stop' stops all SPMD processes subroutine mp_stop() - call MPI_BARRIER(commglobal, ierror) + call MPI_BARRIER(commglobal_f08, ierror) if (gid==masterproc) print*, 'Stopping PEs : ', npes call fms_end() ! call MPI_FINALIZE (ierror) @@ -1804,7 +1807,7 @@ end subroutine mp_gather_3d_r8 subroutine mp_bcst_i4(q) integer, intent(INOUT) :: q - call MPI_BCAST(q, 1, MPI_INTEGER, masterproc, commglobal, ierror) + call MPI_BCAST(q, 1, MPI_INTEGER, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_i4 ! @@ -1819,7 +1822,7 @@ end subroutine mp_bcst_i4 subroutine mp_bcst_r4(q) real(kind=4), intent(INOUT) :: q - call MPI_BCAST(q, 1, MPI_REAL, masterproc, commglobal, ierror) + call MPI_BCAST(q, 1, MPI_REAL, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_r4 ! @@ -1834,7 +1837,7 @@ end subroutine mp_bcst_r4 subroutine mp_bcst_r8(q) real(kind=8), intent(INOUT) :: q - call MPI_BCAST(q, 1, MPI_DOUBLE_PRECISION, masterproc, commglobal, ierror) + call MPI_BCAST(q, 1, MPI_DOUBLE_PRECISION, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_r8 ! @@ -1850,7 +1853,7 @@ subroutine mp_bcst_3d_r4(q, idim, jdim, kdim) integer, intent(IN) :: idim, jdim, kdim real(kind=4), intent(INOUT) :: q(idim,jdim,kdim) - call MPI_BCAST(q, idim*jdim*kdim, MPI_REAL, masterproc, commglobal, ierror) + call MPI_BCAST(q, idim*jdim*kdim, MPI_REAL, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_3d_r4 ! @@ -1866,7 +1869,7 @@ subroutine mp_bcst_3d_r8(q, idim, jdim, kdim) integer, intent(IN) :: idim, jdim, kdim real(kind=8), intent(INOUT) :: q(idim,jdim,kdim) - call MPI_BCAST(q, idim*jdim*kdim, MPI_DOUBLE_PRECISION, masterproc, commglobal, ierror) + call MPI_BCAST(q, idim*jdim*kdim, MPI_DOUBLE_PRECISION, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_3d_r8 ! @@ -1882,7 +1885,7 @@ subroutine mp_bcst_4d_r4(q, idim, jdim, kdim, ldim) integer, intent(IN) :: idim, jdim, kdim, ldim real(kind=4), intent(INOUT) :: q(idim,jdim,kdim,ldim) - call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_REAL, masterproc, commglobal, ierror) + call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_REAL, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_4d_r4 ! @@ -1898,7 +1901,7 @@ subroutine mp_bcst_4d_r8(q, idim, jdim, kdim, ldim) integer, intent(IN) :: idim, jdim, kdim, ldim real(kind=8), intent(INOUT) :: q(idim,jdim,kdim,ldim) - call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_DOUBLE_PRECISION, masterproc, commglobal, ierror) + call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_DOUBLE_PRECISION, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_4d_r8 ! @@ -1914,7 +1917,7 @@ subroutine mp_bcst_3d_i8(q, idim, jdim, kdim) integer, intent(IN) :: idim, jdim, kdim integer, intent(INOUT) :: q(idim,jdim,kdim) - call MPI_BCAST(q, idim*jdim*kdim, MPI_INTEGER, masterproc, commglobal, ierror) + call MPI_BCAST(q, idim*jdim*kdim, MPI_INTEGER, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_3d_i8 ! @@ -1930,7 +1933,7 @@ subroutine mp_bcst_4d_i8(q, idim, jdim, kdim, ldim) integer, intent(IN) :: idim, jdim, kdim, ldim integer, intent(INOUT) :: q(idim,jdim,kdim,ldim) - call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_INTEGER, masterproc, commglobal, ierror) + call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_INTEGER, masterproc, commglobal_f08, ierror) end subroutine mp_bcst_4d_i8 ! @@ -1950,7 +1953,7 @@ subroutine mp_reduce_max_r4_1d(mymax,npts) real(kind=4) :: gmax(npts) call MPI_ALLREDUCE( mymax, gmax, npts, MPI_REAL, MPI_MAX, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax = gmax @@ -1972,7 +1975,7 @@ subroutine mp_reduce_max_r8_1d(mymax,npts) real(kind=8) :: gmax(npts) call MPI_ALLREDUCE( mymax, gmax, npts, MPI_DOUBLE_PRECISION, MPI_MAX, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax = gmax @@ -1993,7 +1996,7 @@ subroutine mp_reduce_max_r4(mymax) real(kind=4) :: gmax call MPI_ALLREDUCE( mymax, gmax, 1, MPI_REAL, MPI_MAX, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax = gmax @@ -2013,7 +2016,7 @@ subroutine mp_reduce_max_r8(mymax) real(kind=8) :: gmax call MPI_ALLREDUCE( mymax, gmax, 1, MPI_DOUBLE_PRECISION, MPI_MAX, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax = gmax @@ -2034,14 +2037,14 @@ subroutine mp_reduce_maxval_r4(mymax, idex, jdex) integer :: bcast(2), mrank real(kind=4) :: inreduce(2), outreduce(2) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymax, real(mrank,4)/) bcast=(/idex, jdex/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2REAL, MPI_MAXLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax=outreduce(1) mrank=outreduce(2) - call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal_f08, ierror ) idex=bcast(1) jdex=bcast(2) @@ -2062,14 +2065,14 @@ subroutine mp_reduce_maxval_r8(mymax, idex, jdex) integer :: bcast(2), mrank real(kind=8) :: inreduce(2), outreduce(2) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymax, real(mrank,8)/) bcast=(/idex, jdex/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2DOUBLE_PRECISION, MPI_MAXLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax=outreduce(1) mrank=outreduce(2) - call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal_f08, ierror ) idex=bcast(1) jdex=bcast(2) @@ -2091,14 +2094,14 @@ subroutine mp_reduce_maxloc_r4(mymax, lat, lon, lev, idex, jdex) integer :: mrank real(kind=4) :: inreduce(2), outreduce(2), bcast(5) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymax, real(mrank,4)/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2REAL, MPI_MAXLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax=outreduce(1) mrank=outreduce(2) bcast=(/lat, lon, lev, real(idex,4), real(jdex,4)/) - call MPI_BCAST( bcast, 5, MPI_REAL, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 5, MPI_REAL, mrank, commglobal_f08, ierror ) lat=bcast(1) lon=bcast(2) lev=bcast(3) @@ -2123,14 +2126,14 @@ subroutine mp_reduce_maxloc_r8(mymax, lat, lon, lev, idex, jdex) integer :: mrank real(kind=8) :: inreduce(2), outreduce(2), bcast(5) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymax, real(mrank,8)/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2DOUBLE_PRECISION, MPI_MAXLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax=outreduce(1) mrank=outreduce(2) bcast=(/lat, lon, lev, real(idex,8), real(jdex,8)/) - call MPI_BCAST( bcast, 5, MPI_DOUBLE_PRECISION, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 5, MPI_DOUBLE_PRECISION, mrank, commglobal_f08, ierror ) lat=bcast(1) lon=bcast(2) lev=bcast(3) @@ -2153,7 +2156,7 @@ subroutine mp_reduce_min_r4(mymin) real(kind=4) :: gmin call MPI_ALLREDUCE( mymin, gmin, 1, MPI_REAL, MPI_MIN, & - commglobal, ierror ) + commglobal_f08, ierror ) mymin = gmin @@ -2173,7 +2176,7 @@ subroutine mp_reduce_min_r8(mymin) real(kind=8) :: gmin call MPI_ALLREDUCE( mymin, gmin, 1, MPI_DOUBLE_PRECISION, MPI_MIN, & - commglobal, ierror ) + commglobal_f08, ierror ) mymin = gmin @@ -2194,14 +2197,14 @@ subroutine mp_reduce_minval_r4(mymin, idex, jdex) integer :: bcast(2), mrank real(kind=4) :: inreduce(2), outreduce(2) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymin, real(mrank,4)/) bcast=(/idex, jdex/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2REAL, MPI_MINLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymin=outreduce(1) mrank=outreduce(2) - call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal_f08, ierror ) idex=bcast(1) jdex=bcast(2) @@ -2222,14 +2225,14 @@ subroutine mp_reduce_minval_r8(mymin, idex, jdex) integer :: bcast(2), mrank real(kind=8) :: inreduce(2), outreduce(2) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymin, real(mrank,8)/) bcast=(/idex, jdex/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2DOUBLE_PRECISION, MPI_MINLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymin=outreduce(1) mrank=outreduce(2) - call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 2, MPI_INTEGER, mrank, commglobal_f08, ierror ) idex=bcast(1) jdex=bcast(2) @@ -2251,14 +2254,14 @@ subroutine mp_reduce_minloc_r4(mymin, lat, lon, lev, idex, jdex) integer :: mrank real(kind=4) :: inreduce(2), outreduce(2), bcast(5) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymin, real(mrank,4)/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2REAL, MPI_MINLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymin=outreduce(1) mrank=outreduce(2) bcast=(/lat, lon, lev, real(idex,4), real(jdex,4)/) - call MPI_BCAST( bcast, 5, MPI_REAL, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 5, MPI_REAL, mrank, commglobal_f08, ierror ) lat=bcast(1) lon=bcast(2) lev=bcast(3) @@ -2283,14 +2286,14 @@ subroutine mp_reduce_minloc_r8(mymin, lat, lon, lev, idex, jdex) integer :: mrank real(kind=8) :: inreduce(2), outreduce(2), bcast(5) - call MPI_COMM_RANK( commglobal, mrank, ierror ) + call MPI_COMM_RANK( commglobal_f08, mrank, ierror ) inreduce=(/mymin, real(mrank,8)/) call MPI_ALLREDUCE( inreduce, outreduce, 1, MPI_2DOUBLE_PRECISION, MPI_MINLOC, & - commglobal, ierror ) + commglobal_f08, ierror ) mymin=outreduce(1) mrank=outreduce(2) bcast=(/lat, lon, lev, real(idex,8), real(jdex,8)/) - call MPI_BCAST( bcast, 5, MPI_DOUBLE_PRECISION, mrank, commglobal, ierror ) + call MPI_BCAST( bcast, 5, MPI_DOUBLE_PRECISION, mrank, commglobal_f08, ierror ) lat=bcast(1) lon=bcast(2) lev=bcast(3) @@ -2313,7 +2316,7 @@ subroutine mp_reduce_max_i4(mymax) integer :: gmax call MPI_ALLREDUCE( mymax, gmax, 1, MPI_INTEGER, MPI_MAX, & - commglobal, ierror ) + commglobal_f08, ierror ) mymax = gmax @@ -2333,7 +2336,7 @@ subroutine mp_reduce_sum_r4(mysum) real(kind=4) :: gsum call MPI_ALLREDUCE( mysum, gsum, 1, MPI_REAL, MPI_SUM, & - commglobal, ierror ) + commglobal_f08, ierror ) mysum = gsum @@ -2353,7 +2356,7 @@ subroutine mp_reduce_sum_r8(mysum) real(kind=8) :: gsum call MPI_ALLREDUCE( mysum, gsum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, & - commglobal, ierror ) + commglobal_f08, ierror ) mysum = gsum @@ -2381,7 +2384,7 @@ subroutine mp_reduce_sum_r4_1d(mysum, sum1d, npts) enddo call MPI_ALLREDUCE( mysum, gsum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, & - commglobal, ierror ) + commglobal_f08, ierror ) mysum = gsum @@ -2409,7 +2412,7 @@ subroutine mp_reduce_sum_r8_1d(mysum, sum1d, npts) enddo call MPI_ALLREDUCE( mysum, gsum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, & - commglobal, ierror ) + commglobal_f08, ierror ) mysum = gsum