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()
70 logical :: length_units = .false.
71 logical :: nogrb = .false.
72 logical :: xorigin = .false.
73 logical :: yorigin = .false.
74 logical :: angrot = .false.
75 logical :: nodes = .false.
76 logical :: nvert = .false.
77 logical :: bottom = .false.
78 logical :: idomain = .false.
79 logical :: iv = .false.
80 logical :: xv = .false.
81 logical :: yv = .false.
82 logical :: icell2d = .false.
83 logical :: xc = .false.
84 logical :: yc = .false.
85 logical :: ncvert = .false.
86 logical :: icvert = .false.
93 subroutine disv2d_cr(dis, name_model, input_mempath, inunit, iout)
96 character(len=*),
intent(in) :: name_model
97 character(len=*),
intent(in) :: input_mempath
98 integer(I4B),
intent(in) :: inunit
99 integer(I4B),
intent(in) :: iout
103 character(len=*),
parameter :: fmtheader = &
104 "(1X, /1X, 'DISV -- VERTEX GRID DISCRETIZATION PACKAGE,', &
105 &' VERSION 1 : 12/23/2015 - INPUT READ FROM MEMPATH: ', A, //)"
109 call disnew%allocate_scalars(name_model, input_mempath)
118 write (iout, fmtheader) dis%input_mempath
122 call disnew%disv2d_load()
134 call this%source_options()
135 call this%source_dimensions()
136 call this%source_griddata()
137 call this%source_vertices()
138 call this%source_cell2d()
148 call this%grid_finalize()
180 call this%DisBaseType%dis_da()
221 character(len=LENVARNAME),
dimension(3) :: lenunits = &
222 &[character(len=LENVARNAME) ::
'FEET',
'METERS',
'CENTIMETERS']
226 call mem_set_value(this%lenuni,
'LENGTH_UNITS', this%input_mempath, &
227 lenunits, found%length_units)
228 call mem_set_value(this%nogrb,
'NOGRB', this%input_mempath, found%nogrb)
229 call mem_set_value(this%xorigin,
'XORIGIN', this%input_mempath, found%xorigin)
230 call mem_set_value(this%yorigin,
'YORIGIN', this%input_mempath, found%yorigin)
231 call mem_set_value(this%angrot,
'ANGROT', this%input_mempath, found%angrot)
234 if (this%iout > 0)
then
235 call this%log_options(found)
247 write (this%iout,
'(1x,a)')
'Setting Discretization Options'
249 if (found%length_units)
then
250 write (this%iout,
'(4x,a,i0)')
'Model length unit [0=UND, 1=FEET, &
251 &2=METERS, 3=CENTIMETERS] set as ', this%lenuni
254 if (found%nogrb)
then
255 write (this%iout,
'(4x,a,i0)')
'Binary grid file [0=GRB, 1=NOGRB] &
256 &set as ', this%nogrb
259 if (found%xorigin)
then
260 write (this%iout,
'(4x,a,G0)')
'XORIGIN = ', this%xorigin
263 if (found%yorigin)
then
264 write (this%iout,
'(4x,a,G0)')
'YORIGIN = ', this%yorigin
267 if (found%angrot)
then
268 write (this%iout,
'(4x,a,G0)')
'ANGROT = ', this%angrot
271 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Options'
285 call mem_set_value(this%nodes,
'NODES', this%input_mempath, found%nodes)
286 call mem_set_value(this%nvert,
'NVERT', this%input_mempath, found%nvert)
289 if (this%iout > 0)
then
290 call this%log_dimensions(found)
294 if (this%nodes < 1)
then
296 'NODES was not specified or was specified incorrectly.')
299 if (this%nvert < 1)
then
301 'NVERT was not specified or was specified incorrectly.')
306 this%nodesuser = this%nodes
309 call mem_allocate(this%idomain, this%nodes,
'IDOMAIN', &
315 call mem_allocate(this%vertices, 2, this%nvert,
'VERTICES', this%memoryPath)
316 call mem_allocate(this%cellxy, 2, this%nodes,
'CELLXY', this%memoryPath)
332 write (this%iout,
'(1x,a)')
'Setting Discretization Dimensions'
334 if (found%nodes)
then
335 write (this%iout,
'(4x,a,i0)')
'NODES = ', this%nodes
338 if (found%nvert)
then
339 write (this%iout,
'(4x,a,i0)')
'NVERT = ', this%nvert
342 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Dimensions'
355 call mem_set_value(this%bottom,
'BOTTOM', this%input_mempath, found%bottom)
356 call mem_set_value(this%idomain,
'IDOMAIN', this%input_mempath, found%idomain)
359 if (this%iout > 0)
then
360 call this%log_griddata(found)
372 write (this%iout,
'(1x,a)')
'Setting Discretization Griddata'
374 if (found%bottom)
then
375 write (this%iout,
'(4x,a)')
'BOTTOM set from input file'
378 if (found%idomain)
then
379 write (this%iout,
'(4x,a)')
'IDOMAIN set from input file'
382 write (this%iout,
'(1x,a,/)')
'End Setting Discretization Griddata'
392 integer(I4B) :: node, noder, j, ncell_count
394 character(len=*),
parameter :: fmtnr = &
395 "(/1x, 'The specified IDOMAIN results in a reduced number of cells.',&
396 &/1x, 'Number of user nodes: ',I0,&
397 &/1X, 'Number of nodes in solution: ', I0, //)"
402 if (this%idomain(j) > 0) ncell_count = ncell_count + 1
406 if (ncell_count == 0)
then
407 call store_error(
'Model does not have any active nodes. &
408 &Ensure IDOMAIN array has some values greater &
418 call this%allocate_arrays()
424 if (this%nodes < this%nodesuser)
then
428 if (this%idomain(j) > 0)
then
429 this%nodereduced(node) = noder
432 this%nodereduced(node) = 0
439 if (this%nodes < this%nodesuser)
then
443 if (this%idomain(j) > 0)
then
444 this%nodeuser(noder) = node
452 do node = 1, this%nodesuser
453 this%bot(node) = this%bottom(node)
462 if (this%nodes < this%nodesuser) noder = this%nodereduced(node)
463 if (noder <= 0) cycle
464 this%bot(noder) = this%bottom(j)
465 this%xc(noder) = this%cellxy(1, j)
466 this%yc(noder) = this%cellxy(2, j)
481 real(DP),
dimension(:),
contiguous,
pointer :: vert_x => null()
482 real(DP),
dimension(:),
contiguous,
pointer :: vert_y => null()
485 call mem_setptr(vert_x,
'XV', this%input_mempath)
486 call mem_setptr(vert_y,
'YV', this%input_mempath)
489 if (
associated(vert_x) .and.
associated(vert_y))
then
491 this%vertices(1, i) = vert_x(i)
492 this%vertices(2, i) = vert_y(i)
495 call store_error(
'Required Vertex arrays not found.')
499 if (this%iout > 0)
then
500 write (this%iout,
'(1x,a)')
'Discretization Vertex data loaded'
512 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: icell2d
513 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: ncvert
514 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: icvert
517 integer(I4B) :: i, j, ierr
518 integer(I4B) :: icv_idx, startvert, maxnnz = 5
521 call vert_spm%init(this%nodes, this%nvert, maxnnz)
526 if (icell2d(i) /= i)
call store_error(
'ICELL2D input sequence violation.')
528 call vert_spm%addconnection(i, icvert(icv_idx), 0)
530 startvert = icvert(icv_idx)
531 elseif (j == ncvert(i) .and. (icvert(icv_idx) /= startvert))
then
532 call vert_spm%addconnection(i, startvert, 0)
534 icv_idx = icv_idx + 1
539 call mem_allocate(this%iavert, this%nodes + 1,
'IAVERT', this%memoryPath)
540 call mem_allocate(this%javert, vert_spm%nnz,
'JAVERT', this%memoryPath)
541 call vert_spm%filliaja(this%iavert, this%javert, ierr)
542 call vert_spm%destroy()
552 integer(I4B),
dimension(:),
contiguous,
pointer :: icell2d => null()
553 integer(I4B),
dimension(:),
contiguous,
pointer :: ncvert => null()
554 integer(I4B),
dimension(:),
contiguous,
pointer :: icvert => null()
555 real(DP),
dimension(:),
contiguous,
pointer :: cell_x => null()
556 real(DP),
dimension(:),
contiguous,
pointer :: cell_y => null()
560 call mem_setptr(icell2d,
'ICELL2D', this%input_mempath)
561 call mem_setptr(ncvert,
'NCVERT', this%input_mempath)
562 call mem_setptr(icvert,
'ICVERT', this%input_mempath)
565 if (
associated(icell2d) .and.
associated(ncvert) &
566 .and.
associated(icvert))
then
567 call this%define_cellverts(icell2d, ncvert, icvert)
569 call store_error(
'Required cell vertex array(s) [ICELL2D, NCVERT, ICVERT] &
574 call mem_setptr(cell_x,
'XC', this%input_mempath)
575 call mem_setptr(cell_y,
'YC', this%input_mempath)
578 if (
associated(cell_x) .and.
associated(cell_y))
then
580 this%cellxy(1, i) = cell_x(i)
581 this%cellxy(2, i) = cell_y(i)
584 call store_error(
'Required cell center arrays not found.')
588 if (this%iout > 0)
then
589 write (this%iout,
'(1x,a)')
'Discretization Cell2d data loaded'
601 integer(I4B) :: noder, nrsize
602 integer(I4B) :: narea_eq_zero
603 integer(I4B) :: narea_lt_zero
612 area = this%get_cell2d_area(j)
613 noder = this%get_nodenumber(j, 0)
614 if (noder > 0) this%area(noder) = area
615 if (area <
dzero)
then
616 narea_lt_zero = narea_lt_zero + 1
617 write (
errmsg,
'(a,i0,a)') &
618 &
'Calculated CELL2D area less than zero for cell ', j,
'.'
621 if (area ==
dzero)
then
622 narea_eq_zero = narea_eq_zero + 1
623 write (
errmsg,
'(a,i0,a)') &
624 'Calculated CELL2D area is zero for cell ', j,
'.'
631 if (narea_lt_zero > 0)
then
632 write (
errmsg,
'(i0,a)') narea_lt_zero, &
633 ' cell(s) have an area less than zero. Calculated cell &
634 &areas must be greater than zero. Negative areas often &
635 &mean vertices are not listed in clockwise order.'
638 if (narea_eq_zero > 0)
then
639 write (
errmsg,
'(i0,a)') narea_eq_zero, &
640 ' cell(s) have an area equal to zero. Calculated cell &
641 &areas must be greater than zero. Calculated cell &
642 &areas equal to zero indicate that the cell is not defined &
643 &by a valid polygon.'
651 if (this%nodes < this%nodesuser) nrsize = this%nodes
653 call this%con%disvconnections(this%name_model, this%nodes, &
654 this%nodes, 1, nrsize, &
655 this%nvert, this%vertices, this%iavert, &
656 this%javert, this%cellxy, &
657 this%bot, this%bot, &
658 this%nodereduced, this%nodeuser)
659 this%nja = this%con%nja
660 this%njas = this%con%njas
671 integer(I4B),
dimension(:),
intent(in) :: icelltype
673 integer(I4B) :: iunit, i, ntxt
674 integer(I4B),
parameter :: lentxt = 100
675 character(len=50) :: txthdr
676 character(len=lentxt) :: txt
677 character(len=LINELENGTH) :: fname
679 character(len=*),
parameter :: fmtgrdsave = &
680 "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', &
681 &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)"
687 fname = trim(this%input_fname)//
'.grb'
689 write (this%iout, fmtgrdsave) iunit, trim(adjustl(fname))
690 call openfile(iunit, this%iout, trim(adjustl(fname)),
'DATA(BINARY)', &
694 write (txthdr,
'(a)')
'GRID DISV2D'
695 txthdr(50:50) = new_line(
'a')
697 write (txthdr,
'(a)')
'VERSION 1'
698 txthdr(50:50) = new_line(
'a')
700 write (txthdr,
'(a, i0)')
'NTXT ', ntxt
701 txthdr(50:50) = new_line(
'a')
703 write (txthdr,
'(a, i0)')
'LENTXT ', lentxt
704 txthdr(50:50) = new_line(
'a')
708 write (txt,
'(3a, i0)')
'NCELLS ',
'INTEGER ',
'NDIM 0 # ', this%nodesuser
709 txt(lentxt:lentxt) = new_line(
'a')
711 write (txt,
'(3a, i0)')
'NODES ',
'INTEGER ',
'NDIM 0 # ', this%nodes
712 txt(lentxt:lentxt) = new_line(
'a')
714 write (txt,
'(3a, i0)')
'NVERT ',
'INTEGER ',
'NDIM 0 # ', this%nvert
715 txt(lentxt:lentxt) = new_line(
'a')
717 write (txt,
'(3a, i0)')
'NJAVERT ',
'INTEGER ',
'NDIM 0 # ',
size(this%javert)
718 txt(lentxt:lentxt) = new_line(
'a')
720 write (txt,
'(3a, i0)')
'NJA ',
'INTEGER ',
'NDIM 0 # ', this%con%nja
721 txt(lentxt:lentxt) = new_line(
'a')
723 write (txt,
'(3a, 1pg25.15e3)') &
724 'XORIGIN ',
'DOUBLE ',
'NDIM 0 # ', this%xorigin
725 txt(lentxt:lentxt) = new_line(
'a')
727 write (txt,
'(3a, 1pg25.15e3)') &
728 'YORIGIN ',
'DOUBLE ',
'NDIM 0 # ', this%yorigin
729 txt(lentxt:lentxt) = new_line(
'a')
731 write (txt,
'(3a, 1pg25.15e3)')
'ANGROT ',
'DOUBLE ',
'NDIM 0 # ', this%angrot
732 txt(lentxt:lentxt) = new_line(
'a')
734 write (txt,
'(3a, i0)')
'BOTM ',
'DOUBLE ',
'NDIM 1 ', this%nodesuser
735 txt(lentxt:lentxt) = new_line(
'a')
737 write (txt,
'(3a, i0)')
'VERTICES ',
'DOUBLE ',
'NDIM 2 2 ', this%nvert
738 txt(lentxt:lentxt) = new_line(
'a')
740 write (txt,
'(3a, i0)')
'CELLX ',
'DOUBLE ',
'NDIM 1 ', this%nodes
741 txt(lentxt:lentxt) = new_line(
'a')
743 write (txt,
'(3a, i0)')
'CELLY ',
'DOUBLE ',
'NDIM 1 ', this%nodes
744 txt(lentxt:lentxt) = new_line(
'a')
746 write (txt,
'(3a, i0)')
'IAVERT ',
'INTEGER ',
'NDIM 1 ', this%nodes + 1
747 txt(lentxt:lentxt) = new_line(
'a')
749 write (txt,
'(3a, i0)')
'JAVERT ',
'INTEGER ',
'NDIM 1 ',
size(this%javert)
750 txt(lentxt:lentxt) = new_line(
'a')
752 write (txt,
'(3a, i0)')
'IA ',
'INTEGER ',
'NDIM 1 ', this%nodesuser + 1
753 txt(lentxt:lentxt) = new_line(
'a')
755 write (txt,
'(3a, i0)')
'JA ',
'INTEGER ',
'NDIM 1 ',
size(this%con%jausr)
756 txt(lentxt:lentxt) = new_line(
'a')
758 write (txt,
'(3a, i0)')
'IDOMAIN ',
'INTEGER ',
'NDIM 1 ', this%nodesuser
759 txt(lentxt:lentxt) = new_line(
'a')
761 write (txt,
'(3a, i0)')
'ICELLTYPE ',
'INTEGER ',
'NDIM 1 ', this%nodesuser
762 txt(lentxt:lentxt) = new_line(
'a')
766 write (iunit) this%nodesuser
767 write (iunit) this%nodes
768 write (iunit) this%nvert
769 write (iunit)
size(this%javert)
770 write (iunit) this%nja
771 write (iunit) this%xorigin
772 write (iunit) this%yorigin
773 write (iunit) this%angrot
774 write (iunit) this%bottom
775 write (iunit) this%vertices
776 write (iunit) (this%cellxy(1, i), i=1, this%nodes)
777 write (iunit) (this%cellxy(2, i), i=1, this%nodes)
778 write (iunit) this%iavert
779 write (iunit) this%javert
780 write (iunit) this%con%iausr
781 write (iunit) this%con%jausr
782 write (iunit) this%idomain
783 write (iunit) icelltype
795 integer(I4B),
intent(in) :: nodeu
796 character(len=*),
intent(inout) :: str
798 integer(I4B) :: i, j, k
799 character(len=10) :: jstr
801 call get_ijk(nodeu, 1, this%nodes, 1, i, j, k)
802 write (jstr,
'(i10)') j
803 str =
'('//trim(adjustl(jstr))//
')'
812 integer(I4B),
intent(in) :: nodeu
813 integer(I4B),
dimension(:),
intent(inout) :: arr
815 integer(I4B) :: isize
816 integer(I4B) :: i, j, k
820 if (isize /= this%ndim)
then
821 write (
errmsg,
'(a,i0,a,i0,a)') &
822 'Program error: nodeu_to_array size of array (', isize, &
823 ') is not equal to the discretization dimension (', this%ndim,
').'
828 call get_ijk(nodeu, 1, this%nodes, 1, i, j, k)
839 integer(I4B) :: nodenumber
842 integer(I4B),
intent(in) :: nodeu
843 integer(I4B),
intent(in) :: icheck
847 if (icheck /= 0)
then
850 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
852 write (
errmsg,
'(a,i0,a,i0,a)') &
853 'Node number (', nodeu,
') is less than 1 or greater than nodes (', &
858 if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
862 if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
875 integer(I4B),
intent(in) :: noden
876 integer(I4B),
intent(in) :: nodem
877 integer(I4B),
intent(in) :: ihc
878 real(DP),
intent(inout) :: xcomp
879 real(DP),
intent(inout) :: ycomp
880 real(DP),
intent(inout) :: zcomp
881 integer(I4B),
intent(in) :: ipos
883 real(DP) :: angle, dmult
889 if (nodem < noden)
then
902 angle = this%con%anglex(this%con%jas(ipos))
904 if (nodem < noden) dmult = -
done
905 xcomp = cos(angle) * dmult
906 ycomp = sin(angle) * dmult
918 xcomp, ycomp, zcomp, conlen)
921 integer(I4B),
intent(in) :: noden
922 integer(I4B),
intent(in) :: nodem
923 logical,
intent(in) :: nozee
924 real(DP),
intent(in) :: satn
925 real(DP),
intent(in) :: satm
926 integer(I4B),
intent(in) :: ihc
927 real(DP),
intent(inout) :: xcomp
928 real(DP),
intent(inout) :: ycomp
929 real(DP),
intent(inout) :: zcomp
930 real(DP),
intent(inout) :: conlen
932 integer(I4B) :: nodeun, nodeum
933 real(DP) :: xn, xm, yn, ym, zn, zm
944 nodeun = this%get_nodeuser(noden)
945 nodeum = this%get_nodeuser(nodem)
946 xn = this%cellxy(1, nodeun)
947 yn = this%cellxy(2, nodeun)
948 xm = this%cellxy(1, nodeum)
949 ym = this%cellxy(2, nodeum)
960 character(len=*),
intent(out) :: dis_type
971 character(len=*),
intent(in) :: name_model
972 character(len=*),
intent(in) :: input_mempath
975 call this%DisBaseType%allocate_scalars(name_model, input_mempath)
993 call this%DisBaseType%allocate_arrays()
996 if (this%nodes < this%nodesuser)
then
997 call mem_allocate(this%nodeuser, this%nodes,
'NODEUSER', this%memoryPath)
998 call mem_allocate(this%nodereduced, this%nodesuser,
'NODEREDUCED', &
1001 call mem_allocate(this%nodeuser, 1,
'NODEUSER', this%memoryPath)
1002 call mem_allocate(this%nodereduced, 1,
'NODEREDUCED', this%memoryPath)
1005 this%mshape(1) = this%nodes
1019 integer(I4B),
intent(in) :: icell2d
1023 integer(I4B) :: ivert
1024 integer(I4B) :: nvert
1025 integer(I4B) :: icount
1033 nvert = this%iavert(icell2d + 1) - this%iavert(icell2d)
1035 iv1 = this%javert(this%iavert(icell2d))
1036 x1 = this%vertices(1, iv1)
1037 y1 = this%vertices(2, iv1)
1038 do ivert = this%iavert(icell2d), this%iavert(icell2d + 1) - 1
1039 x = this%vertices(1, this%javert(ivert))
1040 if (icount < nvert)
then
1041 y = this%vertices(2, this%javert(ivert + 1))
1043 y = this%vertices(2, this%javert(this%iavert(icell2d)))
1045 area = area + (x - x1) * (y - y1)
1050 do ivert = this%iavert(icell2d), this%iavert(icell2d + 1) - 1
1051 y = this%vertices(2, this%javert(ivert))
1052 if (icount < nvert)
then
1053 x = this%vertices(1, this%javert(ivert + 1))
1055 x = this%vertices(1, this%javert(this%iavert(icell2d)))
1057 area = area - (x - x1) * (y - y1)
1072 flag_string, allow_zero)
result(nodeu)
1075 integer(I4B),
intent(inout) :: lloc
1076 integer(I4B),
intent(inout) :: istart
1077 integer(I4B),
intent(inout) :: istop
1078 integer(I4B),
intent(in) :: in
1079 integer(I4B),
intent(in) :: iout
1080 character(len=*),
intent(inout) :: line
1081 logical,
optional,
intent(in) :: flag_string
1082 logical,
optional,
intent(in) :: allow_zero
1083 integer(I4B) :: nodeu
1085 integer(I4B) :: j, nodes
1086 integer(I4B) :: lloclocal, ndum, istat, n
1089 if (
present(flag_string))
then
1090 if (flag_string)
then
1093 call urword(line, lloclocal, istart, istop, 1, ndum, r, iout, in)
1094 read (line(istart:istop), *, iostat=istat) n
1095 if (istat /= 0)
then
1103 nodes = this%mshape(1)
1105 call urword(line, lloc, istart, istop, 2, j, r, iout, in)
1108 if (
present(allow_zero))
then
1109 if (allow_zero)
then
1118 if (j < 1 .or. j > nodes)
then
1119 write (
errmsg,
'(a,1x,a,i0,a)') &
1120 trim(adjustl(
errmsg)),
'Cell number in list (', j, &
1121 ') is outside of the grid.'
1124 nodeu =
get_node(1, 1, j, 1, 1, nodes)
1126 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
1127 write (
errmsg,
'(a,1x,a,i0,a)') &
1129 "Node number in list (", nodeu,
") is outside of the grid. "// &
1130 "Cell number cannot be determined in line '"// &
1131 trim(adjustl(line))//
"'."
1134 if (len_trim(adjustl(
errmsg)) > 0)
then
1150 allow_zero)
result(nodeu)
1152 integer(I4B) :: nodeu
1155 character(len=*),
intent(inout) :: cellid
1156 integer(I4B),
intent(in) :: inunit
1157 integer(I4B),
intent(in) :: iout
1158 logical,
optional,
intent(in) :: flag_string
1159 logical,
optional,
intent(in) :: allow_zero
1161 integer(I4B) :: j, nodes
1162 integer(I4B) :: lloclocal, ndum, istat, n
1163 integer(I4B) :: istart, istop
1166 if (
present(flag_string))
then
1167 if (flag_string)
then
1170 call urword(cellid, lloclocal, istart, istop, 1, ndum, r, iout, inunit)
1171 read (cellid(istart:istop), *, iostat=istat) n
1172 if (istat /= 0)
then
1180 nodes = this%mshape(1)
1183 call urword(cellid, lloclocal, istart, istop, 2, j, r, iout, inunit)
1186 if (
present(allow_zero))
then
1187 if (allow_zero)
then
1196 if (j < 1 .or. j > nodes)
then
1197 write (
errmsg,
'(a,1x,a,i0,a)') &
1198 trim(adjustl(
errmsg)),
'Cell2d number in list (', j, &
1199 ') is outside of the grid.'
1202 nodeu =
get_node(1, 1, j, 1, 1, nodes)
1204 if (nodeu < 1 .or. nodeu > this%nodesuser)
then
1205 write (
errmsg,
'(a,1x,a,i0,a)') &
1207 "Cell number cannot be determined for cellid ("// &
1208 trim(adjustl(cellid))//
") and results in a user "// &
1209 "node number (", nodeu,
") that is outside of the grid."
1212 if (len_trim(adjustl(
errmsg)) > 0)
then
1225 integer(I4B),
intent(in) :: ic
1226 real(DP),
allocatable,
intent(out) :: polyverts(:, :)
1227 logical(LGP),
intent(in),
optional :: closed
1229 integer(I4B) :: icu, icu2d, iavert, nverts, m, j
1230 logical(LGP) :: lclosed
1233 icu = this%get_nodeuser(ic)
1234 icu2d = icu - ((icu - 1) / this%nodes) * this%nodes
1235 nverts = this%iavert(icu2d + 1) - this%iavert(icu2d) - 1
1236 if (nverts .le. 0) nverts = nverts +
size(this%javert)
1239 if (.not. (
present(closed)))
then
1247 allocate (polyverts(2, nverts + 1))
1249 allocate (polyverts(2, nverts))
1253 iavert = this%iavert(icu2d)
1255 j = this%javert(iavert - 1 + m)
1256 polyverts(:, m) = (/this%vertices(1, j), this%vertices(2, j)/)
1261 polyverts(:, nverts + 1) = polyverts(:, 1)
1271 cdatafmp, nvaluesp, nwidthp, editdesc, dinact)
1274 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: darray
1275 integer(I4B),
intent(in) :: iout
1276 integer(I4B),
intent(in) :: iprint
1277 integer(I4B),
intent(in) :: idataun
1278 character(len=*),
intent(in) :: aname
1279 character(len=*),
intent(in) :: cdatafmp
1280 integer(I4B),
intent(in) :: nvaluesp
1281 integer(I4B),
intent(in) :: nwidthp
1282 character(len=*),
intent(in) :: editdesc
1283 real(DP),
intent(in) :: dinact
1285 integer(I4B) :: k, ifirst
1286 integer(I4B) :: nlay
1287 integer(I4B) :: nrow
1288 integer(I4B) :: ncol
1289 integer(I4B) :: nval
1290 integer(I4B) :: nodeu, noder
1291 integer(I4B) :: istart, istop
1292 real(DP),
dimension(:),
pointer,
contiguous :: dtemp
1294 character(len=*),
parameter :: fmthsv = &
1295 "(1X,/1X,a,' WILL BE SAVED ON UNIT ',I4, &
1296 &' AT END OF TIME STEP',I5,', STRESS PERIOD ',I4)"
1301 ncol = this%mshape(1)
1305 if (this%nodes < this%nodesuser)
then
1308 do nodeu = 1, this%nodesuser
1309 noder = this%get_nodenumber(nodeu, 0)
1310 if (noder <= 0)
then
1311 dtemp(nodeu) = dinact
1314 dtemp(nodeu) = darray(noder)
1322 if (iprint /= 0)
then
1325 istop = istart + nrow * ncol - 1
1327 aname, cdatafmp, nvaluesp, nwidthp, editdesc)
1333 if (idataun > 0)
then
1338 istop = istart + nrow * ncol - 1
1339 if (ifirst == 1)
write (iout, fmthsv) &
1340 trim(adjustl(aname)), idataun, &
1347 elseif (idataun < 0)
then
1350 call ubdsv1(
kstp,
kper, aname, -idataun, dtemp, ncol, nrow, nlay, &
1359 dstmodel, dstpackage, naux, auxtxt, &
1360 ibdchn, nlist, iout)
1363 character(len=16),
intent(in) :: text
1364 character(len=16),
intent(in) :: textmodel
1365 character(len=16),
intent(in) :: textpackage
1366 character(len=16),
intent(in) :: dstmodel
1367 character(len=16),
intent(in) :: dstpackage
1368 integer(I4B),
intent(in) :: naux
1369 character(len=16),
dimension(:),
intent(in) :: auxtxt
1370 integer(I4B),
intent(in) :: ibdchn
1371 integer(I4B),
intent(in) :: nlist
1372 integer(I4B),
intent(in) :: iout
1374 integer(I4B) :: nlay, nrow, ncol
1378 ncol = this%mshape(1)
1381 call ubdsv06(
kstp,
kper, text, textmodel, textpackage, dstmodel, dstpackage, &
1382 ibdchn, naux, auxtxt, ncol, nrow, nlay, &
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
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.
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 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
Vertex grid discretization.