MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
structarraymodule Module Reference

This module contains the StructArrayModule. More...

Data Types

type  structarraytype
 type for structured array More...
 

Functions/Subroutines

type(structarraytype) function, pointer, public constructstructarray (mf6_input, ncol, nrow, blocknum, mempath, component_mempath)
 constructor for a struct_array More...
 
subroutine, public destructstructarray (struct_array)
 destructor for a struct_array More...
 
subroutine mem_create_vector (this, icol, idt)
 create new vector in StructArrayType More...
 
integer(i4b) function count (this)
 
subroutine set_pointer (sv, sv_target)
 
type(structvectortype) function, pointer get (this, idx)
 
subroutine allocate_int_type (this, sv)
 allocate integer input type More...
 
subroutine allocate_dbl_type (this, sv)
 allocate double input type More...
 
subroutine allocate_charstr_type (this, sv)
 allocate charstr input type More...
 
subroutine allocate_int1d_type (this, sv)
 allocate int1d input type More...
 
subroutine allocate_dbl1d_type (this, sv)
 allocate dbl1d input type More...
 
subroutine load_deferred_vector (this, icol)
 
subroutine memload_vectors (this)
 load deferred vectors into managed memory More...
 
subroutine log_structarray_vars (this, iout)
 log information about the StructArrayType More...
 
subroutine check_reallocate (this)
 reallocate local memory for deferred vectors if necessary More...
 
subroutine write_struct_vector (this, parser, sv_col, irow, timeseries, iout, auxcol)
 
integer(i4b) function read_from_parser (this, parser, timeseries, iout)
 read from the block parser to fill the StructArrayType More...
 
integer(i4b) function read_from_binary (this, inunit, iout)
 read from binary input to fill the StructArrayType More...
 

Detailed Description

This module contains the routines for reading a structured list, which consists of a separate vector for each column in the list.

Function/Subroutine Documentation

◆ allocate_charstr_type()

