23 integer(I4B),
pointer :: nsections => null()
24 integer(I4B),
pointer :: npoints => null()
25 integer(I4B),
dimension(:),
pointer,
contiguous :: idcxs => null()
26 integer(I4B),
dimension(:),
pointer,
contiguous :: nxspoints => null()
27 real(dp),
dimension(:),
pointer,
contiguous :: xfraction => null()
28 real(dp),
dimension(:),
pointer,
contiguous :: height => null()
29 real(dp),
dimension(:),
pointer,
contiguous :: manfraction => null()
32 integer(I4B),
dimension(:),
pointer,
contiguous :: iacross => null()
64 subroutine cxs_cr(pobj, name_model, input_mempath, inunit, iout, dis)
69 character(len=*),
intent(in) :: name_model
70 character(len=*),
intent(in) :: input_mempath
71 integer(I4B),
intent(in) :: inunit
72 integer(I4B),
intent(in) :: iout
75 logical(LGP) :: found_fname
77 character(len=*),
parameter :: fmtheader = &
78 "(1x, /1x, 'CXS -- CROSS SECTION PACKAGE, VERSION 1, 5/24/2023', &
79 &' INPUT READ FROM MEMPATH: ', A, /)"
85 call pobj%set_names(1, name_model,
'CXS',
'CXS')
88 call pobj%allocate_scalars()
91 pobj%input_mempath = input_mempath
97 call mem_set_value(pobj%input_fname,
'INPUT_FNAME', pobj%input_mempath, &
104 write (iout, fmtheader) input_mempath
107 call pobj%source_options()
110 call pobj%source_dimensions()
113 call pobj%allocate_arrays()
116 call pobj%source_packagedata()
119 call pobj%source_crosssectiondata()
136 call this%NumericalPackageType%allocate_scalars()
139 call mem_allocate(this%nsections,
'NSECTIONS', this%memoryPath)
140 call mem_allocate(this%npoints,
'NPOINTS', this%memoryPath)
158 character(len=LENMEMPATH) :: idmMemoryPath
165 call mem_set_value(this%iprpak,
'PRINT_INPUT', idmmemorypath, &
169 if (this%iout > 0)
then
170 call this%log_options(found)
181 write (this%iout,
'(1x,a)')
'Setting CXS Options'
183 if (found%iprpak)
then
184 write (this%iout,
'(4x,a)')
'Package information will be printed.'
187 write (this%iout,
'(1x,a,/)')
'End Setting CXS Options'
202 character(len=LENMEMPATH) :: idmMemoryPath
209 call mem_set_value(this%nsections,
'NSECTIONS', idmmemorypath, &
215 if (.not. found%nsections)
then
216 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NSECTIONS not found.'
221 if (.not. found%npoints)
then
222 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NPOINTS not found.'
227 if (this%iout > 0)
then
228 call this%log_dimensions(found)
239 write (this%iout,
'(1x,a)')
'Setting CXS Dimensions'
241 if (found%nsections)
then
242 write (this%iout,
'(4x,a)')
'NSECTIONS set from input file.'
245 if (found%npoints)
then
246 write (this%iout,
'(4x,a)')
'NPOINTS set from input file.'
249 write (this%iout,
'(1x,a,/)')
'End Setting CXS Dimensions'
263 'IDCXS', this%memoryPath)
265 'NXSPOINTS', this%memoryPath)
267 'XFRACTION', this%memoryPath)
269 'HEIGHT', this%memoryPath)
271 'MANFRACTION', this%memoryPath)
273 'IACROSS', this%memoryPath)
276 do n = 1, this%nsections
278 this%nxspoints(n) = 0
280 do n = 1, this%npoints
281 this%xfraction(n) =
dzero
282 this%height(n) =
dzero
283 this%manfraction(n) =
dzero
285 do n = 1, this%nsections + 1
301 character(len=LENMEMPATH) :: idmMemoryPath
310 call mem_set_value(this%nxspoints,
'NXSPOINTS', idmmemorypath, &
314 if (.not. found%idcxs)
then
315 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: IDCXS not found.'
320 if (.not. found%nxspoints)
then
321 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: NXSPOINTS not found.'
326 if (this%iout > 0)
then
327 call this%log_packagedata(found)
331 call this%check_packagedata()
340 integer(I4B),
dimension(:),
intent(in) :: nxspoints
341 integer(I4B),
dimension(:),
intent(inout) :: iacross
344 do n = 1,
size(nxspoints)
345 iacross(n + 1) = iacross(n) + nxspoints(n)
358 do i = 1,
size(this%idcxs)
359 if (this%idcxs(i) <= 0 .or. this%idcxs(i) > this%nsections)
then
360 write (
errmsg,
'(a, i0, a)') &
361 'IDCXS values must be greater than 0 and less than NSECTIONS. &
362 &Found ', this%idcxs(i),
'.'
368 do i = 1,
size(this%nxspoints)
369 if (this%nxspoints(i) <= 1)
then
370 write (
errmsg,
'(a, i0, a, i0, a)') &
371 'NXSPOINTS values must be greater than 1 for each cross section. &
372 &Found ', this%nxspoints(i),
' for cross section ', this%idcxs(i),
'.'
391 write (this%iout,
'(1x,a)')
'Setting CXS Package Data'
393 if (found%idcxs)
then
394 write (this%iout,
'(4x,a)')
'IDCXS set from input file.'
397 if (found%nxspoints)
then
398 write (this%iout,
'(4x,a)')
'NXSPOINTS set from input file.'
401 write (this%iout,
'(1x,a,/)')
'End Setting CXS Package Data'
416 character(len=LENMEMPATH) :: idmMemoryPath
423 call mem_set_value(this%xfraction,
'XFRACTION', idmmemorypath, &
427 call mem_set_value(this%manfraction,
'MANFRACTION', idmmemorypath, &
431 if (.not. found%xfraction)
then
432 write (errmsg,
'(a)') &
433 'Error in CROSSSECTIONDATA block: xfraction not found.'
438 if (.not. found%height)
then
439 write (errmsg,
'(a)') &
440 'Error in CROSSSECTIONDATA block: HEIGHT not found.'
445 if (.not. found%manfraction)
then
446 write (errmsg,
'(a)') &
447 'Error in CROSSSECTIONDATA block: MANFRACTION not found.'
452 if (this%iout > 0)
then
453 call this%log_crosssectiondata(found)
464 write (this%iout,
'(1x,a)')
'Setting CXS Cross Section Data'
466 if (found%xfraction)
then
467 write (this%iout,
'(4x,a)')
'XFRACTION set from input file.'
470 if (found%height)
then
471 write (this%iout,
'(4x,a)')
'HEIGHT set from input file.'
474 if (found%manfraction)
then
475 write (this%iout,
'(4x,a)')
'MANFRACTION set from input file.'
478 write (this%iout,
'(1x,a,/)')
'End Setting CXS Cross Section Data'
487 integer(I4B),
intent(in) :: idcxs
488 real(DP),
intent(in) :: width
489 real(DP),
intent(in) :: slope
490 real(DP),
intent(in) :: rough
491 real(DP),
intent(in) :: unitconv
504 integer(I4B) :: icalcmeth
505 real(DP),
dimension(:),
allocatable :: depths
506 real(DP),
dimension(:),
allocatable :: depths_unique
507 integer(I4B),
dimension(:),
allocatable :: indx
509 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
513 write (this%iout, *)
'Processing information for cross section ', idcxs
514 write (this%iout, *)
'Depth Area WettedP HydRad Rough Conveyance Q'
516 allocate (depths(npts))
517 allocate (indx(
size(depths)))
519 depths(:) = this%height(:)
520 call qsort(indx, depths)
523 do ipt = 1,
size(depths_unique)
524 d = depths_unique(ipt)
525 a = this%get_area(idcxs, width, d)
526 wp = this%get_wetted_perimeter(idcxs, width, d)
527 rh = this%get_hydraulic_radius(idcxs, width, d, a)
528 r = this%get_roughness(idcxs, width, d, rough, slope)
529 c = this%get_conveyance(idcxs, width, d, rough)
530 if (slope >
dzero)
then
531 q = unitconv * c * sqrt(slope)
535 write (this%iout, *) d, a, wp, rh, r, c, q
539 deallocate (depths_unique)
540 write (this%iout, *)
'Done processing information for cross section ', idcxs
564 if (this%inunit > 0)
then
574 call this%NumericalPackageType%da()
580 integer(I4B),
intent(in) :: idcxs
581 integer(I4B),
intent(inout) :: i0
582 integer(I4B),
intent(inout) :: i1
583 integer(I4B),
intent(inout) :: npts
584 integer(I4B),
intent(inout) :: icalcmeth
588 if (this%inunit == 0 .or. idcxs == 0)
then
598 i0 = this%iacross(idcxs)
599 i1 = this%iacross(idcxs + 1) - 1
613 function get_area(this, idcxs, width, depth)
result(area)
618 integer(I4B),
intent(in) :: idcxs
619 real(dp),
intent(in) :: width
620 real(dp),
intent(in) :: depth
626 integer(I4B) :: icalcmeth
627 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
632 this%xfraction(i0:i1), &
633 this%height(i0:i1), &
643 integer(I4B),
intent(in) :: idcxs
644 real(dp),
intent(in) :: width
645 real(dp),
intent(in) :: depth
651 integer(I4B) :: icalcmeth
652 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
657 this%xfraction(i0:i1), &
658 this%height(i0:i1), &
664 slope)
result(roughc)
669 integer(I4B),
intent(in) :: idcxs
670 real(dp),
intent(in) :: width
671 real(dp),
intent(in) :: depth
672 real(dp),
intent(in) :: rough
673 real(dp),
intent(in) :: slope
679 integer(I4B) :: icalcmeth
680 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
689 this%xfraction(i0:i1), &
690 this%height(i0:i1), &
691 this%manfraction(i0:i1), &
702 rough)
result(conveyance)
707 integer(I4B),
intent(in) :: idcxs
708 real(dp),
intent(in) :: width
709 real(dp),
intent(in) :: depth
710 real(dp),
intent(in) :: rough
712 real(dp) :: conveyance
719 integer(I4B) :: icalcmeth
720 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
727 this%xfraction(i0:i1), &
728 this%height(i0:i1), &
729 this%manfraction(i0:i1), &
739 integer(I4B),
intent(in) :: idcxs
740 real(dp),
intent(in) :: width
741 real(dp),
intent(in) :: depth
742 real(dp),
intent(in),
optional :: area
749 integer(I4B) :: icalcmeth
750 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
751 if (
present(area))
then
754 a = this%get_area(idcxs, width, depth)
760 this%xfraction(i0:i1), &
761 this%height(i0:i1), &
771 integer(I4B),
intent(in) :: idcxs
772 real(dp),
intent(in) :: width
773 real(dp),
intent(in) :: depth
779 integer(I4B) :: icalcmeth
780 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
785 this%height(i0:i1), width, depth)
794 integer(I4B),
intent(in) :: idcxs
795 real(dp),
intent(in) :: width
801 integer(I4B) :: icalcmeth
802 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
This module contains simulation constants.
real(dp), parameter dtwothirds
real constant 2/3
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenmempath
maximum length of the memory path
This module defines variable data types.
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.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
real(dp) function get_wetted_top_width(this, idcxs, width, depth)
subroutine source_packagedata(this)
Copy options from IDM into package.
real(dp) function cxs_wetted_perimeter(this, idcxs, width, depth)
subroutine source_options(this)
Copy options from IDM into package.
real(dp) function get_roughness(this, idcxs, width, depth, rough, slope)
subroutine allocate_arrays(this)
allocate memory for arrays
subroutine log_options(this, found)
Write user options to list file.
subroutine calc_iacross(nxspoints, iacross)
Calculate index pointer array iacross from nxspoints.
real(dp) function get_maximum_top_width(this, idcxs, width)
real(dp) function get_hydraulic_radius(this, idcxs, width, depth, area)
subroutine log_dimensions(this, found)
Write user options to list file.
subroutine get_cross_section_info(this, idcxs, i0, i1, npts, icalcmeth)
subroutine check_packagedata(this)
Check packagedata.
real(dp) function get_area(this, idcxs, width, depth)
subroutine source_dimensions(this)
Copy options from IDM into package.
subroutine cxs_da(this)
deallocate memory
subroutine source_crosssectiondata(this)
Copy options from IDM into package.
real(dp) function cxs_conveyance(this, idcxs, width, depth, rough)
Calculate and return conveyance.
subroutine allocate_scalars(this)
@ brief Allocate scalars
subroutine log_crosssectiondata(this, found)
Write user packagedata to list file.
subroutine, public cxs_cr(pobj, name_model, input_mempath, inunit, iout, dis)
create package
subroutine log_packagedata(this, found)
Write user packagedata to list file.
subroutine write_cxs_table(this, idcxs, width, slope, rough, unitconv)
This module contains stateless sfr subroutines and functions.
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.