Skip to content

Commit

Permalink
put back the routine for upstream threshold based decomposition for O…
Browse files Browse the repository at this point in the history 
…MP. Implemented flow accumulation omp parallel routine. Removed timing for openMP within OMP parallel do loop
  • Loading branch information
@nmizukami
nmizukami committed Jun 20, 2019
1 parent d6c2ecc commit 2e11481
Show file tree
Hide file tree
Showing 6 changed files with 267 additions and 112 deletions.
75 changes: 49 additions & 26 deletions route/build/src/accum_runoff.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,8 @@ MODULE accum_runoff_module
! ---------------------------------------------------------------------------------------
! Public subroutine main driver for basin routing
! ---------------------------------------------------------------------------------------
SUBROUTINE accum_runoff(&
iEns, & ! input: index of runoff ensemble to be processed
SUBROUTINE accum_runoff(iEns, & ! input: index of runoff ensemble to be processed
river_basin, & ! input: river basin information (mainstem, tributary outlet etc.)
ixDesire, & ! input: ReachID to be checked by on-screen printing
NETOPO_in, & ! input: reach topology data structure
RCHFLX_out, & ! inout: reach flux data structure
Expand All @@ -33,28 +33,32 @@ SUBROUTINE accum_runoff(&
!
! ----------------------------------------------------------------------------------------

USE nr_utility_module, ONLY : arth
USE dataTypes, ONLY: subbasin_omp ! mainstem+tributary data structures

implicit none
! input
integer(i4b), intent(in) :: iens ! runoff ensemble index
integer(i4b), intent(in) :: ixDesire ! index of the reach for verbose output
type(RCHTOPO),intent(in), allocatable :: NETOPO_in(:) ! River Network topology
integer(i4b), intent(in) :: iens ! runoff ensemble index
type(subbasin_omp), intent(in), allocatable :: river_basin(:) ! river basin information (mainstem, tributary outlet etc.)
integer(i4b), intent(in) :: ixDesire ! index of the reach for verbose output
type(RCHTOPO), intent(in), allocatable :: NETOPO_in(:) ! River Network topology
! inout
TYPE(STRFLX), intent(inout), allocatable :: RCHFLX_out(:,:)! Reach fluxes (ensembles, space [reaches]) for decomposed domains
TYPE(STRFLX), intent(inout), allocatable :: RCHFLX_out(:,:) ! Reach fluxes (ensembles, space [reaches]) for decomposed domains
! output
integer(i4b), intent(out) :: ierr ! error code
character(*), intent(out) :: message ! error message
integer(i4b), intent(out) :: ierr ! error code
character(*), intent(out) :: message ! error message
! input (optional)
integer(i4b), intent(in), optional :: ixSubRch(:) ! subset of reach indices to be processed
integer(i4b), intent(in), optional :: ixSubRch(:) ! subset of reach indices to be processed
! local variables
integer(i4b) :: nSeg ! number of segments in the network
integer(i4b) :: iSeg, jSeg ! reach segment indices
logical(lgt), allocatable :: doRoute(:) ! logical to indicate which reaches are processed
character(len=strLen) :: cmessage ! error message from subroutines
integer*8 :: cr ! rate
integer*8 :: startTime,endTime ! date/time for the start and end of the initialization
real(dp) :: elapsedTime ! elapsed time for the process
integer(i4b) :: nSeg ! number of segments in the network
integer(i4b) :: nTrib ! number of tributaries
integer(i4b) :: nDom ! number of domains defined by e.g., stream order, tributary/mainstem
integer(i4b) :: iSeg, jSeg ! reach segment indices
integer(i4b) :: iTrib, ix ! loop indices
logical(lgt), allocatable :: doRoute(:) ! logical to indicate which reaches are processed
character(len=strLen) :: cmessage ! error message from subroutines
integer*8 :: cr ! rate
integer*8 :: startTime,endTime ! date/time for the start and end of the initialization
real(dp) :: elapsedTime ! elapsed time for the process

ierr=0; message='accum_runoff/'
call system_clock(count_rate=cr)
Expand All @@ -78,17 +82,36 @@ SUBROUTINE accum_runoff(&
doRoute(:)=.true. ! every reach is on
endif

call system_clock(startTime)

! compute the sum of all upstream runoff at each point in the river network
do iSeg=1,nSeg

jSeg = NETOPO_in(iSeg)%RHORDER
nDom = size(river_basin)

if (.not. doRoute(jSeg)) cycle
call system_clock(startTime)

call accum_qupstream(iens, jSeg, ixDesire, NETOPO_in, RCHFLX_out, ierr, cmessage)
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
do ix = 1,nDom
! 1. Route tributary reaches (parallel)
! compute the sum of all upstream runoff at each point in the river network
nTrib=size(river_basin(ix)%branch)

!$OMP PARALLEL DO schedule(dynamic,1) &
!$OMP private(jSeg, iSeg) & ! private for a given thread
!$OMP private(ierr, cmessage) & ! private for a given thread
!$OMP shared(river_basin) & ! data structure shared
!$OMP shared(doRoute) & ! data array shared
!$OMP shared(NETOPO_in) & ! data structure shared
!$OMP shared(RCHFLX_out) & ! data structure shared
!$OMP shared(ix, iEns, ixDesire) & ! indices shared
!$OMP firstprivate(nTrib)
do iTrib = 1,nTrib
do iSeg=1,river_basin(ix)%branch(iTrib)%nRch
jSeg = river_basin(ix)%branch(iTrib)%segIndex(iSeg)

if (.not. doRoute(jSeg)) cycle

call accum_qupstream(iens, jSeg, ixDesire, NETOPO_in, RCHFLX_out, ierr, cmessage)
!if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif

end do
end do
!$OMP END PARALLEL DO

end do ! looping through stream segments

Expand Down
Loading

0 comments on commit 2e11481

Please sign in to comment.