MODFLOW 6  version 6.7.0.dev1
USGS Modular Hydrologic Model
disv2dmodule Module Reference

Data Types

type  disv2dtype
 Vertex grid discretization. More...
 
type  disvfoundtype
 

Functions/Subroutines

subroutine, public disv2d_cr (dis, name_model, input_mempath, inunit, iout)
 Create a new discretization by vertices object. More...
 
subroutine disv2d_load (this)
 Transfer IDM data into this discretization object. More...
 
subroutine disv2d_df (this)
 Define the discretization. More...
 
subroutine disv2d_da (this)
 
subroutine source_options (this)
 Copy options from IDM into package. More...
 
subroutine log_options (this, found)
 Write user options to list file. More...
 
subroutine source_dimensions (this)
 Copy dimensions from IDM into package. More...
 
subroutine log_dimensions (this, found)
 Write dimensions to list file. More...
 
subroutine source_griddata (this)
 Copy grid data from IDM into package. More...
 
subroutine log_griddata (this, found)
 Write griddata found to list file. More...
 
subroutine grid_finalize (this)
 Finalize grid (check properties, allocate arrays, compute connections) More...
 
subroutine source_vertices (this)
 Load grid vertices from IDM into package. More...
 
subroutine define_cellverts (this, icell2d, ncvert, icvert)
 Build data structures to hold cell vertex info. More...
 
subroutine source_cell2d (this)
 Copy cell2d data from IDM into package. More...
 
subroutine connect (this)
 Build grid connections. More...
 
subroutine write_grb (this, icelltype)
 Write a binary grid file. More...
 
subroutine nodeu_to_string (this, nodeu, str)
 Convert a user nodenumber to a string (nodenumber) or (k,j) More...
 
subroutine nodeu_to_array (this, nodeu, arr)
 Convert a user nodenumber to an array (nodenumber) or (k,j) More...
 
integer(i4b) function get_nodenumber_idx1 (this, nodeu, icheck)
 Get reduced node number from user node number. More...
 
subroutine connection_normal (this, noden, nodem, ihc, xcomp, ycomp, zcomp, ipos)
 Get normal vector components between the cell and a given neighbor. More...
 
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. More...
 
subroutine get_dis_type (this, dis_type)
 Get the discretization type. More...
 
integer(i4b) function get_dis_enum (this)
 Get the discretization type enumeration. More...
 
subroutine allocate_scalars (this, name_model, input_mempath)
 Allocate and initialize scalars. More...
 
subroutine allocate_arrays (this)
 Allocate and initialize arrays. More...
 
real(dp) function get_cell2d_area (this, icell2d)
 Get the signed area of the cell. More...
 
integer(i4b) function nodeu_from_string (this, lloc, istart, istop, in, iout, line, flag_string, allow_zero)
 Convert a string to a user nodenumber. More...
 
integer(i4b) function nodeu_from_cellid (this, cellid, inunit, iout, flag_string, allow_zero)
 Convert a cellid string to a user nodenumber. More...
 
subroutine get_polyverts (this, ic, polyverts, closed)
 Get a 2D array of polygon vertices, listed in clockwise order beginning with the lower left corner. More...
 
subroutine record_array (this, darray, iout, iprint, idataun, aname, cdatafmp, nvaluesp, nwidthp, editdesc, dinact)
 Record a double precision array. More...
 
subroutine record_srcdst_list_header (this, text, textmodel, textpackage, dstmodel, dstpackage, naux, auxtxt, ibdchn, nlist, iout)
 Record list header for imeth=6. More...
 

Function/Subroutine Documentation

◆ allocate_arrays()

subroutine disv2dmodule::allocate_arrays ( class(disv2dtype this)
private

Definition at line 991 of file Disv2d.f90.

992  ! dummy
993  class(Disv2dType) :: this
994 
995  ! Allocate arrays in DisBaseType (mshape, top, bot, area)
996  call this%DisBaseType%allocate_arrays()
997  !
998  ! Allocate arrays for DisvType
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', &
1002  this%memoryPath)
1003  else
1004  call mem_allocate(this%nodeuser, 1, 'NODEUSER', this%memoryPath)
1005  call mem_allocate(this%nodereduced, 1, 'NODEREDUCED', this%memoryPath)
1006  end if
1007 
1008  ! Initialize
1009  this%mshape(1) = this%nodesuser
1010 

◆ allocate_scalars()

