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()
61 subroutine cxs_cr(pobj, name_model, input_mempath, inunit, iout, dis)
66 character(len=*),
intent(in) :: name_model
67 character(len=*),
intent(in) :: input_mempath
68 integer(I4B),
intent(in) :: inunit
69 integer(I4B),
intent(in) :: iout
72 logical(LGP) :: found_fname
74 character(len=*),
parameter :: fmtheader = &
75 "(1x, /1x, 'CXS -- CROSS SECTION PACKAGE, VERSION 1, 5/24/2023', &
76 &' INPUT READ FROM MEMPATH: ', A, /)"
82 call pobj%set_names(1, name_model,
'CXS',
'CXS')
85 call pobj%allocate_scalars()
88 pobj%input_mempath = input_mempath
94 call mem_set_value(pobj%input_fname,
'INPUT_FNAME', pobj%input_mempath, &
101 write (iout, fmtheader) input_mempath
104 call pobj%source_options()
107 call pobj%source_dimensions()
110 call pobj%allocate_arrays()
113 call pobj%source_packagedata()
116 call pobj%source_crosssectiondata()
133 call this%NumericalPackageType%allocate_scalars()
136 call mem_allocate(this%nsections,
'NSECTIONS', this%memoryPath)
137 call mem_allocate(this%npoints,
'NPOINTS', this%memoryPath)
155 character(len=LENMEMPATH) :: idmMemoryPath
162 call mem_set_value(this%iprpak,
'PRINT_INPUT', idmmemorypath, &
166 if (this%iout > 0)
then
167 call this%log_options(found)
178 write (this%iout,
'(1x,a)')
'Setting CXS Options'
180 if (found%iprpak)
then
181 write (this%iout,
'(4x,a)')
'Package information will be printed.'
184 write (this%iout,
'(1x,a,/)')
'End Setting CXS Options'
199 character(len=LENMEMPATH) :: idmMemoryPath
206 call mem_set_value(this%nsections,
'NSECTIONS', idmmemorypath, &
212 if (.not. found%nsections)
then
213 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NSECTIONS not found.'
218 if (.not. found%npoints)
then
219 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NPOINTS not found.'
224 if (this%iout > 0)
then
225 call this%log_dimensions(found)
236 write (this%iout,
'(1x,a)')
'Setting CXS Dimensions'
238 if (found%nsections)
then
239 write (this%iout,
'(4x,a)')
'NSECTIONS set from input file.'
242 if (found%npoints)
then
243 write (this%iout,
'(4x,a)')
'NPOINTS set from input file.'
246 write (this%iout,
'(1x,a,/)')
'End Setting CXS Dimensions'
260 'IDCXS', this%memoryPath)
262 'NXSPOINTS', this%memoryPath)
264 'XFRACTION', this%memoryPath)
266 'HEIGHT', this%memoryPath)
268 'MANFRACTION', this%memoryPath)
270 'IACROSS', this%memoryPath)
273 do n = 1, this%nsections
275 this%nxspoints(n) = 0
277 do n = 1, this%npoints
278 this%xfraction(n) =
dzero
279 this%height(n) =
dzero
280 this%manfraction(n) =
dzero
282 do n = 1, this%nsections + 1
298 character(len=LENMEMPATH) :: idmMemoryPath
307 call mem_set_value(this%nxspoints,
'NXSPOINTS', idmmemorypath, &
311 if (.not. found%idcxs)
then
312 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: IDCXS not found.'
317 if (.not. found%nxspoints)
then
318 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: NXSPOINTS not found.'
323 if (this%iout > 0)
then
324 call this%log_packagedata(found)
334 integer(I4B),
dimension(:),
intent(in) :: nxspoints
335 integer(I4B),
dimension(:),
intent(inout) :: iacross
338 do n = 1,
size(nxspoints)
339 iacross(n + 1) = iacross(n) + nxspoints(n)
350 write (this%iout,
'(1x,a)')
'Setting CXS Package Data'
352 if (found%idcxs)
then
353 write (this%iout,
'(4x,a)')
'IDCXS set from input file.'
356 if (found%nxspoints)
then
357 write (this%iout,
'(4x,a)')
'NXSPOINTS set from input file.'
360 write (this%iout,
'(1x,a,/)')
'End Setting CXS Package Data'
375 character(len=LENMEMPATH) :: idmMemoryPath
382 call mem_set_value(this%xfraction,
'XFRACTION', idmmemorypath, &
386 call mem_set_value(this%manfraction,
'MANFRACTION', idmmemorypath, &
390 if (.not. found%xfraction)
then
391 write (errmsg,
'(a)') &
392 'Error in CROSSSECTIONDATA block: xfraction not found.'
397 if (.not. found%height)
then
398 write (errmsg,
'(a)') &
399 'Error in CROSSSECTIONDATA block: HEIGHT not found.'
404 if (.not. found%manfraction)
then
405 write (errmsg,
'(a)') &
406 'Error in CROSSSECTIONDATA block: MANFRACTION not found.'
411 if (this%iout > 0)
then
412 call this%log_crosssectiondata(found)
423 write (this%iout,
'(1x,a)')
'Setting CXS Cross Section Data'
425 if (found%xfraction)
then
426 write (this%iout,
'(4x,a)')
'XFRACTION set from input file.'
429 if (found%height)
then
430 write (this%iout,
'(4x,a)')
'HEIGHT set from input file.'
433 if (found%manfraction)
then
434 write (this%iout,
'(4x,a)')
'MANFRACTION set from input file.'
437 write (this%iout,
'(1x,a,/)')
'End Setting CXS Cross Section Data'
446 integer(I4B),
intent(in) :: idcxs
447 real(DP),
intent(in) :: width
448 real(DP),
intent(in) :: slope
449 real(DP),
intent(in) :: rough
450 real(DP),
intent(in) :: unitconv
463 integer(I4B) :: icalcmeth
464 real(DP),
dimension(:),
allocatable :: depths
465 real(DP),
dimension(:),
allocatable :: depths_unique
466 integer(I4B),
dimension(:),
allocatable :: indx
468 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
472 write (this%iout, *)
'Processing information for cross section ', idcxs
473 write (this%iout, *)
'Depth Area WettedP HydRad Rough Conveyance Q'
475 allocate (depths(npts))
476 allocate (indx(
size(depths)))
478 depths(:) = this%height(:)
479 call qsort(indx, depths)
482 do ipt = 1,
size(depths_unique)
483 d = depths_unique(ipt)
484 a = this%get_area(idcxs, width, d)
485 wp = this%get_wetted_perimeter(idcxs, width, d)
486 rh = this%get_hydraulic_radius(idcxs, width, d, a)
487 r = this%get_roughness(idcxs, width, d, rough, slope)
488 c = this%get_conveyance(idcxs, width, d, rough)
489 if (slope >
dzero)
then
490 q = unitconv * c * sqrt(slope)
494 write (this%iout, *) d, a, wp, rh, r, c, q
498 deallocate (depths_unique)
499 write (this%iout, *)
'Done processing information for cross section ', idcxs
523 if (this%inunit > 0)
then
533 call this%NumericalPackageType%da()
539 integer(I4B),
intent(in) :: idcxs
540 integer(I4B),
intent(inout) :: i0
541 integer(I4B),
intent(inout) :: i1
542 integer(I4B),
intent(inout) :: npts
543 integer(I4B),
intent(inout) :: icalcmeth
547 if (this%inunit == 0 .or. idcxs == 0)
then
557 i0 = this%iacross(idcxs)
558 i1 = this%iacross(idcxs + 1) - 1
572 function get_area(this, idcxs, width, depth)
result(area)
577 integer(I4B),
intent(in) :: idcxs
578 real(dp),
intent(in) :: width
579 real(dp),
intent(in) :: depth
585 integer(I4B) :: icalcmeth
586 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
591 this%xfraction(i0:i1), &
592 this%height(i0:i1), &
602 integer(I4B),
intent(in) :: idcxs
603 real(dp),
intent(in) :: width
604 real(dp),
intent(in) :: depth
610 integer(I4B) :: icalcmeth
611 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
616 this%xfraction(i0:i1), &
617 this%height(i0:i1), &
623 slope)
result(roughc)
628 integer(I4B),
intent(in) :: idcxs
629 real(dp),
intent(in) :: width
630 real(dp),
intent(in) :: depth
631 real(dp),
intent(in) :: rough
632 real(dp),
intent(in) :: slope
638 integer(I4B) :: icalcmeth
639 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
648 this%xfraction(i0:i1), &
649 this%height(i0:i1), &
650 this%manfraction(i0:i1), &
661 rough)
result(conveyance)
666 integer(I4B),
intent(in) :: idcxs
667 real(dp),
intent(in) :: width
668 real(dp),
intent(in) :: depth
669 real(dp),
intent(in) :: rough
671 real(dp) :: conveyance
678 integer(I4B) :: icalcmeth
679 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
686 this%xfraction(i0:i1), &
687 this%height(i0:i1), &
688 this%manfraction(i0:i1), &
698 integer(I4B),
intent(in) :: idcxs
699 real(dp),
intent(in) :: width
700 real(dp),
intent(in) :: depth
701 real(dp),
intent(in),
optional :: area
708 integer(I4B) :: icalcmeth
709 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
710 if (
present(area))
then
713 a = this%get_area(idcxs, width, depth)
719 this%xfraction(i0:i1), &
720 this%height(i0:i1), &
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_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
character(len=maxcharlen) warnmsg
warning message string
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_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)
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_conveyance(npts, xfraction, heights, cxs_rf, width, rough, d)
Calculate conveyance.
real(dp) function, public get_wetted_perimeter(npts, xfraction, heights, width, d)
Calculate the wetted perimeter for a reach.