MODFLOW 6  version 6.5.0.dev2
MODFLOW 6 Code Documentation
disconnexchangemodule Module Reference

Data Types

type  disconnexchangetype
 Exchange based on connection between discretizations of DisBaseType. The data specifies the connections, similar to the information stored in the connections object: DisBaseTypecon. More...
 
type  disconnexchangefoundtype
 @ brief DisConnExchangeFoundType More...
 

Functions/Subroutines

subroutine source_options (this, iout)
 Source options from input context. More...
 
subroutine source_dimensions (this, iout)
 Source dimension from input context. More...
 
integer(i4b) function noder (this, model, cellid, iout)
 Returns reduced node number from user. More...
 
character(len=20) function cellstr (this, ndim, cellid, iout)
 
subroutine source_data (this, iout)
 Source exchange data from input context. More...
 
subroutine allocate_scalars (this)
 Allocate scalars and initialize to defaults. More...
 
subroutine allocate_arrays (this)
 Allocate array data, using the number of connected nodes. More...
 
logical(lgp) function use_interface_model (this)
 Should interface model be used to handle these exchanges, to be overridden for inheriting types. More...
 
subroutine disconnex_da (this)
 Clean up all scalars and arrays. More...
 
class(disconnexchangetype) function, pointer, public castasdisconnexchangeclass (obj)
 
subroutine, public adddisconnexchangetolist (list, exchange)
 
class(disconnexchangetype) function, pointer, public getdisconnexchangefromlist (list, idx)
 

Function/Subroutine Documentation

◆ adddisconnexchangetolist()

subroutine, public disconnexchangemodule::adddisconnexchangetolist ( type(listtype), intent(inout)  list,
class(disconnexchangetype), intent(in), pointer  exchange 
)

Definition at line 553 of file DisConnExchange.f90.

554  implicit none
555  ! -- dummy
556  type(ListType), intent(inout) :: list
557  class(DisConnExchangeType), pointer, intent(in) :: exchange
558  ! -- local
559  class(*), pointer :: obj
560  !
561  obj => exchange
562  call list%Add(obj)
563  !
564  ! -- Return
565  return

◆ allocate_arrays()