subroutine structarraymodule::allocate_charstr_type ( class(structarraytype this,
type(structvectortype), intent(inout)  sv 
)
private
Parameters
thisStructArrayType

Definition at line 267 of file StructArray.f90.

268  class(StructArrayType) :: this !< StructArrayType
269  type(StructVectorType), intent(inout) :: sv
270  type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d
271  integer(I4B) :: j
272  !
273  if (this%deferred_shape) then
274  allocate (charstr1d(this%deferred_size_init))
275  else
276  call mem_allocate(charstr1d, linelength, this%nrow, &
277  sv%idt%mf6varname, this%mempath)
278  end if
279  !
280  do j = 1, this%nrow
281  charstr1d(j) = ''
282  end do
283  !
284  sv%memtype = 3
285  sv%charstr1d => charstr1d

◆ allocate_dbl1d_type()

subroutine structarraymodule::allocate_dbl1d_type ( class(structarraytype this,
type(structvectortype), intent(inout)  sv 
)
Parameters
thisStructArrayType

Definition at line 375 of file StructArray.f90.

376  use memorymanagermodule, only: get_isize
377  class(StructArrayType) :: this !< StructArrayType
378  type(StructVectorType), intent(inout) :: sv
379  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
380  integer(I4B), pointer :: naux, nseg, nseg_1
381  integer(I4B) :: nseg1_isize, n, m
382  !
383  if (sv%idt%shape == 'NAUX') then
384  call mem_setptr(naux, sv%idt%shape, this%mempath)
385  !
386  call mem_allocate(dbl2d, naux, this%nrow, sv%idt%mf6varname, this%mempath)
387  !
388  ! -- initialize
389  do m = 1, this%nrow
390  do n = 1, naux
391  dbl2d(n, m) = dzero
392  end do
393  end do
394  !
395  sv%memtype = 6
396  sv%dbl2d => dbl2d
397  sv%intshape => naux
398  !
399  else if (sv%idt%shape == 'NSEG-1') then
400  call mem_setptr(nseg, 'NSEG', this%mempath)
401  !
402  call get_isize('NSEG_1', this%mempath, nseg1_isize)
403  !
404  if (nseg1_isize < 0) then
405  call mem_allocate(nseg_1, 'NSEG_1', this%mempath)
406  nseg_1 = nseg - 1
407  else
408  call mem_setptr(nseg_1, 'NSEG_1', this%mempath)
409  end if
410  !
411  call mem_allocate(dbl2d, nseg_1, this%nrow, sv%idt%mf6varname, this%mempath)
412  !
413  ! -- initialize
414  do m = 1, this%nrow
415  do n = 1, nseg_1
416  dbl2d(n, m) = dzero
417  end do
418  end do
419  !
420  sv%memtype = 6
421  sv%dbl2d => dbl2d
422  sv%intshape => nseg_1
423  !
424  else
425  errmsg = 'IDM unimplemented. StructArray::allocate_dbl1d_type &
426  & unsupported shape "'//trim(sv%idt%shape)//'".'
427  call store_error(errmsg, terminate=.true.)
428  end if
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
Here is the call graph for this function:

◆ allocate_dbl_type()

subroutine structarraymodule::allocate_dbl_type ( class(structarraytype this,
type(structvectortype), intent(inout)  sv 
)
private
Parameters
thisStructArrayType

Definition at line 240 of file StructArray.f90.

241  class(StructArrayType) :: this !< StructArrayType
242  type(StructVectorType), intent(inout) :: sv
243  real(DP), dimension(:), pointer, contiguous :: dbl1d
244  integer(I4B) :: j, nrow
245  !
246  if (this%deferred_shape) then
247  ! -- shape not known, allocate locally
248  nrow = this%deferred_size_init
249  allocate (dbl1d(this%deferred_size_init))
250  else
251  ! -- shape known, allocate in managed memory
252  nrow = this%nrow
253  call mem_allocate(dbl1d, this%nrow, sv%idt%mf6varname, this%mempath)
254  end if
255  !
256  ! -- initialize
257  do j = 1, nrow
258  dbl1d(j) = dzero
259  end do
260  !
261  sv%memtype = 2
262  sv%dbl1d => dbl1d

◆ allocate_int1d_type()

subroutine structarraymodule::allocate_int1d_type ( class(structarraytype this,
type(structvectortype), intent(inout)  sv 
)
private
Parameters
thisStructArrayType

Definition at line 290 of file StructArray.f90.

291  use constantsmodule, only: lenmodelname
294  class(StructArrayType) :: this !< StructArrayType
295  type(StructVectorType), intent(inout) :: sv
296  integer(I4B), dimension(:, :), pointer, contiguous :: int2d
297  type(STLVecInt), pointer :: intvector
298  integer(I4B), pointer :: ncelldim, exgid
299  character(len=LENMEMPATH) :: input_mempath
300  character(len=LENMODELNAME) :: mname
301  type(CharacterStringType), dimension(:), contiguous, &
302  pointer :: charstr1d
303  integer(I4B) :: nrow, n, m
304  !
305  if (sv%idt%shape == 'NCELLDIM') then
306  !
307  ! -- if EXCHANGE set to NCELLDIM of appropriate model
308  if (this%mf6_input%component_type == 'EXG') then
309  !
310  ! -- set pointer to EXGID
311  call mem_setptr(exgid, 'EXGID', this%mf6_input%mempath)
312  !
313  ! -- set pointer to appropriate exchange model array
314  input_mempath = create_mem_path('SIM', 'NAM', idm_context)
315  !
316  if (sv%idt%tagname == 'CELLIDM1') then
317  call mem_setptr(charstr1d, 'EXGMNAMEA', input_mempath)
318  else if (sv%idt%tagname == 'CELLIDM2') then
319  call mem_setptr(charstr1d, 'EXGMNAMEB', input_mempath)
320  end if
321  !
322  ! -- set the model name
323  mname = charstr1d(exgid)
324  !
325  ! -- set ncelldim pointer
326  input_mempath = create_mem_path(component=mname, context=idm_context)
327  call mem_setptr(ncelldim, sv%idt%shape, input_mempath)
328  else
329  !
330  call mem_setptr(ncelldim, sv%idt%shape, this%component_mempath)
331  end if
332  !
333  if (this%deferred_shape) then
334  ! -- shape not known, allocate locally
335  nrow = this%deferred_size_init
336  allocate (int2d(ncelldim, this%deferred_size_init))
337  !
338  else
339  ! -- shape known, allocate in managed memory
340  nrow = this%nrow
341  call mem_allocate(int2d, ncelldim, this%nrow, &
342  sv%idt%mf6varname, this%mempath)
343  end if
344  !
345  ! -- initialize
346  do m = 1, nrow
347  do n = 1, ncelldim
348  int2d(n, m) = izero
349  end do
350  end do
351  !
352  sv%memtype = 5
353  sv%int2d => int2d
354  sv%intshape => ncelldim
355  !
356  else
357  !
358  ! -- allocate intvector object
359  allocate (intvector)
360  !
361  ! -- initialize STLVecInt
362  call intvector%init()
363  !
364  sv%memtype = 4
365  sv%intvector => intvector
366  sv%size = -1
367  !
368  ! -- set pointer to dynamic shape
369  call mem_setptr(sv%intvector_shape, sv%idt%shape, this%mempath)
370  end if
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter lenmodelname
maximum length of the model name
Definition: Constants.f90:22
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=linelength) idm_context
Here is the call graph for this function:

◆ allocate_int_type()

subroutine structarraymodule::allocate_int_type ( class(structarraytype this,
type(structvectortype), intent(inout)  sv 
)
private
Parameters
thisStructArrayType

Definition at line 213 of file StructArray.f90.

214  class(StructArrayType) :: this !< StructArrayType
215  type(StructVectorType), intent(inout) :: sv
216  integer(I4B), dimension(:), pointer, contiguous :: int1d
217  integer(I4B) :: j, nrow
218  !
219  if (this%deferred_shape) then
220  ! -- shape not known, allocate locally
221  nrow = this%deferred_size_init
222  allocate (int1d(this%deferred_size_init))
223  else
224  ! -- shape known, allocate in managed memory
225  nrow = this%nrow
226  call mem_allocate(int1d, this%nrow, sv%idt%mf6varname, this%mempath)
227  end if
228  !
229  ! -- initialize vector values
230  do j = 1, nrow
231  int1d(j) = izero
232  end do
233  !
234  sv%memtype = 1
235  sv%int1d => int1d

◆ check_reallocate()

subroutine structarraymodule::check_reallocate ( class(structarraytype this)
private
Parameters
thisStructArrayType

Definition at line 672 of file StructArray.f90.

673  class(StructArrayType) :: this !< StructArrayType
674  integer(I4B) :: i, j, k, newsize
675  integer(I4B), dimension(:), pointer, contiguous :: p_int1d
676  integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d
677  real(DP), dimension(:), pointer, contiguous :: p_dbl1d
678  type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d
679  integer(I4B) :: reallocate_mult
680  !
681  ! -- set growth rate
682  reallocate_mult = 2
683  !
684  do j = 1, this%ncol
685  !
686  ! -- reallocate based on memtype
687  select case (this%struct_vectors(j)%memtype)
688  !
689  case (1) ! -- memtype integer
690  !
691  ! -- check if more space needed
692  if (this%nrow > this%struct_vectors(j)%size) then
693  !
694  ! -- calculate new size
695  newsize = this%struct_vectors(j)%size * reallocate_mult
696  !
697  ! -- allocate new vector
698  allocate (p_int1d(newsize))
699  !
700  ! -- copy from old to new
701  do i = 1, this%struct_vectors(j)%size
702  p_int1d(i) = this%struct_vectors(j)%int1d(i)
703  end do
704  !
705  ! -- deallocate old vector
706  deallocate (this%struct_vectors(j)%int1d)
707  !
708  ! -- update struct array object
709  this%struct_vectors(j)%int1d => p_int1d
710  this%struct_vectors(j)%size = newsize
711  end if
712  !
713  case (2) ! -- memtype real
714  if (this%nrow > this%struct_vectors(j)%size) then
715  !
716  newsize = this%struct_vectors(j)%size * reallocate_mult
717  !
718  allocate (p_dbl1d(newsize))
719  !
720  do i = 1, this%struct_vectors(j)%size
721  p_dbl1d(i) = this%struct_vectors(j)%dbl1d(i)
722  end do
723  !
724  deallocate (this%struct_vectors(j)%dbl1d)
725  !
726  this%struct_vectors(j)%dbl1d => p_dbl1d
727  this%struct_vectors(j)%size = newsize
728  end if
729  !
730  case (3) ! -- memtype charstring
731  if (this%nrow > this%struct_vectors(j)%size) then
732  !
733  newsize = this%struct_vectors(j)%size * reallocate_mult
734  !
735  allocate (p_charstr1d(newsize))
736  !
737  do i = 1, this%struct_vectors(j)%size
738  p_charstr1d(i) = this%struct_vectors(j)%charstr1d(i)
739  end do
740  !
741  deallocate (this%struct_vectors(j)%charstr1d)
742  !
743  this%struct_vectors(j)%charstr1d => p_charstr1d
744  this%struct_vectors(j)%size = newsize
745  end if
746  case (5)
747  if (this%nrow > this%struct_vectors(j)%size) then
748  !
749  newsize = this%struct_vectors(j)%size * reallocate_mult
750  !
751  allocate (p_int2d(this%struct_vectors(j)%intshape, newsize))
752  !
753  do i = 1, this%struct_vectors(j)%size
754  do k = 1, this%struct_vectors(j)%intshape
755  p_int2d(k, i) = this%struct_vectors(j)%int2d(k, i)
756  end do
757  end do
758  !
759  deallocate (this%struct_vectors(j)%int2d)
760  !
761  this%struct_vectors(j)%int2d => p_int2d
762  this%struct_vectors(j)%size = newsize
763  end if
764  ! TODO: case (6)
765  case default
766  errmsg = 'IDM unimplemented. StructArray::check_reallocate &
767  &unsupported memtype.'
768  call store_error(errmsg, terminate=.true.)
769  end select
770  end do
Here is the call graph for this function:

◆ constructstructarray()

type(structarraytype) function, pointer, public structarraymodule::constructstructarray ( type(modflowinputtype), intent(in)  mf6_input,
integer(i4b), intent(in)  ncol,
integer(i4b), intent(in)  nrow,
integer(i4b), intent(in)  blocknum,
character(len=*), intent(in)  mempath,
character(len=*), intent(in)  component_mempath 
)
Parameters
[in]ncolnumber of columns in the StructArrayType
[in]nrownumber of rows in the StructArrayType
[in]blocknumvalid block number or 0
[in]mempathmemory path for storing the vector
Returns
new StructArrayType

Definition at line 72 of file StructArray.f90.

74  type(ModflowInputType), intent(in) :: mf6_input
75  integer(I4B), intent(in) :: ncol !< number of columns in the StructArrayType
76  integer(I4B), intent(in) :: nrow !< number of rows in the StructArrayType
77  integer(I4B), intent(in) :: blocknum !< valid block number or 0
78  character(len=*), intent(in) :: mempath !< memory path for storing the vector
79  character(len=*), intent(in) :: component_mempath
80  type(StructArrayType), pointer :: struct_array !< new StructArrayType
81  !
82  ! -- allocate StructArrayType
83  allocate (struct_array)
84  !
85  ! -- set description of input
86  struct_array%mf6_input = mf6_input
87  !
88  ! -- set number of arrays
89  struct_array%ncol = ncol
90  !
91  ! -- set rows if known or set deferred
92  struct_array%nrow = nrow
93  if (struct_array%nrow == -1) then
94  struct_array%nrow = 0
95  struct_array%deferred_shape = .true.
96  end if
97  !
98  ! -- set blocknum
99  if (blocknum > 0) then
100  struct_array%blocknum = blocknum
101  else
102  struct_array%blocknum = 0
103  end if
104  !
105  !
106  struct_array%mempath = mempath
107  struct_array%component_mempath = component_mempath
108  !
109  ! -- allocate StructVectorType objects
110  allocate (struct_array%struct_vectors(ncol))
111  allocate (struct_array%startidx(ncol))
112  allocate (struct_array%numcols(ncol))
Here is the caller graph for this function:

◆ count()

integer(i4b) function structarraymodule::count ( class(structarraytype this)
private
Parameters
thisStructArrayType

Definition at line 192 of file StructArray.f90.

193  class(StructArrayType) :: this !< StructArrayType
194  integer(I4B) :: count
195  count = size(this%struct_vectors)

◆ destructstructarray()

subroutine, public structarraymodule::destructstructarray ( type(structarraytype), intent(inout), pointer  struct_array)
Parameters
[in,out]struct_arrayStructArrayType to destroy

Definition at line 117 of file StructArray.f90.

118  type(StructArrayType), pointer, intent(inout) :: struct_array !< StructArrayType to destroy
119 
120  deallocate (struct_array%struct_vectors)
121  deallocate (struct_array%startidx)
122  deallocate (struct_array%numcols)
123  deallocate (struct_array)
124  nullify (struct_array)
Here is the caller graph for this function:

◆ get()

type(structvectortype) function, pointer structarraymodule::get ( class(structarraytype this,
integer(i4b), intent(in)  idx 
)
private
Parameters
thisStructArrayType

Definition at line 204 of file StructArray.f90.

205  class(StructArrayType) :: this !< StructArrayType
206  integer(I4B), intent(in) :: idx
207  type(StructVectorType), pointer :: sv
208  call set_pointer(sv, this%struct_vectors(idx))
Here is the call graph for this function:

◆ load_deferred_vector()

subroutine structarraymodule::load_deferred_vector ( class(structarraytype this,
integer(i4b), intent(in)  icol 
)
Parameters
thisStructArrayType

Definition at line 431 of file StructArray.f90.

432  use memorymanagermodule, only: get_isize
433  class(StructArrayType) :: this !< StructArrayType
434  integer(I4B), intent(in) :: icol
435  integer(I4B) :: i, j, isize
436  integer(I4B), dimension(:), pointer, contiguous :: p_int1d
437  integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d
438  real(DP), dimension(:), pointer, contiguous :: p_dbl1d
439  type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d
440  character(len=LENVARNAME) :: varname
441  !
442  ! -- set varname
443  varname = this%struct_vectors(icol)%idt%mf6varname
444  !
445  ! -- check if already mem managed variable
446  call get_isize(varname, this%mempath, isize)
447  !
448  ! -- allocate and load based on memtype
449  select case (this%struct_vectors(icol)%memtype)
450  !
451  case (1) ! -- memtype integer
452  !
453  if (isize > -1) then
454  ! -- variable exists, reallocate and append
455  call mem_setptr(p_int1d, varname, this%mempath)
456  ! -- Currently deferred vectors are appended to managed
457  ! memory vectors when they are already allocated
458  ! (e.g. SIMNAM SolutionGroup)
459  call mem_reallocate(p_int1d, this%nrow + isize, varname, this%mempath)
460 
461  do i = 1, this%nrow
462  p_int1d(isize + i) = this%struct_vectors(icol)%int1d(i)
463  end do
464  else
465  !
466  ! -- allocate memory manager vector
467  call mem_allocate(p_int1d, this%nrow, varname, this%mempath)
468  !
469  ! -- load local vector to managed memory
470  do i = 1, this%nrow
471  p_int1d(i) = this%struct_vectors(icol)%int1d(i)
472  end do
473  end if
474  !
475  ! -- deallocate local memory
476  deallocate (this%struct_vectors(icol)%int1d)
477  !
478  ! -- update structvector
479  this%struct_vectors(icol)%int1d => p_int1d
480  this%struct_vectors(icol)%size = this%nrow
481  !
482  case (2) ! -- memtype real
483  !
484  if (isize > -1) then
485  call mem_setptr(p_dbl1d, varname, this%mempath)
486  call mem_reallocate(p_dbl1d, this%nrow + isize, varname, &
487  this%mempath)
488  !
489  do i = 1, this%nrow
490  p_dbl1d(isize + i) = this%struct_vectors(icol)%dbl1d(i)
491  end do
492  else
493  call mem_allocate(p_dbl1d, this%nrow, varname, this%mempath)
494  !
495  do i = 1, this%nrow
496  p_dbl1d(i) = this%struct_vectors(icol)%dbl1d(i)
497  end do
498  end if
499  !
500  deallocate (this%struct_vectors(icol)%dbl1d)
501  !
502  this%struct_vectors(icol)%dbl1d => p_dbl1d
503  this%struct_vectors(icol)%size = this%nrow
504  !
505  case (3) ! -- memtype charstring
506  !
507  if (isize > -1) then
508  call mem_setptr(p_charstr1d, varname, this%mempath)
509  call mem_reallocate(p_charstr1d, linelength, this%nrow + isize, varname, &
510  this%mempath)
511 
512  do i = 1, this%nrow
513  p_charstr1d(isize + i) = this%struct_vectors(icol)%charstr1d(i)
514  end do
515  else
516  !
517  call mem_allocate(p_charstr1d, linelength, this%nrow, varname, &
518  this%mempath)
519  !
520  do i = 1, this%nrow
521  p_charstr1d(i) = this%struct_vectors(icol)%charstr1d(i)
522  end do
523  end if
524  !
525  deallocate (this%struct_vectors(icol)%charstr1d)
526  !
527  this%struct_vectors(icol)%charstr1d => p_charstr1d
528  this%struct_vectors(icol)%size = this%nrow
529  !
530  case (4) ! -- memtype intvector
531  ! no-op
532  case (5)
533  if (isize > -1) then
534  call mem_setptr(p_int2d, varname, this%mempath)
535  call mem_reallocate(p_int2d, this%struct_vectors(icol)%intshape, &
536  this%nrow, varname, this%mempath)
537 
538  do i = 1, this%nrow
539  do j = 1, this%struct_vectors(icol)%intshape
540  p_int2d(j, isize + i) = this%struct_vectors(icol)%int2d(j, i)
541  end do
542  end do
543  else
544  call mem_allocate(p_int2d, this%struct_vectors(icol)%intshape, &
545  this%nrow, varname, this%mempath)
546  !
547  do i = 1, this%nrow
548  do j = 1, this%struct_vectors(icol)%intshape
549  p_int2d(j, i) = this%struct_vectors(icol)%int2d(j, i)
550  end do
551  end do
552  end if
553  !
554  deallocate (this%struct_vectors(icol)%int2d)
555  !
556  this%struct_vectors(icol)%int2d => p_int2d
557  this%struct_vectors(icol)%size = this%nrow
558  !
559  ! TODO: case (6)
560  case default
561  errmsg = 'IDM unimplemented. StructArray::load_deferred_vector &
562  &unsupported memtype.'
563  call store_error(errmsg, terminate=.true.)
564  end select
Here is the call graph for this function:

◆ log_structarray_vars()

subroutine structarraymodule::log_structarray_vars ( class(structarraytype this,
integer(i4b), intent(in)  iout 
)
private
Parameters
thisStructArrayType
[in]ioutunit number for output

Definition at line 611 of file StructArray.f90.

612  class(StructArrayType) :: this !< StructArrayType
613  integer(I4B), intent(in) :: iout !< unit number for output
614  integer(I4B) :: j
615  integer(I4B), dimension(:), pointer, contiguous :: int1d
616  !
617  ! -- idm variable logging
618  do j = 1, this%ncol
619  !
620  ! -- log based on memtype
621  select case (this%struct_vectors(j)%memtype)
622  !
623  case (1) ! -- memtype integer
624  !
625  call idm_log_var(this%struct_vectors(j)%int1d, &
626  this%struct_vectors(j)%idt%tagname, &
627  this%mempath, iout)
628  !
629  case (2) ! -- memtype real
630  !
631  if (this%struct_vectors(j)%ts_strlocs%count() > 0) then
632  call idm_log_var(this%struct_vectors(j)%idt%tagname, &
633  this%mempath, iout, .false.)
634  else
635  call idm_log_var(this%struct_vectors(j)%dbl1d, &
636  this%struct_vectors(j)%idt%tagname, &
637  this%mempath, iout)
638  end if
639  !
640  case (4) ! -- memtype intvector
641  !
642  call mem_setptr(int1d, this%struct_vectors(j)%idt%mf6varname, &
643  this%mempath)
644  !
645  call idm_log_var(int1d, this%struct_vectors(j)%idt%tagname, &
646  this%mempath, iout)
647  !
648  case (5) ! -- memtype int2d
649  !
650  call idm_log_var(this%struct_vectors(j)%int2d, &
651  this%struct_vectors(j)%idt%tagname, &
652  this%mempath, iout)
653  !
654  case (6) ! -- memtype dbl2d
655  !
656  if (this%struct_vectors(j)%ts_strlocs%count() > 0) then
657  call idm_log_var(this%struct_vectors(j)%idt%tagname, &
658  this%mempath, iout, .false.)
659  else
660  call idm_log_var(this%struct_vectors(j)%dbl2d, &
661  this%struct_vectors(j)%idt%tagname, &
662  this%mempath, iout)
663  end if
664  !
665  end select
666  !
667  end do

◆ mem_create_vector()

subroutine structarraymodule::mem_create_vector ( class(structarraytype this,
integer(i4b), intent(in)  icol,
type(inputparamdefinitiontype), pointer  idt 
)
private
Parameters
thisStructArrayType
[in]icolcolumn to create

Definition at line 129 of file StructArray.f90.

130  class(StructArrayType) :: this !< StructArrayType
131  integer(I4B), intent(in) :: icol !< column to create
132  type(InputParamDefinitionType), pointer :: idt
133  type(StructVectorType) :: sv
134  integer(I4B) :: numcol
135  !
136  numcol = 1
137  !
138  sv%idt => idt
139  sv%icol = icol
140  !
141  ! -- set size
142  if (this%deferred_shape) then
143  sv%size = this%deferred_size_init
144  else
145  sv%size = this%nrow
146  end if
147  !
148  ! -- allocate array memory for StructVectorType
149  select case (idt%datatype)
150  !
151  case ('INTEGER')
152  !
153  call this%allocate_int_type(sv)
154  !
155  case ('DOUBLE')
156  !
157  call this%allocate_dbl_type(sv)
158  !
159  case ('STRING', 'KEYWORD')
160  !
161  call this%allocate_charstr_type(sv)
162  !
163  case ('INTEGER1D')
164  !
165  call this%allocate_int1d_type(sv)
166  if (sv%memtype == 5) then
167  numcol = sv%intshape
168  end if
169  !
170  case ('DOUBLE1D')
171  !
172  call this%allocate_dbl1d_type(sv)
173  numcol = sv%intshape
174  !
175  case default
176  errmsg = 'IDM unimplemented. StructArray::mem_create_vector &
177  &type='//trim(idt%datatype)
178  call store_error(errmsg, .true.)
179  end select
180  !
181  ! -- set the object in the Struct Array
182  this%struct_vectors(icol) = sv
183  !
184  this%numcols(icol) = numcol
185  if (icol == 1) then
186  this%startidx(icol) = 1
187  else
188  this%startidx(icol) = this%startidx(icol - 1) + this%numcols(icol - 1)
189  end if
Here is the call graph for this function:

◆ memload_vectors()

subroutine structarraymodule::memload_vectors ( class(structarraytype this)
Parameters
thisStructArrayType

Definition at line 569 of file StructArray.f90.

570  class(StructArrayType) :: this !< StructArrayType
571  integer(I4B) :: icol, j
572  integer(I4B), dimension(:), pointer, contiguous :: p_intvector
573  character(len=LENVARNAME) :: varname
574  !
575  do icol = 1, this%ncol
576  !
577  ! -- set varname
578  varname = this%struct_vectors(icol)%idt%mf6varname
579  !
580  if (this%struct_vectors(icol)%memtype == 4) then
581  ! -- intvectors always need to be loaded
582  !
583  ! -- size intvector to number of values read
584  call this%struct_vectors(icol)%intvector%shrink_to_fit()
585  !
586  ! -- allocate memory manager vector
587  call mem_allocate(p_intvector, &
588  this%struct_vectors(icol)%intvector%size, &
589  varname, this%mempath)
590  !
591  ! -- load local vector to managed memory
592  do j = 1, this%struct_vectors(icol)%intvector%size
593  p_intvector(j) = this%struct_vectors(icol)%intvector%at(j)
594  end do
595  !
596  ! -- cleanup local memory
597  call this%struct_vectors(icol)%intvector%destroy()
598  deallocate (this%struct_vectors(icol)%intvector)
599  nullify (this%struct_vectors(icol)%intvector_shape)
600  !
601  else if (this%deferred_shape) then
602  !
603  ! -- load as shape wasn't known
604  call this%load_deferred_vector(icol)
605  end if
606  end do

◆ read_from_binary()

integer(i4b) function structarraymodule::read_from_binary ( class(structarraytype this,
integer(i4b), intent(in)  inunit,
integer(i4b), intent(in)  iout 
)
private
Parameters
thisStructArrayType
[in]inunitunit number for binary input
[in]ioutunit number for output

Definition at line 922 of file StructArray.f90.

923  class(StructArrayType) :: this !< StructArrayType
924  integer(I4B), intent(in) :: inunit !< unit number for binary input
925  integer(I4B), intent(in) :: iout !< unit number for output
926  integer(I4B) :: irow, ierr
927  integer(I4B) :: j, k
928  integer(I4B) :: intval, numval
929  character(len=LINELENGTH) :: fname
930  character(len=*), parameter :: fmtlsterronly = &
931  "('Error reading LIST from file: ',&
932  &1x,a,1x,' on UNIT: ',I0)"
933  !
934  ! -- set error and exit if deferred shape
935  if (this%deferred_shape) then
936  !
937  errmsg = 'IDM unimplemented. StructArray::read_from_binary deferred shape &
938  &not supported for binary inputs.'
939  call store_error(errmsg, terminate=.true.)
940  !
941  end if
942  !
943  ! -- initialize
944  irow = 0
945  ierr = 0
946  !
947  readloop: do
948  !
949  ! -- update irow index
950  irow = irow + 1
951  !
952  ! -- handle line reads by column memtype
953  do j = 1, this%ncol
954  !
955  select case (this%struct_vectors(j)%memtype)
956  !
957  case (1) ! -- memtype integer
958  read (inunit, iostat=ierr) this%struct_vectors(j)%int1d(irow)
959  case (2) ! -- memtype real
960  read (inunit, iostat=ierr) this%struct_vectors(j)%dbl1d(irow)
961  case (3) ! -- memtype charstring
962  !
963  errmsg = 'List style binary inputs not supported &
964  &for text columns, tag='// &
965  trim(this%struct_vectors(j)%idt%tagname)//'.'
966  call store_error(errmsg, terminate=.true.)
967  !
968  case (4) ! -- memtype intvector
969  !
970  ! -- get shape for this row
971  numval = this%struct_vectors(j)%intvector_shape(irow)
972  !
973  ! -- read and store row values
974  do k = 1, numval
975  if (ierr == 0) then
976  read (inunit, iostat=ierr) intval
977  call this%struct_vectors(j)%intvector%push_back(intval)
978  end if
979  end do
980  !
981  case (5) ! -- memtype int2d
982  !
983  ! -- read and store row values
984  do k = 1, this%struct_vectors(j)%intshape
985  if (ierr == 0) then
986  read (inunit, iostat=ierr) this%struct_vectors(j)%int2d(k, irow)
987  end if
988  end do
989  !
990  case (6) ! -- memtype dbl2d
991  do k = 1, this%struct_vectors(j)%intshape
992  if (ierr == 0) then
993  read (inunit, iostat=ierr) this%struct_vectors(j)%dbl2d(k, irow)
994  end if
995  end do
996  end select
997  !
998  ! -- handle error cases
999  select case (ierr)
1000  case (0)
1001  ! no error
1002  case (:-1)
1003  !
1004  ! -- End of block was encountered
1005  irow = irow - 1
1006  exit readloop
1007  !
1008  case (1:)
1009  !
1010  ! -- Error
1011  inquire (unit=inunit, name=fname)
1012  write (errmsg, fmtlsterronly) trim(adjustl(fname)), inunit
1013  call store_error(errmsg, terminate=.true.)
1014  !
1015  case default
1016  end select
1017  !
1018  end do
1019  !
1020  if (irow == this%nrow) exit readloop
1021  !
1022  end do readloop
1023  !
1024  ! -- Stop if errors were detected
1025  !if (count_errors() > 0) then
1026  ! call store_error_unit(inunit)
1027  !end if
1028  !
1029  ! -- if deferred shape vectors were read, load to input path
1030  call this%memload_vectors()
1031  !
1032  ! -- log loaded variables
1033  if (iout > 0) then
1034  call this%log_structarray_vars(iout)
1035  end if
Here is the call graph for this function:

◆ read_from_parser()

integer(i4b) function structarraymodule::read_from_parser ( class(structarraytype this,
type(blockparsertype parser,
logical(lgp), intent(in)  timeseries,
integer(i4b), intent(in)  iout 
)
private
Parameters
thisStructArrayType
parserblock parser to read from
[in]ioutunit number for output

Definition at line 870 of file StructArray.f90.

871  class(StructArrayType) :: this !< StructArrayType
872  type(BlockParserType) :: parser !< block parser to read from
873  logical(LGP), intent(in) :: timeseries
874  integer(I4B), intent(in) :: iout !< unit number for output
875  integer(I4B) :: irow, j
876  logical(LGP) :: endOfBlock
877  !
878  ! -- initialize index irow
879  irow = 0
880  !
881  ! -- read entire block
882  do
883  !
884  ! -- read next line
885  call parser%GetNextLine(endofblock)
886  !
887  if (endofblock) then
888  ! -- no more lines
889  exit
890  !
891  else if (this%deferred_shape) then
892  !
893  ! -- shape unknown, track lines read
894  this%nrow = this%nrow + 1
895  !
896  ! -- check and update memory allocation
897  call this%check_reallocate()
898  end if
899  !
900  ! -- update irow index
901  irow = irow + 1
902  !
903  ! -- handle line reads by column memtype
904  do j = 1, this%ncol
905  !
906  call this%write_struct_vector(parser, j, irow, timeseries, iout)
907  !
908  end do
909  end do
910  !
911  ! -- if deferred shape vectors were read, load to input path
912  call this%memload_vectors()
913  !
914  ! -- log loaded variables
915  if (iout > 0) then
916  call this%log_structarray_vars(iout)
917  end if

◆ set_pointer()

subroutine structarraymodule::set_pointer ( type(structvectortype), pointer  sv,
type(structvectortype), target  sv_target 
)
private

Definition at line 198 of file StructArray.f90.

199  type(StructVectorType), pointer :: sv
200  type(StructVectorType), target :: sv_target
201  sv => sv_target
Here is the caller graph for this function:

◆ write_struct_vector()

subroutine structarraymodule::write_struct_vector ( class(structarraytype this,
type(blockparsertype), intent(inout)  parser,
integer(i4b), intent(in)  sv_col,
integer(i4b), intent(in)  irow,
logical(lgp), intent(in)  timeseries,
integer(i4b), intent(in)  iout,
integer(i4b), intent(in), optional  auxcol 
)
private
Parameters
thisStructArrayType
[in,out]parserblock parser to read from
[in]ioutunit number for output

Definition at line 773 of file StructArray.f90.

775  class(StructArrayType) :: this !< StructArrayType
776  type(BlockParserType), intent(inout) :: parser !< block parser to read from
777  integer(I4B), intent(in) :: sv_col
778  integer(I4B), intent(in) :: irow
779  logical(LGP), intent(in) :: timeseries
780  integer(I4B), intent(in) :: iout !< unit number for output
781  integer(I4B), optional, intent(in) :: auxcol
782  integer(I4B) :: n, intval, numval, icol
783  character(len=LINELENGTH) :: str
784  character(len=:), allocatable :: line
785  logical(LGP) :: preserve_case
786  !
787  select case (this%struct_vectors(sv_col)%memtype)
788  !
789  case (1) ! -- memtype integer
790  !
791  ! -- if reloadable block and first col, store blocknum
792  if (sv_col == 1 .and. this%blocknum > 0) then
793  ! -- store blocknum
794  this%struct_vectors(sv_col)%int1d(irow) = this%blocknum
795  else
796  ! -- read and store int
797  this%struct_vectors(sv_col)%int1d(irow) = parser%GetInteger()
798  end if
799  !
800  case (2) ! -- memtype real
801  !
802  if (this%struct_vectors(sv_col)%idt%timeseries .and. timeseries) then
803  call parser%GetString(str)
804  if (present(auxcol)) then
805  icol = auxcol
806  else
807  icol = 1
808  end if
809  this%struct_vectors(sv_col)%dbl1d(irow) = &
810  this%struct_vectors(sv_col)%read_token(str, this%startidx(sv_col), &
811  icol, irow)
812  else
813  this%struct_vectors(sv_col)%dbl1d(irow) = parser%GetDouble()
814  end if
815  !
816  case (3) ! -- memtype charstring
817  !
818  if (this%struct_vectors(sv_col)%idt%shape /= '') then
819  ! -- if last column with any shape, store rest of line
820  if (sv_col == this%ncol) then
821  call parser%GetRemainingLine(line)
822  this%struct_vectors(sv_col)%charstr1d(irow) = line
823  deallocate (line)
824  end if
825  else
826  !
827  ! -- read string token
828  preserve_case = (.not. this%struct_vectors(sv_col)%idt%preserve_case)
829  call parser%GetString(str, preserve_case)
830  this%struct_vectors(sv_col)%charstr1d(irow) = str
831  end if
832  !
833  case (4) ! -- memtype intvector
834  !
835  ! -- get shape for this row
836  numval = this%struct_vectors(sv_col)%intvector_shape(irow)
837  !
838  ! -- read and store row values
839  do n = 1, numval
840  intval = parser%GetInteger()
841  call this%struct_vectors(sv_col)%intvector%push_back(intval)
842  end do
843  !
844  case (5) ! -- memtype int2d
845  !
846  ! -- read and store row values
847  do n = 1, this%struct_vectors(sv_col)%intshape
848  this%struct_vectors(sv_col)%int2d(n, irow) = parser%GetInteger()
849  end do
850  !
851  case (6) ! -- memtype dbl2d
852  !
853  ! -- read and store row values
854  do n = 1, this%struct_vectors(sv_col)%intshape
855  if (this%struct_vectors(sv_col)%idt%timeseries .and. timeseries) then
856  call parser%GetString(str)
857  icol = this%startidx(sv_col) + n - 1
858  this%struct_vectors(sv_col)%dbl2d(n, irow) = &
859  this%struct_vectors(sv_col)%read_token(str, icol, n, irow)
860  else
861  this%struct_vectors(sv_col)%dbl2d(n, irow) = parser%GetDouble()
862  end if
863  end do
864  !
865  end select