From a645fcf904c807f129eefae2e4378640495263c1 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 24 Jun 2020 08:53:15 -0600 Subject: [PATCH 1/5] 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/5] 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/5] 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/5] 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 From 945f4e76b3287f9971ad49506b7920cf72b3fdea Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 26 Jun 2020 14:35:37 -0600 Subject: [PATCH 5/5] Bugfix in tools/fv_diagnostics.F90: correct dimensions of delz in several routines --- tools/fv_diagnostics.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tools/fv_diagnostics.F90 b/tools/fv_diagnostics.F90 index cbdac9c79..7aeb867ad 100644 --- a/tools/fv_diagnostics.F90 +++ b/tools/fv_diagnostics.F90 @@ -1549,7 +1549,7 @@ subroutine fv_diag(Atm, zvir, Time, print_freq) isc, iec, jsc, jec, 0, npz, 1.) call prt_maxmin('Bottom DZ (m)', Atm(n)%delz(isc:iec,jsc:jec,npz), & isc, iec, jsc, jec, 0, 1, 1.) -! call prt_maxmin('Top DZ (m)', Atm(n)%delz(isc:iec,jsc:jec,1), & +! call prt_maxmin('Top DZ (m)', Atm(n)%delz(is:ie,js:jec,1), & ! isc, iec, jsc, jec, 0, 1, 1.) endif @@ -5572,7 +5572,7 @@ subroutine max_vorticity(is, ie, js, je, ng, km, zvir, sphum, delz, q, hydrostat real, intent(in):: grav, zvir, z_bot, z_top real, intent(in), dimension(is-ng:ie+ng,js-ng:je+ng,km):: pt real, intent(in), dimension(is:ie,js:je,km):: vort - real, intent(in):: delz(is-ng:ie+ng,js-ng:je+ng,km) + real, intent(in):: delz(is:ie,js:je,km) real, intent(in):: q(is-ng:ie+ng,js-ng:je+ng,km,*) real, intent(in):: phis(is-ng:ie+ng,js-ng:je+ng) real, intent(in):: peln(is:ie,km+1,js:je) @@ -5630,7 +5630,7 @@ subroutine max_uh(is, ie, js, je, ng, km, zvir, sphum, uphmax,uphmin, & real, intent(in):: grav, zvir, z_bot, z_top real, intent(in), dimension(is-ng:ie+ng,js-ng:je+ng,km):: pt, w real, intent(in), dimension(is:ie,js:je,km):: vort - real, intent(in):: delz(is-ng:ie+ng,js-ng:je+ng,km) + real, intent(in):: delz(is:ie,js:je,km) real, intent(in):: q(is-ng:ie+ng,js-ng:je+ng,km,*) real, intent(in):: phis(is-ng:ie+ng,js-ng:je+ng) real, intent(in):: peln(is:ie,km+1,js:je)