subroutine disconnexchangemodule::allocate_arrays ( class(disconnexchangetype this)
Parameters
nexg
thisinstance of exchange object

Definition at line 454 of file DisConnExchange.f90.

455  ! -- dummy
456  class(DisConnExchangeType) :: this !< instance of exchange object
457  !
458  call mem_allocate(this%nodem1, this%nexg, 'NODEM1', this%memoryPath)
459  call mem_allocate(this%nodem2, this%nexg, 'NODEM2', this%memoryPath)
460  call mem_allocate(this%ihc, this%nexg, 'IHC', this%memoryPath)
461  call mem_allocate(this%cl1, this%nexg, 'CL1', this%memoryPath)
462  call mem_allocate(this%cl2, this%nexg, 'CL2', this%memoryPath)
463  call mem_allocate(this%hwva, this%nexg, 'HWVA', this%memoryPath)
464  ! NB: auxname array is allocated while parsing
465  call mem_allocate(this%auxvar, this%naux, this%nexg, &
466  'AUXVAR', this%memoryPath)
467  !
468  ! allocate boundname
469  if (this%inamedbound == 1) then
470  allocate (this%boundname(this%nexg))
471  else
472  allocate (this%boundname(1))
473  end if
474  this%boundname(:) = ''
475  !
476  ! -- Return
477  return

◆ allocate_scalars()

subroutine disconnexchangemodule::allocate_scalars ( class(disconnexchangetype this)
Parameters
thisinstance of exchange object

Definition at line 410 of file DisConnExchange.f90.

411  ! -- modules
413  ! -- dummy
414  class(DisConnExchangeType) :: this !< instance of exchange object
415  !
416  allocate (this%filename)
417  this%filename = ''
418  !
419  call mem_allocate(this%nexg, 'NEXG', this%memoryPath)
420  call mem_allocate(this%naux, 'NAUX', this%memoryPath)
421  call mem_allocate(this%ianglex, 'IANGLEX', this%memoryPath)
422  call mem_allocate(this%icdist, 'ICDIST', this%memoryPath)
423  call mem_allocate(this%ixt3d, 'IXT3D', this%memoryPath)
424  call mem_allocate(this%iprpak, 'IPRPAK', this%memoryPath)
425  call mem_allocate(this%iprflow, 'IPRFLOW', this%memoryPath)
426  call mem_allocate(this%ipakcb, 'IPAKCB', this%memoryPath)
427  call mem_allocate(this%inamedbound, 'INAMEDBOUND', this%memoryPath)
428  call mem_allocate(this%dev_ifmod_on, 'DEV_IFMOD_ON', this%memoryPath)
429 
430  call mem_allocate(this%auxname, lenauxname, 0, &
431  'AUXNAME', this%memoryPath)
432  call mem_allocate(this%auxname_cst, lenauxname, 0, &
433  'AUXNAME_CST', this%memoryPath)
434  !
435  this%nexg = 0
436  this%naux = 0
437  this%ianglex = 0
438  this%icdist = 0
439  this%ixt3d = 0
440  this%iprpak = 0
441  this%iprflow = 0
442  this%ipakcb = 0
443  this%inamedbound = 0
444  !
445  this%dev_ifmod_on = .false.
446  !
447  ! -- Return
448  return

◆ castasdisconnexchangeclass()

class(disconnexchangetype) function, pointer, public disconnexchangemodule::castasdisconnexchangeclass ( class(*), intent(inout), pointer  obj)

Definition at line 534 of file DisConnExchange.f90.

535  implicit none
536  ! -- dummy
537  class(*), pointer, intent(inout) :: obj
538  ! -- return
539  class(DisConnExchangeType), pointer :: res
540  !
541  res => null()
542  if (.not. associated(obj)) return
543  !
544  select type (obj)
545  class is (disconnexchangetype)
546  res => obj
547  end select
548  !
549  ! -- Return
550  return
Here is the caller graph for this function:

◆ cellstr()

character(len=20) function disconnexchangemodule::cellstr ( class(disconnexchangetype this,
integer(i4b)  ndim,
integer(i4b), dimension(:), intent(in), pointer  cellid,
integer(i4b), intent(in)  iout 
)
Parameters
thisinstance of exchange object
ndimmodel DIS dimension
[in]ioutthe output file unit

Definition at line 229 of file DisConnExchange.f90.

230  ! -- modules
231  ! -- dummy
232  class(DisConnExchangeType) :: this !< instance of exchange object
233  integer(I4B) :: ndim !< model DIS dimension
234  integer(I4B), dimension(:), pointer, intent(in) :: cellid
235  integer(I4B), intent(in) :: iout !< the output file unit
236  character(len=20) :: cellstr
237  character(len=*), parameter :: fmtndim1 = &
238  "('(',i0,')')"
239  character(len=*), parameter :: fmtndim2 = &
240  "('(',i0,',',i0,')')"
241  character(len=*), parameter :: fmtndim3 = &
242  "('(',i0,',',i0,',',i0,')')"
243  !
244  cellstr = ''
245  !
246  select case (ndim)
247  case (1)
248  write (cellstr, fmtndim1) cellid(1)
249  case (2)
250  write (cellstr, fmtndim2) cellid(1), cellid(2)
251  case (3)
252  write (cellstr, fmtndim3) cellid(1), cellid(2), cellid(3)
253  case default
254  end select
255  !
256  ! -- return
257  return

◆ disconnex_da()

subroutine disconnexchangemodule::disconnex_da ( class(disconnexchangetype this)
private
Parameters
thisinstance of exchange object

Definition at line 499 of file DisConnExchange.f90.

500  ! -- modules
502  ! -- dummy
503  class(DisConnExchangeType) :: this !< instance of exchange object
504  !
505  ! arrays
506  call mem_deallocate(this%nodem1)
507  call mem_deallocate(this%nodem2)
508  call mem_deallocate(this%ihc)
509  call mem_deallocate(this%cl1)
510  call mem_deallocate(this%cl2)
511  call mem_deallocate(this%hwva)
512  call mem_deallocate(this%auxvar)
513  !
514  deallocate (this%boundname)
515  !
516  ! scalars
517  call mem_deallocate(this%nexg)
518  call mem_deallocate(this%naux)
519  call mem_deallocate(this%auxname, 'AUXNAME', this%memoryPath)
520  call mem_deallocate(this%auxname_cst, 'AUXNAME_CST', this%memoryPath)
521  call mem_deallocate(this%ianglex)
522  call mem_deallocate(this%icdist)
523  call mem_deallocate(this%ixt3d)
524  call mem_deallocate(this%iprpak)
525  call mem_deallocate(this%iprflow)
526  call mem_deallocate(this%ipakcb)
527  call mem_deallocate(this%inamedbound)
528  call mem_deallocate(this%dev_ifmod_on)
529  !
530  ! -- Return
531  return

◆ getdisconnexchangefromlist()

class(disconnexchangetype) function, pointer, public disconnexchangemodule::getdisconnexchangefromlist ( type(listtype), intent(inout)  list,
integer(i4b), intent(in)  idx 
)

Definition at line 568 of file DisConnExchange.f90.

569  implicit none
570  ! -- dummy
571  type(ListType), intent(inout) :: list
572  integer(I4B), intent(in) :: idx
573  ! -- return
574  class(DisConnExchangeType), pointer :: res
575  ! -- local
576  class(*), pointer :: obj
577  !
578  obj => list%GetItem(idx)
579  res => castasdisconnexchangeclass(obj)
580  !
581  ! -- Return
582  return
Here is the call graph for this function:
Here is the caller graph for this function:

◆ noder()

integer(i4b) function disconnexchangemodule::noder ( class(disconnexchangetype this,
class(numericalmodeltype), intent(in), pointer  model,
integer(i4b), dimension(:), intent(in), pointer  cellid,
integer(i4b), intent(in)  iout 
)
Parameters
thisinstance of exchange object
[in]ioutthe output file unit

Definition at line 199 of file DisConnExchange.f90.

200  ! -- modules
201  use geomutilmodule, only: get_node
202  ! -- dummy
203  class(DisConnExchangeType) :: this !< instance of exchange object
204  class(NumericalModelType), pointer, intent(in) :: model
205  integer(I4B), dimension(:), pointer, intent(in) :: cellid
206  integer(I4B), intent(in) :: iout !< the output file unit
207  integer(I4B) :: noder, node
208  !
209  if (model%dis%ndim == 1) then
210  node = cellid(1)
211  elseif (model%dis%ndim == 2) then
212  node = get_node(cellid(1), 1, cellid(2), &
213  model%dis%mshape(1), 1, &
214  model%dis%mshape(2))
215  else
216  node = get_node(cellid(1), cellid(2), cellid(3), &
217  model%dis%mshape(1), &
218  model%dis%mshape(2), &
219  model%dis%mshape(3))
220  end if
221  noder = model%dis%get_nodenumber(node, 0)
222  !
223  ! -- return
224  return
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...
Definition: GeomUtil.f90:80
Here is the call graph for this function:

◆ source_data()

subroutine disconnexchangemodule::source_data ( class(disconnexchangetype this,
integer(i4b), intent(in)  iout 
)
private
Parameters
thisinstance of exchange object
[in]ioutthe output file unit

Definition at line 262 of file DisConnExchange.f90.

263  ! -- modules
265  ! -- dummy
266  class(DisConnExchangeType) :: this !< instance of exchange object
267  integer(I4B), intent(in) :: iout !< the output file unit
268  ! -- local
269  integer(I4B), dimension(:, :), contiguous, pointer :: cellidm1
270  integer(I4B), dimension(:, :), contiguous, pointer :: cellidm2
271  integer(I4B), dimension(:), contiguous, pointer :: ihc
272  real(DP), dimension(:), contiguous, pointer :: cl1
273  real(DP), dimension(:), contiguous, pointer :: cl2
274  real(DP), dimension(:), contiguous, pointer :: hwva
275  real(DP), dimension(:, :), contiguous, pointer :: auxvar
276  type(CharacterStringType), dimension(:), contiguous, pointer :: boundname
277  integer(I4B) :: ndim1, ndim2
278  character(len=20) :: cellstr1, cellstr2
279  character(len=2) :: cnfloat
280  integer(I4B) :: nerr, iaux
281  integer(I4B) :: iexg, nodem1, nodem2
282  ! -- format
283  character(len=*), parameter :: fmtexglabel = "(1x, 3a10, 50(a16))"
284  character(len=*), parameter :: fmtexgdata = &
285  "(5x, a, 1x, a ,I10, 50(1pg16.6))"
286  character(len=40) :: fmtexgdata2
287  !
288  call mem_setptr(cellidm1, 'CELLIDM1', this%input_mempath)
289  call mem_setptr(cellidm2, 'CELLIDM2', this%input_mempath)
290  call mem_setptr(ihc, 'IHC', this%input_mempath)
291  call mem_setptr(cl1, 'CL1', this%input_mempath)
292  call mem_setptr(cl2, 'CL2', this%input_mempath)
293  call mem_setptr(hwva, 'HWVA', this%input_mempath)
294  call mem_setptr(auxvar, 'AUX', this%input_mempath)
295  call mem_setptr(boundname, 'BOUNDNAME', this%input_mempath)
296  ndim1 = size(cellidm1, dim=1)
297  ndim2 = size(cellidm2, dim=1)
298  !
299  write (iout, '(1x,a)') 'PROCESSING EXCHANGEDATA'
300  !
301  if (this%iprpak /= 0) then
302  if (this%inamedbound == 0) then
303  write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', &
304  'CL1', 'CL2', 'HWVA', (adjustr(this%auxname(iaux)), &
305  iaux=1, this%naux)
306  else
307  write (iout, fmtexglabel) 'NODEM1', 'NODEM2', 'IHC', 'CL1', 'CL2', &
308  'HWVA', (adjustr(this%auxname(iaux)), iaux=1, this%naux), &
309  ' BOUNDNAME '
310  ! Define format suitable for writing input data,
311  ! any auxiliary variables, and boundname.
312  write (cnfloat, '(i0)') 3 + this%naux
313  fmtexgdata2 = '(5x, a, 1x, a, i10, '//trim(cnfloat)// &
314  '(1pg16.6), 1x, a)'
315  end if
316  end if
317  !
318  do iexg = 1, this%nexg
319  !
320  if (associated(this%model1)) then
321  !
322  ! -- Determine reduced node number
323  nodem1 = this%noder(this%model1, cellidm1(:, iexg), iout)
324  this%nodem1(iexg) = nodem1
325  !
326  else
327  this%nodem1(iexg) = -1
328  end if
329  !
330  if (associated(this%model2)) then
331  !
332  ! -- Determine reduced node number
333  nodem2 = this%noder(this%model2, cellidm2(:, iexg), iout)
334  this%nodem2(iexg) = nodem2
335  !
336  else
337  this%nodem2(iexg) = -1
338  end if
339  !
340  ! -- Read rest of input line
341  this%ihc(iexg) = ihc(iexg)
342  this%cl1(iexg) = cl1(iexg)
343  this%cl2(iexg) = cl2(iexg)
344  this%hwva(iexg) = hwva(iexg)
345  do iaux = 1, this%naux
346  this%auxvar(iaux, iexg) = auxvar(iaux, iexg)
347  end do
348  if (this%inamedbound == 1) then
349  this%boundname(iexg) = boundname(iexg)
350  end if
351  !
352  ! -- Write the data to listing file if requested
353  if (this%iprpak /= 0) then
354  cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout)
355  cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout)
356  if (this%inamedbound == 0) then
357  write (iout, fmtexgdata) trim(cellstr1), trim(cellstr2), &
358  this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), &
359  this%hwva(iexg), &
360  (this%auxvar(iaux, iexg), iaux=1, this%naux)
361  else
362  write (iout, fmtexgdata2) trim(cellstr1), trim(cellstr2), &
363  this%ihc(iexg), this%cl1(iexg), this%cl2(iexg), &
364  this%hwva(iexg), &
365  (this%auxvar(iaux, iexg), iaux=1, this%naux), &
366  trim(this%boundname(iexg))
367  end if
368  end if
369  !
370  ! -- Check to see if nodem1 is outside of active domain
371  if (associated(this%model1)) then
372  if (nodem1 <= 0) then
373  cellstr1 = this%cellstr(ndim1, cellidm1(:, iexg), iout)
374  write (errmsg, *) &
375  trim(adjustl(this%model1%name))// &
376  ' Cell is outside active grid domain ('// &
377  trim(adjustl(cellstr1))//').'
378  call store_error(errmsg)
379  end if
380  end if
381  !
382  ! -- Check to see if nodem2 is outside of active domain
383  if (associated(this%model2)) then
384  if (nodem2 <= 0) then
385  cellstr2 = this%cellstr(ndim2, cellidm2(:, iexg), iout)
386  write (errmsg, *) &
387  trim(adjustl(this%model2%name))// &
388  ' Cell is outside active grid domain ('// &
389  trim(adjustl(cellstr2))//').'
390  call store_error(errmsg)
391  end if
392  end if
393  end do
394  !
395  write (iout, '(1x,a)') 'END OF EXCHANGEDATA'
396  !
397  ! -- Stop if errors
398  nerr = count_errors()
399  if (nerr > 0) then
400  call store_error('Errors encountered in exchange input file.')
401  call store_error_filename(this%filename)
402  end if
403  !
404  ! -- Return
405  return
Here is the call graph for this function:

◆ source_dimensions()

subroutine disconnexchangemodule::source_dimensions ( class(disconnexchangetype this,
integer(i4b), intent(in)  iout 
)
Parameters
thisinstance of exchange object
[in]ioutfor logging

Definition at line 173 of file DisConnExchange.f90.

174  ! -- modules
176  ! -- dummy
177  class(DisConnExchangeType) :: this !< instance of exchange object
178  integer(I4B), intent(in) :: iout !< for logging
179  ! -- local
180  type(DisConnExchangeFoundType) :: found
181  !
182  ! -- update defaults with idm sourced values
183  call mem_set_value(this%nexg, 'NEXG', this%input_mempath, found%nexg)
184  !
185  write (iout, '(1x,a)') 'PROCESSING EXCHANGE DIMENSIONS'
186  !
187  if (found%nexg) then
188  write (iout, '(4x,a,i0)') 'NEXG = ', this%nexg
189  end if
190  !
191  write (iout, '(1x,a)') 'END OF EXCHANGE DIMENSIONS'
192  !
193  ! -- return
194  return

◆ source_options()

subroutine disconnexchangemodule::source_options ( class(disconnexchangetype this,
integer(i4b), intent(in)  iout 
)
private
Parameters
thisinstance of exchange object
[in]ioutfor logging

Definition at line 95 of file DisConnExchange.f90.

96  ! -- modules
98  use arrayhandlersmodule, only: ifind
99  ! -- dummy
100  class(DisConnExchangeType) :: this !< instance of exchange object
101  integer(I4B), intent(in) :: iout !< for logging
102  ! -- local
103  type(DisConnExchangeFoundType) :: found
104  integer(I4B) :: ival, n
105  !
106  ! -- update defaults with idm sourced values
107  call mem_set_value(this%naux, 'NAUX', this%input_mempath, found%naux)
108  call mem_set_value(this%ipakcb, 'IPAKCB', this%input_mempath, found%ipakcb)
109  call mem_set_value(this%iprpak, 'IPRPAK', this%input_mempath, found%iprpak)
110  call mem_set_value(this%iprflow, 'IPRFLOW', this%input_mempath, found%iprflow)
111  call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%input_mempath, &
112  found%boundnames)
113  call mem_set_value(this%dev_ifmod_on, 'DEV_IFMOD_ON', this%input_mempath, &
114  found%dev_ifmod_on)
115  !
116  ! -- reallocate aux arrays if aux variables provided
117  if (found%naux .and. this%naux > 0) then
118  call mem_reallocate(this%auxname, lenauxname, this%naux, &
119  'AUXNAME', this%memoryPath)
120  call mem_reallocate(this%auxname_cst, lenauxname, this%naux, &
121  'AUXNAME_CST', this%memoryPath)
122  call mem_set_value(this%auxname_cst, 'AUXILIARY', this%input_mempath, &
123  found%auxiliary)
124  !
125  do n = 1, this%naux
126  this%auxname(n) = this%auxname_cst(n)
127  end do
128  !
129  ! -- If ANGLDEGX is an auxiliary variable, then anisotropy can be
130  ! used in either model. Store ANGLDEGX position in this%ianglex
131  ival = ifind(this%auxname, 'ANGLDEGX')
132  if (ival > 0) then
133  this%ianglex = ival
134  end if
135  !
136  ival = ifind(this%auxname, 'CDIST')
137  if (ival > 0) then
138  this%icdist = ival
139  end if
140  end if
141  !
142  if (found%ipakcb) then
143  this%ipakcb = -1
144  write (iout, '(4x,a)') &
145  'EXCHANGE FLOWS WILL BE SAVED TO BINARY BUDGET FILES.'
146  end if
147  !
148  if (found%iprpak) then
149  write (iout, '(4x,a)') &
150  'THE LIST OF EXCHANGES WILL BE PRINTED.'
151  end if
152  !
153  if (found%iprflow) then
154  write (iout, '(4x,a)') &
155  'EXCHANGE FLOWS WILL BE PRINTED TO LIST FILES.'
156  end if
157  !
158  if (found%boundnames) then
159  write (iout, '(4x,a)') 'EXCHANGE BOUNDARIES HAVE NAMES IN LAST COLUMN'
160  end if
161  !
162  if (found%dev_ifmod_on) then
163  write (iout, '(4x,2a)') 'Interface model coupling approach manually &
164  &activated for ', trim(this%name)
165  end if
166  !
167  ! -- Return
168  return

◆ use_interface_model()

logical(lgp) function disconnexchangemodule::use_interface_model ( class(disconnexchangetype this)
private
Parameters
thisinstance of exchange object
Returns
flag whether interface model should be used for this exchange instead

Definition at line 483 of file DisConnExchange.f90.

484  ! -- dummy
485  class(DisConnExchangeType) :: this !< instance of exchange object
486  ! -- return
487  logical(LGP) :: use_im !< flag whether interface model should be used
488  !! for this exchange instead
489  !
490  ! use im when one of the models is not local
491  use_im = .not. (this%v_model1%is_local .and. this%v_model2%is_local)
492  !
493  ! -- Return
494  return