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()
136 call this%NumericalPackageType%allocate_scalars()
139 call mem_allocate(this%nsections,
'NSECTIONS', this%memoryPath)
140 call mem_allocate(this%npoints,
'NPOINTS', this%memoryPath)
160 character(len=LENMEMPATH) :: idmMemoryPath
167 call mem_set_value(this%iprpak,
'PRINT_INPUT', idmmemorypath, &
171 if (this%iout > 0)
then
172 call this%log_options(found)
186 write (this%iout,
'(1x,a)')
'Setting CXS Options'
188 if (found%iprpak)
then
189 write (this%iout,
'(4x,a)')
'Package information will be printed.'
192 write (this%iout,
'(1x,a,/)')
'End Setting CXS Options'
207 character(len=LENMEMPATH) :: idmMemoryPath
214 call mem_set_value(this%nsections,
'NSECTIONS', idmmemorypath, &
220 if (.not. found%nsections)
then
221 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NSECTIONS not found.'
226 if (.not. found%npoints)
then
227 write (errmsg,
'(a)')
'Error in DIMENSIONS block: NPOINTS not found.'
232 if (this%iout > 0)
then
233 call this%log_dimensions(found)
247 write (this%iout,
'(1x,a)')
'Setting CXS Dimensions'
249 if (found%nsections)
then
250 write (this%iout,
'(4x,a)')
'NSECTIONS set from input file.'
253 if (found%npoints)
then
254 write (this%iout,
'(4x,a)')
'NPOINTS set from input file.'
257 write (this%iout,
'(1x,a,/)')
'End Setting CXS Dimensions'
271 'IDCXS', this%memoryPath)
273 'NXSPOINTS', this%memoryPath)
275 'XFRACTION', this%memoryPath)
277 'HEIGHT', this%memoryPath)
279 'MANFRACTION', this%memoryPath)
281 'IACROSS', this%memoryPath)
284 do n = 1, this%nsections
286 this%nxspoints(n) = 0
288 do n = 1, this%npoints
289 this%xfraction(n) =
dzero
290 this%height(n) =
dzero
291 this%manfraction(n) =
dzero
293 do n = 1, this%nsections + 1
312 character(len=LENMEMPATH) :: idmMemoryPath
321 call mem_set_value(this%nxspoints,
'NXSPOINTS', idmmemorypath, &
325 if (.not. found%idcxs)
then
326 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: IDCXS not found.'
331 if (.not. found%nxspoints)
then
332 write (errmsg,
'(a)')
'Error in PACKAGEDATA block: NXSPOINTS not found.'
337 if (this%iout > 0)
then
338 call this%log_packagedata(found)
351 integer(I4B),
dimension(:),
intent(in) :: nxspoints
352 integer(I4B),
dimension(:),
intent(inout) :: iacross
355 do n = 1,
size(nxspoints)
356 iacross(n + 1) = iacross(n) + nxspoints(n)
367 write (this%iout,
'(1x,a)')
'Setting CXS Package Data'
369 if (found%idcxs)
then
370 write (this%iout,
'(4x,a)')
'IDCXS set from input file.'
373 if (found%nxspoints)
then
374 write (this%iout,
'(4x,a)')
'NXSPOINTS set from input file.'
377 write (this%iout,
'(1x,a,/)')
'End Setting CXS Package Data'
392 character(len=LENMEMPATH) :: idmMemoryPath
399 call mem_set_value(this%xfraction,
'XFRACTION', idmmemorypath, &
403 call mem_set_value(this%manfraction,
'MANFRACTION', idmmemorypath, &
407 if (.not. found%xfraction)
then
408 write (errmsg,
'(a)') &
409 'Error in CROSSSECTIONDATA block: xfraction not found.'
414 if (.not. found%height)
then
415 write (errmsg,
'(a)') &
416 'Error in CROSSSECTIONDATA block: HEIGHT not found.'
421 if (.not. found%manfraction)
then
422 write (errmsg,
'(a)') &
423 'Error in CROSSSECTIONDATA block: MANFRACTION not found.'
428 if (this%iout > 0)
then
429 call this%log_crosssectiondata(found)
443 write (this%iout,
'(1x,a)')
'Setting CXS Cross Section Data'
445 if (found%xfraction)
then
446 write (this%iout,
'(4x,a)')
'XFRACTION set from input file.'
449 if (found%height)
then
450 write (this%iout,
'(4x,a)')
'HEIGHT set from input file.'
453 if (found%manfraction)
then
454 write (this%iout,
'(4x,a)')
'MANFRACTION set from input file.'
457 write (this%iout,
'(1x,a,/)')
'End Setting CXS Cross Section Data'
466 integer(I4B),
intent(in) :: idcxs
467 real(DP),
intent(in) :: width
468 real(DP),
intent(in) :: slope
469 real(DP),
intent(in) :: rough
470 real(DP),
intent(in) :: unitconv
483 integer(I4B) :: icalcmeth
484 real(DP),
dimension(:),
allocatable :: depths
485 real(DP),
dimension(:),
allocatable :: depths_unique
486 integer(I4B),
dimension(:),
allocatable :: indx
488 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
492 write (this%iout, *)
'Processing information for cross section ', idcxs
493 write (this%iout, *)
'Depth Area WettedP HydRad Rough Conveyance Q'
495 allocate (depths(npts))
496 allocate (indx(
size(depths)))
498 depths(:) = this%height(:)
499 call qsort(indx, depths)
502 do ipt = 1,
size(depths_unique)
503 d = depths_unique(ipt)
504 a = this%get_area(idcxs, width, d)
505 wp = this%get_wetted_perimeter(idcxs, width, d)
506 rh = this%get_hydraulic_radius(idcxs, width, d, a)
507 r = this%get_roughness(idcxs, width, d, rough, slope)
508 c = this%get_conveyance(idcxs, width, d, rough)
509 if (slope >
dzero)
then
510 q = unitconv * c * sqrt(slope)
514 write (this%iout, *) d, a, wp, rh, r, c, q
518 deallocate (depths_unique)
519 write (this%iout, *)
'Done processing information for cross section ', idcxs
545 if (this%inunit > 0)
then
555 call this%NumericalPackageType%da()
564 integer(I4B),
intent(in) :: idcxs
565 integer(I4B),
intent(inout) :: i0
566 integer(I4B),
intent(inout) :: i1
567 integer(I4B),
intent(inout) :: npts
568 integer(I4B),
intent(inout) :: icalcmeth
572 if (this%inunit == 0 .or. idcxs == 0)
then
582 i0 = this%iacross(idcxs)
583 i1 = this%iacross(idcxs + 1) - 1
598 function get_area(this, idcxs, width, depth)
result(area)
603 integer(I4B),
intent(in) :: idcxs
604 real(dp),
intent(in) :: width
605 real(dp),
intent(in) :: depth
611 integer(I4B) :: icalcmeth
612 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
617 this%xfraction(i0:i1), &
618 this%height(i0:i1), &
628 integer(I4B),
intent(in) :: idcxs
629 real(dp),
intent(in) :: width
630 real(dp),
intent(in) :: depth
636 integer(I4B) :: icalcmeth
637 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
642 this%xfraction(i0:i1), &
643 this%height(i0:i1), &
649 slope)
result(roughc)
654 integer(I4B),
intent(in) :: idcxs
655 real(dp),
intent(in) :: width
656 real(dp),
intent(in) :: depth
657 real(dp),
intent(in) :: rough
658 real(dp),
intent(in) :: slope
664 integer(I4B) :: icalcmeth
665 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
674 this%xfraction(i0:i1), &
675 this%height(i0:i1), &
676 this%manfraction(i0:i1), &
687 rough)
result(conveyance)
692 integer(I4B),
intent(in) :: idcxs
693 real(dp),
intent(in) :: width
694 real(dp),
intent(in) :: depth
695 real(dp),
intent(in) :: rough
697 real(dp) :: conveyance
704 integer(I4B) :: icalcmeth
705 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
712 this%xfraction(i0:i1), &
713 this%height(i0:i1), &
714 this%manfraction(i0:i1), &
724 integer(I4B),
intent(in) :: idcxs
725 real(dp),
intent(in) :: width
726 real(dp),
intent(in) :: depth
727 real(dp),
intent(in),
optional :: area
734 integer(I4B) :: icalcmeth
735 call this%get_cross_section_info(idcxs, i0, i1, npts, icalcmeth)
736 if (
present(area))
then
739 a = this%get_area(idcxs, width, depth)
745 this%xfraction(i0:i1), &
746 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 memorylist_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.