22 logical(LGP) :: iprpak = .false.
27 logical(LGP) :: nsections = .false.
28 logical(LGP) :: npoints = .false.
33 logical(LGP) :: idcxs = .false.
34 logical(LGP) :: nxspoints = .false.
39 logical(LGP) :: xfraction = .false.
40 logical(LGP) :: height = .false.
41 logical(LGP) :: manfraction = .false.
47 integer(I4B),
pointer :: nsections => null()
48 integer(I4B),
pointer :: npoints => null()
49 integer(I4B),
dimension(:),
pointer,
contiguous :: idcxs => null()
50 integer(I4B),
dimension(:),
pointer,
contiguous :: nxspoints => null()
51 real(dp),
dimension(:),
pointer,
contiguous :: xfraction => null()
52 real(dp),
dimension(:),
pointer,
contiguous :: height => null()
53 real(dp),
dimension(:),
pointer,
contiguous :: manfraction => null()
56 integer(I4B),
dimension(:),
pointer,
contiguous :: iacross => null()
88 subroutine cxs_cr(pobj, name_model, input_mempath, inunit, iout, dis)
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
99 logical(LGP) :: found_fname
101 character(len=*),
parameter :: fmtheader = &
102 "(1x, /1x, 'CXS -- CROSS SECTION PACKAGE, VERSION 1, 5/24/2023', &
103 &' INPUT READ FROM MEMPATH: ', A, /)"
109 call pobj%set_names(1, name_model,
'CXS',
'CXS')
112 call pobj%allocate_scalars()
115 pobj%input_mempath = input_mempath
121 call mem_set_value(pobj%input_fname,
'INPUT_FNAME', pobj%input_mempath, &
128 write (iout, fmtheader) input_mempath
131 call pobj%source_options()
134 call pobj%source_dimensions()
137 call pobj%allocate_arrays()
140 call pobj%source_packagedata()
143 call pobj%source_crosssectiondata()
160 call this%NumericalPackageType%allocate_scalars()
163 call mem_allocate(this%nsections,
'NSECTIONS', this%memoryPath)
164 call mem_allocate(this%npoints,
'NPOINTS', this%memoryPath)
181 character(len=LENMEMPATH) :: idmMemoryPath
188 call mem_set_value(this%iprpak,
'PRINT_INPUT', idmmemorypath, &
192 if (this%iout > 0)
then
193 call this%log_options(found)
203 write (this%iout,
'(1x,a)')
'Setting CXS Options'
205 if (found%iprpak)
then
206 write (this%iout,
'(4x,a)')
'Package information will be printed.'
209 write (this%iout,
'(1x,a,/)')
'End Setting CXS Options'
223 character(len=LENMEMPATH) :: idmMemoryPath
230 call mem_set_value(this%nsections,
'NSECTIONS', idmmemorypath, &
236 if (.not. found%nsections)
then
237 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NSECTIONS not found.'
242 if (.not. found%npoints)
then
243 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NPOINTS not found.'
248 if (this%iout > 0)
then
249 call this%log_dimensions(found)
259 write (this%iout,
'(1x,a)')
'Setting CXS Dimensions'
261 if (found%nsections)
then
262 write (this%iout,
'(4x,a)')
'NSECTIONS set from input file.'
265 if (found%npoints)
then
266 write (this%iout,
'(4x,a)')
'NPOINTS set from input file.'
269 write (this%iout,
'(1x,a,/)')
'End Setting CXS Dimensions'
283 'IDCXS', this%memoryPath)
285 'NXSPOINTS', this%memoryPath)
287 'XFRACTION', this%memoryPath)
289 'HEIGHT', this%memoryPath)
291 'MANFRACTION', this%memoryPath)
293 'IACROSS', this%memoryPath)
296 do n = 1, this%nsections
298 this%nxspoints(n) = 0
300 do n = 1, this%npoints
301 this%xfraction(n) =
dzero
302 this%height(n) =
dzero
303 this%manfraction(n) =
dzero
305 do n = 1, this%nsections + 1
320 character(len=LENMEMPATH) :: idmMemoryPath
329 call mem_set_value(this%nxspoints,
'NXSPOINTS', idmmemorypath, &
333 if (.not. found%idcxs)
then
334 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: IDCXS not found.'
339 if (.not. found%nxspoints)
then
340 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: NXSPOINTS not found.'
345 if (this%iout > 0)
then
346 call this%log_packagedata(found)
350 call this%check_packagedata()
359 integer(I4B),
dimension(:),
intent(in) :: nxspoints
360 integer(I4B),
dimension(:),
intent(inout) :: iacross
363 do n = 1,
size(nxspoints)
364 iacross(n + 1) = iacross(n) + nxspoints(n)
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),
'.'
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),
'.'
409 write (this%iout,
'(1x,a)')
'Setting CXS Package Data'
411 if (found%idcxs)
then
412 write (this%iout,
'(4x,a)')
'IDCXS set from input file.'
415 if (found%nxspoints)
then
416 write (this%iout,
'(4x,a)')
'NXSPOINTS set from input file.'
419 write (this%iout,
'(1x,a,/)')
'End Setting CXS Package Data'
433 character(len=LENMEMPATH) :: idmMemoryPath
440 call mem_set_value(this%xfraction,
'XFRACTION', idmmemorypath, &
444 call mem_set_value(this%manfraction,
'MANFRACTION', idmmemorypath, &
448 if (.not. found%xfraction)
then
449 write (errmsg,
'(a)') &
450 'Error in CROSSSECTIONDATA block: xfraction not found.'
455 if (.not. found%height)
then
456 write (errmsg,
'(a)') &
457 'Error in CROSSSECTIONDATA block: HEIGHT not found.'
462 if (.not. found%manfraction)
then
463 write (errmsg,
'(a)') &
464 'Error in CROSSSECTIONDATA block: MANFRACTION not found.'
469 if (this%iout > 0)
then
470 call this%log_crosssectiondata(found)
480 write (this%iout,
'(1x,a)')
'Setting CXS Cross Section Data'
482 if (found%xfraction)
then
483 write (this%iout,
'(4x,a)')
'XFRACTION set from input file.'
486 if (found%height)
then
487 write (this%iout,
'(4x,a)')
'HEIGHT set from input file.'
490 if (found%manfraction)
then
491 write (this%iout,
'(4x,a)')
'MANFRACTION set from input file.'
494 write (this%iout,
'(1x,a,/)')
'End Setting CXS Cross Section Data'
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
520 integer(I4B) :: icalcmeth
521 real(DP),
dimension(:),
allocatable :: depths
522 real(DP),
dimension(:),
allocatable :: depths_unique
523 integer(I4B),
dimension(:),
allocatable :: indx
525 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
529 write (this%iout, *)
'Processing information for cross section ', idcxs
530 write (this%iout, *)
'Depth Area WettedP HydRad Rough Conveyance Q'
532 allocate (depths(npts))
533 allocate (indx(
size(depths)))
535 depths(:) = this%height(:)
536 call qsort(indx, depths)
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)
551 write (this%iout, *) d, a, wp, rh, r, c, q
555 deallocate (depths_unique)
556 write (this%iout, *)
'Done processing information for cross section ', idcxs
580 if (this%inunit > 0)
then
590 call this%NumericalPackageType%da()
596 integer(I4B),
intent(in) :: idcxs
597 integer(I4B),
intent(inout) :: i0
598 integer(I4B),
intent(inout) :: i1
599 integer(I4B),
intent(inout) :: npts
600 integer(I4B),
intent(inout) :: icalcmeth
604 if (this%inunit == 0 .or. idcxs == 0)
then
614 i0 = this%iacross(idcxs)
615 i1 = this%iacross(idcxs + 1) - 1
629 function get_area(this, idcxs, width, depth)
result(area)
634 integer(I4B),
intent(in) :: idcxs
635 real(dp),
intent(in) :: width
636 real(dp),
intent(in) :: depth
642 integer(I4B) :: icalcmeth
643 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
648 this%xfraction(i0:i1), &
649 this%height(i0:i1), &
659 integer(I4B),
intent(in) :: idcxs
660 real(dp),
intent(in) :: width
661 real(dp),
intent(in) :: depth
667 integer(I4B) :: icalcmeth
668 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
673 this%xfraction(i0:i1), &
674 this%height(i0:i1), &
680 slope)
result(roughc)
685 integer(I4B),
intent(in) :: idcxs
686 real(dp),
intent(in) :: width
687 real(dp),
intent(in) :: depth
688 real(dp),
intent(in) :: rough
689 real(dp),
intent(in) :: slope
695 integer(I4B) :: icalcmeth
696 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
705 this%xfraction(i0:i1), &
706 this%height(i0:i1), &
707 this%manfraction(i0:i1), &
718 rough)
result(conveyance)
723 integer(I4B),
intent(in) :: idcxs
724 real(dp),
intent(in) :: width
725 real(dp),
intent(in) :: depth
726 real(dp),
intent(in) :: rough
728 real(dp) :: conveyance
735 integer(I4B) :: icalcmeth
736 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
743 this%xfraction(i0:i1), &
744 this%height(i0:i1), &
745 this%manfraction(i0:i1), &
755 integer(I4B),
intent(in) :: idcxs
756 real(dp),
intent(in) :: width
757 real(dp),
intent(in) :: depth
758 real(dp),
intent(in),
optional :: area
765 integer(I4B) :: icalcmeth
766 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
767 if (
present(area))
then
770 a = this%get_area(idcxs, width, depth)
776 this%xfraction(i0:i1), &
777 this%height(i0:i1), &
787 integer(I4B),
intent(in) :: idcxs
788 real(dp),
intent(in) :: width
789 real(dp),
intent(in) :: depth
795 integer(I4B) :: icalcmeth
796 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
801 this%height(i0:i1), width, depth)
810 integer(I4B),
intent(in) :: idcxs
811 real(dp),
intent(in) :: width
817 integer(I4B) :: icalcmeth
818 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.
flags indicating which CXS crosssectiondata were found in the input
flags indicating which CXS dimensions were found in the input
flags indicating which CXS options were found in the input
flags indicating which CXS packagedata were found in the input