Skip to content

Commit

Permalink
Add a flush statement before each coupled shr_sys_abort
Browse files Browse the repository at this point in the history
  • Loading branch information
@ekluzek
ekluzek committed May 16, 2023
1 parent 9a3a723 commit b6ca44d
Show file tree
Hide file tree
Showing 7 changed files with 100 additions and 31 deletions.
6 changes: 5 additions & 1 deletion route/build/cpl/RtmFileUtils.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ module RtmFileUtils
! Module containing file I/O utilities
!
! !USES:
USE shr_sys_mod , ONLY : shr_sys_abort
USE shr_sys_mod , ONLY : shr_sys_abort, shr_sys_flush
USE shr_file_mod, ONLY : shr_file_get, shr_file_getUnit, shr_file_freeUnit
USE globalData , ONLY : masterproc
USE public_var , ONLY : iulog
Expand Down Expand Up @@ -107,6 +107,7 @@ subroutine getfil (fulpath, dir, locfn, iflag)
dir = get_dirname ( fulpath )
if (len_trim(locfn) == 0) then
if (masterproc) write(iulog,*)'(GETFIL): local filename has zero length'
call shr_sys_flush(iulog)
call shr_sys_abort()
else
if (masterproc) write(iulog,*)'(GETFIL): attempting to find local file ', &
Expand All @@ -131,6 +132,7 @@ subroutine getfil (fulpath, dir, locfn, iflag)
else
if (masterproc) write(iulog,*)'(GETFIL): failed getting file from full path: ', fulpath
if (iflag==0) then
call shr_sys_flush(iulog)
call shr_sys_abort ('GETFIL: FAILED to get '//trim(fulpath))
else
RETURN
Expand Down Expand Up @@ -159,6 +161,7 @@ subroutine opnfil (locfn, iun, form)

if (len_trim(locfn) == 0) then
write(iulog,*)'(OPNFIL): local filename has zero length'
call shr_sys_flush(iulog)
call shr_sys_abort()
endif
if (form=='u' .or. form=='U') then
Expand All @@ -170,6 +173,7 @@ subroutine opnfil (locfn, iun, form)
if (ioe /= 0) then
write(iulog,*)'(OPNFIL): failed to open file ',trim(locfn), &
& ' on unit ',iun,' ierr=',ioe
call shr_sys_flush(iulog)
call shr_sys_abort()
else if ( masterproc )then
write(iulog,*)'(OPNFIL): Successfully opened file ',trim(locfn), &
Expand Down
53 changes: 29 additions & 24 deletions route/build/cpl/RtmMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,7 @@ SUBROUTINE route_ini(rof_active,flood_active)

! mizuRoute time initialize based on time from coupler
call init_time(ierr, cmessage)
if(ierr/=0) then; cmessage = trim(subname)//trim(cmessage); call shr_sys_abort( subname//cmessage ); endif
if(ierr/=0) then; cmessage = trim(subname)//trim(cmessage); call shr_sys_flush(iulog); call shr_sys_abort( subname//cmessage ); endif

if (masterproc) then
write(iulog,*) 'define run:'
Expand All @@ -139,11 +139,13 @@ SUBROUTINE route_ini(rof_active,flood_active)

if (coupling_period <= 0) then
write(iulog,*) subname,' ERROR mizuRoute coupling_period invalid',coupling_period
call shr_sys_flush(iulog)
call shr_sys_abort( subname//' ERROR: coupling_period invalid' )
endif

if (dt <= 0) then
write(iulog,*) subname,' ERROR mizuRoute dt invalid',dt
call shr_sys_flush(iulog)
call shr_sys_abort( subname//' ERROR: mizuRoute dt invalid' )
endif

Expand All @@ -155,15 +157,15 @@ SUBROUTINE route_ini(rof_active,flood_active)
select case(shr_pio_getioformat(inst_name))
case(PIO_64BIT_OFFSET); pio_netcdf_format = '64bit_offset'
case(PIO_64BIT_DATA); pio_netcdf_format = '64bit_data'
case default; call shr_sys_abort(trim(subname)//'unexpected netcdf format index')
case default; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//'unexpected netcdf format index')
end select

select case(shr_pio_getiotype(inst_name))
case(pio_iotype_netcdf); pio_typename = 'netcdf'
case(pio_iotype_pnetcdf); pio_typename = 'pnetcdf'
case(pio_iotype_netcdf4c); pio_typename = 'netcdf4c'
case(pio_iotype_NETCDF4p); pio_typename = 'netcdf4p'
case default; call shr_sys_abort(trim(subname)//'unexpected netcdf io type index')
case default; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//'unexpected netcdf io type index')
end select

!pio_numiotasks = shr_pio_(inst_name) ! there is no function to extract pio_numiotasks in cime/src/drivers/nuops/nems/util/shr_pio_mod.F90
Expand All @@ -184,10 +186,10 @@ SUBROUTINE route_ini(rof_active,flood_active)
!-------------------------------------------------------

call init_ntopo_data(iam, npes, mpicom_rof, ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

call pass_global_data(mpicom_rof, ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

!-------------------------------------------------------
! 4. Define Decomposed domain
Expand Down Expand Up @@ -236,9 +238,11 @@ SUBROUTINE route_ini(rof_active,flood_active)
end if

if ( any(rtmCTL%gindex(rtmCTL%begr:rtmCTL%endr) < 1) )then
call shr_sys_flush(iulog)
call shr_sys_abort(trim(subname)//"bad gindex < 1")
endif
if ( any(rtmCTL%gindex(rtmCTL%begr:rtmCTL%endr) > rtmCTL%numr) )then
call shr_sys_flush(iulog)
call shr_sys_abort(trim(subname)//"bad gindex > max")
endif

Expand All @@ -251,7 +255,7 @@ SUBROUTINE route_ini(rof_active,flood_active)
call RtmRestGetfile()
if (nsrest == nsrContinue) then
call init_histFile(ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
end if
endif

Expand All @@ -260,7 +264,7 @@ SUBROUTINE route_ini(rof_active,flood_active)
!-------------------------------------------------------

call init_state_data(iam, npes, mpicom_rof, ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

!-------------------------------------------------------
! subroutines used only route_ini
Expand Down Expand Up @@ -406,7 +410,7 @@ SUBROUTINE route_run(rstwr)
call t_startf('mizuRoute_histinit')

call main_new_file(ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

call t_stopf('mizuRoute_histinit')

Expand Down Expand Up @@ -498,42 +502,42 @@ SUBROUTINE route_run(rstwr)
! Transfer hru negative flow [mm/s] to volume [m3/s] at river segment
if (masterproc) then
allocate(qvolSend(nRch_mainstem+nRch_trib), qvolRecv(nRch_mainstem+nRch_trib), stat=ierr)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//"allocate qvolSend/qvolRecv error"); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//"allocate qvolSend/qvolRecv error"); endif
qvolRecv = 0._r8
if (nRch_mainstem > 0) then ! mainstem
call basin2reach(qsend(1:nHRU_mainstem), NETOPO_main, RPARAM_main, qvolSend(1:nRch_mainstem), &
ierr, cmessage, limitRunoff=.false.)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
end if
if (nRch_trib > 0) then ! tributaries in main processor
call basin2reach(qsend(nHRU_mainstem+1:rtmCTL%lnumr), NETOPO_trib, RPARAM_trib, qvolSend(nRch_mainstem+1:nRch_trib), &
ierr, cmessage, limitRunoff=.false.)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
end if
else ! other processors (tributary)
allocate(qvolSend(nRch_trib), qvolRecv(nRch_trib), stat=ierr)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//"allocate qvolSend/qvolRecv error"); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//"allocate qvolSend/qvolRecv error"); endif
qvolRecv = 0._r8
call basin2reach(qsend, NETOPO_trib, RPARAM_trib, qvolSend, ierr, cmessage, limitRunoff=.false.)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
end if

! Send negative flow [m3/s] to outlet
do nr=1,size(commRch)
if (commRch(nr)%srcTask/=commRch(nr)%destTask) then
call shr_mpi_send(qvolSend, commRch(nr)%srcTask, commRch(nr)%srcIndex, &
qvolRecv, commRch(nr)%destTask, commRch(nr)%destIndex, ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
else
if (iam==commRch(nr)%srcTask) then
qvolRecv(commRch(nr)%destIndex) = qvolRecv(commRch(nr)%destIndex) + qvolSend(commRch(nr)%srcIndex)
end if
end if
end do
call shr_mpi_barrier(mpicom_rof, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

case default; call shr_sys_abort(trim(subname)//'unexpected bypass_routing_option')
case default; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//'unexpected bypass_routing_option')
end select

call t_stopf('mizuRoute_bypass_route')
Expand All @@ -546,22 +550,22 @@ SUBROUTINE route_run(rstwr)
if (nRch_mainstem > 0) then ! mainstem
call basin2reach(rtmCTL%qirrig_actual(1:nHRU_mainstem), NETOPO_main, RPARAM_main, flux_wm_main, &
ierr, cmessage, limitRunoff=.false.)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if (trim(bypass_routing_option)=='direct_to_outlet') then
flux_wm_main = flux_wm_main + qvolRecv(1:nRch_mainstem)
end if
end if
if (nRch_trib > 0) then ! tributaries in main processor
call basin2reach(rtmCTL%qirrig_actual(nHRU_mainstem+1:rtmCTL%lnumr), NETOPO_trib, RPARAM_trib, flux_wm_trib, &
ierr, cmessage, limitRunoff=.false.)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if (trim(bypass_routing_option)=='direct_to_outlet') then
flux_wm_trib = flux_wm_trib + qvolRecv(nRch_mainstem+1:nRch_trib)
end if
end if
else ! other processors (tributary)
call basin2reach(rtmCTL%qirrig_actual, NETOPO_trib, RPARAM_trib, flux_wm_trib, ierr, cmessage, limitRunoff=.false.)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if (trim(bypass_routing_option)=='direct_to_outlet') then
flux_wm_trib = flux_wm_trib + qvolRecv
end if
Expand All @@ -588,7 +592,7 @@ SUBROUTINE route_run(rstwr)
if (barrier_timers) then
call t_startf('mizuRoute_SMdirect_barrier')
call mpi_barrier(mpicom_rof,ierr)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//"mpi_barrier error"); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//"mpi_barrier error"); endif
call t_stopf ('mizuRoute_SMdirect_barrier')
endif

Expand All @@ -614,7 +618,7 @@ SUBROUTINE route_run(rstwr)

do ns = 1,nsub
call mpi_route(iam, npes, mpicom_rof, iens, ierr, cmessage, scatter_ro=.false.)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif
enddo

call t_stopf('mizuRoute_subcycling')
Expand Down Expand Up @@ -653,7 +657,7 @@ SUBROUTINE route_run(rstwr)
call t_startf('mizuRoute_htapes')

call output(ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

call t_stopf('mizuRoute_htapes')

Expand All @@ -664,14 +668,14 @@ SUBROUTINE route_run(rstwr)
call t_startf('mizuRoute_rest')

call restart_output(ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

call t_stopf('mizuRoute_rest')
end if

! increment mizuRoute time step
call update_time(finished, ierr, cmessage)
if(ierr/=0)then; call shr_sys_abort(trim(subname)//trim(cmessage)); endif
if(ierr/=0)then; call shr_sys_flush(iulog); call shr_sys_abort(trim(subname)//trim(cmessage)); endif

!-----------------------------------
! Done
Expand Down Expand Up @@ -767,6 +771,7 @@ SUBROUTINE RtmRestGetfile()
write(iulog,*) 'previous case filename= ',trim(fname_state_in), &
' current case = ',trim(caseid), ' ctest = ',trim(ctest), &
' ftest = ',trim(ftest)
call shr_sys_flush(iulog)
call shr_sys_abort()
end if
end if
Expand Down
7 changes: 6 additions & 1 deletion route/build/cpl/RtmVar.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,10 @@ MODULE RtmVar
! Public variables used for only coupled version mizuRoute

USE shr_kind_mod , ONLY: r8 => shr_kind_r8, CL => SHR_KIND_CL
USE shr_sys_mod , ONLY: shr_sys_abort
USE shr_sys_mod , ONLY: shr_sys_abort, shr_sys_flush
USE globalData , ONLY: masterproc
USE globalData , ONLY: version
USE public_var , ONLY: iulog

implicit none

Expand Down Expand Up @@ -79,6 +80,7 @@ SUBROUTINE rofVarSet( caseid_in, ctitle_in, brnch_retain_casename_in, &
!-----------------------------------------------------------------------

if ( rofVar_isset )then
call shr_sys_flush(iulog)
call shr_sys_abort( 'rofVarSet ERROR:: control variables already set -- EXIT' )
end if

Expand All @@ -98,9 +100,11 @@ END SUBROUTINE rofVarSet
SUBROUTINE RtmVarInit( )
if (masterproc) then
if (nsrest == iundef) then
call shr_sys_flush(iulog)
call shr_sys_abort( 'RtmVarInit ERROR:: must set nsrest' )
end if
if (nsrest == nsrBranch .and. nrevsn_rtm == ' ') then
call shr_sys_flush(iulog)
call shr_sys_abort( 'RtmVarInit ERROR: need to set restart data file name' )
end if
if (nsrest == nsrStartup ) then
Expand All @@ -110,6 +114,7 @@ SUBROUTINE RtmVarInit( )
nrevsn_rtm = 'set by restart pointer file file'
end if
if (nsrest /= nsrStartup .and. nsrest /= nsrContinue .and. nsrest /= nsrBranch ) then
call shr_sys_flush(iulog)
call shr_sys_abort( 'RtmVarInit ERROR: nsrest NOT set to a valid value' )
end if
endif
Expand Down
3 changes: 2 additions & 1 deletion route/build/cpl/RunoffMod.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ MODULE RunoffMod
USE public_var, ONLY : iulog
USE public_var, ONLY : integerMissing
USE rtmVar, ONLY : nt_rof
USE shr_sys_mod,ONLY : shr_sys_abort
USE shr_sys_mod,ONLY : shr_sys_abort, shr_sys_flush

implicit none

Expand Down Expand Up @@ -62,6 +62,7 @@ SUBROUTINE RunoffInit(begr, endr, numr)
stat=ierr)
if (ierr/=0) then
write(iulog,*)'Rtmini ERROR allocation of runoff local arrays'
call shr_sys_flush(iulog)
call shr_sys_abort
end if

Expand Down
Loading

0 comments on commit b6ca44d

Please sign in to comment.