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) :: ifno = .false.
40 logical(LGP) :: xfraction = .false.
41 logical(LGP) :: height = .false.
42 logical(LGP) :: manfraction = .false.
48 integer(I4B),
pointer :: nsections => null()
49 integer(I4B),
pointer :: npoints => null()
50 integer(I4B),
dimension(:),
pointer,
contiguous :: idcxs => null()
51 integer(I4B),
dimension(:),
pointer,
contiguous :: nxspoints => null()
52 real(dp),
dimension(:),
pointer,
contiguous :: xfraction => null()
53 real(dp),
dimension(:),
pointer,
contiguous :: height => null()
54 real(dp),
dimension(:),
pointer,
contiguous :: manfraction => null()
57 integer(I4B),
dimension(:),
pointer,
contiguous :: iacross => null()
90 subroutine cxs_cr(pobj, name_model, input_mempath, inunit, iout, dis)
95 character(len=*),
intent(in) :: name_model
96 character(len=*),
intent(in) :: input_mempath
97 integer(I4B),
intent(in) :: inunit
98 integer(I4B),
intent(in) :: iout
101 logical(LGP) :: found_fname
103 character(len=*),
parameter :: fmtheader = &
104 "(1x, /1x, 'CXS -- CROSS SECTION PACKAGE, VERSION 1, 5/24/2023', &
105 &' INPUT READ FROM MEMPATH: ', A, /)"
111 call pobj%set_names(1, name_model,
'CXS',
'CXS')
114 call pobj%allocate_scalars()
117 pobj%input_mempath = input_mempath
123 call mem_set_value(pobj%input_fname,
'INPUT_FNAME', pobj%input_mempath, &
130 write (iout, fmtheader) input_mempath
133 call pobj%source_options()
136 call pobj%source_dimensions()
139 call pobj%allocate_arrays()
142 call pobj%source_packagedata()
145 call pobj%source_crosssectiondata()
162 call this%NumericalPackageType%allocate_scalars()
165 call mem_allocate(this%nsections,
'NSECTIONS', this%memoryPath)
166 call mem_allocate(this%npoints,
'NPOINTS', this%memoryPath)
183 character(len=LENMEMPATH) :: idmMemoryPath
190 call mem_set_value(this%iprpak,
'PRINT_INPUT', idmmemorypath, &
194 if (this%iout > 0)
then
195 call this%log_options(found)
205 write (this%iout,
'(1x,a)')
'Setting CXS Options'
207 if (found%iprpak)
then
208 write (this%iout,
'(4x,a)')
'Package information will be printed.'
211 write (this%iout,
'(1x,a,/)')
'End Setting CXS Options'
225 character(len=LENMEMPATH) :: idmMemoryPath
232 call mem_set_value(this%nsections,
'NSECTIONS', idmmemorypath, &
238 if (.not. found%nsections)
then
239 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NSECTIONS not found.'
244 if (.not. found%npoints)
then
245 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NPOINTS not found.'
250 if (this%iout > 0)
then
251 call this%log_dimensions(found)
261 write (this%iout,
'(1x,a)')
'Setting CXS Dimensions'
263 if (found%nsections)
then
264 write (this%iout,
'(4x,a)')
'NSECTIONS set from input file.'
267 if (found%npoints)
then
268 write (this%iout,
'(4x,a)')
'NPOINTS set from input file.'
271 write (this%iout,
'(1x,a,/)')
'End Setting CXS Dimensions'
285 'IDCXS', this%memoryPath)
287 'NXSPOINTS', this%memoryPath)
289 'XFRACTION', this%memoryPath)
291 'HEIGHT', this%memoryPath)
293 'MANFRACTION', this%memoryPath)
295 'IACROSS', this%memoryPath)
298 do n = 1, this%nsections
300 this%nxspoints(n) = 0
302 do n = 1, this%npoints
303 this%xfraction(n) =
dzero
304 this%height(n) =
dzero
305 this%manfraction(n) =
dzero
307 do n = 1, this%nsections + 1
322 character(len=LENMEMPATH) :: idmMemoryPath
329 call mem_set_value(this%idcxs,
'IFNO_PKGDATA', idmmemorypath, &
331 call mem_set_value(this%nxspoints,
'NXSPOINTS', idmmemorypath, &
335 if (.not. found%idcxs)
then
336 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: IFNO not found.'
341 if (.not. found%nxspoints)
then
342 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: NXSPOINTS not found.'
347 if (this%iout > 0)
then
348 call this%log_packagedata(found)
352 call this%check_packagedata()
361 integer(I4B),
dimension(:),
intent(in) :: nxspoints
362 integer(I4B),
dimension(:),
intent(inout) :: iacross
365 do n = 1,
size(nxspoints)
366 iacross(n + 1) = iacross(n) + nxspoints(n)
379 do i = 1,
size(this%idcxs)
380 if (this%idcxs(i) <= 0 .or. this%idcxs(i) > this%nsections)
then
381 write (
errmsg,
'(a, i0, a)') &
382 'IFNO values must be greater than 0 and less than NSECTIONS. &
383 &Found ', this%idcxs(i),
'.'
389 do i = 1,
size(this%nxspoints)
390 if (this%nxspoints(i) <= 1)
then
391 write (
errmsg,
'(a, i0, a, i0, a)') &
392 'NXSPOINTS values must be greater than 1 for each cross section. &
393 &Found ', this%nxspoints(i),
' for cross section ', this%idcxs(i),
'.'
411 write (this%iout,
'(1x,a)')
'Setting CXS Package Data'
413 if (found%idcxs)
then
414 write (this%iout,
'(4x,a)')
'IFNO set from input file.'
417 if (found%nxspoints)
then
418 write (this%iout,
'(4x,a)')
'NXSPOINTS set from input file.'
421 write (this%iout,
'(1x,a,/)')
'End Setting CXS Package Data'
435 character(len=LENMEMPATH) :: idmMemoryPath
437 integer(I4B),
dimension(:),
pointer,
contiguous :: ifno => null()
443 allocate (ifno(this%npoints))
446 call mem_set_value(this%xfraction,
'XFRACTION', idmmemorypath, &
450 call mem_set_value(this%manfraction,
'MANFRACTION', idmmemorypath, &
454 if (.not. found%ifno)
then
455 write (errmsg,
'(a)') &
456 'Error in CROSSSECTIONDATA block: IFNO not found.'
461 if (.not. found%xfraction)
then
462 write (errmsg,
'(a)') &
463 'Error in CROSSSECTIONDATA block: xfraction not found.'
468 if (.not. found%height)
then
469 write (errmsg,
'(a)') &
470 'Error in CROSSSECTIONDATA block: HEIGHT not found.'
475 if (.not. found%manfraction)
then
476 write (errmsg,
'(a)') &
477 'Error in CROSSSECTIONDATA block: MANFRACTION not found.'
484 call this%check_crosssectiondata(ifno)
489 if (this%iout > 0)
then
490 call this%log_crosssectiondata(found)
499 integer(I4B),
dimension(:),
intent(in) :: ifno
506 do n = 1, this%nsections
508 i1 = this%iacross(n + 1) - 1
510 if (ifno(i) /= this%idcxs(n))
then
511 write (
errmsg,
'(a, i0, a, i0, a, i0, a)') &
512 'IFNO value in CROSSSECTIONDATA does not match the cross &
513 §ion implied by PACKAGEDATA. Found IFNO = ', ifno(i), &
514 ' at point ', i,
' but expected ', this%idcxs(n),
'.'
531 write (this%iout,
'(1x,a)')
'Setting CXS Cross Section Data'
534 write (this%iout,
'(4x,a)')
'IFNO set from input file.'
537 if (found%xfraction)
then
538 write (this%iout,
'(4x,a)')
'XFRACTION set from input file.'
541 if (found%height)
then
542 write (this%iout,
'(4x,a)')
'HEIGHT set from input file.'
545 if (found%manfraction)
then
546 write (this%iout,
'(4x,a)')
'MANFRACTION set from input file.'
549 write (this%iout,
'(1x,a,/)')
'End Setting CXS Cross Section Data'
558 integer(I4B),
intent(in) :: idcxs
559 real(DP),
intent(in) :: width
560 real(DP),
intent(in) :: slope
561 real(DP),
intent(in) :: rough
562 real(DP),
intent(in) :: unitconv
575 integer(I4B) :: icalcmeth
576 real(DP),
dimension(:),
allocatable :: depths
577 real(DP),
dimension(:),
allocatable :: depths_unique
578 integer(I4B),
dimension(:),
allocatable :: indx
580 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
584 write (this%iout, *)
'Processing information for cross section ', idcxs
585 write (this%iout, *)
'Depth Area WettedP HydRad Rough Conveyance Q'
587 allocate (depths(npts))
588 allocate (indx(
size(depths)))
590 depths(:) = this%height(:)
591 call qsort(indx, depths)
594 do ipt = 1,
size(depths_unique)
595 d = depths_unique(ipt)
596 a = this%get_area(idcxs, width, d)
597 wp = this%get_wetted_perimeter(idcxs, width, d)
598 rh = this%get_hydraulic_radius(idcxs, width, d, a)
599 r = this%get_roughness(idcxs, width, d, rough, slope)
600 c = this%get_conveyance(idcxs, width, d, rough)
601 if (slope >
dzero)
then
602 q = unitconv * c * sqrt(slope)
606 write (this%iout, *) d, a, wp, rh, r, c, q
610 deallocate (depths_unique)
611 write (this%iout, *)
'Done processing information for cross section ', idcxs
635 if (this%inunit > 0)
then
645 call this%NumericalPackageType%da()
651 integer(I4B),
intent(in) :: idcxs
652 integer(I4B),
intent(inout) :: i0
653 integer(I4B),
intent(inout) :: i1
654 integer(I4B),
intent(inout) :: npts
655 integer(I4B),
intent(inout) :: icalcmeth
659 if (this%inunit == 0 .or. idcxs == 0)
then
669 i0 = this%iacross(idcxs)
670 i1 = this%iacross(idcxs + 1) - 1
684 function get_area(this, idcxs, width, depth)
result(area)
689 integer(I4B),
intent(in) :: idcxs
690 real(dp),
intent(in) :: width
691 real(dp),
intent(in) :: depth
697 integer(I4B) :: icalcmeth
698 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
703 this%xfraction(i0:i1), &
704 this%height(i0:i1), &
714 integer(I4B),
intent(in) :: idcxs
715 real(dp),
intent(in) :: width
716 real(dp),
intent(in) :: depth
722 integer(I4B) :: icalcmeth
723 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
728 this%xfraction(i0:i1), &
729 this%height(i0:i1), &
735 slope)
result(roughc)
740 integer(I4B),
intent(in) :: idcxs
741 real(dp),
intent(in) :: width
742 real(dp),
intent(in) :: depth
743 real(dp),
intent(in) :: rough
744 real(dp),
intent(in) :: slope
750 integer(I4B) :: icalcmeth
751 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
760 this%xfraction(i0:i1), &
761 this%height(i0:i1), &
762 this%manfraction(i0:i1), &
773 rough)
result(conveyance)
778 integer(I4B),
intent(in) :: idcxs
779 real(dp),
intent(in) :: width
780 real(dp),
intent(in) :: depth
781 real(dp),
intent(in) :: rough
783 real(dp) :: conveyance
790 integer(I4B) :: icalcmeth
791 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
798 this%xfraction(i0:i1), &
799 this%height(i0:i1), &
800 this%manfraction(i0:i1), &
810 integer(I4B),
intent(in) :: idcxs
811 real(dp),
intent(in) :: width
812 real(dp),
intent(in) :: depth
813 real(dp),
intent(in),
optional :: area
820 integer(I4B) :: icalcmeth
821 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
822 if (
present(area))
then
825 a = this%get_area(idcxs, width, depth)
831 this%xfraction(i0:i1), &
832 this%height(i0:i1), &
842 integer(I4B),
intent(in) :: idcxs
843 real(dp),
intent(in) :: width
844 real(dp),
intent(in) :: depth
850 integer(I4B) :: icalcmeth
851 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
856 this%height(i0:i1), width, depth)
865 integer(I4B),
intent(in) :: idcxs
866 real(dp),
intent(in) :: width
872 integer(I4B) :: icalcmeth
873 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 check_crosssectiondata(this, ifno)
Check crosssectiondata IFNO against PACKAGEDATA section groupings.
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