subroutine disv2dmodule::allocate_scalars ( class(disv2dtype this,
character(len=*), intent(in)  name_model,
character(len=*), intent(in)  input_mempath 
)

Definition at line 971 of file Disv2d.f90.

972  ! -- dummy
973  class(Disv2dType) :: this
974  character(len=*), intent(in) :: name_model
975  character(len=*), intent(in) :: input_mempath
976  !
977  ! -- Allocate parent scalars
978  call this%DisBaseType%allocate_scalars(name_model, input_mempath)
979  !
980  ! -- Allocate
981  call mem_allocate(this%nvert, 'NVERT', this%memoryPath)
982  !
983  ! -- Initialize
984  this%nvert = 0
985  this%ndim = 1
986  !

◆ connect()

subroutine disv2dmodule::connect ( class(disv2dtype this)
private

Definition at line 591 of file Disv2d.f90.

592  ! -- dummy
593  class(Disv2dType) :: this
594  ! -- local
595  integer(I4B) :: j
596  integer(I4B) :: noder, nrsize
597  integer(I4B) :: narea_eq_zero
598  integer(I4B) :: narea_lt_zero
599  real(DP) :: area
600  !
601  ! -- Initialize
602  narea_eq_zero = 0
603  narea_lt_zero = 0
604  !
605  ! -- Assign the cell area
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, '.'
614  call store_error(errmsg)
615  end if
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, '.'
620  call store_error(errmsg)
621  end if
622  end do
623  !
624  ! -- check for errors
625  if (count_errors() > 0) then
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.'
631  call store_error(errmsg)
632  end if
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.'
639  call store_error(errmsg)
640  end if
641  call store_error_filename(this%input_fname)
642  end if
643  !
644  ! -- create and fill the connections object
645  nrsize = 0
646  if (this%nodes < this%nodesuser) nrsize = this%nodes
647  allocate (this%con)
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
656  !
Here is the call graph for this function:

◆ connection_normal()

subroutine disv2dmodule::connection_normal ( class(disv2dtype this,
integer(i4b), intent(in)  noden,
integer(i4b), intent(in)  nodem,
integer(i4b), intent(in)  ihc,
real(dp), intent(inout)  xcomp,
real(dp), intent(inout)  ycomp,
real(dp), intent(inout)  zcomp,
integer(i4b), intent(in)  ipos 
)
private

The normal points outward from the shared face between noden and nodem.

Parameters
[in]nodencell (reduced nn)
[in]nodemneighbor (reduced nn)
[in]ihchorizontal connection flag

Definition at line 866 of file Disv2d.f90.

868  ! -- dummy
869  class(Disv2dType) :: this
870  integer(I4B), intent(in) :: noden !< cell (reduced nn)
871  integer(I4B), intent(in) :: nodem !< neighbor (reduced nn)
872  integer(I4B), intent(in) :: ihc !< horizontal connection flag
873  real(DP), intent(inout) :: xcomp
874  real(DP), intent(inout) :: ycomp
875  real(DP), intent(inout) :: zcomp
876  integer(I4B), intent(in) :: ipos
877  ! -- local
878  real(DP) :: angle, dmult
879  !
880  ! -- Set vector components based on ihc
881  if (ihc == 0) then
882  xcomp = dzero
883  ycomp = dzero
884  if (nodem < noden) then
885  !
886  ! -- nodem must be above noden, so upward connection
887  zcomp = done
888  else
889  !
890  ! -- nodem must be below noden, so downward connection
891  zcomp = -done
892  end if
893  else
894  ! -- find from anglex, since anglex is symmetric, need to flip vector
895  ! for lower triangle (nodem < noden)
896  !ipos = this%con%getjaindex(noden, nodem)
897  angle = this%con%anglex(this%con%jas(ipos))
898  dmult = done
899  if (nodem < noden) dmult = -done
900  xcomp = cos(angle) * dmult
901  ycomp = sin(angle) * dmult
902  zcomp = dzero
903  end if
904  !

◆ connection_vector()

subroutine disv2dmodule::connection_vector ( class(disv2dtype this,
integer(i4b), intent(in)  noden,
integer(i4b), intent(in)  nodem,
logical, intent(in)  nozee,
real(dp), intent(in)  satn,
real(dp), intent(in)  satm,
integer(i4b), intent(in)  ihc,
real(dp), intent(inout)  xcomp,
real(dp), intent(inout)  ycomp,
real(dp), intent(inout)  zcomp,
real(dp), intent(inout)  conlen 
)
private

Saturation must be provided to compute cell center vertical coordinates. Also return the straight-line connection length.

Parameters
[in]nodencell (reduced nn)
[in]nodemneighbor (reduced nn)
[in]nozeedo not use z in calculations
[in]satnnot used for disv1d
[in]satmnot used for disv1d
[in]ihchorizontal connection flag
[in,out]xcompx component of connection vector
[in,out]ycompy component of connection vector
[in,out]zcompz component of connection vector
[in,out]conlencalculated straight-line distance between cell centers

Definition at line 912 of file Disv2d.f90.

914  ! -- dummy
915  class(Disv2dType) :: this
916  integer(I4B), intent(in) :: noden !< cell (reduced nn)
917  integer(I4B), intent(in) :: nodem !< neighbor (reduced nn)
918  logical, intent(in) :: nozee !< do not use z in calculations
919  real(DP), intent(in) :: satn !< not used for disv1d
920  real(DP), intent(in) :: satm !< not used for disv1d
921  integer(I4B), intent(in) :: ihc !< horizontal connection flag
922  real(DP), intent(inout) :: xcomp !< x component of connection vector
923  real(DP), intent(inout) :: ycomp !< y component of connection vector
924  real(DP), intent(inout) :: zcomp !< z component of connection vector
925  real(DP), intent(inout) :: conlen !< calculated straight-line distance between cell centers
926  ! -- local
927  integer(I4B) :: nodeun, nodeum
928  real(DP) :: xn, xm, yn, ym, zn, zm
929 
930  ! horizontal connection, with possible z component due to cell offsets
931  ! and/or water table conditions
932  if (nozee) then
933  zn = dzero
934  zm = dzero
935  else
936  zn = this%bot(noden)
937  zm = this%bot(nodem)
938  end if
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)
945  call line_unit_vector(xn, yn, zn, xm, ym, zm, xcomp, ycomp, zcomp, &
946  conlen)
947 
Here is the call graph for this function:

◆ define_cellverts()

subroutine disv2dmodule::define_cellverts ( class(disv2dtype this,
integer(i4b), dimension(:), intent(in), pointer, contiguous  icell2d,
integer(i4b), dimension(:), intent(in), pointer, contiguous  ncvert,
integer(i4b), dimension(:), intent(in), pointer, contiguous  icvert 
)
private

Definition at line 502 of file Disv2d.f90.

503  ! -- modules
504  use sparsemodule, only: sparsematrix
505  ! -- dummy
506  class(Disv2dType) :: this
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
510  ! -- locals
511  type(sparsematrix) :: vert_spm
512  integer(I4B) :: i, j, ierr
513  integer(I4B) :: icv_idx, startvert, maxnnz = 5
514  !
515  ! -- initialize sparse matrix
516  call vert_spm%init(this%nodes, this%nvert, maxnnz)
517  !
518  ! -- add sparse matrix connections from input memory paths
519  icv_idx = 1
520  do i = 1, this%nodes
521  if (icell2d(i) /= i) call store_error('ICELL2D input sequence violation.')
522  do j = 1, ncvert(i)
523  call vert_spm%addconnection(i, icvert(icv_idx), 0)
524  if (j == 1) then
525  startvert = icvert(icv_idx)
526  elseif (j == ncvert(i) .and. (icvert(icv_idx) /= startvert)) then
527  call vert_spm%addconnection(i, startvert, 0)
528  end if
529  icv_idx = icv_idx + 1
530  end do
531  end do
532  !
533  ! -- allocate and fill iavert and javert
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()
538  !
Here is the call graph for this function:

◆ disv2d_cr()

subroutine, public disv2dmodule::disv2d_cr ( class(disbasetype), pointer  dis,
character(len=*), intent(in)  name_model,
character(len=*), intent(in)  input_mempath,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout 
)

Definition at line 94 of file Disv2d.f90.

95  ! -- dummy
96  class(DisBaseType), pointer :: dis
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
101  ! -- local
102  type(Disv2dType), pointer :: disnew
103  ! -- formats
104  character(len=*), parameter :: fmtheader = &
105  "(1X, /1X, 'DISV -- VERTEX GRID DISCRETIZATION PACKAGE,', &
106  &' VERSION 1 : 12/23/2015 - INPUT READ FROM MEMPATH: ', A, //)"
107  !
108  allocate (disnew)
109  dis => disnew
110  call disnew%allocate_scalars(name_model, input_mempath)
111  dis%inunit = inunit
112  dis%iout = iout
113  !
114  ! -- If disv enabled
115  if (inunit > 0) then
116  !
117  ! -- Identify package
118  if (iout > 0) then
119  write (iout, fmtheader) dis%input_mempath
120  end if
121  !
122  ! -- load disv
123  call disnew%disv2d_load()
124  end if
125  !
Here is the caller graph for this function:

◆ disv2d_da()

subroutine disv2dmodule::disv2d_da ( class(disv2dtype this)
private

Definition at line 153 of file Disv2d.f90.

154  ! -- modules
158  ! -- dummy
159  class(Disv2dType) :: this
160  ! -- local
161 
162  ! -- Deallocate idm memory
163  call memorystore_remove(this%name_model, 'DISV2D', idm_context)
164 
165  ! -- scalars
166  call mem_deallocate(this%nvert)
167 
168  ! -- arrays
169  call mem_deallocate(this%nodeuser)
170  call mem_deallocate(this%nodereduced)
171  call mem_deallocate(this%bottom)
172  call mem_deallocate(this%idomain)
173 
174  ! -- cdl hack for arrays for vertices and cell2d blocks
175  call mem_deallocate(this%vertices)
176  call mem_deallocate(this%cellxy)
177  call mem_deallocate(this%iavert)
178  call mem_deallocate(this%javert)
179  !
180  ! -- DisBaseType deallocate
181  call this%DisBaseType%dis_da()
subroutine, public memorystore_remove(component, subcomponent, context)
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=linelength) idm_context
Here is the call graph for this function:

◆ disv2d_df()

subroutine disv2dmodule::disv2d_df ( class(disv2dtype this)
private

Definition at line 145 of file Disv2d.f90.

146  ! -- dummy
147  class(Disv2dType) :: this
148  !
149  call this%grid_finalize()
150  !

◆ disv2d_load()

subroutine disv2dmodule::disv2d_load ( class(disv2dtype this)
private

Definition at line 130 of file Disv2d.f90.

131  ! -- dummy
132  class(Disv2dType) :: this
133  !
134  ! -- source input data
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()
140  !

◆ get_cell2d_area()

real(dp) function disv2dmodule::get_cell2d_area ( class(disv2dtype this,
integer(i4b), intent(in)  icell2d 
)
private

A negative result means points are in counter-clockwise orientation. Area is computed from the formula: a = 1/2 *[(x1*y2 + x2*y3 + x3*y4 + ... + xn*y1) - (x2*y1 + x3*y2 + x4*y3 + ... + x1*yn)]

Definition at line 1020 of file Disv2d.f90.

1021  ! -- dummy
1022  class(Disv2dType) :: this
1023  integer(I4B), intent(in) :: icell2d
1024  ! -- return
1025  real(DP) :: area
1026  ! -- local
1027  integer(I4B) :: ivert
1028  integer(I4B) :: nvert
1029  integer(I4B) :: icount
1030  integer(I4B) :: iv1
1031  real(DP) :: x
1032  real(DP) :: y
1033  real(DP) :: x1
1034  real(DP) :: y1
1035  !
1036  area = dzero
1037  nvert = this%iavert(icell2d + 1) - this%iavert(icell2d)
1038  icount = 1
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))
1046  else
1047  y = this%vertices(2, this%javert(this%iavert(icell2d)))
1048  end if
1049  area = area + (x - x1) * (y - y1)
1050  icount = icount + 1
1051  end do
1052  !
1053  icount = 1
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))
1058  else
1059  x = this%vertices(1, this%javert(this%iavert(icell2d)))
1060  end if
1061  area = area - (x - x1) * (y - y1)
1062  icount = icount + 1
1063  end do
1064  !
1065  area = -done * area * dhalf
1066  !

◆ get_dis_enum()

integer(i4b) function disv2dmodule::get_dis_enum ( class(disv2dtype), intent(in)  this)
private

Definition at line 962 of file Disv2d.f90.

963  use constantsmodule, only: disv2d
964  class(Disv2dType), intent(in) :: this
965  integer(I4B) :: dis_enum
966  dis_enum = disv2d
This module contains simulation constants.
Definition: Constants.f90:9
@ disv2d
DISV2D6 discretization.
Definition: Constants.f90:164

◆ get_dis_type()

subroutine disv2dmodule::get_dis_type ( class(disv2dtype), intent(in)  this,
character(len=*), intent(out)  dis_type 
)
private

Definition at line 952 of file Disv2d.f90.

953  ! -- dummy
954  class(Disv2dType), intent(in) :: this
955  character(len=*), intent(out) :: dis_type
956  !
957  dis_type = "DISV2D"
958  !

◆ get_nodenumber_idx1()

integer(i4b) function disv2dmodule::get_nodenumber_idx1 ( class(disv2dtype), intent(in)  this,
integer(i4b), intent(in)  nodeu,
integer(i4b), intent(in)  icheck 
)
private

Definition at line 832 of file Disv2d.f90.

833  ! return
834  integer(I4B) :: nodenumber
835  ! dummy
836  class(Disv2dType), intent(in) :: this
837  integer(I4B), intent(in) :: nodeu
838  integer(I4B), intent(in) :: icheck
839  ! local
840 
841  ! check the node number if requested
842  if (icheck /= 0) then
843 
844  ! If within valid range, convert to reduced nodenumber
845  if (nodeu < 1 .or. nodeu > this%nodesuser) then
846  nodenumber = 0
847  write (errmsg, '(a,i0,a,i0,a)') &
848  'Node number (', nodeu, ') is less than 1 or greater than nodes (', &
849  this%nodesuser, ').'
850  call store_error(errmsg)
851  else
852  nodenumber = nodeu
853  if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
854  end if
855  else
856  nodenumber = nodeu
857  if (this%nodes < this%nodesuser) nodenumber = this%nodereduced(nodeu)
858  end if
859 
Here is the call graph for this function:

◆ get_polyverts()

subroutine disv2dmodule::get_polyverts ( class(disv2dtype), intent(inout)  this,
integer(i4b), intent(in)  ic,
real(dp), dimension(:, :), intent(out), allocatable  polyverts,
logical(lgp), intent(in), optional  closed 
)
private
Parameters
[in]iccell number (reduced)
[out]polyvertspolygon vertices (column-major indexing)
[in]closedwhether to close the polygon, duplicating a vertex (default false)

Definition at line 1226 of file Disv2d.f90.

1227  ! -- dummy
1228  class(Disv2dType), intent(inout) :: this
1229  integer(I4B), intent(in) :: ic !< cell number (reduced)
1230  real(DP), allocatable, intent(out) :: polyverts(:, :) !< polygon vertices (column-major indexing)
1231  logical(LGP), intent(in), optional :: closed !< whether to close the polygon, duplicating a vertex (default false)
1232  ! -- local
1233  integer(I4B) :: icu, icu2d, iavert, nverts, m, j
1234  logical(LGP) :: lclosed
1235  !
1236  ! count vertices
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)
1241  !
1242  ! check closed option
1243  if (.not. (present(closed))) then
1244  lclosed = .false.
1245  else
1246  lclosed = closed
1247  end if
1248  !
1249  ! allocate vertices array
1250  if (lclosed) then
1251  allocate (polyverts(2, nverts + 1))
1252  else
1253  allocate (polyverts(2, nverts))
1254  end if
1255  !
1256  ! set vertices
1257  iavert = this%iavert(icu2d)
1258  do m = 1, nverts
1259  j = this%javert(iavert - 1 + m)
1260  polyverts(:, m) = (/this%vertices(1, j), this%vertices(2, j)/)
1261  end do
1262  !
1263  ! close if enabled
1264  if (lclosed) &
1265  polyverts(:, nverts + 1) = polyverts(:, 1)
1266  !

◆ grid_finalize()

subroutine disv2dmodule::grid_finalize ( class(disv2dtype this)
private

Definition at line 386 of file Disv2d.f90.

387  ! dummy
388  class(Disv2dType) :: this
389  ! locals
390  integer(I4B) :: node, noder, j, ncell_count
391  ! formats
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, //)"
396 
397  ! count active cells and set nodes to that number
398  ncell_count = 0
399  do j = 1, this%nodesuser
400  if (this%idomain(j) > 0) ncell_count = ncell_count + 1
401  end do
402  this%nodes = ncell_count
403 
404  ! Check to make sure nodes is a valid number
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 &
408  &than zero.')
409  call store_error_filename(this%input_fname)
410  end if
411 
412  ! Write message if reduced grid
413  if (this%nodes < this%nodesuser) then
414  write (this%iout, fmtnr) this%nodesuser, this%nodes
415  end if
416 
417  ! Array size is now known, so allocate
418  call this%allocate_arrays()
419 
420  ! Fill the nodereduced array with the reduced nodenumber, or
421  ! a negative number to indicate it is a pass-through cell, or
422  ! a zero to indicate that the cell is excluded from the
423  ! solution.
424  if (this%nodes < this%nodesuser) then
425  node = 1
426  noder = 1
427  do j = 1, this%nodesuser
428  if (this%idomain(j) > 0) then
429  this%nodereduced(node) = noder
430  noder = noder + 1
431  else
432  this%nodereduced(node) = 0
433  end if
434  node = node + 1
435  end do
436  end if
437 
438  ! allocate and fill nodeuser if a reduced grid
439  if (this%nodes < this%nodesuser) then
440  node = 1
441  noder = 1
442  do j = 1, this%nodesuser
443  if (this%idomain(j) > 0) then
444  this%nodeuser(noder) = node
445  noder = noder + 1
446  end if
447  node = node + 1
448  end do
449  end if
450 
451  ! Move bottom into bot
452  ! and set x and y center coordinates
453  node = 0
454  do j = 1, this%nodesuser
455  node = node + 1
456  noder = node
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)
462  end do
463 
464  ! Build connections
465  call this%connect()
466 
Here is the call graph for this function:

◆ log_dimensions()

subroutine disv2dmodule::log_dimensions ( class(disv2dtype this,
type(disvfoundtype), intent(in)  found 
)
private

Definition at line 325 of file Disv2d.f90.

326  ! -- dummy
327  class(Disv2dType) :: this
328  type(DisvFoundType), intent(in) :: found
329  !
330  write (this%iout, '(1x,a)') 'Setting Discretization Dimensions'
331  !
332  if (found%nodes) then
333  write (this%iout, '(4x,a,i0)') 'NODES = ', this%nodesuser
334  end if
335  !
336  if (found%nvert) then
337  write (this%iout, '(4x,a,i0)') 'NVERT = ', this%nvert
338  end if
339  !
340  write (this%iout, '(1x,a,/)') 'End Setting Discretization Dimensions'
341  !

◆ log_griddata()

subroutine disv2dmodule::log_griddata ( class(disv2dtype this,
type(disvfoundtype), intent(in)  found 
)
private

Definition at line 365 of file Disv2d.f90.

366  ! -- dummy
367  class(Disv2dType) :: this
368  type(DisvFoundType), intent(in) :: found
369  !
370  write (this%iout, '(1x,a)') 'Setting Discretization Griddata'
371  !
372  if (found%bottom) then
373  write (this%iout, '(4x,a)') 'BOTTOM set from input file'
374  end if
375  !
376  if (found%idomain) then
377  write (this%iout, '(4x,a)') 'IDOMAIN set from input file'
378  end if
379  !
380  write (this%iout, '(1x,a,/)') 'End Setting Discretization Griddata'
381  !

◆ log_options()

subroutine disv2dmodule::log_options ( class(disv2dtype this,
type(disvfoundtype), intent(in)  found 
)
private

Definition at line 240 of file Disv2d.f90.

241  ! -- dummy
242  class(Disv2dType) :: this
243  type(DisvFoundType), intent(in) :: found
244  !
245  write (this%iout, '(1x,a)') 'Setting Discretization Options'
246  !
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
250  end if
251  !
252  if (found%nogrb) then
253  write (this%iout, '(4x,a,i0)') 'Binary grid file [0=GRB, 1=NOGRB] &
254  &set as ', this%nogrb
255  end if
256  !
257  if (found%xorigin) then
258  write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin
259  end if
260  !
261  if (found%yorigin) then
262  write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin
263  end if
264  !
265  if (found%angrot) then
266  write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot
267  end if
268  !
269  write (this%iout, '(1x,a,/)') 'End Setting Discretization Options'
270  !

◆ nodeu_from_cellid()

integer(i4b) function disv2dmodule::nodeu_from_cellid ( class(disv2dtype this,
character(len=*), intent(inout)  cellid,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout,
logical, intent(in), optional  flag_string,
logical, intent(in), optional  allow_zero 
)
private

If flag_string is present and true, the first token may be non-numeric (e.g. boundary name). In this case, return -2.

If allow_zero is present and true, and all indices are zero, the result can be zero. If allow_zero is false, a zero in any index is an error.

Definition at line 1153 of file Disv2d.f90.

1155  ! -- return
1156  integer(I4B) :: nodeu
1157  ! -- dummy
1158  class(Disv2dType) :: this
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
1164  ! -- local
1165  integer(I4B) :: j, nodes
1166  integer(I4B) :: lloclocal, ndum, istat, n
1167  integer(I4B) :: istart, istop
1168  real(DP) :: r
1169  !
1170  if (present(flag_string)) then
1171  if (flag_string) then
1172  ! Check to see if first token in cellid can be read as an integer.
1173  lloclocal = 1
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
1177  ! First token in cellid is not an integer; return flag to this effect.
1178  nodeu = -2
1179  return
1180  end if
1181  end if
1182  end if
1183  !
1184  nodes = this%mshape(1)
1185  !
1186  lloclocal = 1
1187  call urword(cellid, lloclocal, istart, istop, 2, j, r, iout, inunit)
1188  !
1189  if (j == 0) then
1190  if (present(allow_zero)) then
1191  if (allow_zero) then
1192  nodeu = 0
1193  return
1194  end if
1195  end if
1196  end if
1197  !
1198  errmsg = ''
1199  !
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.'
1204  end if
1205  !
1206  nodeu = get_node(1, 1, j, 1, 1, nodes)
1207  !
1208  if (nodeu < 1 .or. nodeu > this%nodesuser) then
1209  write (errmsg, '(a,1x,a,i0,a)') &
1210  trim(adjustl(errmsg)), &
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."
1214  end if
1215  !
1216  if (len_trim(adjustl(errmsg)) > 0) then
1217  call store_error(errmsg)
1218  call store_error_unit(inunit)
1219  end if
1220  !
Here is the call graph for this function:

◆ nodeu_from_string()

integer(i4b) function disv2dmodule::nodeu_from_string ( class(disv2dtype this,
integer(i4b), intent(inout)  lloc,
integer(i4b), intent(inout)  istart,
integer(i4b), intent(inout)  istop,
integer(i4b), intent(in)  in,
integer(i4b), intent(in)  iout,
character(len=*), intent(inout)  line,
logical, intent(in), optional  flag_string,
logical, intent(in), optional  allow_zero 
)
private

Parse layer and within-layer cell number and return user nodenumber. If flag_string is present and true, the first token may be non-numeric (e.g. boundary name). In this case, return -2.

Definition at line 1075 of file Disv2d.f90.

1077  ! -- dummy
1078  class(Disv2dType) :: this
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
1088  ! -- local
1089  integer(I4B) :: j, nodes
1090  integer(I4B) :: lloclocal, ndum, istat, n
1091  real(DP) :: r
1092  !
1093  if (present(flag_string)) then
1094  if (flag_string) then
1095  ! Check to see if first token in line can be read as an integer.
1096  lloclocal = lloc
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
1100  ! First token in line is not an integer; return flag to this effect.
1101  nodeu = -2
1102  return
1103  end if
1104  end if
1105  end if
1106  !
1107  nodes = this%mshape(1)
1108  !
1109  call urword(line, lloc, istart, istop, 2, j, r, iout, in)
1110  !
1111  if (j == 0) then
1112  if (present(allow_zero)) then
1113  if (allow_zero) then
1114  nodeu = 0
1115  return
1116  end if
1117  end if
1118  end if
1119  !
1120  errmsg = ''
1121  !
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.'
1126  end if
1127  !
1128  nodeu = get_node(1, 1, j, 1, 1, nodes)
1129  !
1130  if (nodeu < 1 .or. nodeu > this%nodesuser) then
1131  write (errmsg, '(a,1x,a,i0,a)') &
1132  trim(adjustl(errmsg)), &
1133  "Node number in list (", nodeu, ") is outside of the grid. "// &
1134  "Cell number cannot be determined in line '"// &
1135  trim(adjustl(line))//"'."
1136  end if
1137  !
1138  if (len_trim(adjustl(errmsg)) > 0) then
1139  call store_error(errmsg)
1140  call store_error_unit(in)
1141  end if
1142  !
Here is the call graph for this function:

◆ nodeu_to_array()

subroutine disv2dmodule::nodeu_to_array ( class(disv2dtype this,
integer(i4b), intent(in)  nodeu,
integer(i4b), dimension(:), intent(inout)  arr 
)
private

Definition at line 804 of file Disv2d.f90.

805  ! -- dummy
806  class(Disv2dType) :: this
807  integer(I4B), intent(in) :: nodeu
808  integer(I4B), dimension(:), intent(inout) :: arr
809  ! -- local
810  integer(I4B) :: isize
811  integer(I4B) :: i, j, k
812  !
813  ! -- check the size of arr
814  isize = size(arr)
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, ').'
819  call store_error(errmsg, terminate=.true.)
820  end if
821  !
822  ! -- get k, i, j
823  call get_ijk(nodeu, 1, this%nodes, 1, i, j, k)
824  !
825  ! -- fill array
826  arr(1) = j
827  !
Here is the call graph for this function:

◆ nodeu_to_string()

subroutine disv2dmodule::nodeu_to_string ( class(disv2dtype this,
integer(i4b), intent(in)  nodeu,
character(len=*), intent(inout)  str 
)

Definition at line 787 of file Disv2d.f90.

788  ! -- dummy
789  class(Disv2dType) :: this
790  integer(I4B), intent(in) :: nodeu
791  character(len=*), intent(inout) :: str
792  ! -- local
793  integer(I4B) :: i, j, k
794  character(len=10) :: jstr
795  !
796  call get_ijk(nodeu, 1, this%nodes, 1, i, j, k)
797  write (jstr, '(i10)') j
798  str = '('//trim(adjustl(jstr))//')'
799  !
Here is the call graph for this function:

◆ record_array()

subroutine disv2dmodule::record_array ( class(disv2dtype), intent(inout)  this,
real(dp), dimension(:), intent(inout), pointer, contiguous  darray,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in)  iprint,
integer(i4b), intent(in)  idataun,
character(len=*), intent(in)  aname,
character(len=*), intent(in)  cdatafmp,
integer(i4b), intent(in)  nvaluesp,
integer(i4b), intent(in)  nwidthp,
character(len=*), intent(in)  editdesc,
real(dp), intent(in)  dinact 
)
private

The array is written to a formatted or unformatted external file depending on the arguments.

Parameters
[in,out]darraydouble precision array to record
[in]ioutascii output unit number
[in]iprintwhether to print the array
[in]idataunbinary output unit number, if negative don't write by layers, write entire array
[in]anametext descriptor
[in]cdatafmpwrite format
[in]nvaluespvalues per line
[in]nwidthpnumber width
[in]editdescformat type (I, G, F, S, E)
[in]dinactdouble precision value for cells excluded from model domain

Definition at line 1274 of file Disv2d.f90.

1276  ! -- dummy
1277  class(Disv2dType), intent(inout) :: this
1278  real(DP), dimension(:), pointer, contiguous, intent(inout) :: darray !< double precision array to record
1279  integer(I4B), intent(in) :: iout !< ascii output unit number
1280  integer(I4B), intent(in) :: iprint !< whether to print the array
1281  integer(I4B), intent(in) :: idataun !< binary output unit number, if negative don't write by layers, write entire array
1282  character(len=*), intent(in) :: aname !< text descriptor
1283  character(len=*), intent(in) :: cdatafmp !< write format
1284  integer(I4B), intent(in) :: nvaluesp !< values per line
1285  integer(I4B), intent(in) :: nwidthp !< number width
1286  character(len=*), intent(in) :: editdesc !< format type (I, G, F, S, E)
1287  real(DP), intent(in) :: dinact !< double precision value for cells excluded from model domain
1288  ! -- local
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
1297  ! -- formats
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)"
1301  !
1302  ! -- set variables
1303  nlay = 1
1304  nrow = 1
1305  ncol = this%mshape(1)
1306  !
1307  ! -- If this is a reduced model, then copy the values from darray into
1308  ! dtemp.
1309  if (this%nodes < this%nodesuser) then
1310  nval = this%nodes
1311  dtemp => this%dbuff
1312  do nodeu = 1, this%nodesuser
1313  noder = this%get_nodenumber(nodeu, 0)
1314  if (noder <= 0) then
1315  dtemp(nodeu) = dinact
1316  cycle
1317  end if
1318  dtemp(nodeu) = darray(noder)
1319  end do
1320  else
1321  nval = this%nodes
1322  dtemp => darray
1323  end if
1324  !
1325  ! -- Print to iout if iprint /= 0
1326  if (iprint /= 0) then
1327  istart = 1
1328  do k = 1, nlay
1329  istop = istart + nrow * ncol - 1
1330  call ulaprufw(ncol, nrow, kstp, kper, k, iout, dtemp(istart:istop), &
1331  aname, cdatafmp, nvaluesp, nwidthp, editdesc)
1332  istart = istop + 1
1333  end do
1334  end if
1335  !
1336  ! -- Save array to an external file.
1337  if (idataun > 0) then
1338  ! -- write to binary file by layer
1339  ifirst = 1
1340  istart = 1
1341  do k = 1, nlay
1342  istop = istart + nrow * ncol - 1
1343  if (ifirst == 1) write (iout, fmthsv) &
1344  trim(adjustl(aname)), idataun, &
1345  kstp, kper
1346  ifirst = 0
1347  call ulasav(dtemp(istart:istop), aname, kstp, kper, &
1348  pertim, totim, ncol, nrow, k, idataun)
1349  istart = istop + 1
1350  end do
1351  elseif (idataun < 0) then
1352  !
1353  ! -- write entire array as one record
1354  call ubdsv1(kstp, kper, aname, -idataun, dtemp, ncol, nrow, nlay, &
1355  iout, delt, pertim, totim)
1356  end if
1357  !
Here is the call graph for this function:

◆ record_srcdst_list_header()

subroutine disv2dmodule::record_srcdst_list_header ( class(disv2dtype this,
character(len=16), intent(in)  text,
character(len=16), intent(in)  textmodel,
character(len=16), intent(in)  textpackage,
character(len=16), intent(in)  dstmodel,
character(len=16), intent(in)  dstpackage,
integer(i4b), intent(in)  naux,
character(len=16), dimension(:), intent(in)  auxtxt,
integer(i4b), intent(in)  ibdchn,
integer(i4b), intent(in)  nlist,
integer(i4b), intent(in)  iout 
)
private

Definition at line 1362 of file Disv2d.f90.

1365  ! -- dummy
1366  class(Disv2dType) :: this
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
1377  ! -- local
1378  integer(I4B) :: nlay, nrow, ncol
1379  !
1380  nlay = 1
1381  nrow = 1
1382  ncol = this%mshape(1)
1383  !
1384  ! -- Use ubdsv06 to write list header
1385  call ubdsv06(kstp, kper, text, textmodel, textpackage, dstmodel, dstpackage, &
1386  ibdchn, naux, auxtxt, ncol, nrow, nlay, &
1387  nlist, iout, delt, pertim, totim)
1388  !
Here is the call graph for this function:

◆ source_cell2d()

subroutine disv2dmodule::source_cell2d ( class(disv2dtype this)

Definition at line 543 of file Disv2d.f90.

544  ! -- dummy
545  class(Disv2dType) :: this
546  ! -- locals
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()
552  integer(I4B) :: i
553  !
554  ! -- set pointers to input path ncvert and icvert
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)
558  !
559  ! --
560  if (associated(icell2d) .and. associated(ncvert) &
561  .and. associated(icvert)) then
562  call this%define_cellverts(icell2d, ncvert, icvert)
563  else
564  call store_error('Required cell vertex array(s) [ICELL2D, NCVERT, ICVERT] &
565  &not found.')
566  end if
567  !
568  ! -- copy cell center idm sourced values to local arrays
569  call mem_setptr(cell_x, 'XC', this%input_mempath)
570  call mem_setptr(cell_y, 'YC', this%input_mempath)
571  !
572  ! -- set cell centers
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)
577  end do
578  else
579  call store_error('Required cell center arrays not found.')
580  end if
581  !
582  ! -- log
583  if (this%iout > 0) then
584  write (this%iout, '(1x,a)') 'Discretization Cell2d data loaded'
585  end if
586  !
Here is the call graph for this function:

◆ source_dimensions()

subroutine disv2dmodule::source_dimensions ( class(disv2dtype this)
private

Definition at line 275 of file Disv2d.f90.

276  ! -- dummy
277  class(Disv2dType) :: this
278  ! -- locals
279  integer(I4B) :: j
280  type(DisvFoundType) :: found
281  !
282  ! -- update defaults with idm sourced values
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)
285  !
286  ! -- log simulation values
287  if (this%iout > 0) then
288  call this%log_dimensions(found)
289  end if
290  !
291  ! -- verify dimensions were set
292  if (this%nodes < 1) then
293  call store_error( &
294  'NODES was not specified or was specified incorrectly.')
295  call store_error_filename(this%input_fname)
296  end if
297  if (this%nvert < 1) then
298  call store_error( &
299  'NVERT was not specified or was specified incorrectly.')
300  call store_error_filename(this%input_fname)
301  end if
302  !
303  ! -- Calculate nodesuser
304  this%nodesuser = this%nodes
305  !
306  ! -- Allocate non-reduced vectors for disv
307  call mem_allocate(this%idomain, this%nodes, 'IDOMAIN', &
308  this%memoryPath)
309  call mem_allocate(this%bottom, this%nodes, 'BOTTOM', &
310  this%memoryPath)
311  !
312  ! -- Allocate vertices array
313  call mem_allocate(this%vertices, 2, this%nvert, 'VERTICES', this%memoryPath)
314  call mem_allocate(this%cellxy, 2, this%nodesuser, 'CELLXY', this%memoryPath)
315  !
316  ! -- initialize all cells to be active (idomain = 1)
317  do j = 1, this%nodesuser
318  this%idomain(j) = 1
319  end do
320  !
Here is the call graph for this function:

◆ source_griddata()

subroutine disv2dmodule::source_griddata ( class(disv2dtype this)
private

Definition at line 346 of file Disv2d.f90.

347  ! -- dummy
348  class(Disv2dType) :: this
349  ! -- locals
350  type(DisvFoundType) :: found
351  !
352  ! -- update defaults with idm sourced values
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)
355  !
356  ! -- log simulation values
357  if (this%iout > 0) then
358  call this%log_griddata(found)
359  end if
360  !

◆ source_options()

subroutine disv2dmodule::source_options ( class(disv2dtype this)

Definition at line 215 of file Disv2d.f90.

216  ! -- dummy
217  class(Disv2dType) :: this
218  ! -- locals
219  character(len=LENVARNAME), dimension(3) :: lenunits = &
220  &[character(len=LENVARNAME) :: 'FEET', 'METERS', 'CENTIMETERS']
221  type(disvfoundtype) :: found
222  !
223  ! -- update defaults with idm sourced values
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)
230  !
231  ! -- log values to list file
232  if (this%iout > 0) then
233  call this%log_options(found)
234  end if
235  !

◆ source_vertices()

subroutine disv2dmodule::source_vertices ( class(disv2dtype this)
private

Definition at line 471 of file Disv2d.f90.

472  ! -- dummy
473  class(Disv2dType) :: this
474  ! -- local
475  integer(I4B) :: i
476  real(DP), dimension(:), contiguous, pointer :: vert_x => null()
477  real(DP), dimension(:), contiguous, pointer :: vert_y => null()
478  !
479  ! -- set pointers to memory manager input arrays
480  call mem_setptr(vert_x, 'XV', this%input_mempath)
481  call mem_setptr(vert_y, 'YV', this%input_mempath)
482  !
483  ! -- set vertices 2d array
484  if (associated(vert_x) .and. associated(vert_y)) then
485  do i = 1, this%nvert
486  this%vertices(1, i) = vert_x(i)
487  this%vertices(2, i) = vert_y(i)
488  end do
489  else
490  call store_error('Required Vertex arrays not found.')
491  end if
492  !
493  ! -- log
494  if (this%iout > 0) then
495  write (this%iout, '(1x,a)') 'Discretization Vertex data loaded'
496  end if
497  !
Here is the call graph for this function:

◆ write_grb()

subroutine disv2dmodule::write_grb ( class(disv2dtype this,
integer(i4b), dimension(:), intent(in)  icelltype 
)
private

Definition at line 661 of file Disv2d.f90.

662  ! -- modules
663  use openspecmodule, only: access, form
664  ! -- dummy
665  class(Disv2dType) :: this
666  integer(I4B), dimension(:), intent(in) :: icelltype
667  ! -- local
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
673  ! -- formats
674  character(len=*), parameter :: fmtgrdsave = &
675  "(4X,'BINARY GRID INFORMATION WILL BE WRITTEN TO:', &
676  &/,6X,'UNIT NUMBER: ', I0,/,6X, 'FILE NAME: ', A)"
677  !
678  ! -- Initialize
679  ntxt = 18
680  !
681  ! -- Open the file
682  fname = trim(this%input_fname)//'.grb'
683  iunit = getunit()
684  write (this%iout, fmtgrdsave) iunit, trim(adjustl(fname))
685  call openfile(iunit, this%iout, trim(adjustl(fname)), 'DATA(BINARY)', &
686  form, access, 'REPLACE')
687  !
688  ! -- write header information
689  write (txthdr, '(a)') 'GRID DISV2D'
690  txthdr(50:50) = new_line('a')
691  write (iunit) txthdr
692  write (txthdr, '(a)') 'VERSION 1'
693  txthdr(50:50) = new_line('a')
694  write (iunit) txthdr
695  write (txthdr, '(a, i0)') 'NTXT ', ntxt
696  txthdr(50:50) = new_line('a')
697  write (iunit) txthdr
698  write (txthdr, '(a, i0)') 'LENTXT ', lentxt
699  txthdr(50:50) = new_line('a')
700  write (iunit) txthdr
701  !
702  ! -- write variable definitions
703  write (txt, '(3a, i0)') 'NCELLS ', 'INTEGER ', 'NDIM 0 # ', this%nodesuser
704  txt(lentxt:lentxt) = new_line('a')
705  write (iunit) txt
706  write (txt, '(3a, i0)') 'NODES ', 'INTEGER ', 'NDIM 0 # ', this%nodes
707  txt(lentxt:lentxt) = new_line('a')
708  write (iunit) txt
709  write (txt, '(3a, i0)') 'NVERT ', 'INTEGER ', 'NDIM 0 # ', this%nvert
710  txt(lentxt:lentxt) = new_line('a')
711  write (iunit) txt
712  write (txt, '(3a, i0)') 'NJAVERT ', 'INTEGER ', 'NDIM 0 # ', size(this%javert)
713  txt(lentxt:lentxt) = new_line('a')
714  write (iunit) txt
715  write (txt, '(3a, i0)') 'NJA ', 'INTEGER ', 'NDIM 0 # ', this%con%nja
716  txt(lentxt:lentxt) = new_line('a')
717  write (iunit) txt
718  write (txt, '(3a, 1pg25.15e3)') &
719  'XORIGIN ', 'DOUBLE ', 'NDIM 0 # ', this%xorigin
720  txt(lentxt:lentxt) = new_line('a')
721  write (iunit) txt
722  write (txt, '(3a, 1pg25.15e3)') &
723  'YORIGIN ', 'DOUBLE ', 'NDIM 0 # ', this%yorigin
724  txt(lentxt:lentxt) = new_line('a')
725  write (iunit) txt
726  write (txt, '(3a, 1pg25.15e3)') 'ANGROT ', 'DOUBLE ', 'NDIM 0 # ', this%angrot
727  txt(lentxt:lentxt) = new_line('a')
728  write (iunit) txt
729  write (txt, '(3a, i0)') 'BOTM ', 'DOUBLE ', 'NDIM 1 ', this%nodesuser
730  txt(lentxt:lentxt) = new_line('a')
731  write (iunit) txt
732  write (txt, '(3a, i0)') 'VERTICES ', 'DOUBLE ', 'NDIM 2 2 ', this%nvert
733  txt(lentxt:lentxt) = new_line('a')
734  write (iunit) txt
735  write (txt, '(3a, i0)') 'CELLX ', 'DOUBLE ', 'NDIM 1 ', this%nodesuser
736  txt(lentxt:lentxt) = new_line('a')
737  write (iunit) txt
738  write (txt, '(3a, i0)') 'CELLY ', 'DOUBLE ', 'NDIM 1 ', this%nodesuser
739  txt(lentxt:lentxt) = new_line('a')
740  write (iunit) txt
741  write (txt, '(3a, i0)') 'IAVERT ', 'INTEGER ', 'NDIM 1 ', this%nodesuser + 1
742  txt(lentxt:lentxt) = new_line('a')
743  write (iunit) txt
744  write (txt, '(3a, i0)') 'JAVERT ', 'INTEGER ', 'NDIM 1 ', size(this%javert)
745  txt(lentxt:lentxt) = new_line('a')
746  write (iunit) txt
747  write (txt, '(3a, i0)') 'IA ', 'INTEGER ', 'NDIM 1 ', this%nodesuser + 1
748  txt(lentxt:lentxt) = new_line('a')
749  write (iunit) txt
750  write (txt, '(3a, i0)') 'JA ', 'INTEGER ', 'NDIM 1 ', size(this%con%jausr)
751  txt(lentxt:lentxt) = new_line('a')
752  write (iunit) txt
753  write (txt, '(3a, i0)') 'IDOMAIN ', 'INTEGER ', 'NDIM 1 ', this%nodesuser
754  txt(lentxt:lentxt) = new_line('a')
755  write (iunit) txt
756  write (txt, '(3a, i0)') 'ICELLTYPE ', 'INTEGER ', 'NDIM 1 ', this%nodesuser
757  txt(lentxt:lentxt) = new_line('a')
758  write (iunit) txt
759  !
760  ! -- write data
761  write (iunit) this%nodesuser ! ncells
762  write (iunit) this%nodes ! nodes
763  write (iunit) this%nvert ! nvert
764  write (iunit) size(this%javert) ! njavert
765  write (iunit) this%nja ! nja
766  write (iunit) this%xorigin ! xorigin
767  write (iunit) this%yorigin ! yorigin
768  write (iunit) this%angrot ! angrot
769  write (iunit) this%bottom ! botm
770  write (iunit) this%vertices ! vertices
771  write (iunit) (this%cellxy(1, i), i=1, this%nodesuser) ! cellx
772  write (iunit) (this%cellxy(2, i), i=1, this%nodesuser) ! celly
773  write (iunit) this%iavert ! iavert
774  write (iunit) this%javert ! javert
775  write (iunit) this%con%iausr ! iausr
776  write (iunit) this%con%jausr ! jausr
777  write (iunit) this%idomain ! idomain
778  write (iunit) icelltype ! icelltype
779  !
780  ! -- Close the file
781  close (iunit)
782  !
character(len=20) access
Definition: OpenSpec.f90:7
character(len=20) form
Definition: OpenSpec.f90:7
Here is the call graph for this function: