From a645fcf904c807f129eefae2e4378640495263c1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 24 Jun 2020 08:53:15 -0600 Subject: [PATCH 1/4] model/fv_regional_bc.F90: bugfix, use correct MPI variable type in exch_uv --- model/fv_regional_bc.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index f7222e6ad..f4ae3beb8 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -3431,6 +3431,7 @@ subroutine remap_scalar_nggps_regional_bc(Atm & print *, 'clwmr = ', liq_wat print *, ' o3mr = ', o3mr print *, 'ncnst = ', ncnst + print *, 'ntracers = ', ntracers endif if ( sphum/=1 ) then @@ -6509,17 +6510,22 @@ subroutine exch_uv(domain, bd, npz, u, v) je=bd%je ! 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,ibufexch,MPI_REAL,north_pe,north_pe & + call MPI_Irecv(buf1,ibufexch,_DYN_MPI_REAL,north_pe,north_pe & ,MPI_COMM_WORLD,ihandle1,irecv) endif ! Receive from south if( south_pe /= NULL_PE )then - call MPI_Irecv(buf2,ibufexch,MPI_REAL,south_pe,south_pe & + call MPI_Irecv(buf2,ibufexch,_DYN_MPI_REAL,south_pe,south_pe & ,MPI_COMM_WORLD,ihandle2,irecv) endif @@ -6551,7 +6557,7 @@ subroutine exch_uv(domain, bd, npz, u, v) enddo enddo - call MPI_Issend(buf3,ic,MPI_REAL,north_pe,mype & + call MPI_Issend(buf3,ic,_DYN_MPI_REAL,north_pe,mype & ,MPI_COMM_WORLD,ihandle3,isend) endif @@ -6583,7 +6589,7 @@ subroutine exch_uv(domain, bd, npz, u, v) enddo enddo - call MPI_Issend(buf4,ic,MPI_REAL,south_pe,mype & + call MPI_Issend(buf4,ic,_DYN_MPI_REAL,south_pe,mype & ,MPI_COMM_WORLD,ihandle4,isend) endif From b2b0d336d644430ca27d57f1d2b1dfb905c7e1f1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 24 Jun 2020 21:19:38 -0600 Subject: [PATCH 2/4] model/fv_regional_bc.F90: allocate bufr1 to bufr4 to required size for bit-for-bit identical results on Cheyenne with Intel 19.1 and SGI MPT 2.19 --- model/fv_regional_bc.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index f4ae3beb8..6bf016392 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -6484,7 +6484,7 @@ subroutine exch_uv(domain, bd, npz, u, v) real, intent(inout) :: v (bd%isd:bd%ied+1,bd%jsd:bd%jed ,1:npz) integer,parameter :: ibufexch=2500000 - real,dimension(ibufexch) :: buf1,buf2,buf3,buf4 + real, dimension(:), allocatable :: buf1,buf2,buf3,buf4 integer :: ihandle1,ihandle2,ihandle3,ihandle4 integer,dimension(MPI_STATUS_SIZE) :: istat integer :: ic, i, j, k, is, ie, js, je @@ -6509,14 +6509,19 @@ subroutine exch_uv(domain, bd, npz, u, v) js=bd%js je=bd%je + allocate(buf1(1:24*npz)) + allocate(buf2(1:36*npz)) + allocate(buf3(1:36*npz)) + allocate(buf4(1:24*npz)) + ! 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,ibufexch,_DYN_MPI_REAL,north_pe,north_pe & @@ -6655,6 +6660,11 @@ subroutine exch_uv(domain, bd, npz, u, v) enddo endif + deallocate(buf1) + deallocate(buf2) + deallocate(buf3) + deallocate(buf4) + end subroutine exch_uv !--------------------------------------------------------------------- From 2d0479dc0abcec7708b11b9390a7be1e386d0e57 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 25 Jun 2020 11:27:48 -0600 Subject: [PATCH 3/4] model/fv_regional_bc.F90: bugfix, use correct message size --- model/fv_regional_bc.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index 6bf016392..a87e57506 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -6483,7 +6483,6 @@ 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) - integer,parameter :: ibufexch=2500000 real, dimension(:), allocatable :: buf1,buf2,buf3,buf4 integer :: ihandle1,ihandle2,ihandle3,ihandle4 integer,dimension(MPI_STATUS_SIZE) :: istat @@ -6524,13 +6523,13 @@ subroutine exch_uv(domain, bd, npz, u, v) ! Receive from north if( north_pe /= NULL_PE )then - call MPI_Irecv(buf1,ibufexch,_DYN_MPI_REAL,north_pe,north_pe & + call MPI_Irecv(buf1,size(buf1),_DYN_MPI_REAL,north_pe,north_pe & ,MPI_COMM_WORLD,ihandle1,irecv) endif ! Receive from south if( south_pe /= NULL_PE )then - call MPI_Irecv(buf2,ibufexch,_DYN_MPI_REAL,south_pe,south_pe & + call MPI_Irecv(buf2,size(buf2),_DYN_MPI_REAL,south_pe,south_pe & ,MPI_COMM_WORLD,ihandle2,irecv) endif @@ -6562,7 +6561,7 @@ subroutine exch_uv(domain, bd, npz, u, v) enddo enddo - call MPI_Issend(buf3,ic,_DYN_MPI_REAL,north_pe,mype & + call MPI_Issend(buf3,size(buf3),_DYN_MPI_REAL,north_pe,mype & ,MPI_COMM_WORLD,ihandle3,isend) endif @@ -6594,7 +6593,7 @@ subroutine exch_uv(domain, bd, npz, u, v) enddo enddo - call MPI_Issend(buf4,ic,_DYN_MPI_REAL,south_pe,mype & + call MPI_Issend(buf4,size(buf4),_DYN_MPI_REAL,south_pe,mype & ,MPI_COMM_WORLD,ihandle4,isend) endif From 8e64423d0cddee9ac9c276a73fe8072a159beef0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 25 Jun 2020 13:37:40 -0600 Subject: [PATCH 4/4] model/fv_regional_bc.F90: add comments and a sanity check for buffer sizes --- model/fv_regional_bc.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/model/fv_regional_bc.F90 b/model/fv_regional_bc.F90 index a87e57506..5c0bd7972 100644 --- a/model/fv_regional_bc.F90 +++ b/model/fv_regional_bc.F90 @@ -6508,6 +6508,11 @@ subroutine exch_uv(domain, bd, npz, u, v) js=bd%js je=bd%je + ! The size of these buffers must match the number of indices + ! required below to send/receive the data. In particular, + ! buf1 and buf4 must be of the same size (sim. for buf2 and buf3). + ! Changes to the code below should be tested with debug flags + ! enabled (out-of-bounds reads/writes). allocate(buf1(1:24*npz)) allocate(buf2(1:36*npz)) allocate(buf3(1:36*npz)) @@ -6559,8 +6564,9 @@ subroutine exch_uv(domain, bd, npz, u, v) buf3(ic)=v(i,j,k) enddo enddo - enddo + if (ic/=size(buf2).or.ic/=size(buf3)) & + call mpp_error(FATAL,'Buffer sizes buf2 and buf3 in routine exch_uv do not match actual message size') call MPI_Issend(buf3,size(buf3),_DYN_MPI_REAL,north_pe,mype & ,MPI_COMM_WORLD,ihandle3,isend) endif @@ -6593,6 +6599,8 @@ subroutine exch_uv(domain, bd, npz, u, v) enddo enddo + if (ic/=size(buf1).or.ic/=size(buf4)) & + call mpp_error(FATAL,'Buffer sizes buf1 and buf4 in routine exch_uv do not match actual message size') call MPI_Issend(buf4,size(buf4),_DYN_MPI_REAL,south_pe,mype & ,MPI_COMM_WORLD,ihandle4,isend) endif