25 integer(I4B),
pointer :: nvert => null()
26 real(dp),
dimension(:, :),
pointer,
contiguous :: vertices => null()
27 real(dp),
dimension(:, :),
pointer,
contiguous :: cellxy => null()
28 integer(I4B),
dimension(:),
pointer,
contiguous :: iavert => null()
29 integer(I4B),
dimension(:),
pointer,
contiguous :: javert => null()
30 real(dp),
dimension(:),
pointer,
contiguous :: bottom => null()
31 integer(I4B),
dimension(:),
pointer,
contiguous :: idomain => null()
71 logical :: length_units = .false.
72 logical :: nogrb = .false.
73 logical :: xorigin = .false.
74 logical :: yorigin = .false.
75 logical :: angrot = .false.
76 logical :: nodes = .false.
77 logical :: nvert = .false.
78 logical :: bottom = .false.
79 logical :: idomain = .false.
80 logical :: iv = .false.
81 logical :: xv = .false.
82 logical :: yv = .false.
83 logical :: icell2d = .false.
84 logical :: xc = .false.
85 logical :: yc = .false.
86 logical :: ncvert = .false.
87 logical :: icvert = .false.
94 subroutine disv2d_cr(dis, name_model, input_mempath, inunit, iout)
97 character(len=*),
intent(in) :: name_model
98 character(len=*),
intent(in) :: input_mempath
99 integer(I4B),
intent(in) :: inunit
100 integer(I4B),
intent(in) :: iout
104 character(len=*),
parameter :: fmtheader = &
105 "(1X, /1X, 'DISV -- VERTEX GRID DISCRETIZATION PACKAGE,', &
106 &' VERSION 1 : 12/23/2015 - INPUT READ FROM MEMPATH: ', A, //)"
110 call disnew%allocate_scalars(name_model, input_mempath)
119 write (iout, fmtheader) dis%input_mempath
123 call disnew%disv2d_load()
135 call this%source_options()
136 call this%source_dimensions()
137 call this%source_griddata()
138 call this%source_vertices()
139 call this%source_cell2d()
149 call this%grid_finalize()
181 call this%DisBaseType%dis_da()
219 character(len=LENVARNAME),
dimension(3) :: lenunits = &
220 &[character(len=LENVARNAME) ::
'FEET',
'METERS',
'CENTIMETERS']
224 call mem_set_value(this%lenuni,
'LENGTH_UNITS', this%input_mempath, &
225 lenunits, found%length_units)
226 call mem_set_value(this%nogrb,
'NOGRB', this%input_mempath, found%nogrb)
227 call mem_set_value(this%xorigin,
'XORIGIN', this%input_mempath, found%xorigin)
228 call mem_set_value(this%yorigin,
'YORIGIN', this%input_mempath, found%yorigin)
229 call mem_set_value(this%angrot,
'ANGROT', this%input_mempath, found%angrot)
232 if (this%iout > 0)
then
233 call this%log_options(found)
245 write (this%iout,
'(1x,a)')
'Setting Discretization Options'
247 if (found%length_units)
then
248 write (this%iout,
'(4x,a,i0)')
'Model length unit [0=UND, 1=FEET, &
249 &2=METERS, 3=CENTIMETERS] set as ', this%lenuni
252 if (found%nogrb)
then
253 write (this%iout,
'(4x,a,i0)')
'Binary grid file [0=GRB, 1=NOGRB] &
254 &set as ', this%nogrb
257 if (found%xorigin)
then
258 write (this%iout,
'(4x,a,G0)')
'XORIGIN = ', this%xorigin
261 if (found%yorigin)
then
262 write (this%iout,
'(4x,a,G0)')
'YORIGIN = ', this%yorigin
265 if (found%angrot)
then
266 write (this%iout,
'(4x,a,G0)')
'ANGROT = ', this%angrot
269 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Options'
283 call mem_set_value(this%nodes,
'NODES', this%input_mempath, found%nodes)
284 call mem_set_value(this%nvert,
'NVERT', this%input_mempath, found%nvert)
287 if (this%iout > 0)
then
288 call this%log_dimensions(found)
292 if (this%nodes < 1)
then
294 'NODES was not specified or was specified incorrectly.')
297 if (this%nvert < 1)
then
299 'NVERT was not specified or was specified incorrectly.')
304 this%nodesuser = this%nodes
307 call mem_allocate(this%idomain, this%nodes,
'IDOMAIN', &
313 call mem_allocate(this%vertices, 2, this%nvert,
'VERTICES', this%memoryPath)
314 call mem_allocate(this%cellxy, 2, this%nodesuser,
'CELLXY', this%memoryPath)
317 do j = 1, this%nodesuser
330 write (this%iout,
'(1x,a)')
'Setting Discretization Dimensions'
332 if (found%nodes)
then
333 write (this%iout,
'(4x,a,i0)')
'NODES = ', this%nodesuser
336 if (found%nvert)
then
337 write (this%iout,
'(4x,a,i0)')
'NVERT = ', this%nvert
340 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Dimensions'
353 call mem_set_value(this%bottom,
'BOTTOM', this%input_mempath, found%bottom)
354 call mem_set_value(this%idomain,
'IDOMAIN', this%input_mempath, found%idomain)
357 if (this%iout > 0)
then
358 call this%log_griddata(found)
370 write (this%iout,
'(1x,a)')
'Setting Discretization Griddata'
372 if (found%bottom)
then
373 write (this%iout,
'(4x,a)')
'BOTTOM set from input file'
376 if (found%idomain)
then
377 write (this%iout,
'(4x,a)')
'IDOMAIN set from input file'
380 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Griddata'
390 integer(I4B) :: node, noder, j, ncell_count
392 character(len=*),
parameter :: fmtnr = &
393 "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',&
394 &/1x, 'Number of user nodes: ',I0,&
395 &/1X, 'Number of nodes in solution: ', I0, //)"
399 do j = 1, this%nodesuser
400 if (this%idomain(j) > 0) ncell_count = ncell_count + 1
402 this%nodes = ncell_count
405 if (ncell_count == 0)
then
406 call store_error(
'Model does not have any active nodes. &
407 &Ensure IDOMAIN array has some values greater &
413 if (this%nodes < this%nodesuser)
then
414 write (this%iout, fmtnr) this%nodesuser, this%nodes
418 call this%allocate_arrays()
424 if (this%nodes < this%nodesuser)
then
427 do j = 1, this%nodesuser
428 if (this%idomain(j) > 0)
then
429 this%nodereduced(node) = noder
432 this%nodereduced(node) = 0
439 if (this%nodes < this%nodesuser)
then
442 do j = 1, this%nodesuser
443 if (this%idomain(j) > 0)
then
444 this%nodeuser(noder) = node
454 do j = 1, this%nodesuser
457 if (this%nodes < this%nodesuser) noder = this%nodereduced(node)
458 if (noder <= 0) cycle
459 this%bot(noder) = this%bottom(j)
460 this%xc(noder) = this%cellxy(1, j)
461 this%yc(noder) = this%cellxy(2, j)
476 real(DP),
dimension(:),
contiguous,
pointer :: vert_x => null()
477 real(DP),
dimension(:),
contiguous,
pointer :: vert_y => null()
480 call mem_setptr(vert_x,
'XV', this%input_mempath)
481 call mem_setptr(vert_y,
'YV', this%input_mempath)
484 if (
associated(vert_x) .and.
associated(vert_y))
then
486 this%vertices(1, i) = vert_x(i)
487 this%vertices(2, i) = vert_y(i)
490 call store_error(
'Required Vertex arrays not found.')
494 if (this%iout > 0)
then
495 write (this%iout,
'(1x,a)')
'Discretization Vertex data loaded'
507 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: icell2d
508 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: ncvert
509 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: icvert
512 integer(I4B) :: i, j, ierr
513 integer(I4B) :: icv_idx, startvert, maxnnz = 5
516 call vert_spm%init(this%nodes, this%nvert, maxnnz)
521 if (icell2d(i) /= i)
call store_error(
'ICELL2D input sequence violation.')
523 call vert_spm%addconnection(i, icvert(icv_idx), 0)
525 startvert = icvert(icv_idx)
526 elseif (j == ncvert(i) .and. (icvert(icv_idx) /= startvert))
then
527 call vert_spm%addconnection(i, startvert, 0)
529 icv_idx = icv_idx + 1
534 call mem_allocate(this%iavert, this%nodes + 1,
'IAVERT', this%memoryPath)
535 call mem_allocate(this%javert, vert_spm%nnz,
'JAVERT', this%memoryPath)
536 call vert_spm%filliaja(this%iavert, this%javert, ierr)
537 call vert_spm%destroy()
547 integer(I4B),
dimension(:),
contiguous,
pointer :: icell2d => null()
548 integer(I4B),
dimension(:),
contiguous,
pointer :: ncvert => null()
549 integer(I4B),
dimension(:),
contiguous,
pointer :: icvert => null()
550 real(DP),
dimension(:),
contiguous,
pointer :: cell_x => null()
551 real(DP),
dimension(:),
contiguous,
pointer :: cell_y => null()
555 call mem_setptr(icell2d,
'ICELL2D', this%input_mempath)
556 call mem_setptr(ncvert,
'NCVERT', this%input_mempath)
557 call mem_setptr(icvert,
'ICVERT', this%input_mempath)
560 if (
associated(icell2d) .and.
associated(ncvert) &
561 .and.
associated(icvert))
then
562 call this%define_cellverts(icell2d, ncvert, icvert)
564 call store_error(
'Required cell vertex array(s) [ICELL2D, NCVERT, ICVERT] &
569 call mem_setptr(cell_x,
'XC', this%input_mempath)
570 call mem_setptr(cell_y,
'YC', this%input_mempath)
573 if (
associated(cell_x) .and.
associated(cell_y))
then
574 do i = 1, this%nodesuser
575 this%cellxy(1, i) = cell_x(i)
576 this%cellxy(2, i) = cell_y(i)
579 call store_error(
'Required cell center arrays not found.')
583 if (this%iout > 0)
then
584 write (this%iout,
'(1x,a)')
'Discretization Cell2d data loaded'
596 integer(I4B) :: noder, nrsize
597 integer(I4B) :: narea_eq_zero
598 integer(I4B) :: narea_lt_zero
606 do j = 1, this%nodesuser
607 area = this%get_cell2d_area(j)
608 noder = this%get_nodenumber(j, 0)
609 if (noder > 0) this%area(noder) = area
610 if (area <
dzero)
then
611 narea_lt_zero = narea_lt_zero + 1
612 write (
errmsg,
'(a,i0,a)') &
613 &
'Calculated CELL2D area less than zero for cell ', j,
'.'
616 if (area ==
dzero)
then
617 narea_eq_zero = narea_eq_zero + 1
618 write (
errmsg,
'(a,i0,a)') &
619 'Calculated CELL2D area is zero for cell ', j,
'.'
626 if (narea_lt_zero > 0)
then
627 write (
errmsg,
'(i0,a)') narea_lt_zero, &
628 ' cell(s) have an area less than zero. Calculated cell &
629 &areas must be greater than zero. Negative areas often &
630 &mean vertices are not listed in clockwise order.'
633 if (narea_eq_zero > 0)
then
634 write (
errmsg,
'(i0,a)') narea_eq_zero, &
635 ' cell(s) have an area equal to zero. Calculated cell &
636 &areas must be greater than zero. Calculated cell &
637 &areas equal to zero indicate that the cell is not defined &
638 &by a valid polygon.'
646 if (this%nodes < this%nodesuser) nrsize = this%nodes
648 call this%con%disvconnections(this%name_model, this%nodes, &
649 this%nodesuser, 1, nrsize, &
650 this%nvert, this%vertices, this%iavert, &
651 this%javert, this%cellxy, &
652 this%bot, this%bot, &
653 this%nodereduced, this%nodeuser)
654 this%nja = this%con%nja
655 this%njas = this%con%njas
666 integer(I4B),
dimension(:),
intent(in) :: icelltype
668 integer(I4B) :: iunit, i, ntxt
669 integer(I4B),
parameter :: lentxt = 100
670 character(len=50) :: txthdr
671 character(len=lentxt) :: txt
672 character(len=LINELENGTH) :: fname
674 character(len=*),
parameter :: fmtgrdsave = &
675 "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', &
676 &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)"
682 fname = trim(this%input_fname)//
'.grb'
684 write (this%iout, fmtgrdsave) iunit, trim(adjustl(fname))
685 call openfile(iunit, this%iout, trim(adjustl(fname)),
'DATA(BINARY)', &
689 write (txthdr,
'(a)')
'GRID DISV2D'
690 txthdr(50:50) = new_line(
'a')
692 write (txthdr,
'(a)')
'VERSION 1'
693 txthdr(50:50) = new_line(
'a')
695 write (txthdr,
'(a, i0)')
'NTXT ', ntxt
696 txthdr(50:50) = new_line(
'a')
698 write (txthdr,
'(a, i0)')
'LENTXT ', lentxt
699 txthdr(50:50) = new_line(
'a')
703 write (txt,
'(3a, i0)')
'NCELLS ',
'INTEGER ',
'NDIM 0 # ', this%nodesuser
704 txt(lentxt:lentxt) = new_line(
'a')
706 write (txt,
'(3a, i0)')
'NODES ',
'INTEGER ',
'NDIM 0 # ', this%nodes
707 txt(lentxt:lentxt) = new_line(
'a')
709 write (txt,
'(3a, i0)')
'NVERT ',
'INTEGER ',
'NDIM 0 # ', this%nvert
710 txt(lentxt:lentxt) = new_line(
'a')
712 write (txt,
'(3a, i0)')
'NJAVERT ',
'INTEGER ',
'NDIM 0 # ',
size(this%javert)
713 txt(lentxt:lentxt) = new_line(
'a')
715 write (txt,
'(3a, i0)')
'NJA ',
'INTEGER ',
'NDIM 0 # ', this%con%nja
716 txt(lentxt:lentxt) = new_line(
'a')
718 write (txt,
'(3a, 1pg25.15e3)') &
719 'XORIGIN ',
'DOUBLE ',
'NDIM 0 # ', this%xorigin
720 txt(lentxt:lentxt) = new_line(
'a')
722 write (txt,
'(3a, 1pg25.15e3)') &
723 'YORIGIN ',
'DOUBLE ',
'NDIM 0 # ', this%yorigin
724 txt(lentxt:lentxt) = new_line(
'a')
726 write (txt,
'(3a, 1pg25.15e3)')
'ANGROT ',
'DOUBLE ',
'NDIM 0 # ', this%angrot
727 txt(lentxt:lentxt) = new_line(
'a')
729 write (txt,
'(3a, i0)')
'BOTM ',
'DOUBLE ',
'NDIM 1 ', this%nodesuser
730 txt(lentxt:lentxt) = new_line(
'a')
732 write (txt,
'(3a, i0)')
'VERTICES ',
'DOUBLE ',
'NDIM 2 2 ', this%nvert
733 txt(lentxt:lentxt) = new_line(
'a')
735 write (txt,
'(3a, i0)')
'CELLX ',
'DOUBLE ',
'NDIM 1 ', this%nodesuser
736 txt(lentxt:lentxt) = new_line(
'a')
738 write (txt,
'(3a, i0)')
'CELLY ',
'DOUBLE ',
'NDIM 1 ', this%nodesuser
739 txt(lentxt:lentxt) = new_line(
'a')
741 write (txt,
'(3a, i0)')
'IAVERT ',
'INTEGER ',
'NDIM 1 ', this%nodesuser + 1
742 txt(lentxt:lentxt) = new_line(
'a')
744 write (txt,
'(3a, i0)')
'JAVERT ',
'INTEGER ',
'NDIM 1 ',
size(this%javert)
745 txt(lentxt:lentxt) = new_line(
'a')
747 write (txt,
'(3a, i0)')
'IA ',
'INTEGER ',
'NDIM 1 ', this%nodesuser + 1
748 txt(lentxt:lentxt) = new_line(
'a')
750 write (txt,
'(3a, i0)')
'JA ',
'INTEGER ',
'NDIM 1 ',
size(this%con%jausr)
751 txt(lentxt:lentxt) = new_line(
'a')
753 write (txt,
'(3a, i0)')
'IDOMAIN ',
'INTEGER ',
'NDIM 1 ', this%nodesuser
754 txt(lentxt:lentxt) = new_line(
'a')
756 write (txt,
'(3a, i0)')
'ICELLTYPE ',
'INTEGER ',
'NDIM 1 ', this%nodesuser
757 txt(lentxt:lentxt) = new_line(
'a')
761 write (iunit) this%nodesuser
762 write (iunit) this%nodes
763 write (iunit) this%nvert
764 write (iunit)
size(this%javert)
765 write (iunit) this%nja
766 write (iunit) this%xorigin
767 write (iunit) this%yorigin
768 write (iunit) this%angrot
769 write (iunit) this%bottom
770 write (iunit) this%vertices
771 write (iunit) (this%cellxy(1, i), i=1, this%nodesuser)
772 write (iunit) (this%cellxy(2, i), i=1, this%nodesuser)
773 write (iunit) this%iavert
774 write (iunit) this%javert
775 write (iunit) this%con%iausr
776 write (iunit) this%con%jausr
777 write (iunit) this%idomain
778 write (iunit) icelltype
790 integer(I4B),
intent(in) :: nodeu
791 character(len=*),
intent(inout) :: str
793 integer(I4B) :: i, j, k
794 character(len=10) :: jstr
796 call get_ijk(nodeu, 1, this%nodes, 1, i, j, k)
797 write (jstr,
'(i10)') j
798 str =
'('//trim(adjustl(jstr))//
')'
807 integer(I4B),
intent(in) :: nodeu
808 integer(I4B),
dimension(:),
intent(inout) :: arr
810 integer(I4B) :: isize
811 integer(I4B) :: i, j, k
815 if (isize /= this%ndim)
then
816 write (
errmsg,
'(a,i0,a,i0,a)') &
817 'Program error: nodeu_to_array size of array (', isize, &
818 ') is not equal to the discretization dimension (', this%ndim,
').'
823 call get_ijk(nodeu, 1, this%nodes, 1, i, j, k)
834 integer(I4B) :: nodenumber
837 integer(I4B),
intent(in) :: nodeu
838 integer(I4B),
intent(in) :: icheck
842 if (icheck /= 0)
then
845 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
847 write (
errmsg,
'(a,i0,a,i0,a)') &
848 'Node number (', nodeu,
') is less than 1 or greater than nodes (', &
853 if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
857 if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
870 integer(I4B),
intent(in) :: noden
871 integer(I4B),
intent(in) :: nodem
872 integer(I4B),
intent(in) :: ihc
873 real(DP),
intent(inout) :: xcomp
874 real(DP),
intent(inout) :: ycomp
875 real(DP),
intent(inout) :: zcomp
876 integer(I4B),
intent(in) :: ipos
878 real(DP) :: angle, dmult
884 if (nodem < noden)
then
897 angle = this%con%anglex(this%con%jas(ipos))
899 if (nodem < noden) dmult = -
done
900 xcomp = cos(angle) * dmult
901 ycomp = sin(angle) * dmult
913 xcomp, ycomp, zcomp, conlen)
916 integer(I4B),
intent(in) :: noden
917 integer(I4B),
intent(in) :: nodem
918 logical,
intent(in) :: nozee
919 real(DP),
intent(in) :: satn
920 real(DP),
intent(in) :: satm
921 integer(I4B),
intent(in) :: ihc
922 real(DP),
intent(inout) :: xcomp
923 real(DP),
intent(inout) :: ycomp
924 real(DP),
intent(inout) :: zcomp
925 real(DP),
intent(inout) :: conlen
927 integer(I4B) :: nodeun, nodeum
928 real(DP) :: xn, xm, yn, ym, zn, zm
939 nodeun = this%get_nodeuser(noden)
940 nodeum = this%get_nodeuser(nodem)
941 xn = this%cellxy(1, nodeun)
942 yn = this%cellxy(2, nodeun)
943 xm = this%cellxy(1, nodeum)
944 ym = this%cellxy(2, nodeum)
955 character(len=*),
intent(out) :: dis_type
965 integer(I4B) :: dis_enum
974 character(len=*),
intent(in) :: name_model
975 character(len=*),
intent(in) :: input_mempath
978 call this%DisBaseType%allocate_scalars(name_model, input_mempath)
996 call this%DisBaseType%allocate_arrays()
999 if (this%nodes < this%nodesuser)
then
1000 call mem_allocate(this%nodeuser, this%nodes,
'NODEUSER', this%memoryPath)
1001 call mem_allocate(this%nodereduced, this%nodesuser,
'NODEREDUCED', &
1004 call mem_allocate(this%nodeuser, 1,
'NODEUSER', this%memoryPath)
1005 call mem_allocate(this%nodereduced, 1,
'NODEREDUCED', this%memoryPath)
1009 this%mshape(1) = this%nodesuser
1023 integer(I4B),
intent(in) :: icell2d
1027 integer(I4B) :: ivert
1028 integer(I4B) :: nvert
1029 integer(I4B) :: icount
1037 nvert = this%iavert(icell2d + 1) - this%iavert(icell2d)
1039 iv1 = this%javert(this%iavert(icell2d))
1040 x1 = this%vertices(1, iv1)
1041 y1 = this%vertices(2, iv1)
1042 do ivert = this%iavert(icell2d), this%iavert(icell2d + 1) - 1
1043 x = this%vertices(1, this%javert(ivert))
1044 if (icount < nvert)
then
1045 y = this%vertices(2, this%javert(ivert + 1))
1047 y = this%vertices(2, this%javert(this%iavert(icell2d)))
1049 area = area + (x - x1) * (y - y1)
1054 do ivert = this%iavert(icell2d), this%iavert(icell2d + 1) - 1
1055 y = this%vertices(2, this%javert(ivert))
1056 if (icount < nvert)
then
1057 x = this%vertices(1, this%javert(ivert + 1))
1059 x = this%vertices(1, this%javert(this%iavert(icell2d)))
1061 area = area - (x - x1) * (y - y1)
1076 flag_string, allow_zero)
result(nodeu)
1079 integer(I4B),
intent(inout) :: lloc
1080 integer(I4B),
intent(inout) :: istart
1081 integer(I4B),
intent(inout) :: istop
1082 integer(I4B),
intent(in) :: in
1083 integer(I4B),
intent(in) :: iout
1084 character(len=*),
intent(inout) :: line
1085 logical,
optional,
intent(in) :: flag_string
1086 logical,
optional,
intent(in) :: allow_zero
1087 integer(I4B) :: nodeu
1089 integer(I4B) :: j, nodes
1090 integer(I4B) :: lloclocal, ndum, istat, n
1093 if (
present(flag_string))
then
1094 if (flag_string)
then
1097 call urword(line, lloclocal, istart, istop, 1, ndum, r, iout, in)
1098 read (line(istart:istop), *, iostat=istat) n
1099 if (istat /= 0)
then
1107 nodes = this%mshape(1)
1109 call urword(line, lloc, istart, istop, 2, j, r, iout, in)
1112 if (
present(allow_zero))
then
1113 if (allow_zero)
then
1122 if (j < 1 .or. j > nodes)
then
1123 write (
errmsg,
'(a,1x,a,i0,a)') &
1124 trim(adjustl(
errmsg)),
'Cell number in list (', j, &
1125 ') is outside of the grid.'
1128 nodeu =
get_node(1, 1, j, 1, 1, nodes)
1130 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
1131 write (
errmsg,
'(a,1x,a,i0,a)') &
1133 "Node number in list (", nodeu,
") is outside of the grid. "// &
1134 "Cell number cannot be determined in line '"// &
1135 trim(adjustl(line))//
"'."
1138 if (len_trim(adjustl(
errmsg)) > 0)
then
1154 allow_zero)
result(nodeu)
1156 integer(I4B) :: nodeu
1159 character(len=*),
intent(inout) :: cellid
1160 integer(I4B),
intent(in) :: inunit
1161 integer(I4B),
intent(in) :: iout
1162 logical,
optional,
intent(in) :: flag_string
1163 logical,
optional,
intent(in) :: allow_zero
1165 integer(I4B) :: j, nodes
1166 integer(I4B) :: lloclocal, ndum, istat, n
1167 integer(I4B) :: istart, istop
1170 if (
present(flag_string))
then
1171 if (flag_string)
then
1174 call urword(cellid, lloclocal, istart, istop, 1, ndum, r, iout, inunit)
1175 read (cellid(istart:istop), *, iostat=istat) n
1176 if (istat /= 0)
then
1184 nodes = this%mshape(1)
1187 call urword(cellid, lloclocal, istart, istop, 2, j, r, iout, inunit)
1190 if (
present(allow_zero))
then
1191 if (allow_zero)
then
1200 if (j < 1 .or. j > nodes)
then
1201 write (
errmsg,
'(a,1x,a,i0,a)') &
1202 trim(adjustl(
errmsg)),
'Cell2d number in list (', j, &
1203 ') is outside of the grid.'
1206 nodeu =
get_node(1, 1, j, 1, 1, nodes)
1208 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
1209 write (
errmsg,
'(a,1x,a,i0,a)') &
1211 "Cell number cannot be determined for cellid ("// &
1212 trim(adjustl(cellid))//
") and results in a user "// &
1213 "node number (", nodeu,
") that is outside of the grid."
1216 if (len_trim(adjustl(
errmsg)) > 0)
then
1229 integer(I4B),
intent(in) :: ic
1230 real(DP),
allocatable,
intent(out) :: polyverts(:, :)
1231 logical(LGP),
intent(in),
optional :: closed
1233 integer(I4B) :: icu, icu2d, iavert, nverts, m, j
1234 logical(LGP) :: lclosed
1237 icu = this%get_nodeuser(ic)
1238 icu2d = icu - ((icu - 1) / this%nodes) * this%nodes
1239 nverts = this%iavert(icu2d + 1) - this%iavert(icu2d) - 1
1240 if (nverts .le. 0) nverts = nverts +
size(this%javert)
1243 if (.not. (
present(closed)))
then
1251 allocate (polyverts(2, nverts + 1))
1253 allocate (polyverts(2, nverts))
1257 iavert = this%iavert(icu2d)
1259 j = this%javert(iavert - 1 + m)
1260 polyverts(:, m) = (/this%vertices(1, j), this%vertices(2, j)/)
1265 polyverts(:, nverts + 1) = polyverts(:, 1)
1275 cdatafmp, nvaluesp, nwidthp, editdesc, dinact)
1278 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: darray
1279 integer(I4B),
intent(in) :: iout
1280 integer(I4B),
intent(in) :: iprint
1281 integer(I4B),
intent(in) :: idataun
1282 character(len=*),
intent(in) :: aname
1283 character(len=*),
intent(in) :: cdatafmp
1284 integer(I4B),
intent(in) :: nvaluesp
1285 integer(I4B),
intent(in) :: nwidthp
1286 character(len=*),
intent(in) :: editdesc
1287 real(DP),
intent(in) :: dinact
1289 integer(I4B) :: k, ifirst
1290 integer(I4B) :: nlay
1291 integer(I4B) :: nrow
1292 integer(I4B) :: ncol
1293 integer(I4B) :: nval
1294 integer(I4B) :: nodeu, noder
1295 integer(I4B) :: istart, istop
1296 real(DP),
dimension(:),
pointer,
contiguous :: dtemp
1298 character(len=*),
parameter :: fmthsv = &
1299 "(1X,/1X,a,' WILL BE SAVED ON UNIT ',I4, &
1300 &' AT END OF TIME STEP',I5,', STRESS PERIOD ',I4)"
1305 ncol = this%mshape(1)
1309 if (this%nodes < this%nodesuser)
then
1312 do nodeu = 1, this%nodesuser
1313 noder = this%get_nodenumber(nodeu, 0)
1314 if (noder <= 0)
then
1315 dtemp(nodeu) = dinact
1318 dtemp(nodeu) = darray(noder)
1326 if (iprint /= 0)
then
1329 istop = istart + nrow * ncol - 1
1331 aname, cdatafmp, nvaluesp, nwidthp, editdesc)
1337 if (idataun > 0)
then
1342 istop = istart + nrow * ncol - 1
1343 if (ifirst == 1)
write (iout, fmthsv) &
1344 trim(adjustl(aname)), idataun, &
1351 elseif (idataun < 0)
then
1354 call ubdsv1(
kstp,
kper, aname, -idataun, dtemp, ncol, nrow, nlay, &
1363 dstmodel, dstpackage, naux, auxtxt, &
1364 ibdchn, nlist, iout)
1367 character(len=16),
intent(in) :: text
1368 character(len=16),
intent(in) :: textmodel
1369 character(len=16),
intent(in) :: textpackage
1370 character(len=16),
intent(in) :: dstmodel
1371 character(len=16),
intent(in) :: dstpackage
1372 integer(I4B),
intent(in) :: naux
1373 character(len=16),
dimension(:),
intent(in) :: auxtxt
1374 integer(I4B),
intent(in) :: ibdchn
1375 integer(I4B),
intent(in) :: nlist
1376 integer(I4B),
intent(in) :: iout
1378 integer(I4B) :: nlay, nrow, ncol
1382 ncol = this%mshape(1)
1385 call ubdsv06(
kstp,
kper, text, textmodel, textpackage, dstmodel, dstpackage, &
1386 ibdchn, naux, auxtxt, ncol, nrow, nlay, &
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ disv2d
DISV2D6 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 get_dis_type(this, dis_type)
Get the discretization type.
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 log_griddata(this, found)
Write griddata found to list file.
subroutine source_vertices(this)
Load grid vertices from IDM into package.
subroutine source_griddata(this)
Copy grid data from IDM into package.
subroutine define_cellverts(this, icell2d, ncvert, icvert)
Build data structures to hold cell vertex info.
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 write_grb(this, icelltype)
Write a binary grid file.
subroutine allocate_scalars(this, name_model, input_mempath)
Allocate and initialize scalars.
subroutine nodeu_to_string(this, nodeu, str)
Convert a user nodenumber to a string (nodenumber) or (k,j)
subroutine get_polyverts(this, ic, polyverts, closed)
Get a 2D array of polygon vertices, listed in clockwise order beginning with the lower left corner.
subroutine record_array(this, darray, iout, iprint, idataun, aname, cdatafmp, nvaluesp, nwidthp, editdesc, dinact)
Record a double precision array.
subroutine connect(this)
Build grid connections.
subroutine grid_finalize(this)
Finalize grid (check properties, allocate arrays, compute connections)
subroutine log_options(this, found)
Write user options to list file.
subroutine disv2d_da(this)
subroutine allocate_arrays(this)
Allocate and initialize arrays.
subroutine source_dimensions(this)
Copy dimensions from IDM into package.
integer(i4b) function get_nodenumber_idx1(this, nodeu, icheck)
Get reduced node number from user node number.
integer(i4b) function get_dis_enum(this)
Get the discretization type enumeration.
subroutine record_srcdst_list_header(this, text, textmodel, textpackage, dstmodel, dstpackage, naux, auxtxt, ibdchn, nlist, iout)
Record list header for imeth=6.
subroutine, public disv2d_cr(dis, name_model, input_mempath, inunit, iout)
Create a new discretization by vertices object.
real(dp) function get_cell2d_area(this, icell2d)
Get the signed area of the cell.
subroutine source_options(this)
Copy options from IDM into package.
integer(i4b) function nodeu_from_cellid(this, cellid, inunit, iout, flag_string, allow_zero)
Convert a cellid string to a user nodenumber.
subroutine source_cell2d(this)
Copy cell2d data from IDM into package.
subroutine disv2d_df(this)
Define the discretization.
subroutine disv2d_load(this)
Transfer IDM data into this discretization object.
subroutine nodeu_to_array(this, nodeu, arr)
Convert a user nodenumber to an array (nodenumber) or (k,j)
subroutine connection_normal(this, noden, nodem, ihc, xcomp, ycomp, zcomp, ipos)
Get normal vector components between the cell and a given neighbor.
subroutine log_dimensions(this, found)
Write dimensions to list file.
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,...
subroutine, public get_jk(nodenumber, ncpl, nlay, icpl, ilay)
Get layer index and within-layer node index from node number and grid dimensions. If nodenumber is in...
This module defines variable data types.
subroutine, public memorystore_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
Vertex grid discretization.