Skip to content

Commit d6ba771

Browse files
committed
start adding tracer dimension in arrays
1 parent 85bbe71 commit d6ba771

10 files changed

Lines changed: 99 additions & 80 deletions

File tree

route/build/src/basinUH.f90

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -125,13 +125,15 @@ SUBROUTINE hru_irf(iSeg, & ! input: index of segment to be processed
125125
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
126126

127127
if(tracer) then
128-
! perform river network UH routing
129-
call irf_conv(FRAC_FUTURE_local, & ! input: unit hydrograph
130-
RCHFLX_out(iSeg)%BASIN_solute_inst, & ! input: upstream fluxes
131-
RCHFLX_out(iSeg)%solute_future, & ! inout: updated solute future time series
132-
RCHFLX_out(iSeg)%BASIN_solute, & ! inout: updated fluxes at reach
133-
ierr, message) ! output: error control
134-
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
128+
do iTracer=1,nTracer
129+
! perform river network UH routing
130+
call irf_conv(FRAC_FUTURE_local, & ! input: unit hydrograph
131+
RCHFLX_out(iSeg)%BASIN_solute_inst(iTracer), & ! input: upstream fluxes
132+
RCHFLX_out(iSeg)%solute_future, & ! inout: updated solute future time series
133+
RCHFLX_out(iSeg)%BASIN_solute(iTracer), & ! inout: updated fluxes at reach
134+
ierr, message) ! output: error control
135+
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
136+
end do
135137
end if
136138

137139
END SUBROUTINE hru_irf

route/build/src/dataTypes.f90

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -168,7 +168,7 @@ MODULE dataTypes
168168
real(dp) , allocatable :: basinRunoff(:) ! remapped river network catchment runoff [depth/time] (size: number of nHRU)
169169
real(dp) , allocatable :: basinEvapo(:) ! remapped river network catchment evaporation [depth/time] (size: number of nHRU)
170170
real(dp) , allocatable :: basinPrecip(:) ! remapped river network catchment precipitation [depth/time] (size: number of nHRU)
171-
real(dp) , allocatable :: basinSolute(:) ! remapped river network catchment solute in water [mass/time] (size: number of nHRU)
171+
real(dp) , allocatable :: basinSolute(:,:)! remapped river network catchment solute in water [mass/time] (size: nHRU, nTracer)
172172
end type runoff
173173

174174
type, public, extends(inputData) :: wm ! water-management
@@ -357,8 +357,8 @@ MODULE dataTypes
357357
real(dp) :: REACH_WM_FLUX_actual ! water management fluxes to and from each reach [m3/s]
358358
real(dp) :: WB ! reach water balance error [m3]
359359
real(dp) :: Qerror ! simulated discharge error compared to obs [m3/s] -- only for data assimilation
360-
real(dp) :: reach_solute_mass(0:1) ! constituent mass in channel [mg]
361-
real(dp) :: reach_solute_flux ! constituent mass flux from reach outlet [mg/s]
360+
real(dp),allocatable :: reach_solute_mass(0:1,:) ! mass of constituent(s) in channel [mg]
361+
real(dp),allocatable :: reach_solute_flux(:) ! mass flux of constituent(s) from reach outlet [mg/s]
362362
end type hydraulic
363363

364364
! fluxes and states in each reach
@@ -368,8 +368,8 @@ MODULE dataTypes
368368
real(dp), allocatable :: QPASTUP_IRF(:,:) ! runoff volume in the past time steps for lake upstream [m3/s]
369369
real(dp), allocatable :: DEMANDPAST_IRF(:,:) ! demand volume for lake [m3/s]
370370
real(dp), allocatable :: solute_future(:) ! lateral solute mass in future time steps [mg/s]
371-
real(dp) :: BASIN_solute ! instantaneous constituent mass from the local basin [mg/s]
372-
real(dp) :: BASIN_solute_inst ! instantaneous constituent mass from the local basin [mg/s]
371+
real(dp), allocatable :: BASIN_solute(:) ! mass of instantaneous constituent(s) from the local basin [mg/s]
372+
real(dp), allocatable :: BASIN_solute_inst(:) ! mass of instantaneous constituent(s) from the local basin [mg/s]
373373
real(dp) :: BASIN_QI ! instantaneous runoff volume from the local basin [m3/s]
374374
real(dp) :: BASIN_QR(0:1) ! routed runoff volume from the local basin [m3/s]
375375
type(hydraulic), allocatable :: ROUTE(:) ! reach fluxes and states for each routing method

route/build/src/globalData.f90

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -252,9 +252,10 @@ MODULE globalData
252252
real(dp), allocatable, public :: basinEvapo_main(:) ! HRU evaporation array (m/s) for mainstem
253253
real(dp), allocatable, public :: basinPrecip_trib(:) ! HRU precipitation array (m/s) for tributaries
254254
real(dp), allocatable, public :: basinPrecip_main(:) ! HRU precipitation array (m/s) for mainstem
255-
real(dp), allocatable, public :: basinSolute_trib(:) ! HRU constituent array (mg/s) for tributaries
256-
real(dp), allocatable, public :: basinSolute_main(:) ! HRU constituent array (mg/s) for mainstem
257-
255+
! solute (tracer) data
256+
integer(i4b) :: nTracer ! number of tracers
257+
real(dp), allocatable, public :: basinSolute_trib(:,:) ! HRU constituent array [nhru, nTracer] (mg/s) for tributaries
258+
real(dp), allocatable, public :: basinSolute_main(:,:) ! HRU constituent array [nhru, nTracer] (mg/s) for mainstem
258259
! seg water management fluxes and target volume
259260
type(wm), public :: wm_data ! SEG flux and target vol data structure for one time step for river network
260261
real(dp), allocatable, public :: flux_wm_trib(:) ! SEG flux array (m3/s) for tributaries

route/build/src/main_route.f90

Lines changed: 22 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ MODULE main_route_module
3030
SUBROUTINE main_route(basinRunoff_in, & ! input: basin (i.e.,HRU) runoff (m/s)
3131
basinEvapo_in, & ! input: basin (i.e.,HRU) evaporation (m/s)
3232
basinPrecip_in, & ! input: basin (i.e.,HRU) precipitation (m/s)
33-
basinSolute_in, & ! input: basin (i.e.,HRU) constituent mass fluw (mg/s/m2)
33+
basinSolute_in, & ! input: basin (i.e.,HRU) mass flux of constituent(s) (mg/s/m2)
3434
reachflux_in, & ! input: reach (i.e.,reach) flux (m3/s)
3535
reachvol_in, & ! input: reach (i.e.,reach) target volume for lakes (m3)
3636
ixRchProcessed, & ! input: indices of reach to be routed
@@ -52,7 +52,8 @@ SUBROUTINE main_route(basinRunoff_in, & ! input: basin (i.e.,HRU) runoff (m/s)
5252
USE globalData, ONLY: TSEC ! beginning/ending of simulation time step [sec]
5353
USE globalData, ONLY: simDatetime ! current model datetime
5454
USE globalData, ONLY: rch_routes !
55-
USE public_var, ONLY: doesBasinRoute
55+
USE globalData, ONLY: nTracer ! number of active tracers
56+
USE public_var, ONLY: doesBasinRoute ! hillslope routing option
5657
USE public_var, ONLY: is_flux_wm ! logical whether or not fluxes should be passed
5758
USE public_var, ONLY: is_vol_wm ! logical whether or not target volume should be passed
5859
USE public_var, ONLY: qmodOption ! options for streamflow modification (DA)
@@ -62,7 +63,7 @@ SUBROUTINE main_route(basinRunoff_in, & ! input: basin (i.e.,HRU) runoff (m/s)
6263
real(dp), allocatable, intent(in) :: basinRunoff_in(:) ! basin (i.e.,HRU) runoff (m/s)
6364
real(dp), allocatable, intent(in) :: basinEvapo_in(:) ! basin (i.e.,HRU) evaporation (m/s)
6465
real(dp), allocatable, intent(in) :: basinPrecip_in(:) ! basin (i.e.,HRU) precipitation (m/s)
65-
real(dp), allocatable, intent(in) :: basinSolute_in(:) ! basin (i.e.,HRU) constituent (mg/s/m2)
66+
real(dp), allocatable, intent(in) :: basinSolute_in(:,:) ! basin (i.e.,HRU) constituent(s) (mg/s/m2)
6667
real(dp), allocatable, intent(in) :: reachflux_in(:) ! reach (i.e.,reach) flux (m3/s)
6768
real(dp), allocatable, intent(in) :: reachvol_in(:) ! reach (i.e.,reach) target volume for lakes (m3)
6869
integer(i4b), allocatable, intent(in) :: ixRchProcessed(:) ! indices of reach to be routed
@@ -78,11 +79,12 @@ SUBROUTINE main_route(basinRunoff_in, & ! input: basin (i.e.,HRU) runoff (m/s)
7879
character(len=strLen) :: cmessage ! error message of downwind routine
7980
real(dp) :: qobs ! observed discharge at a time step and site
8081
real(dp), allocatable :: reachRunoff_local(:) ! reach runoff (m3/s)
81-
real(dp), allocatable :: reachSolute_local(:) ! reach constituent (mg/s)
82+
real(dp), allocatable :: reachSolute_local(:,:) ! reach constituent(s) (mg/s)
8283
real(dp), allocatable :: reachEvapo_local(:) ! reach evaporation (m3/s)
8384
real(dp), allocatable :: reachPrecip_local(:) ! reach precipitation (m3/s)
8485
integer(i4b) :: nSeg ! number of reach to be processed
8586
integer(i4b) :: iSeg ! index of reach
87+
integer(i4b) :: iTracer ! index of tracers
8688
integer(i4b) :: ix,jx ! loop index
8789
integer(i4b), allocatable :: reach_ix(:)
8890
integer(i4b), parameter :: no_mod=0
@@ -149,16 +151,17 @@ SUBROUTINE main_route(basinRunoff_in, & ! input: basin (i.e.,HRU) runoff (m/s)
149151
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
150152

151153
if(tracer) then
152-
allocate(reachSolute_local(nSeg), source=0._dp, stat=ierr)
154+
allocate(reachSolute_local(nSeg,nTracer), source=0._dp, stat=ierr)
153155
if(ierr/=0)then; message=trim(message)//'problem allocating arrays for [reachSolute_local]'; return; endif
154-
155-
call basin2reach_mass(basinSolute_in, & ! input: basin total constitunet (mg/s/m2)
156-
NETOPO_in, & ! input: reach topology
157-
RPARAM_in, & ! input: reach parameter
158-
reachSolute_local, & ! output:total constituent going to reach (mg/s)
159-
ierr, cmessage, & ! output: error control
160-
ixRchProcessed) ! optional input: indices of reach to be routed
161-
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
156+
do iTracer=1,nTracer
157+
call basin2reach_mass(basinSolute_in(:,iTracer), & ! input: basin total constitunet (mg/s/m2)
158+
NETOPO_in, & ! input: reach topology
159+
RPARAM_in, & ! input: reach parameter
160+
reachSolute_local(:,iTracer), & ! output:total constituent going to reach (mg/s)
161+
ierr, cmessage, & ! output: error control
162+
ixRchProcessed) ! optional input: indices of reach to be routed
163+
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
164+
end do
162165
end if
163166

164167
if (is_lake_sim) then
@@ -196,7 +199,9 @@ SUBROUTINE main_route(basinRunoff_in, & ! input: basin (i.e.,HRU) runoff (m/s)
196199
RCHFLX_out(ixRchProcessed(iSeg))%BASIN_QI = reachRunoff_local(iSeg)
197200
if (tracer) then
198201
if (RCHFLX_out(ixRchProcessed(iSeg))%BASIN_QI>0) then ! this may cause mass inbalance between input and output. so may need to feed flag to land surface model
199-
RCHFLX_out(ixRchProcessed(iSeg))%BASIN_solute_inst = reachSolute_local(iSeg)
202+
do iTracer=1,nTracer
203+
RCHFLX_out(ixRchProcessed(iSeg))%BASIN_solute_inst(iTracer) = reachSolute_local(iSeg,iTracer)
204+
end do
200205
else
201206
RCHFLX_out(ixRchProcessed(iSeg))%BASIN_solute_inst = 0._dp
202207
endif
@@ -218,7 +223,9 @@ SUBROUTINE main_route(basinRunoff_in, & ! input: basin (i.e.,HRU) runoff (m/s)
218223
if (tracer) then
219224
do iSeg = 1,nSeg
220225
if (RCHFLX_out(ixRchProcessed(iSeg))%BASIN_QR(1)>0) then
221-
RCHFLX_out(ixRchProcessed(iSeg))%BASIN_solute = reachSolute_local(iSeg) ! total constituent going to reach (mg/s)
226+
do iTracer=1,nTracer
227+
RCHFLX_out(ixRchProcessed(iSeg))%BASIN_solute(iTracer) = reachSolute_local(iSeg,iTracer) ! total constituent going to reach (mg/s)
228+
end do
222229
else
223230
RCHFLX_out(ixRchProcessed(iSeg))%BASIN_solute = 0._dp
224231
endif

route/build/src/mpi_process.f90

Lines changed: 18 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -107,6 +107,7 @@ SUBROUTINE comm_ntopo_data(pid, & ! input: proc id
107107
USE globalData, ONLY: vol_wm_trib ! nRch target vol holder for mainstem
108108
USE globalData, ONLY: nRch_trib ! number of tributary reaches
109109
USE globalData, ONLY: nHRU_trib ! number of tributary HRUs
110+
USE globalData, ONLY: nTracer ! number of tracer
110111
USE globalData, ONLY: hru_per_proc ! number of hrus assigned to each proc (size = num of procs+1)
111112
USE globalData, ONLY: rch_per_proc ! number of reaches assigned to each proc (size = num of procs+1)
112113
USE globalData, ONLY: ixHRU_order ! global HRU index in the order of proc assignment (size = total number of HRUs contributing to any reaches, nContribHRU)
@@ -574,10 +575,10 @@ SUBROUTINE comm_ntopo_data(pid, & ! input: proc id
574575
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
575576

576577
if (tracer) then
577-
allocate(basinSolute_main(nHRU_mainstem), source=0.0_dp, stat=ierr, errmsg=cmessage)
578+
allocate(basinSolute_main(nHRU_mainstem,nTracer), source=0.0_dp, stat=ierr, errmsg=cmessage)
578579
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
579580

580-
allocate(basinSolute_trib(nHRU_trib), source=0.0_dp, stat=ierr, errmsg=cmessage)
581+
allocate(basinSolute_trib(nHRU_trib,nTracer), source=0.0_dp, stat=ierr, errmsg=cmessage)
581582
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
582583
end if
583584

@@ -629,7 +630,7 @@ SUBROUTINE comm_ntopo_data(pid, & ! input: proc id
629630
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
630631

631632
if (tracer) then
632-
allocate(basinSolute_trib(nHRU_trib), source=0.0_dp, stat=ierr, errmsg=cmessage)
633+
allocate(basinSolute_trib(nHRU_trib,nTracer), source=0.0_dp, stat=ierr, errmsg=cmessage)
633634
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
634635
end if
635636

@@ -1394,6 +1395,7 @@ SUBROUTINE scatter_runoff(nNodes, & ! mpi variables: number nodes
13941395

13951396
USE globalData, ONLY: nHRU ! number of all HRUs
13961397
USE globalData, ONLY: nHRU_mainstem ! number of mainstem HRUs
1398+
USE globalData, ONLY: nTracer ! number of tracers
13971399
USE globalData, ONLY: runoff_data ! runoff data structure
13981400
USE globalData, ONLY: hru_per_proc ! number of hrus assigned to each proc (i.e., node)
13991401
USE globalData, ONLY: basinRunoff_main ! HRU runoff holder for mainstem
@@ -1413,10 +1415,11 @@ SUBROUTINE scatter_runoff(nNodes, & ! mpi variables: number nodes
14131415
integer(i4b), intent(out) :: ierr ! error code
14141416
character(len=strLen), intent(out) :: message ! error message
14151417
! local variables
1418+
integer(i4b) :: iTracer ! tracer loop index
14161419
real(dp) :: basinRunoff_local(nHRU) ! temporal basin runoff (m/s) for whole domain
14171420
real(dp) :: basinEvapo_local(nHRU) ! temporal basin evaporation (m/s) for whole domain
14181421
real(dp) :: basinPrecip_local(nHRU) ! temporal basin precipitation (m/s) for whole domain
1419-
real(dp) :: basinSolute_local(nHRU) ! temporal basin constituent (g) for whole domain
1422+
real(dp) :: basinSolute_local(nHRU,nTracer) ! temporal basin constituent (mg) for whole domain
14201423
character(len=strLen) :: cmessage ! error message from a subroutine
14211424

14221425
ierr=0; message='scatter_runoff/'
@@ -1433,7 +1436,7 @@ SUBROUTINE scatter_runoff(nNodes, & ! mpi variables: number nodes
14331436
end if
14341437

14351438
if (tracer) then
1436-
basinSolute_local (1:nHRU) = runoff_data%basinSolute(1:nHRU)
1439+
basinSolute_local (1:nHRU,1:nTracer) = runoff_data%basinSolute(1:nHRU,1:nTracer)
14371440
end if
14381441

14391442
if (nHRU_mainstem>0) then
@@ -1459,11 +1462,10 @@ SUBROUTINE scatter_runoff(nNodes, & ! mpi variables: number nodes
14591462

14601463
if (tracer) then
14611464
if (.not. allocated(basinSolute_main)) then
1462-
allocate(basinSolute_main(nHRU_mainstem), stat=ierr)
1463-
if(ierr/=0)then; message=trim(message)//'problem allocating array for [basinEvapo_main]'; return; endif
1465+
allocate(basinSolute_main(nHRU_mainstem,nTracer), source=0.0_dp, stat=ierr, errmsg=cmessage)
1466+
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
14641467
endif
1465-
basinSolute_main (1:nHRU_mainstem) = basinSolute_local (1:nHRU_mainstem)
1466-
1468+
basinSolute_main (1:nHRU_mainstem, 1:nTracer) = basinSolute_local(1:nHRU_mainstem,1:nTracer)
14671469
end if
14681470
end if
14691471

@@ -1491,11 +1493,13 @@ SUBROUTINE scatter_runoff(nNodes, & ! mpi variables: number nodes
14911493
end if
14921494

14931495
if (tracer) then
1494-
call shr_mpi_scatterV(basinSolute_local(nHRU_mainstem+1:nHRU), &
1495-
hru_per_proc(0:nNodes-1), &
1496-
basinSolute_trib, &
1497-
ierr, cmessage)
1498-
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
1496+
do iTracer=1,nTracer
1497+
call shr_mpi_scatterV(basinSolute_local(nHRU_mainstem+1:nHRU,iTracer), &
1498+
hru_per_proc(0:nNodes-1), &
1499+
basinSolute_trib(:,iTracer), &
1500+
ierr, cmessage)
1501+
if(ierr/=0)then; message=trim(message)//trim(cmessage); return; endif
1502+
end do
14991503
end if
15001504

15011505
END SUBROUTINE scatter_runoff

0 commit comments

Comments
 (0)