MODFLOW 6  version 6.8.0.dev0
USGS Modular Hydrologic Model
swf-cxs.f90
Go to the documentation of this file.
1 ! The SwfCxsType package is assigned for a model
2 ! and can be used to calculate wetted area, wetted
3 ! perimeter, hydraulic radius, composite roughness, etc.
4 ! even if the user doesn't specify a CXS Package.
6 
7  use kindmodule, only: dp, i4b, lgp
11  use simvariablesmodule, only: errmsg
14  use basedismodule, only: disbasetype
15 
16  implicit none
17  private
18  public :: swfcxstype, cxs_cr
19 
20  !> @brief flags indicating which CXS options were found in the input
22  logical(LGP) :: iprpak = .false.
23  end type cxsoptionsfoundtype
24 
25  !> @brief flags indicating which CXS dimensions were found in the input
27  logical(LGP) :: nsections = .false.
28  logical(LGP) :: npoints = .false.
29  end type cxsdimensionsfoundtype
30 
31  !> @brief flags indicating which CXS packagedata were found in the input
33  logical(LGP) :: idcxs = .false.
34  logical(LGP) :: nxspoints = .false.
36 
37  !> @brief flags indicating which CXS crosssectiondata were found in the input
39  logical(LGP) :: xfraction = .false.
40  logical(LGP) :: height = .false.
41  logical(LGP) :: manfraction = .false.
43 
44  type, extends(numericalpackagetype) :: swfcxstype
45 
46  ! provided as input
47  integer(I4B), pointer :: nsections => null() !< number of cross section
48  integer(I4B), pointer :: npoints => null() !< total number of cross-section points
49  integer(I4B), dimension(:), pointer, contiguous :: idcxs => null() !< cross section id number, size nsections
50  integer(I4B), dimension(:), pointer, contiguous :: nxspoints => null() !< number of cross section points for section, size nsections
51  real(dp), dimension(:), pointer, contiguous :: xfraction => null() !< cross-section relative x distance, of size npoints
52  real(dp), dimension(:), pointer, contiguous :: height => null() !< cross-section heights, of size npoints
53  real(dp), dimension(:), pointer, contiguous :: manfraction => null() !< cross-section roughness data, of size npoints
54 
55  ! calculated from input
56  integer(I4B), dimension(:), pointer, contiguous :: iacross => null() !< pointers to cross-section data for each section, of size nsections + 1
57 
58  contains
59 
60  procedure :: allocate_scalars
61  procedure :: allocate_arrays
62  procedure :: source_options
63  procedure :: log_options
64  procedure :: source_dimensions
65  procedure :: log_dimensions
66  procedure :: source_packagedata
67  procedure :: log_packagedata
68  procedure :: check_packagedata
70  procedure :: log_crosssectiondata
71  procedure :: cxs_da
73  procedure :: get_area
74  procedure :: get_wetted_perimeter => cxs_wetted_perimeter
75  procedure :: get_roughness
76  procedure :: get_conveyance => cxs_conveyance
77  procedure :: get_hydraulic_radius
78  procedure :: get_wetted_top_width
79  procedure :: get_maximum_top_width
80  procedure :: write_cxs_table
81 
82  end type swfcxstype
83 
84 contains
85 
86  !> @brief create package
87  !<
88  subroutine cxs_cr(pobj, name_model, input_mempath, inunit, iout, dis)
89  ! -- modules
91  ! -- dummy
92  type(swfcxstype), pointer :: pobj
93  character(len=*), intent(in) :: name_model
94  character(len=*), intent(in) :: input_mempath
95  integer(I4B), intent(in) :: inunit
96  integer(I4B), intent(in) :: iout
97  class(disbasetype), pointer, intent(inout) :: dis !< the pointer to the discretization
98  ! -- locals
99  logical(LGP) :: found_fname
100  ! -- formats
101  character(len=*), parameter :: fmtheader = &
102  "(1x, /1x, 'CXS -- CROSS SECTION PACKAGE, VERSION 1, 5/24/2023', &
103  &' INPUT READ FROM MEMPATH: ', A, /)"
104  !
105  ! -- Create the object
106  allocate (pobj)
107 
108  ! -- create name and memory path
109  call pobj%set_names(1, name_model, 'CXS', 'CXS')
110 
111  ! -- Allocate scalars
112  call pobj%allocate_scalars()
113 
114  ! -- Set variables
115  pobj%input_mempath = input_mempath
116  pobj%inunit = inunit
117  pobj%iout = iout
118  pobj%dis => dis
119 
120  ! -- set name of input file
121  call mem_set_value(pobj%input_fname, 'INPUT_FNAME', pobj%input_mempath, &
122  found_fname)
123 
124  ! -- check if package is enabled
125  if (inunit > 0) then
126 
127  ! -- Print a message identifying the package.
128  write (iout, fmtheader) input_mempath
129 
130  ! -- source options
131  call pobj%source_options()
132 
133  ! -- source dimensions
134  call pobj%source_dimensions()
135 
136  ! -- allocate arrays
137  call pobj%allocate_arrays()
138 
139  ! -- source dimensions
140  call pobj%source_packagedata()
141 
142  ! -- source dimensions
143  call pobj%source_crosssectiondata()
144 
145  end if
146  end subroutine cxs_cr
147 
148  !> @ brief Allocate scalars
149  !!
150  !! Allocate and initialize scalars for the package. The base model
151  !! allocate scalars method is also called.
152  !!
153  !<
154  subroutine allocate_scalars(this)
155  ! -- modules
156  ! -- dummy
157  class(swfcxstype) :: this
158  !
159  ! -- allocate scalars in NumericalPackageType
160  call this%NumericalPackageType%allocate_scalars()
161  !
162  ! -- Allocate scalars
163  call mem_allocate(this%nsections, 'NSECTIONS', this%memoryPath)
164  call mem_allocate(this%npoints, 'NPOINTS', this%memoryPath)
165 
166  ! -- initialize
167  this%nsections = 0
168  this%npoints = 0
169  end subroutine allocate_scalars
170 
171  !> @brief Copy options from IDM into package
172  !<
173  subroutine source_options(this)
174  ! -- modules
175  use kindmodule, only: lgp
178  ! -- dummy
179  class(swfcxstype) :: this
180  ! -- locals
181  character(len=LENMEMPATH) :: idmMemoryPath
182  type(cxsoptionsfoundtype) :: found
183  !
184  ! -- set memory path
185  idmmemorypath = create_mem_path(this%name_model, 'CXS', idm_context)
186  !
187  ! -- update defaults with idm sourced values
188  call mem_set_value(this%iprpak, 'PRINT_INPUT', idmmemorypath, &
189  found%iprpak)
190  !
191  ! -- log values to list file
192  if (this%iout > 0) then
193  call this%log_options(found)
194  end if
195  end subroutine source_options
196 
197  !> @brief Write user options to list file
198  !<
199  subroutine log_options(this, found)
200  class(swfcxstype) :: this
201  type(cxsoptionsfoundtype), intent(in) :: found
202 
203  write (this%iout, '(1x,a)') 'Setting CXS Options'
204 
205  if (found%iprpak) then
206  write (this%iout, '(4x,a)') 'Package information will be printed.'
207  end if
208 
209  write (this%iout, '(1x,a,/)') 'End Setting CXS Options'
210 
211  end subroutine log_options
212 
213  !> @brief Copy options from IDM into package
214  !<
215  subroutine source_dimensions(this)
216  ! -- modules
217  use kindmodule, only: lgp
220  ! -- dummy
221  class(swfcxstype) :: this
222  ! -- locals
223  character(len=LENMEMPATH) :: idmMemoryPath
224  type(cxsdimensionsfoundtype) :: found
225  !
226  ! -- set memory path
227  idmmemorypath = create_mem_path(this%name_model, 'CXS', idm_context)
228  !
229  ! -- update defaults with idm sourced values
230  call mem_set_value(this%nsections, 'NSECTIONS', idmmemorypath, &
231  found%nsections)
232  call mem_set_value(this%npoints, 'NPOINTS', idmmemorypath, &
233  found%npoints)
234  !
235  ! -- ensure nsections was found
236  if (.not. found%nsections) then
237  write (errmsg, '(a)') 'Error in DIMENSIONS block: NSECTIONS not found.'
238  call store_error(errmsg)
239  end if
240  !
241  ! -- ensure npoints was found
242  if (.not. found%npoints) then
243  write (errmsg, '(a)') 'Error in DIMENSIONS block: NPOINTS not found.'
244  call store_error(errmsg)
245  end if
246  !
247  ! -- log values to list file
248  if (this%iout > 0) then
249  call this%log_dimensions(found)
250  end if
251  end subroutine source_dimensions
252 
253  !> @brief Write user options to list file
254  !<
255  subroutine log_dimensions(this, found)
256  class(swfcxstype) :: this
257  type(cxsdimensionsfoundtype), intent(in) :: found
258 
259  write (this%iout, '(1x,a)') 'Setting CXS Dimensions'
260 
261  if (found%nsections) then
262  write (this%iout, '(4x,a)') 'NSECTIONS set from input file.'
263  end if
264 
265  if (found%npoints) then
266  write (this%iout, '(4x,a)') 'NPOINTS set from input file.'
267  end if
268 
269  write (this%iout, '(1x,a,/)') 'End Setting CXS Dimensions'
270 
271  end subroutine log_dimensions
272 
273  !> @brief allocate memory for arrays
274  !<
275  subroutine allocate_arrays(this)
276  ! -- dummy
277  class(swfcxstype) :: this
278  ! -- locals
279  integer(I4B) :: n
280  !
281  ! -- arrays allocation
282  call mem_allocate(this%idcxs, this%nsections, &
283  'IDCXS', this%memoryPath)
284  call mem_allocate(this%nxspoints, this%nsections, &
285  'NXSPOINTS', this%memoryPath)
286  call mem_allocate(this%xfraction, this%npoints, &
287  'XFRACTION', this%memoryPath)
288  call mem_allocate(this%height, this%npoints, &
289  'HEIGHT', this%memoryPath)
290  call mem_allocate(this%manfraction, this%npoints, &
291  'MANFRACTION', this%memoryPath)
292  call mem_allocate(this%iacross, this%nsections + 1, &
293  'IACROSS', this%memoryPath)
294 
295  ! -- initialization
296  do n = 1, this%nsections
297  this%idcxs(n) = 0
298  this%nxspoints(n) = 0
299  end do
300  do n = 1, this%npoints
301  this%xfraction(n) = dzero
302  this%height(n) = dzero
303  this%manfraction(n) = dzero
304  end do
305  do n = 1, this%nsections + 1
306  this%iacross(n) = 0
307  end do
308  end subroutine allocate_arrays
309 
310  !> @brief Copy options from IDM into package
311  !<
312  subroutine source_packagedata(this)
313  ! modules
314  use kindmodule, only: lgp
317  ! dummy
318  class(swfcxstype) :: this
319  ! locals
320  character(len=LENMEMPATH) :: idmMemoryPath
321  type(cxspackagedatafoundtype) :: found
322 
323  ! set memory path
324  idmmemorypath = create_mem_path(this%name_model, 'CXS', idm_context)
325 
326  ! update defaults with idm sourced values
327  call mem_set_value(this%idcxs, 'IDCXS', idmmemorypath, &
328  found%idcxs)
329  call mem_set_value(this%nxspoints, 'NXSPOINTS', idmmemorypath, &
330  found%nxspoints)
331 
332  ! ensure idcxs was found
333  if (.not. found%idcxs) then
334  write (errmsg, '(a)') 'Error in PACKAGEDATA block: IDCXS not found.'
335  call store_error(errmsg)
336  end if
337 
338  ! ensure nxspoints was found
339  if (.not. found%nxspoints) then
340  write (errmsg, '(a)') 'Error in PACKAGEDATA block: NXSPOINTS not found.'
341  call store_error(errmsg)
342  end if
343 
344  ! log values to list file
345  if (this%iout > 0) then
346  call this%log_packagedata(found)
347  end if
348 
349  ! Check to make sure package data is valid
350  call this%check_packagedata()
351 
352  ! Calculate the iacross index array using nxspoints
353  call calc_iacross(this%nxspoints, this%iacross)
354  end subroutine source_packagedata
355 
356  !> @brief Calculate index pointer array iacross from nxspoints
357  !<
358  subroutine calc_iacross(nxspoints, iacross)
359  integer(I4B), dimension(:), intent(in) :: nxspoints
360  integer(I4B), dimension(:), intent(inout) :: iacross
361  integer(I4B) :: n
362  iacross(1) = 1
363  do n = 1, size(nxspoints)
364  iacross(n + 1) = iacross(n) + nxspoints(n)
365  end do
366  end subroutine calc_iacross
367 
368  !> @brief Check packagedata
369  !<
370  subroutine check_packagedata(this)
371  ! dummy arguments
372  class(swfcxstype) :: this !< this instance
373  ! local variables
374  integer(I4B) :: i
375 
376  ! Check that all cross section IDs are in range
377  do i = 1, size(this%idcxs)
378  if (this%idcxs(i) <= 0 .or. this%idcxs(i) > this%nsections) then
379  write (errmsg, '(a, i0, a)') &
380  'IDCXS values must be greater than 0 and less than NSECTIONS. &
381  &Found ', this%idcxs(i), '.'
382  call store_error(errmsg)
383  end if
384  end do
385 
386  ! Check that nxspoints are greater than one
387  do i = 1, size(this%nxspoints)
388  if (this%nxspoints(i) <= 1) then
389  write (errmsg, '(a, i0, a, i0, a)') &
390  'NXSPOINTS values must be greater than 1 for each cross section. &
391  &Found ', this%nxspoints(i), ' for cross section ', this%idcxs(i), '.'
392  call store_error(errmsg)
393  end if
394  end do
395 
396  ! write summary of package error messages
397  if (count_errors() > 0) then
398  call store_error_filename(this%input_fname)
399  end if
400 
401  end subroutine check_packagedata
402 
403  !> @brief Write user packagedata to list file
404  !<
405  subroutine log_packagedata(this, found)
406  class(swfcxstype) :: this
407  type(cxspackagedatafoundtype), intent(in) :: found
408 
409  write (this%iout, '(1x,a)') 'Setting CXS Package Data'
410 
411  if (found%idcxs) then
412  write (this%iout, '(4x,a)') 'IDCXS set from input file.'
413  end if
414 
415  if (found%nxspoints) then
416  write (this%iout, '(4x,a)') 'NXSPOINTS set from input file.'
417  end if
418 
419  write (this%iout, '(1x,a,/)') 'End Setting CXS Package Data'
420 
421  end subroutine log_packagedata
422 
423  !> @brief Copy options from IDM into package
424  !<
425  subroutine source_crosssectiondata(this)
426  ! -- modules
427  use kindmodule, only: lgp
430  ! -- dummy
431  class(swfcxstype) :: this
432  ! -- locals
433  character(len=LENMEMPATH) :: idmMemoryPath
434  type(cxscrosssectiondatafoundtype) :: found
435  !
436  ! -- set memory path
437  idmmemorypath = create_mem_path(this%name_model, 'CXS', idm_context)
438  !
439  ! -- update defaults with idm sourced values
440  call mem_set_value(this%xfraction, 'XFRACTION', idmmemorypath, &
441  found%xfraction)
442  call mem_set_value(this%height, 'HEIGHT', idmmemorypath, &
443  found%height)
444  call mem_set_value(this%manfraction, 'MANFRACTION', idmmemorypath, &
445  found%manfraction)
446  !
447  ! -- ensure xfraction was found
448  if (.not. found%xfraction) then
449  write (errmsg, '(a)') &
450  'Error in CROSSSECTIONDATA block: xfraction not found.'
451  call store_error(errmsg)
452  end if
453  !
454  ! -- ensure height was found
455  if (.not. found%height) then
456  write (errmsg, '(a)') &
457  'Error in CROSSSECTIONDATA block: HEIGHT not found.'
458  call store_error(errmsg)
459  end if
460  !
461  ! -- ensure manfraction was found
462  if (.not. found%manfraction) then
463  write (errmsg, '(a)') &
464  'Error in CROSSSECTIONDATA block: MANFRACTION not found.'
465  call store_error(errmsg)
466  end if
467  !
468  ! -- log values to list file
469  if (this%iout > 0) then
470  call this%log_crosssectiondata(found)
471  end if
472  end subroutine source_crosssectiondata
473 
474  !> @brief Write user packagedata to list file
475  !<
476  subroutine log_crosssectiondata(this, found)
477  class(swfcxstype) :: this
478  type(cxscrosssectiondatafoundtype), intent(in) :: found
479 
480  write (this%iout, '(1x,a)') 'Setting CXS Cross Section Data'
481 
482  if (found%xfraction) then
483  write (this%iout, '(4x,a)') 'XFRACTION set from input file.'
484  end if
485 
486  if (found%height) then
487  write (this%iout, '(4x,a)') 'HEIGHT set from input file.'
488  end if
489 
490  if (found%manfraction) then
491  write (this%iout, '(4x,a)') 'MANFRACTION set from input file.'
492  end if
493 
494  write (this%iout, '(1x,a,/)') 'End Setting CXS Cross Section Data'
495 
496  end subroutine log_crosssectiondata
497 
498  subroutine write_cxs_table(this, idcxs, width, slope, rough, unitconv)
499  ! -- module
500  use sortmodule, only: qsort, unique_values
501  ! -- dummy
502  class(swfcxstype) :: this
503  integer(I4B), intent(in) :: idcxs
504  real(DP), intent(in) :: width
505  real(DP), intent(in) :: slope
506  real(DP), intent(in) :: rough
507  real(DP), intent(in) :: unitconv
508  ! -- local
509  integer(I4B) :: ipt
510  real(DP) :: d
511  real(DP) :: a
512  real(DP) :: rh
513  real(DP) :: wp
514  real(DP) :: r
515  real(DP) :: c
516  real(DP) :: q
517  integer(I4B) :: i0
518  integer(I4B) :: i1
519  integer(I4B) :: npts
520  integer(I4B) :: icalcmeth
521  real(DP), dimension(:), allocatable :: depths
522  real(DP), dimension(:), allocatable :: depths_unique
523  integer(I4B), dimension(:), allocatable :: indx
524 
525  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
526 
527  if (npts > 0) then
528 
529  write (this%iout, *) 'Processing information for cross section ', idcxs
530  write (this%iout, *) 'Depth Area WettedP HydRad Rough Conveyance Q'
531 
532  allocate (depths(npts))
533  allocate (indx(size(depths)))
534 
535  depths(:) = this%height(:)
536  call qsort(indx, depths)
537  call unique_values(depths, depths_unique)
538 
539  do ipt = 1, size(depths_unique)
540  d = depths_unique(ipt)
541  a = this%get_area(idcxs, width, d)
542  wp = this%get_wetted_perimeter(idcxs, width, d)
543  rh = this%get_hydraulic_radius(idcxs, width, d, a)
544  r = this%get_roughness(idcxs, width, d, rough, slope)
545  c = this%get_conveyance(idcxs, width, d, rough)
546  if (slope > dzero) then
547  q = unitconv * c * sqrt(slope)
548  else
549  q = dzero
550  end if
551  write (this%iout, *) d, a, wp, rh, r, c, q
552  end do
553 
554  deallocate (depths)
555  deallocate (depths_unique)
556  write (this%iout, *) 'Done processing information for cross section ', idcxs
557 
558  end if
559  end subroutine write_cxs_table
560 
561  !> @brief deallocate memory
562  !<
563  subroutine cxs_da(this)
564  ! -- modules
568  ! -- dummy
569  class(swfcxstype) :: this
570  !
571  ! -- Deallocate input memory
572  call memorystore_remove(this%name_model, 'CXS', idm_context)
573  !
574  ! -- Scalars
575  call mem_deallocate(this%nsections)
576  call mem_deallocate(this%npoints)
577  !
578  ! -- Deallocate arrays if the package was created
579  ! from an input file
580  if (this%inunit > 0) then
581  call mem_deallocate(this%idcxs)
582  call mem_deallocate(this%nxspoints)
583  call mem_deallocate(this%xfraction)
584  call mem_deallocate(this%height)
585  call mem_deallocate(this%manfraction)
586  call mem_deallocate(this%iacross)
587  end if
588  !
589  ! -- deallocate parent
590  call this%NumericalPackageType%da()
591  end subroutine cxs_da
592 
593  subroutine get_cross_section_info(this, idcxs, i0, i1, npts, icalcmeth)
594  ! -- dummy
595  class(swfcxstype) :: this
596  integer(I4B), intent(in) :: idcxs !< cross section id number
597  integer(I4B), intent(inout) :: i0 !< starting cross section point number
598  integer(I4B), intent(inout) :: i1 !< ending cross section point number
599  integer(I4B), intent(inout) :: npts !< number of points in cross section
600  integer(I4B), intent(inout) :: icalcmeth !< calculation method for mannings roughness
601  ! -- local
602  !
603  ! -- Return npts = 0 if this package does not have input file
604  if (this%inunit == 0 .or. idcxs == 0) then
605  npts = 0
606  i0 = 1
607  i1 = 1
608  icalcmeth = 0
609  else
610  !
611  ! -- If the cross section id is 0, then it is a hydraulically wide channel,
612  ! and only width and rough are needed (not xfraction, height, and manfraction)
613  if (idcxs > 0) then
614  i0 = this%iacross(idcxs)
615  i1 = this%iacross(idcxs + 1) - 1
616  else
617  i0 = 1
618  i1 = 1
619  end if
620  ! set icalcmeth based on number of cross section points
621  npts = i1 - i0 + 1
622  icalcmeth = 0 ! linear composite mannings resistance
623  if (npts > 4) then
624  icalcmeth = 0 ! sum q by cross section segments
625  end if
626  end if
627  end subroutine get_cross_section_info
628 
629  function get_area(this, idcxs, width, depth) result(area)
630  ! -- modules
632  ! -- dummy
633  class(swfcxstype) :: this
634  integer(I4B), intent(in) :: idcxs !< cross section id
635  real(dp), intent(in) :: width !< width in reach
636  real(dp), intent(in) :: depth !< stage in reach
637  ! -- local
638  real(dp) :: area
639  integer(I4B) :: i0
640  integer(I4B) :: i1
641  integer(I4B) :: npts
642  integer(I4B) :: icalcmeth
643  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
644  if (npts == 0) then
645  area = width * depth
646  else
647  area = get_cross_section_area(npts, &
648  this%xfraction(i0:i1), &
649  this%height(i0:i1), &
650  width, depth)
651  end if
652  end function get_area
653 
654  function cxs_wetted_perimeter(this, idcxs, width, depth) result(wp)
655  ! -- modules
657  ! -- dummy
658  class(swfcxstype) :: this
659  integer(I4B), intent(in) :: idcxs !< cross section id
660  real(dp), intent(in) :: width !< width in reach
661  real(dp), intent(in) :: depth !< stage in reach
662  ! -- local
663  real(dp) :: wp
664  integer(I4B) :: i0
665  integer(I4B) :: i1
666  integer(I4B) :: npts
667  integer(I4B) :: icalcmeth
668  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
669  if (npts == 0) then
670  wp = width
671  else
672  wp = get_wetted_perimeter(npts, &
673  this%xfraction(i0:i1), &
674  this%height(i0:i1), &
675  width, depth)
676  end if
677  end function cxs_wetted_perimeter
678 
679  function get_roughness(this, idcxs, width, depth, rough, &
680  slope) result(roughc)
681  ! -- modules
683  ! -- dummy
684  class(swfcxstype) :: this
685  integer(I4B), intent(in) :: idcxs !< cross section id
686  real(dp), intent(in) :: width !< width in reach
687  real(dp), intent(in) :: depth !< stage in reach
688  real(dp), intent(in) :: rough !< mannings value provided for the reach
689  real(dp), intent(in) :: slope !< slope value provided for the reach
690  ! -- local
691  real(dp) :: roughc !< calculated composite roughness
692  integer(I4B) :: i0
693  integer(I4B) :: i1
694  integer(I4B) :: npts
695  integer(I4B) :: icalcmeth
696  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
697  if (npts == 0) then
698  roughc = rough
699  else
700  roughc = calc_composite_roughness(npts, &
701  depth, &
702  width, &
703  rough, &
704  slope, &
705  this%xfraction(i0:i1), &
706  this%height(i0:i1), &
707  this%manfraction(i0:i1), &
708  icalcmeth)
709  end if
710  end function get_roughness
711 
712  !> @brief Calculate and return conveyance
713  !!
714  !! Conveyance = area * hydraulic_radius ** (2/3) / mannings_roughness
715  !! If idcxs = 0 (no cross section specified) then reach is
716  !< hydraulically wide and hydraulic radius is equal to depth.
717  function cxs_conveyance(this, idcxs, width, depth, &
718  rough) result(conveyance)
719  ! -- modules
721  ! -- dummy
722  class(swfcxstype) :: this
723  integer(I4B), intent(in) :: idcxs !< cross section id
724  real(dp), intent(in) :: width !< width in reach
725  real(dp), intent(in) :: depth !< stage in reach
726  real(dp), intent(in) :: rough !< mannings value provided for the reach
727  ! -- return
728  real(dp) :: conveyance !< calculated composite roughness
729  ! -- local
730  real(dp) :: a
731  real(dp) :: rh
732  integer(I4B) :: i0
733  integer(I4B) :: i1
734  integer(I4B) :: npts
735  integer(I4B) :: icalcmeth
736  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
737  if (npts == 0) then
738  a = depth * width
739  rh = depth
740  conveyance = a * rh**dtwothirds / rough
741  else
742  conveyance = get_conveyance(npts, &
743  this%xfraction(i0:i1), &
744  this%height(i0:i1), &
745  this%manfraction(i0:i1), &
746  width, rough, depth)
747  end if
748  end function cxs_conveyance
749 
750  function get_hydraulic_radius(this, idcxs, width, depth, area) result(r)
751  ! -- modules
753  ! -- dummy
754  class(swfcxstype) :: this
755  integer(I4B), intent(in) :: idcxs !< cross section id
756  real(dp), intent(in) :: width !< width in reach
757  real(dp), intent(in) :: depth !< stage in reach
758  real(dp), intent(in), optional :: area !< area of the reach
759  ! -- local
760  real(dp) :: r !< calculated hydraulic radius
761  real(dp) :: a
762  integer(I4B) :: i0
763  integer(I4B) :: i1
764  integer(I4B) :: npts
765  integer(I4B) :: icalcmeth
766  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
767  if (present(area)) then
768  a = area
769  else
770  a = this%get_area(idcxs, width, depth)
771  end if
772  if (npts == 0) then
773  r = a / width
774  else
775  r = get_hydraulic_radius_xf(npts, &
776  this%xfraction(i0:i1), &
777  this%height(i0:i1), &
778  width, depth)
779  end if
780  end function get_hydraulic_radius
781 
782  function get_wetted_top_width(this, idcxs, width, depth) result(r)
783  ! modules
785  ! dummy
786  class(swfcxstype) :: this
787  integer(I4B), intent(in) :: idcxs !< cross section id
788  real(dp), intent(in) :: width !< width in reach
789  real(dp), intent(in) :: depth !< stage in reach
790  ! local
791  real(dp) :: r !< calculated hydraulic radius
792  integer(I4B) :: i0
793  integer(I4B) :: i1
794  integer(I4B) :: npts
795  integer(I4B) :: icalcmeth
796  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
797  if (npts == 0) then
798  r = width
799  else
800  r = get_wetted_topwidth(npts, this%xfraction(i0:i1), &
801  this%height(i0:i1), width, depth)
802  end if
803  end function get_wetted_top_width
804 
805  function get_maximum_top_width(this, idcxs, width) result(r)
806  ! modules
808  ! dummy
809  class(swfcxstype) :: this
810  integer(I4B), intent(in) :: idcxs !< cross section id
811  real(dp), intent(in) :: width !< width in reach
812  ! local
813  real(dp) :: r !< calculated hydraulic radius
814  integer(I4B) :: i0
815  integer(I4B) :: i1
816  integer(I4B) :: npts
817  integer(I4B) :: icalcmeth
818  call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
819  if (npts == 0) then
820  r = width
821  else
822  r = get_saturated_topwidth(npts, this%xfraction(i0:i1), width)
823  end if
824  end function get_maximum_top_width
825 
826 end module swfcxsmodule
This module contains simulation constants.
Definition: Constants.f90:9
real(dp), parameter dtwothirds
real constant 2/3
Definition: Constants.f90:70
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public memorystore_remove(component, subcomponent, context)
This module contains the base numerical package type.
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
Definition: Sim.f90:203
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
real(dp) function get_wetted_top_width(this, idcxs, width, depth)
Definition: swf-cxs.f90:783
subroutine source_packagedata(this)
Copy options from IDM into package.
Definition: swf-cxs.f90:313
real(dp) function cxs_wetted_perimeter(this, idcxs, width, depth)
Definition: swf-cxs.f90:655
subroutine source_options(this)
Copy options from IDM into package.
Definition: swf-cxs.f90:174
real(dp) function get_roughness(this, idcxs, width, depth, rough, slope)
Definition: swf-cxs.f90:681
subroutine allocate_arrays(this)
allocate memory for arrays
Definition: swf-cxs.f90:276
subroutine log_options(this, found)
Write user options to list file.
Definition: swf-cxs.f90:200
subroutine calc_iacross(nxspoints, iacross)
Calculate index pointer array iacross from nxspoints.
Definition: swf-cxs.f90:359
real(dp) function get_maximum_top_width(this, idcxs, width)
Definition: swf-cxs.f90:806
real(dp) function get_hydraulic_radius(this, idcxs, width, depth, area)
Definition: swf-cxs.f90:751
subroutine log_dimensions(this, found)
Write user options to list file.
Definition: swf-cxs.f90:256
subroutine get_cross_section_info(this, idcxs, i0, i1, npts, icalcmeth)
Definition: swf-cxs.f90:594
subroutine check_packagedata(this)
Check packagedata.
Definition: swf-cxs.f90:371
real(dp) function get_area(this, idcxs, width, depth)
Definition: swf-cxs.f90:630
subroutine source_dimensions(this)
Copy options from IDM into package.
Definition: swf-cxs.f90:216
subroutine cxs_da(this)
deallocate memory
Definition: swf-cxs.f90:564
subroutine source_crosssectiondata(this)
Copy options from IDM into package.
Definition: swf-cxs.f90:426
real(dp) function cxs_conveyance(this, idcxs, width, depth, rough)
Calculate and return conveyance.
Definition: swf-cxs.f90:719
subroutine allocate_scalars(this)
@ brief Allocate scalars
Definition: swf-cxs.f90:155
subroutine log_crosssectiondata(this, found)
Write user packagedata to list file.
Definition: swf-cxs.f90:477
subroutine, public cxs_cr(pobj, name_model, input_mempath, inunit, iout, dis)
create package
Definition: swf-cxs.f90:89
subroutine log_packagedata(this, found)
Write user packagedata to list file.
Definition: swf-cxs.f90:406
subroutine write_cxs_table(this, idcxs, width, slope, rough, unitconv)
Definition: swf-cxs.f90:499
This module contains stateless sfr subroutines and functions.
Definition: SwfCxsUtils.f90:11
real(dp) function, public get_hydraulic_radius_xf(npts, xfraction, heights, width, d)
Calculate the hydraulic radius for a reach.
real(dp) function, public calc_composite_roughness(npts, depth, width, rough, slope, cxs_xf, cxs_h, cxs_rf, linmeth)
real(dp) function, public get_cross_section_area(npts, xfraction, heights, width, d)
Calculate the cross-sectional area for a reach.
real(dp) function, public get_wetted_topwidth(npts, xfraction, heights, width, d)
Calculate the wetted top width for a reach.
real(dp) function, public get_conveyance(npts, xfraction, heights, cxs_rf, width, rough, d)
Calculate conveyance.
real(dp) function, public get_saturated_topwidth(npts, xfraction, width)
Calculate the saturated top width for a reach.
real(dp) function, public get_wetted_perimeter(npts, xfraction, heights, width, d)
Calculate the wetted perimeter for a reach.
flags indicating which CXS crosssectiondata were found in the input
Definition: swf-cxs.f90:38
flags indicating which CXS dimensions were found in the input
Definition: swf-cxs.f90:26
flags indicating which CXS options were found in the input
Definition: swf-cxs.f90:21
flags indicating which CXS packagedata were found in the input
Definition: swf-cxs.f90:32