Skip to content

Commit

Permalink
Merge pull request #405 from nmizukami/cesm-coupling_abstract_route
Browse files Browse the repository at this point in the history 
 use abstract route class
  • Loading branch information
@nmizukami
nmizukami authored Jul 1, 2023
2 parents 48fcdd9 + 8c37e9c commit f7d7bfc
Show file tree
Hide file tree
Showing 11 changed files with 521 additions and 931 deletions.
1 change: 1 addition & 0 deletions route/build/Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -153,6 +153,7 @@ DATATYPES = \
datetime_data.f90 \
dataTypes.f90 \
var_lookup.f90 \
base_route.f90 \
csv_data.f90 \
globalData.f90 \
popMetadat.f90 \
Expand Down
171 changes: 44 additions & 127 deletions route/build/src/accum_runoff.f90
View file
Original file line number Diff line number Diff line change
@@ -1,147 +1,64 @@
MODULE accum_runoff_module

! Accumulate upstream flow instantaneously
! This is not used as routed runoff.
! This is used to get total instantaneous upstream runoff at each reach

USE nrtype
! data type
USE dataTypes, ONLY: STRFLX ! fluxes in each reach
USE dataTypes, ONLY: RCHTOPO ! Network topology
USE dataTypes, ONLY: subbasin_omp ! mainstem+tributary data structures
! global data
USE public_var, ONLY: iulog ! i/o logical unit number
USE globalData, ONLY: idxSUM ! index of accumulation method
! subroutines: general
USE perf_mod, ONLY: t_startf,t_stopf ! timing start/stop
USE model_utils, ONLY: handle_err
USE dataTypes, ONLY: STRFLX ! fluxes in each reach
USE dataTypes, ONLY: STRSTA ! state in each reach
USE dataTypes, ONLY: RCHTOPO ! Network topology
USE dataTypes, ONLY: RCHPRP ! Reach parameter
USE public_var, ONLY: iulog ! i/o logical unit number
USE globalData, ONLY: idxSUM ! routing method index for runoff accumulation method
USE base_route, ONLY: base_route_rch ! base (abstract) reach routing method class

implicit none

private
public::accum_runoff
public::accum_runoff_rch

CONTAINS

! ---------------------------------------------------------------------------------------
! Public subroutine main driver for basin routing
! ---------------------------------------------------------------------------------------
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
ierr, message, & ! output: error controls
ixSubRch) ! optional input: subset of reach indices to be processed
! ----------------------------------------------------------------------------------------
! Purpose:
!
! Accumulate all the upstream delayed runoff for each reach
! This is not used as routed runoff.
! This is used to get total instantaneous upstream runoff at each reach
!
! ----------------------------------------------------------------------------------------

implicit none
! argument variables
integer(i4b), intent(in) :: iens ! runoff ensemble index
type(subbasin_omp), allocatable, intent(in) :: river_basin(:) ! river basin information (mainstem, tributary outlet etc.)
integer(i4b), intent(in) :: ixDesire ! index of the reach for verbose output
type(RCHTOPO), allocatable, intent(in) :: NETOPO_in(:) ! River Network topology
type(STRFLX), intent(inout) :: RCHFLX_out(:,:) ! Reach fluxes (ensembles, space [reaches]) for decomposed domains
integer(i4b), intent(out) :: ierr ! error code
character(*), intent(out) :: message ! error message
integer(i4b), optional, intent(in) :: ixSubRch(:) ! subset of reach indices to be processed
! local variables
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

ierr=0; message='accum_runoff/'

if (size(NETOPO_in)/=size(RCHFLX_out(iens,:))) then
ierr=20; message=trim(message)//'sizes of NETOPO and RCHFLX mismatch'; return
endif

nSeg = size(RCHFLX_out(iens,:))

allocate(doRoute(nSeg), stat=ierr)
if(ierr/=0)then; message=trim(message)//'unable to allocate space for [doRoute]'; return; endif

! if a subset of reaches is processed
if (present(ixSubRch))then
doRoute(:)=.false.
doRoute(ixSubRch) = .true. ! only subset of reaches are on
! if all the reaches are processed
else
doRoute(:)=.true. ! every reach is on
endif

nDom = size(river_basin)
type, extends(base_route_rch) :: accum_runoff_rch
CONTAINS
procedure, pass :: route => accum_inst_runoff
end type accum_runoff_rch

