Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Bugfix for regional runs when dycore is compiled in double precision #25

Merged
merged 4 commits into from
Jun 29, 2020
Merged

Bugfix for regional runs when dycore is compiled in double precision #25

Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
a645fcf
model/fv_regional_bc.F90: bugfix, use correct MPI variable type in ex…
climbfuji Jun 24, 2020
b2b0d33
model/fv_regional_bc.F90: allocate bufr1 to bufr4 to required size fo…
climbfuji Jun 25, 2020
2d0479d
model/fv_regional_bc.F90: bugfix, use correct message size
climbfuji Jun 25, 2020
8e64423
model/fv_regional_bc.F90: add comments and a sanity check for buffer …
climbfuji Jun 25, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 30 additions & 7 deletions model/fv_regional_bc.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -6482,8 +6483,7 @@ 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(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
Expand All @@ -6508,18 +6508,33 @@ 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))
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,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,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

Expand Down Expand Up @@ -6549,9 +6564,10 @@ subroutine exch_uv(domain, bd, npz, u, v)
buf3(ic)=v(i,j,k)
enddo
enddo

enddo
call MPI_Issend(buf3,ic,MPI_REAL,north_pe,mype &
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

Expand Down Expand Up @@ -6583,7 +6599,9 @@ subroutine exch_uv(domain, bd, npz, u, v)
enddo

enddo
call MPI_Issend(buf4,ic,MPI_REAL,south_pe,mype &
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

Expand Down Expand Up @@ -6649,6 +6667,11 @@ subroutine exch_uv(domain, bd, npz, u, v)
enddo
endif

deallocate(buf1)
deallocate(buf2)
deallocate(buf3)
deallocate(buf4)

end subroutine exch_uv

!---------------------------------------------------------------------
Expand Down