24 integer(I4B),
pointer :: nrow => null()
25 integer(I4B),
pointer :: ncol => null()
26 real(dp),
dimension(:),
pointer,
contiguous :: delr => null()
27 real(dp),
dimension(:),
pointer,
contiguous :: delc => null()
28 real(dp),
dimension(:, :),
pointer,
contiguous :: botm => null()
29 integer(I4B),
dimension(:, :),
pointer,
contiguous :: idomain => null()
30 real(dp),
dimension(:),
pointer,
contiguous :: cellx => null()
31 real(dp),
dimension(:),
pointer,
contiguous :: celly => null()
74 logical :: length_units = .false.
75 logical :: nogrb = .false.
76 logical :: xorigin = .false.
77 logical :: yorigin = .false.
78 logical :: angrot = .false.
79 logical :: nrow = .false.
80 logical :: ncol = .false.
81 logical :: delr = .false.
82 logical :: delc = .false.
83 logical :: top = .false.
84 logical :: botm = .false.
85 logical :: idomain = .false.
92 subroutine dis2d_cr(dis, name_model, input_mempath, inunit, iout)
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
102 character(len=*),
parameter :: fmtheader = &
103 "(1X, /1X, 'DIS -- STRUCTURED GRID DISCRETIZATION PACKAGE,', &
104 &' VERSION 2 : 3/27/2014 - INPUT READ FROM MEMPATH: ', A, /)"
108 call disnew%allocate_scalars(name_model, input_mempath)
117 write (iout, fmtheader) dis%input_mempath
130 if (this%inunit /= 0)
then
133 call this%source_options()
136 call this%source_dimensions()
139 call this%source_griddata()
143 call this%grid_finalize()
157 call this%DisBaseType%dis_da()
181 character(len=LENVARNAME),
dimension(3) :: lenunits = &
182 &[character(len=LENVARNAME) ::
'FEET',
'METERS',
'CENTIMETERS']
186 call mem_set_value(this%lenuni,
'LENGTH_UNITS', this%input_mempath, &
187 lenunits, found%length_units)
188 call mem_set_value(this%nogrb,
'NOGRB', this%input_mempath, found%nogrb)
189 call mem_set_value(this%xorigin,
'XORIGIN', this%input_mempath, found%xorigin)
190 call mem_set_value(this%yorigin,
'YORIGIN', this%input_mempath, found%yorigin)
191 call mem_set_value(this%angrot,
'ANGROT', this%input_mempath, found%angrot)
194 if (this%iout > 0)
then
195 call this%log_options(found)
207 write (this%iout,
'(1x,a)')
'Setting Discretization Options'
209 if (found%length_units)
then
210 write (this%iout,
'(4x,a,i0)')
'Model length unit [0=UND, 1=FEET, &
211 &2=METERS, 3=CENTIMETERS] set as ', this%lenuni
214 if (found%nogrb)
then
215 write (this%iout,
'(4x,a,i0)')
'Binary grid file [0=GRB, 1=NOGRB] &
216 &set as ', this%nogrb
219 if (found%xorigin)
then
220 write (this%iout,
'(4x,a,G0)')
'XORIGIN = ', this%xorigin
223 if (found%yorigin)
then
224 write (this%iout,
'(4x,a,G0)')
'YORIGIN = ', this%yorigin
227 if (found%angrot)
then
228 write (this%iout,
'(4x,a,G0)')
'ANGROT = ', this%angrot
231 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Options'
245 call mem_set_value(this%nrow,
'NROW', this%input_mempath, found%nrow)
246 call mem_set_value(this%ncol,
'NCOL', this%input_mempath, found%ncol)
249 if (this%iout > 0)
then
250 call this%log_dimensions(found)
254 if (this%nrow < 1)
then
256 'NROW was not specified or was specified incorrectly.')
259 if (this%ncol < 1)
then
261 'NCOL was not specified or was specified incorrectly.')
266 this%nodesuser = this%nrow * this%ncol
269 call mem_allocate(this%delr, this%ncol,
'DELR', this%memoryPath)
270 call mem_allocate(this%delc, this%nrow,
'DELC', this%memoryPath)
271 call mem_allocate(this%idomain, this%ncol, this%nrow,
'IDOMAIN', &
273 call mem_allocate(this%botm, this%ncol, this%nrow,
'BOTM', &
275 call mem_allocate(this%cellx, this%ncol,
'CELLX', this%memoryPath)
276 call mem_allocate(this%celly, this%nrow,
'CELLY', this%memoryPath)
281 this%idomain(j, i) = 1
294 write (this%iout,
'(1x,a)')
'Setting Discretization Dimensions'
297 write (this%iout,
'(4x,a,i0)')
'NROW = ', this%nrow
301 write (this%iout,
'(4x,a,i0)')
'NCOL = ', this%ncol
304 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Dimensions'
316 call mem_set_value(this%delr,
'DELR', this%input_mempath, found%delr)
317 call mem_set_value(this%delc,
'DELC', this%input_mempath, found%delc)
318 call mem_set_value(this%botm,
'BOTM', this%input_mempath, found%botm)
319 call mem_set_value(this%idomain,
'IDOMAIN', this%input_mempath, found%idomain)
322 if (this%iout > 0)
then
323 call this%log_griddata(found)
335 write (this%iout,
'(1x,a)')
'Setting Discretization Griddata'
338 write (this%iout,
'(4x,a)')
'DELR set from input file'
342 write (this%iout,
'(4x,a)')
'DELC set from input file'
346 write (this%iout,
'(4x,a)')
'TOP set from input file'
350 write (this%iout,
'(4x,a)')
'BOTM set from input file'
353 if (found%idomain)
then
354 write (this%iout,
'(4x,a)')
'IDOMAIN set from input file'
357 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Griddata'
371 integer(I4B) :: noder
372 integer(I4B) :: nrsize
374 character(len=*),
parameter :: fmtdz = &
375 "('CELL (',i0,',',i0,',',i0,') THICKNESS <= 0. ', &
376 &'TOP, BOT: ',2(1pg24.15))"
377 character(len=*),
parameter :: fmtnr = &
378 "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',&
379 &/1x, 'Number of user nodes: ',I0,&
380 &/1X, 'Number of nodes in solution: ', I0, //)"
386 if (this%idomain(j, i) > 0) this%nodes = this%nodes + 1
391 if (this%nodes == 0)
then
392 call store_error(
'Model does not have any active nodes. &
393 &Ensure IDOMAIN array has some values greater &
399 if (this%nodes < this%nodesuser)
then
400 write (this%iout, fmtnr) this%nodesuser, this%nodes
404 call this%allocate_arrays()
410 if (this%nodes < this%nodesuser)
then
415 if (this%idomain(j, i) > 0)
then
416 this%nodereduced(node) = noder
418 elseif (this%idomain(j, i) < 0)
then
419 this%nodereduced(node) = -1
421 this%nodereduced(node) = 0
429 if (this%nodes < this%nodesuser)
then
434 if (this%idomain(j, i) > 0)
then
435 this%nodeuser(noder) = node
444 this%cellx(1) =
dhalf * this%delr(1)
445 this%celly(this%nrow) =
dhalf * this%delc(this%nrow)
447 this%cellx(j) = this%cellx(j - 1) +
dhalf * this%delr(j - 1) + &
451 do i = this%nrow - 1, 1, -1
452 this%celly(i) = this%celly(i + 1) +
dhalf * this%delc(i + 1) + &
462 if (this%nodes < this%nodesuser) noder = this%nodereduced(node)
463 if (noder <= 0) cycle
464 this%bot(noder) = this%botm(j, i)
465 this%area(noder) = this%delr(j) * this%delc(i)
466 this%xc(noder) = this%cellx(j)
467 this%yc(noder) = this%celly(i)
473 if (this%nodes < this%nodesuser) nrsize = this%nodes
475 call this%con%disconnections(this%name_model, this%nodes, &
476 this%ncol, this%nrow, 1, &
477 nrsize, this%delr, this%delc, &
478 this%top, this%bot, this%nodereduced, &
480 this%nja = this%con%nja
481 this%njas = this%con%njas
492 integer(I4B),
dimension(:),
intent(in) :: icelltype
494 integer(I4B) :: iunit, ntxt
495 integer(I4B),
parameter :: lentxt = 100
496 character(len=50) :: txthdr
497 character(len=lentxt) :: txt
498 character(len=LINELENGTH) :: fname
499 character(len=*),
parameter :: fmtgrdsave = &
500 "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', &
501 &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)"
507 fname = trim(this%input_fname)//
'.grb'
509 write (this%iout, fmtgrdsave) iunit, trim(adjustl(fname))
510 call openfile(iunit, this%iout, trim(adjustl(fname)),
'DATA(BINARY)', &
514 write (txthdr,
'(a)')
'GRID DIS2D'
515 txthdr(50:50) = new_line(
'a')
517 write (txthdr,
'(a)')
'VERSION 1'
518 txthdr(50:50) = new_line(
'a')
520 write (txthdr,
'(a, i0)')
'NTXT ', ntxt
521 txthdr(50:50) = new_line(
'a')
523 write (txthdr,
'(a, i0)')
'LENTXT ', lentxt
524 txthdr(50:50) = new_line(
'a')
528 write (txt,
'(3a, i0)')
'NCELLS ',
'INTEGER ',
'NDIM 0 # ', this%nodesuser
529 txt(lentxt:lentxt) = new_line(
'a')
531 write (txt,
'(3a, i0)')
'NROW ',
'INTEGER ',
'NDIM 0 # ', this%nrow
532 txt(lentxt:lentxt) = new_line(
'a')
534 write (txt,
'(3a, i0)')
'NCOL ',
'INTEGER ',
'NDIM 0 # ', this%ncol
535 txt(lentxt:lentxt) = new_line(
'a')
537 write (txt,
'(3a, i0)')
'NJA ',
'INTEGER ',
'NDIM 0 # ', this%nja
538 txt(lentxt:lentxt) = new_line(
'a')
540 write (txt,
'(3a, 1pg24.15)')
'XORIGIN ',
'DOUBLE ',
'NDIM 0 # ', this%xorigin
541 txt(lentxt:lentxt) = new_line(
'a')
543 write (txt,
'(3a, 1pg24.15)')
'YORIGIN ',
'DOUBLE ',
'NDIM 0 # ', this%yorigin
544 txt(lentxt:lentxt) = new_line(
'a')
546 write (txt,
'(3a, 1pg24.15)')
'ANGROT ',
'DOUBLE ',
'NDIM 0 # ', this%angrot
547 txt(lentxt:lentxt) = new_line(
'a')
549 write (txt,
'(3a, i0)')
'DELR ',
'DOUBLE ',
'NDIM 1 ', this%ncol
550 txt(lentxt:lentxt) = new_line(
'a')
552 write (txt,
'(3a, i0)')
'DELC ',
'DOUBLE ',
'NDIM 1 ', this%nrow
553 txt(lentxt:lentxt) = new_line(
'a')
555 write (txt,
'(3a, i0)')
'BOTM ',
'DOUBLE ',
'NDIM 1 ', this%nodesuser
556 txt(lentxt:lentxt) = new_line(
'a')
558 write (txt,
'(3a, i0)')
'IA ',
'INTEGER ',
'NDIM 1 ', this%nodesuser + 1
559 txt(lentxt:lentxt) = new_line(
'a')
561 write (txt,
'(3a, i0)')
'JA ',
'INTEGER ',
'NDIM 1 ',
size(this%con%jausr)
562 txt(lentxt:lentxt) = new_line(
'a')
564 write (txt,
'(3a, i0)')
'IDOMAIN ',
'INTEGER ',
'NDIM 1 ', this%nodesuser
565 txt(lentxt:lentxt) = new_line(
'a')
567 write (txt,
'(3a, i0)')
'ICELLTYPE ',
'INTEGER ',
'NDIM 1 ', this%nodesuser
568 txt(lentxt:lentxt) = new_line(
'a')
572 write (iunit) this%nodesuser
573 write (iunit) this%nrow
574 write (iunit) this%ncol
575 write (iunit) this%nja
576 write (iunit) this%xorigin
577 write (iunit) this%yorigin
578 write (iunit) this%angrot
579 write (iunit) this%delr
580 write (iunit) this%delc
581 write (iunit) this%botm
582 write (iunit) this%con%iausr
583 write (iunit) this%con%jausr
584 write (iunit) this%idomain
585 write (iunit) icelltype
597 integer(I4B),
intent(in) :: nodeu
598 character(len=*),
intent(inout) :: str
600 integer(I4B) :: i, j, k
601 character(len=10) :: istr, jstr
603 call get_ijk(nodeu, this%nrow, this%ncol, 1, i, j, k)
604 write (istr,
'(i10)') i
605 write (jstr,
'(i10)') j
606 str =
'('//trim(adjustl(istr))//
','// &
607 trim(adjustl(jstr))//
')'
616 integer(I4B),
intent(in) :: nodeu
617 integer(I4B),
dimension(:),
intent(inout) :: arr
619 integer(I4B) :: isize
620 integer(I4B) :: i, j, k
624 if (isize /= this%ndim)
then
625 write (
errmsg,
'(a,i0,a,i0,a)') &
626 'Program error: nodeu_to_array size of array (', isize, &
627 ') is not equal to the discretization dimension (', this%ndim,
')'
632 call get_ijk(nodeu, this%nrow, this%ncol, 1, i, j, k)
644 integer(I4B) :: nodenumber
647 integer(I4B),
intent(in) :: nodeu
648 integer(I4B),
intent(in) :: icheck
651 if (icheck /= 0)
then
654 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
655 write (
errmsg,
'(a,i0,a)') &
656 'Node number (', nodeu, &
657 ') less than 1 or greater than the number of nodes.'
662 if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
666 if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
675 integer(I4B) :: nodenumber
678 integer(I4B),
intent(in) :: k, j
679 integer(I4B),
intent(in) :: icheck
681 integer(I4B) :: nodeu, i
683 character(len=*),
parameter :: fmterr = &
684 "('Error in structured-grid cell indices: row = ',i0,&
688 nodeu =
get_node(1, i, j, 1, this%nrow, this%ncol)
690 write (
errmsg, fmterr) i, j
694 if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
697 if (icheck /= 0)
then
699 if (i < 1 .or. i > this%nrow) &
700 call store_error(
'Row less than one or greater than nrow')
701 if (j < 1 .or. j > this%ncol) &
702 call store_error(
'Column less than one or greater than ncol')
705 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
706 write (
errmsg,
'(a,i0,a)') &
707 'Node number (', nodeu,
')less than 1 or greater than nodes.'
719 character(len=*),
intent(in) :: name_model
720 character(len=*),
intent(in) :: input_mempath
723 call this%DisBaseType%allocate_scalars(name_model, input_mempath)
743 call this%DisBaseType%allocate_arrays()
746 if (this%nodes < this%nodesuser)
then
747 call mem_allocate(this%nodeuser, this%nodes,
'NODEUSER', this%memoryPath)
748 call mem_allocate(this%nodereduced, this%nodesuser,
'NODEREDUCED', &
751 call mem_allocate(this%nodeuser, 1,
'NODEUSER', this%memoryPath)
752 call mem_allocate(this%nodereduced, 1,
'NODEREDUCED', this%memoryPath)
756 this%mshape(1) = this%nrow
757 this%mshape(2) = this%ncol
768 flag_string, allow_zero)
result(nodeu)
771 integer(I4B),
intent(inout) :: lloc
772 integer(I4B),
intent(inout) :: istart
773 integer(I4B),
intent(inout) :: istop
774 integer(I4B),
intent(in) :: in
775 integer(I4B),
intent(in) :: iout
776 character(len=*),
intent(inout) :: line
777 logical,
optional,
intent(in) :: flag_string
778 logical,
optional,
intent(in) :: allow_zero
779 integer(I4B) :: nodeu
781 integer(I4B) :: i, j, nrow, ncol
782 integer(I4B) :: lloclocal, ndum, istat, n
785 if (
present(flag_string))
then
786 if (flag_string)
then
789 call urword(line, lloclocal, istart, istop, 1, ndum, r, iout, in)
790 read (line(istart:istop), *, iostat=istat) n
799 nrow = this%mshape(1)
800 ncol = this%mshape(2)
802 call urword(line, lloc, istart, istop, 2, i, r, iout, in)
803 call urword(line, lloc, istart, istop, 2, j, r, iout, in)
805 if (i == 0 .and. j == 0)
then
806 if (
present(allow_zero))
then
816 if (i < 1 .or. i > nrow)
then
817 write (
errmsg,
'(a,1x,a,i0,a)') &
818 trim(adjustl(
errmsg)),
'Row number in list (', i, &
819 ') is outside of the grid.'
821 if (j < 1 .or. j > ncol)
then
822 write (
errmsg,
'(a,1x,a,i0,a)') &
823 trim(adjustl(
errmsg)),
'Column number in list (', j, &
824 ') is outside of the grid.'
827 nodeu =
get_node(1, i, j, 1, nrow, ncol)
829 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
830 write (
errmsg,
'(a,1x,a,i0,a)') &
832 "Node number in list (", nodeu,
") is outside of the grid. "// &
833 "Cell number cannot be determined in line '"// &
834 trim(adjustl(line))//
"'."
837 if (len_trim(adjustl(
errmsg)) > 0)
then
853 allow_zero)
result(nodeu)
855 integer(I4B) :: nodeu
858 character(len=*),
intent(inout) :: cellid
859 integer(I4B),
intent(in) :: inunit
860 integer(I4B),
intent(in) :: iout
861 logical,
optional,
intent(in) :: flag_string
862 logical,
optional,
intent(in) :: allow_zero
864 integer(I4B) :: lloclocal, istart, istop, ndum, n
865 integer(I4B) :: i, j, nrow, ncol
866 integer(I4B) :: istat
869 if (
present(flag_string))
then
870 if (flag_string)
then
873 call urword(cellid, lloclocal, istart, istop, 1, ndum, r, iout, inunit)
874 read (cellid(istart:istop), *, iostat=istat) n
883 nrow = this%mshape(1)
884 ncol = this%mshape(2)
887 call urword(cellid, lloclocal, istart, istop, 2, i, r, iout, inunit)
888 call urword(cellid, lloclocal, istart, istop, 2, j, r, iout, inunit)
890 if (i == 0 .and. j == 0)
then
891 if (
present(allow_zero))
then
901 if (i < 1 .or. i > nrow)
then
902 write (
errmsg,
'(a,1x,a,i0,a)') &
903 trim(adjustl(
errmsg)),
'Row number in list (', i, &
904 ') is outside of the grid.'
906 if (j < 1 .or. j > ncol)
then
907 write (
errmsg,
'(a,1x,a,i0,a)') &
908 trim(adjustl(
errmsg)),
'Column number in list (', j, &
909 ') is outside of the grid.'
912 nodeu =
get_node(1, i, j, 1, nrow, ncol)
914 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
915 write (
errmsg,
'(a,1x,a,i0,a)') &
917 "Cell number cannot be determined for cellid ("// &
918 trim(adjustl(cellid))//
") and results in a user "// &
919 "node number (", nodeu,
") that is outside of the grid."
922 if (len_trim(adjustl(
errmsg)) > 0)
then
955 integer(I4B),
intent(in) :: noden
956 integer(I4B),
intent(in) :: nodem
957 integer(I4B),
intent(in) :: ihc
958 real(DP),
intent(inout) :: xcomp
959 real(DP),
intent(inout) :: ycomp
960 real(DP),
intent(inout) :: zcomp
961 integer(I4B),
intent(in) :: ipos
963 integer(I4B) :: nodeu1, i1, j1, k1
964 integer(I4B) :: nodeu2, i2, j2, k2
970 if (nodem < noden)
then
983 nodeu1 = this%get_nodeuser(noden)
984 nodeu2 = this%get_nodeuser(nodem)
985 call get_ijk(nodeu1, this%nrow, this%ncol, 1, i1, j1, k1)
986 call get_ijk(nodeu2, this%nrow, this%ncol, 1, i2, j2, k2)
989 elseif (j2 < j1)
then
991 elseif (j2 > j1)
then
1005 xcomp, ycomp, zcomp, conlen)
1010 integer(I4B),
intent(in) :: noden
1011 integer(I4B),
intent(in) :: nodem
1012 logical,
intent(in) :: nozee
1013 real(DP),
intent(in) :: satn
1014 real(DP),
intent(in) :: satm
1015 integer(I4B),
intent(in) :: ihc
1016 real(DP),
intent(inout) :: xcomp
1017 real(DP),
intent(inout) :: ycomp
1018 real(DP),
intent(inout) :: zcomp
1019 real(DP),
intent(inout) :: conlen
1022 real(DP) :: x1, y1, x2, y2
1024 integer(I4B) :: i1, i2, j1, j2, k1, k2
1025 integer(I4B) :: nodeu1, nodeu2, ipos
1030 ipos = this%con%getjaindex(noden, nodem)
1031 ds = this%con%cl1(this%con%jas(ipos)) + this%con%cl2(this%con%jas(ipos))
1032 nodeu1 = this%get_nodeuser(noden)
1033 nodeu2 = this%get_nodeuser(nodem)
1034 call get_ijk(nodeu1, this%nrow, this%ncol, 1, i1, j1, k1)
1035 call get_ijk(nodeu2, this%nrow, this%ncol, 1, i2, j2, k2)
1042 elseif (j2 < j1)
then
1044 elseif (j2 > j1)
then
1057 character(len=*),
intent(out) :: dis_type
1067 integer(I4B) :: dis_enum
1078 integer(I4B),
intent(in) :: ic
1079 real(DP),
allocatable,
intent(out) :: polyverts(:, :)
1080 logical(LGP),
intent(in),
optional :: closed
1082 integer(I4B) :: icu, nverts, irow, jcol, klay
1083 real(DP) :: cellx, celly, dxhalf, dyhalf
1084 logical(LGP) :: lclosed
1089 if (.not. (
present(closed)))
then
1097 allocate (polyverts(2, nverts + 1))
1099 allocate (polyverts(2, nverts))
1103 icu = this%get_nodeuser(ic)
1104 call get_ijk(icu, this%nrow, this%ncol, 1, irow, jcol, klay)
1105 cellx = this%cellx(jcol)
1106 celly = this%celly(irow)
1107 dxhalf =
dhalf * this%delr(jcol)
1108 dyhalf =
dhalf * this%delc(irow)
1109 polyverts(:, 1) = (/cellx - dxhalf, celly - dyhalf/)
1110 polyverts(:, 2) = (/cellx - dxhalf, celly + dyhalf/)
1111 polyverts(:, 3) = (/cellx + dxhalf, celly + dyhalf/)
1112 polyverts(:, 4) = (/cellx + dxhalf, celly - dyhalf/)
1116 polyverts(:, nverts + 1) = polyverts(:, 1)
1126 character(len=*),
intent(inout) :: line
1127 integer(I4B),
intent(inout) :: lloc
1128 integer(I4B),
intent(inout) :: istart
1129 integer(I4B),
intent(inout) :: istop
1130 integer(I4B),
intent(in) :: in
1131 integer(I4B),
intent(in) :: iout
1132 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: iarray
1133 character(len=*),
intent(in) :: aname
1145 character(len=*),
intent(inout) :: line
1146 integer(I4B),
intent(inout) :: lloc
1147 integer(I4B),
intent(inout) :: istart
1148 integer(I4B),
intent(inout) :: istop
1149 integer(I4B),
intent(in) :: in
1150 integer(I4B),
intent(in) :: iout
1151 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: darray
1152 character(len=*),
intent(in) :: aname
1162 icolbnd, aname, inunit, iout)
1165 integer(I4B),
intent(in) :: maxbnd
1166 integer(I4B),
dimension(maxbnd) :: nodelist
1167 integer(I4B),
intent(in) :: ncolbnd
1168 real(DP),
dimension(ncolbnd, maxbnd),
intent(inout) :: darray
1169 integer(I4B),
intent(in) :: icolbnd
1170 character(len=*),
intent(in) :: aname
1171 integer(I4B),
intent(in) :: inunit
1172 integer(I4B),
intent(in) :: iout
1182 cdatafmp, nvaluesp, nwidthp, editdesc, dinact)
1185 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: darray
1186 integer(I4B),
intent(in) :: iout
1187 integer(I4B),
intent(in) :: iprint
1188 integer(I4B),
intent(in) :: idataun
1189 character(len=*),
intent(in) :: aname
1190 character(len=*),
intent(in) :: cdatafmp
1191 integer(I4B),
intent(in) :: nvaluesp
1192 integer(I4B),
intent(in) :: nwidthp
1193 character(len=*),
intent(in) :: editdesc
1194 real(DP),
intent(in) :: dinact
1196 integer(I4B) :: k, ifirst
1197 integer(I4B) :: nlay
1198 integer(I4B) :: nrow
1199 integer(I4B) :: ncol
1200 integer(I4B) :: nval
1201 integer(I4B) :: nodeu, noder
1202 integer(I4B) :: istart, istop
1203 real(DP),
dimension(:),
pointer,
contiguous :: dtemp
1205 character(len=*),
parameter :: fmthsv = &
1206 "(1X,/1X,a,' WILL BE SAVED ON UNIT ',I4, &
1207 &' AT END OF TIME STEP',I5,', STRESS PERIOD ',I4)"
1211 nrow = this%mshape(1)
1212 ncol = this%mshape(2)
1216 if (this%nodes < this%nodesuser)
then
1219 do nodeu = 1, this%nodesuser
1220 noder = this%get_nodenumber(nodeu, 0)
1221 if (noder <= 0)
then
1222 dtemp(nodeu) = dinact
1225 dtemp(nodeu) = darray(noder)
1233 if (iprint /= 0)
then
1236 istop = istart + nrow * ncol - 1
1238 aname, cdatafmp, nvaluesp, nwidthp, editdesc)
1244 if (idataun > 0)
then
1249 istop = istart + nrow * ncol - 1
1250 if (ifirst == 1)
write (iout, fmthsv) &
1251 trim(adjustl(aname)), idataun, &
1258 elseif (idataun < 0)
then
1261 call ubdsv1(
kstp,
kper, aname, -idataun, dtemp, ncol, nrow, nlay, &
1270 dstmodel, dstpackage, naux, auxtxt, &
1271 ibdchn, nlist, iout)
1274 character(len=16),
intent(in) :: text
1275 character(len=16),
intent(in) :: textmodel
1276 character(len=16),
intent(in) :: textpackage
1277 character(len=16),
intent(in) :: dstmodel
1278 character(len=16),
intent(in) :: dstpackage
1279 integer(I4B),
intent(in) :: naux
1280 character(len=16),
dimension(:),
intent(in) :: auxtxt
1281 integer(I4B),
intent(in) :: ibdchn
1282 integer(I4B),
intent(in) :: nlist
1283 integer(I4B),
intent(in) :: iout
1285 integer(I4B) :: nlay, nrow, ncol
1288 nrow = this%mshape(1)
1289 ncol = this%mshape(2)
1292 call ubdsv06(
kstp,
kper, text, textmodel, textpackage, dstmodel, dstpackage, &
1293 ibdchn, naux, auxtxt, ncol, nrow, nlay, &
1303 integer(I4B),
intent(in) :: maxbnd
1304 integer(I4B),
dimension(:),
pointer,
contiguous :: darray
1305 integer(I4B),
dimension(maxbnd),
intent(inout) :: nodelist
1306 integer(I4B),
intent(inout) :: nbound
1307 character(len=*),
intent(in) :: aname
1309 integer(I4B) :: il, ir, ic, ncol, nrow, nlay, nval, nodeu, noder, ipos, ierr
1313 nrow = this%mshape(1)
1314 ncol = this%mshape(2)
1316 if (this%ndim > 1)
then
1325 nodeu =
get_node(1, ir, ic, nlay, nrow, ncol)
1327 if (il < 1 .or. il > nlay)
then
1328 write (
errmsg,
'(a,1x,i0)')
'Invalid layer number:', il
1331 nodeu =
get_node(il, ir, ic, nlay, nrow, ncol)
1332 noder = this%get_nodenumber(nodeu, 0)
1333 if (ipos > maxbnd)
then
1336 nodelist(ipos) = noder
1345 write (
errmsg,
'(a,1x,i0)') &
1346 'MAXBOUND dimension is too small.'// &
1347 'INCREASE MAXBOUND TO:', ierr
1352 if (nbound < maxbnd)
then
1353 do ipos = nbound + 1, maxbnd
1362 do noder = 1, maxbnd
1363 if (noder < 1 .or. noder > this%nodes)
then
1364 write (
errmsg,
'(a,1x,i0)')
'Invalid node number:', noder
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ dis2d
DIS2D6 discretization.
integer(i4b), parameter lenvarname
maximum length of a variable name
real(dp), parameter dhalf
real constant 1/2
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter done
real constant 1
subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, icolbnd, aname, inunit, iout)
Read a 2d double array into col icolbnd of darray.
subroutine read_int_array(this, line, lloc, istart, istop, iout, in, iarray, aname)
Read an integer array.
integer(i4b) function get_nodenumber_idx2(this, k, j, icheck)
Get reduced node number from layer, row and column indices.
subroutine log_options(this, found)
Write user options to list file.
subroutine, public dis2d_cr(dis, name_model, input_mempath, inunit, iout)
Create a new structured discretization object.
subroutine nodeu_to_string(this, nodeu, str)
Convert a user nodenumber to a string (nodenumber) or (k,i,j)
subroutine record_srcdst_list_header(this, text, textmodel, textpackage, dstmodel, dstpackage, naux, auxtxt, ibdchn, nlist, iout)
Record list header for imeth=6.
subroutine get_dis_type(this, dis_type)
Get the discretization type.
integer(i4b) function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, allow_zero)
Convert a cellid string to a user nodenumber.
integer(i4b) function get_dis_enum(this)
Get the discretization type enumeration.
subroutine dis3d_da(this)
Deallocate variables.
subroutine nodeu_to_array(this, nodeu, arr)
Convert a user nodenumber to an array (nodenumber) or (i,j)
subroutine connection_vector(this, noden, nodem, nozee, satn, satm, ihc, xcomp, ycomp, zcomp, conlen)
Get unit vector components between the cell and a given neighbor.
subroutine read_dbl_array(this, line, lloc, istart, istop, iout, in, darray, aname)
Read a double precision array.
subroutine source_options(this)
Copy options from IDM into package.
subroutine log_griddata(this, found)
Write dimensions to list file.
integer(i4b) function get_ncpl(this)
Return number of cells per layer (nrow * ncol)
subroutine record_array(this, darray, iout, iprint, idataun, aname, cdatafmp, nvaluesp, nwidthp, editdesc, dinact)
Record a double precision array.
subroutine allocate_scalars(this, name_model, input_mempath)
Allocate and initialize scalar variables.
subroutine grid_finalize(this)
Finalize grid (check properties, allocate arrays, compute connections)
logical function supports_layers(this)
Indicates whether the grid discretization supports layers.
subroutine log_dimensions(this, found)
Write dimensions to list file.
subroutine allocate_arrays(this)
Allocate and initialize arrays.
integer(i4b) function get_nodenumber_idx1(this, nodeu, icheck)
Get reduced node number from user node number.
subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, ipos)
Get normal vector components between the cell and a given neighbor.
integer(i4b) function nodeu_from_string(this, lloc, istart, istop, in, iout, line, flag_string, allow_zero)
Convert a string to a user nodenumber.
subroutine source_dimensions(this)
Copy dimensions from IDM into package.
subroutine source_griddata(this)
Copy grid data from IDM into package.
subroutine nlarray_to_nodelist(this, darray, nodelist, maxbnd, nbound, aname)
Convert an integer array (layer numbers) to nodelist.
subroutine write_grb(this, icelltype)
Write a binary grid file.
subroutine get_polyverts(this, ic, polyverts, closed)
Get a 2D array of polygon vertices, listed in.
subroutine dis3d_df(this)
Define the discretization.
subroutine, public line_unit_vector(x0, y0, z0, x1, y1, z1, xcomp, ycomp, zcomp, vmag)
Calculate the vector components (xcomp, ycomp, and zcomp) for a line defined by two points,...
integer(i4b) function, public get_node(ilay, irow, icol, nlay, nrow, ncol)
Get node number, given layer, row, and column indices for a structured grid. If any argument is inval...
subroutine, public get_ijk(nodenumber, nrow, ncol, nlay, irow, icol, ilay)
Get row, column and layer indices from node number and grid dimensions. If nodenumber is invalid,...
This module defines variable data types.
subroutine, public memorylist_remove(component, subcomponent, context)
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.
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
real(dp), pointer, public pertim
time relative to start of stress period
real(dp), pointer, public totim
time relative to start of simulation
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
Structured grid discretization.
Simplifies tracking parameters sourced from the input context.