call t_startf('route/accum-runoff')

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) call handle_err(ierr, trim(message)//trim(cmessage))

end do
end do
!$OMP END PARALLEL DO

end do

call t_stopf('route/accum-runoff')

END SUBROUTINE accum_runoff
CONTAINS

! *********************************************************************
! subroutine: perform accumulate immediate upstream flow
! *********************************************************************
SUBROUTINE accum_qupstream(iEns, & ! input: index of runoff ensemble to be processed
segIndex, & ! input: index of reach to be processed
ixDesire, & ! input: reachID to be checked by on-screen pringing
NETOPO_in, & ! input: reach topology data structure
RCHFLX_out, & ! inout: reach flux data structure
ierr, message) ! output: error control
SUBROUTINE accum_inst_runoff(this, & ! "accum_runoff_rchr" object to bound this procedure
iEns, & ! input: index of runoff ensemble to be processed
segIndex, & ! input: index of reach to be processed
ixDesire, & ! input: reachID to be checked by on-screen pringing
T0,T1, & ! input: start and end of the time step
NETOPO_in, & ! input: reach topology data structure
RPARAM_in, & ! input: reach parameter data structure
RCHSTA_out, & ! inout: reach state data structure
RCHFLX_out, & ! inout: reach flux data structure
ierr, message) ! output: error control
implicit none
! argument variables
integer(i4b), intent(in) :: iEns ! runoff ensemble to be routed
integer(i4b), intent(in) :: segIndex ! segment where routing is performed
integer(i4b), intent(in) :: ixDesire ! index of the reach for verbose output
type(RCHTOPO),intent(in), allocatable :: NETOPO_in(:) ! River Network topology
type(STRFLX), intent(inout) :: RCHFLX_out(:,:)! Reach fluxes (ensembles, space [reaches]) for decomposed domains
integer(i4b), intent(out) :: ierr ! error code
character(*), intent(out) :: message ! error message
! Argument variables
class(accum_runoff_rch) :: this ! "accum_runoff_rchr" object to bound this procedure
integer(i4b), intent(in) :: iEns ! runoff ensemble to be routed
integer(i4b), intent(in) :: segIndex ! segment where routing is performed
integer(i4b), intent(in) :: ixDesire ! index of the reach for verbose output
real(dp), intent(in) :: T0,T1 ! start and end of the time step (seconds)
type(RCHTOPO), intent(in), allocatable :: NETOPO_in(:) ! River Network topology
type(RCHPRP), intent(inout),allocatable :: RPARAM_in(:) ! River reach parameter
type(STRSTA), intent(inout) :: RCHSTA_out(:,:) ! reach state data
type(STRFLX), intent(inout) :: RCHFLX_out(:,:) ! Reach fluxes (ensembles, space [reaches]) for decomposed domains
integer(i4b), intent(out) :: ierr ! error code
character(*), intent(out) :: message ! error message
! Local variables
real(dp) :: q_upstream ! upstream Reach fluxes
integer(i4b) :: nUps ! number of upstream segment
integer(i4b) :: iUps ! upstream reach index
integer(i4b) :: iRch_ups ! index of upstream reach in NETOPO
character(len=strLen) :: fmt1,fmt2 ! format string
real(dp) :: q_upstream ! upstream Reach fluxes
integer(i4b) :: nUps ! number of upstream segment
integer(i4b) :: iUps ! upstream reach index
integer(i4b) :: iRch_ups ! index of upstream reach in NETOPO
character(len=strLen) :: fmt1,fmt2 ! format string

ierr=0; message='accum_qupstream/'
ierr=0; message='accum_inst_runoff/'

! identify number of upstream segments of the reach being processed
nUps = size(NETOPO_in(segIndex)%UREACHI)
Expand Down Expand Up @@ -176,6 +93,6 @@ SUBROUTINE accum_qupstream(iEns, & ! input: index of runoff ensemble to
write(iulog,'(a,x,G15.4)') ' RCHFLX_out%ROUTE(idxSUM)%REACH_Q =', RCHFLX_out(iens,segIndex)%ROUTE(idxSUM)%REACH_Q
endif

END SUBROUTINE accum_qupstream
END SUBROUTINE accum_inst_runoff

END MODULE accum_runoff_module
69 changes: 69 additions & 0 deletions route/build/src/base_route.f90
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,69 @@
MODULE base_route

! Description: Definition of base (or template) reach routing method class.
! this abstract class needs to be extended to specific routing method types for
! implementation and instantiation.

implicit none

private
public:: base_route_rch ! base (abstract) reach routing method class (to be extended to specific)
public:: routeContainer ! a holder of instantiated reach routing method object

! --- routing method container
! This container (holder) include instantiated reach routing method
type :: routeContainer
class(base_route_rch), allocatable :: rch_route
end type


! --- base (abstract or template) reach routing method
type, abstract :: base_route_rch
CONTAINS
procedure(sub_route_rch), deferred :: route
end type

ABSTRACT INTERFACE

SUBROUTINE sub_route_rch(this, & ! object to bound the procedure
iEns, & ! input: ensemble index
segIndex, & ! input: reach indice
ixDesire, & ! input: index of verbose reach
T0, T1, & ! input: start and end of simulation time step since start [sec]
NETOPO_in, & ! input: reach topology data structure
RPARAM_in, & ! input: reach parameter data structure
RCHSTA_out, & ! inout: reach state data structure
RCHFLX_out, & ! inout: reach flux data structure
ierr, message) ! output: error control

! Description: template interfade for reach routing subroutine
! to perform a routing (after instantiated) at a given reasch (segIndex) and time step
! reach parameters (RPARAM), river network topology (NETOPO) to get upstream location,
! state (RCHSTA) and flux (RCHFLX) are required for a set of input
! ixDesire is index of reach where more information is writting in log along the computation

USE nrtype
USE dataTypes, ONLY: STRFLX ! fluxes in each reach
USE dataTypes, ONLY: STRSTA ! states in each reach
USE dataTypes, ONLY: RCHTOPO ! Network topology
USE dataTypes, ONLY: RCHPRP ! Reach parameter

import base_route_rch
! Arguments
class(base_route_rch) :: this ! object to bound the procedure
integer(i4b), intent(in) :: iEns ! ensemble member
integer(i4b), intent(in) :: segIndex ! ensemble member
integer(i4b), intent(in) :: ixDesire ! index of the reach for verbose output
real(dp), intent(in) :: T0, T1 ! start and end of the time step (seconds)
type(RCHTOPO), intent(in), allocatable :: NETOPO_in(:) ! River Network topology
type(RCHPRP), intent(inout), allocatable :: RPARAM_in(:) ! River reach parameter
type(STRSTA), intent(inout) :: RCHSTA_out(:,:) ! reach state data
type(STRFLX), intent(inout) :: RCHFLX_out(:,:) ! Reach fluxes (ensembles, space [reaches]) for decomposed domains
integer(i4b), intent(out) :: ierr ! error code
character(*), intent(out) :: message ! error message

END SUBROUTINE sub_route_rch

END INTERFACE

END MODULE base_route
Loading

0 comments on commit f7d7bfc

Please sign in to comment.