MODFLOW 6  version 6.7.0.dev1
USGS Modular Hydrologic Model
MemoryManager.f90
Go to the documentation of this file.
2 
3  use kindmodule, only: dp, lgp, i4b, i8b
4  use constantsmodule, only: dzero, done, &
5  dem3, dem6, dem9, dep3, dep6, dep9, &
11  tabright
12  use simvariablesmodule, only: errmsg
14  use memorytypemodule, only: memorytype
19  use tablemodule, only: tabletype, table_cr
21 
22  implicit none
23  private
24  public :: mem_allocate
25  public :: mem_checkin
26  public :: mem_reallocate
27  public :: mem_setptr
28  public :: mem_copyptr
29  public :: mem_reassignptr
30  public :: mem_deallocate
31  public :: mem_write_usage
32  public :: mem_da
33  public :: mem_set_print_option
34  public :: get_from_memorystore
35 
36  public :: get_mem_type
37  public :: get_mem_rank
38  public :: get_mem_elem_size
39  public :: get_mem_shape
40  public :: get_isize
41  public :: copy_dbl1d
42 
43  public :: memorystore
44  public :: mem_print_detailed
45 
47  type(tabletype), pointer :: memtab => null()
48  integer(I8B) :: nvalues_alogical = 0
49  integer(I8B) :: nvalues_astr = 0
50  integer(I8B) :: nvalues_aint = 0
51  integer(I8B) :: nvalues_adbl = 0
52  integer(I4B) :: iprmem = 0
53 
54  interface mem_allocate
55  module procedure &
57  allocate_str, &
59  allocate_int, &
63  allocate_dbl, &
68  end interface mem_allocate
69 
70  interface mem_checkin
71  module procedure &
72  checkin_int1d, &
73  checkin_int2d, &
74  checkin_dbl1d, &
75  checkin_dbl2d, &
77  end interface mem_checkin
78 
79  interface mem_reallocate
80  module procedure &
87  end interface mem_reallocate
88 
89  interface mem_setptr
90  module procedure &
92  setptr_int, &
93  setptr_int1d, &
94  setptr_int2d, &
95  setptr_int3d, &
96  setptr_dbl, &
97  setptr_dbl1d, &
98  setptr_dbl2d, &
99  setptr_dbl3d, &
100  setptr_str, &
101  setptr_str1d, &
103  end interface mem_setptr
104 
105  interface mem_copyptr
106  module procedure &
107  copyptr_int1d, &
108  copyptr_int2d, &
109  copyptr_dbl1d, &
111  end interface mem_copyptr
112 
113  interface mem_reassignptr
114  module procedure &
115  reassignptr_int, &
120  end interface mem_reassignptr
121 
122  interface mem_deallocate
123  module procedure &
125  deallocate_str, &
128  deallocate_int, &
132  deallocate_dbl, &
136  end interface mem_deallocate
137 
138 contains
139 
140  !> @ brief Get the variable memory type
141  !!
142  !! Returns any of 'LOGICAL', 'INTEGER', 'DOUBLE', 'STRING'.
143  !! returns 'UNKNOWN' when the variable is not found.
144  !<
145  subroutine get_mem_type(name, mem_path, var_type)
146  character(len=*), intent(in) :: name !< variable name
147  character(len=*), intent(in) :: mem_path !< path where the variable is stored
148  character(len=LENMEMTYPE), intent(out) :: var_type !< memory type
149  ! -- local
150  type(memorytype), pointer :: mt
151  logical(LGP) :: found
152  ! -- code
153  mt => null()
154  var_type = 'UNKNOWN'
155  call get_from_memorystore(name, mem_path, mt, found)
156  if (found) then
157  var_type = mt%memtype
158  end if
159  end subroutine get_mem_type
160 
161  !> @ brief Get the variable rank
162  !!
163  !! Returns rank = -1 when not found.
164  !<
165  subroutine get_mem_rank(name, mem_path, rank)
166  character(len=*), intent(in) :: name !< variable name
167  character(len=*), intent(in) :: mem_path !< mem_path
168  integer(I4B), intent(out) :: rank !< rank
169  ! -- local
170  type(memorytype), pointer :: mt => null()
171  logical(LGP) :: found
172  ! -- code
173  !
174  ! -- initialize rank to a value to communicate failure
175  rank = -1
176  !
177  ! -- get the entry from the memory manager
178  call get_from_memorystore(name, mem_path, mt, found)
179  !
180  ! -- set rank
181  if (found) then
182  if (associated(mt%logicalsclr)) rank = 0
183  if (associated(mt%intsclr)) rank = 0
184  if (associated(mt%dblsclr)) rank = 0
185  if (associated(mt%aint1d)) rank = 1
186  if (associated(mt%aint2d)) rank = 2
187  if (associated(mt%aint3d)) rank = 3
188  if (associated(mt%adbl1d)) rank = 1
189  if (associated(mt%adbl2d)) rank = 2
190  if (associated(mt%adbl3d)) rank = 3
191  if (associated(mt%strsclr)) rank = 0
192  if (associated(mt%astr1d)) rank = 1
193  if (associated(mt%acharstr1d)) rank = 1
194  end if
195  end subroutine get_mem_rank
196 
197  !> @ brief Get the memory size of a single element of the stored variable
198  !!
199  !! Memory size in bytes, returns size = -1 when not found. This is
200  !< also string length.
201  subroutine get_mem_elem_size(name, mem_path, size)
202  character(len=*), intent(in) :: name !< variable name
203  character(len=*), intent(in) :: mem_path !< path where the variable is stored
204  integer(I4B), intent(out) :: size !< size of the variable in bytes
205  ! -- local
206  type(memorytype), pointer :: mt => null()
207  logical(LGP) :: found
208  ! -- code
209  !
210  ! -- initialize size to a value to communicate failure
211  size = -1
212  !
213  ! -- get the entry from the memory manager
214  call get_from_memorystore(name, mem_path, mt, found)
215  !
216  ! -- set memory size
217  if (found) then
218  size = mt%element_size
219  end if
220  end subroutine get_mem_elem_size
221 
222  !> @ brief Get the variable memory shape
223  !!
224  !! Returns an integer array with the shape (Fortran ordering),
225  !! and set shape(1) = -1 when not found.
226  !<
227  subroutine get_mem_shape(name, mem_path, mem_shape)
228  character(len=*), intent(in) :: name !< variable name
229  character(len=*), intent(in) :: mem_path !< path where the variable is stored
230  integer(I4B), dimension(:), intent(out) :: mem_shape !< shape of the variable
231  ! -- local
232  type(memorytype), pointer :: mt => null()
233  logical(LGP) :: found
234  ! -- code
235  !
236  ! -- get the entry from the memory manager
237  call get_from_memorystore(name, mem_path, mt, found)
238  !
239  ! -- set shape
240  if (found) then
241  if (associated(mt%logicalsclr)) mem_shape = shape(mt%logicalsclr)
242  if (associated(mt%intsclr)) mem_shape = shape(mt%logicalsclr)
243  if (associated(mt%dblsclr)) mem_shape = shape(mt%dblsclr)
244  if (associated(mt%aint1d)) mem_shape = shape(mt%aint1d)
245  if (associated(mt%aint2d)) mem_shape = shape(mt%aint2d)
246  if (associated(mt%aint3d)) mem_shape = shape(mt%aint3d)
247  if (associated(mt%adbl1d)) mem_shape = shape(mt%adbl1d)
248  if (associated(mt%adbl2d)) mem_shape = shape(mt%adbl2d)
249  if (associated(mt%adbl3d)) mem_shape = shape(mt%adbl3d)
250  if (associated(mt%strsclr)) mem_shape = shape(mt%strsclr)
251  if (associated(mt%astr1d)) mem_shape = shape(mt%astr1d)
252  if (associated(mt%acharstr1d)) mem_shape = shape(mt%acharstr1d)
253  ! -- to communicate failure
254  else
255  mem_shape(1) = -1
256  end if
257  end subroutine get_mem_shape
258 
259  !> @ brief Get the number of elements for this variable
260  !!
261  !! Returns with isize = -1 when not found.
262  !! Return 1 for scalars.
263  !<
264  subroutine get_isize(name, mem_path, isize)
265  character(len=*), intent(in) :: name !< variable name
266  character(len=*), intent(in) :: mem_path !< path where the variable is stored
267  integer(I4B), intent(out) :: isize !< number of elements (flattened)
268  ! -- local
269  type(memorytype), pointer :: mt => null()
270  logical(LGP) :: found
271  logical(LGP) :: terminate
272  ! -- code
273  !
274  ! -- initialize isize to a value to communicate failure
275  isize = -1
276  !
277  ! -- don't exit program if variable not found
278  terminate = .false.
279  !
280  ! -- get the entry from the memory manager
281  call get_from_memorystore(name, mem_path, mt, found, terminate)
282  !
283  ! -- set isize
284  if (found) then
285  isize = mt%isize
286  end if
287  end subroutine get_isize
288 
289  !> @ brief Get a memory type entry from the memory list
290  !!
291  !! Default value for @par check is .true. which means that this
292  !! routine will kill the program when the memory entry cannot be found.
293  !<
294  subroutine get_from_memorystore(name, mem_path, mt, found, check)
295  character(len=*), intent(in) :: name !< variable name
296  character(len=*), intent(in) :: mem_path !< path where the variable is stored
297  type(memorytype), pointer, intent(inout) :: mt !< memory type entry
298  logical(LGP), intent(out) :: found !< set to .true. when found
299  logical(LGP), intent(in), optional :: check !< to suppress aborting the program when not found,
300  !! set check = .false.
301  ! -- local
302  logical(LGP) check_opt
303  ! -- code
304  mt => memorystore%get(name, mem_path)
305  found = associated(mt)
306 
307  check_opt = .true.
308  if (present(check)) then
309  check_opt = check
310  end if
311  if (check_opt) then
312  if (.not. found) then
313  errmsg = "Programming error in memory manager. Variable '"// &
314  trim(name)//"' in '"//trim(mem_path)//"' cannot be "// &
315  "assigned because it does not exist in memory manager."
316  call store_error(errmsg, terminate=.true.)
317  end if
318  end if
319  end subroutine get_from_memorystore
320 
321  !> @brief Issue allocation error message and stop program execution
322  !<
323  subroutine allocate_error(varname, mem_path, istat, isize)
324  character(len=*), intent(in) :: varname !< variable name
325  character(len=*), intent(in) :: mem_path !< path where the variable is stored
326  integer(I4B), intent(in) :: istat !< status code
327  integer(I4B), intent(in) :: isize !< size of allocation
328  ! -- local
329  character(len=20) :: csize
330  character(len=20) :: cstat
331  ! -- code
332  !
333  ! -- initialize character variables
334  write (csize, '(i0)') isize
335  write (cstat, '(i0)') istat
336  !
337  ! -- create error message
338  errmsg = "Error trying to allocate memory. Path '"//trim(mem_path)// &
339  "' variable name '"//trim(varname)//"' size '"//trim(csize)// &
340  "'. Error message is '"//trim(adjustl(errmsg))// &
341  "'. Status code is "//trim(cstat)//'.'
342  !
343  ! -- store error and stop program execution
344  call store_error(errmsg, terminate=.true.)
345  end subroutine allocate_error
346 
347  !> @brief Allocate a logical scalar
348  !<
349  subroutine allocate_logical(sclr, name, mem_path)
350  logical(LGP), pointer, intent(inout) :: sclr !< variable for allocation
351  character(len=*), intent(in) :: name !< variable name
352  character(len=*), intent(in) :: mem_path !< path where the variable is stored
353  ! -- local
354  integer(I4B) :: istat
355  type(memorytype), pointer :: mt
356  ! -- code
357  !
358  ! -- check variable name length
359  call mem_check_length(name, lenvarname, "variable")
360  !
361  ! -- allocate the logical scalar
362  allocate (sclr, stat=istat, errmsg=errmsg)
363  if (istat /= 0) then
364  call allocate_error(name, mem_path, istat, 1)
365  end if
366  !
367  ! -- update counter
369  !
370  ! -- allocate memory type
371  allocate (mt)
372  !
373  ! -- set memory type
374  mt%logicalsclr => sclr
375  mt%element_size = lgp
376  mt%isize = 1
377  mt%name = name
378  mt%path = mem_path
379  write (mt%memtype, "(a)") 'LOGICAL'
380  !
381  ! -- add memory type to the memory list
382  call memorystore%add(mt)
383  end subroutine allocate_logical
384 
385  !> @brief Allocate a character string
386  !<
387  subroutine allocate_str(sclr, ilen, name, mem_path)
388  integer(I4B), intent(in) :: ilen !< string length
389  character(len=ilen), pointer, intent(inout) :: sclr !< variable for allocation
390  character(len=*), intent(in) :: name !< variable name
391  character(len=*), intent(in) :: mem_path !< path where the variable is stored
392  ! -- local
393  integer(I4B) :: istat
394  type(memorytype), pointer :: mt
395  ! -- format
396  ! -- code
397  !
398  ! -- make sure ilen is greater than 0
399  if (ilen < 1) then
400  errmsg = 'Programming error in allocate_str. ILEN must be greater than 0.'
401  call store_error(errmsg, terminate=.true.)
402  end if
403  !
404  ! -- check variable name length
405  call mem_check_length(name, lenvarname, "variable")
406  !
407  ! -- allocate string
408  allocate (character(len=ilen) :: sclr, stat=istat, errmsg=errmsg)
409  if (istat /= 0) then
410  call allocate_error(name, mem_path, istat, 1)
411  end if
412  !
413  ! -- set sclr to a empty string
414  sclr = ' '
415  !
416  ! -- update counter
417  nvalues_astr = nvalues_astr + ilen
418  !
419  ! -- allocate memory type
420  allocate (mt)
421  !
422  ! -- set memory type
423  mt%strsclr => sclr
424  mt%element_size = ilen
425  mt%isize = 1
426  mt%name = name
427  mt%path = mem_path
428  write (mt%memtype, "(a,' LEN=',i0)") 'STRING', ilen
429  !
430  ! -- add defined length string to the memory manager list
431  call memorystore%add(mt)
432  end subroutine allocate_str
433 
434  !> @brief Allocate a 1-dimensional defined length string array
435  !<
436  subroutine allocate_str1d(astr1d, ilen, nrow, name, mem_path)
437  integer(I4B), intent(in) :: ilen !< string length
438  character(len=ilen), dimension(:), &
439  pointer, contiguous, intent(inout) :: astr1d !< variable for allocation
440  integer(I4B), intent(in) :: nrow !< number of strings in array
441  character(len=*), intent(in) :: name !< variable name
442  character(len=*), intent(in) :: mem_path !< path where the variable is stored
443  ! -- local variables
444  type(memorytype), pointer :: mt
445  character(len=ilen) :: string
446  integer(I4B) :: n
447  integer(I4B) :: istat
448  integer(I4B) :: isize
449  ! -- code
450  !
451  ! -- initialize string
452  string = ''
453  !
454  ! -- make sure ilen is greater than 0
455  if (ilen < 1) then
456  errmsg = 'Programming error in allocate_str1d. '// &
457  'ILEN must be greater than 0.'
458  call store_error(errmsg, terminate=.true.)
459  end if
460  !
461  ! -- check variable name length
462  call mem_check_length(name, lenvarname, "variable")
463  !
464  ! -- calculate isize
465  isize = nrow
466  !
467  ! -- allocate defined length string array
468  allocate (character(len=ilen) :: astr1d(nrow), stat=istat, errmsg=errmsg)
469  !
470  ! -- check for error condition
471  if (istat /= 0) then
472  call allocate_error(name, mem_path, istat, isize)
473  end if
474  !
475  ! -- fill deferred length string with empty string
476  do n = 1, nrow
477  astr1d(n) = string
478  end do
479  !
480  ! -- update counter
481  nvalues_astr = nvalues_astr + isize
482  !
483  ! -- allocate memory type
484  allocate (mt)
485  !
486  ! -- set memory type
487  mt%astr1d => astr1d
488  mt%element_size = ilen
489  mt%isize = isize
490  mt%name = name
491  mt%path = mem_path
492  write (mt%memtype, "(a,' LEN=',i0,' (',i0,')')") 'STRING', ilen, nrow
493  !
494  ! -- add deferred length character array to the memory manager list
495  call memorystore%add(mt)
496  end subroutine allocate_str1d
497 
498  !> @brief Allocate a 1-dimensional array of deferred-length CharacterStringType
499  !<
500  subroutine allocate_charstr1d(acharstr1d, ilen, nrow, name, mem_path)
501  type(characterstringtype), dimension(:), &
502  pointer, contiguous, intent(inout) :: acharstr1d !< variable for allocation
503  integer(I4B), intent(in) :: ilen !< string length
504  integer(I4B), intent(in) :: nrow !< number of strings in array
505  character(len=*), intent(in) :: name !< variable name
506  character(len=*), intent(in) :: mem_path !< path where the variable is stored
507  ! -- local variables
508  character(len=ilen) :: string
509  type(memorytype), pointer :: mt
510  integer(I4B) :: n
511  integer(I4B) :: istat
512  integer(I4B) :: isize
513  ! -- code
514  !
515  ! -- initialize string
516  string = ''
517  !
518  ! -- check variable name length
519  call mem_check_length(name, lenvarname, "variable")
520  !
521  ! -- calculate isize
522  isize = nrow
523  !
524  ! -- allocate deferred length string array
525  allocate (acharstr1d(nrow), stat=istat, errmsg=errmsg)
526  !
527  ! -- check for error condition
528  if (istat /= 0) then
529  call allocate_error(name, mem_path, istat, isize)
530  end if
531  !
532  ! -- fill deferred length string with empty string
533  do n = 1, nrow
534  acharstr1d(n) = string
535  end do
536  !
537  ! -- update counter
538  nvalues_astr = nvalues_astr + isize
539  !
540  ! -- allocate memory type
541  allocate (mt)
542  !
543  ! -- set memory type
544  mt%acharstr1d => acharstr1d
545  mt%element_size = ilen
546  mt%isize = isize
547  mt%name = name
548  mt%path = mem_path
549  write (mt%memtype, "(a,' LEN=',i0,' (',i0,')')") 'STRING', ilen, nrow
550  !
551  ! -- add deferred length character array to the memory manager list
552  call memorystore%add(mt)
553  end subroutine allocate_charstr1d
554 
555  !> @brief Allocate a integer scalar
556  !<
557  subroutine allocate_int(sclr, name, mem_path)
558  integer(I4B), pointer, intent(inout) :: sclr !< variable for allocation
559  character(len=*), intent(in) :: name !< variable name
560  character(len=*), intent(in) :: mem_path !< path where the variable is stored
561  ! -- local
562  type(memorytype), pointer :: mt
563  integer(I4B) :: istat
564  ! -- code
565  !
566  ! -- check variable name length
567  call mem_check_length(name, lenvarname, "variable")
568  !
569  ! -- allocate integer scalar
570  allocate (sclr, stat=istat, errmsg=errmsg)
571  if (istat /= 0) then
572  call allocate_error(name, mem_path, istat, 1)
573  end if
574  !
575  ! -- update counter
577  !
578  ! -- allocate memory type
579  allocate (mt)
580  !
581  ! -- set memory type
582  mt%intsclr => sclr
583  mt%element_size = i4b
584  mt%isize = 1
585  mt%name = name
586  mt%path = mem_path
587  write (mt%memtype, "(a)") 'INTEGER'
588  !
589  ! -- add memory type to the memory list
590  call memorystore%add(mt)
591  end subroutine allocate_int
592 
593  !> @brief Allocate a 1-dimensional integer array
594  !<
595  subroutine allocate_int1d(aint, nrow, name, mem_path)
596  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: aint !< variable for allocation
597  integer(I4B), intent(in) :: nrow !< integer array number of rows
598  character(len=*), intent(in) :: name !< variable name
599  character(len=*), intent(in) :: mem_path !< path where variable is stored
600  ! --local
601  type(memorytype), pointer :: mt
602  integer(I4B) :: istat
603  integer(I4B) :: isize
604  ! -- code
605  !
606  ! -- check variable name length
607  call mem_check_length(name, lenvarname, "variable")
608  !
609  ! -- set isize
610  isize = nrow
611  !
612  ! -- allocate integer array
613  allocate (aint(nrow), stat=istat, errmsg=errmsg)
614  if (istat /= 0) then
615  call allocate_error(name, mem_path, istat, isize)
616  end if
617  !
618  ! -- update counter
619  nvalues_aint = nvalues_aint + isize
620  !
621  ! -- allocate memory type
622  allocate (mt)
623  !
624  ! -- set memory type
625  mt%aint1d => aint
626  mt%element_size = i4b
627  mt%isize = isize
628  mt%name = name
629  mt%path = mem_path
630  write (mt%memtype, "(a,' (',i0,')')") 'INTEGER', isize
631  !
632  ! -- add memory type to the memory list
633  call memorystore%add(mt)
634  end subroutine allocate_int1d
635 
636  !> @brief Allocate a 2-dimensional integer array
637  !<
638  subroutine allocate_int2d(aint, ncol, nrow, name, mem_path)
639  integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint !< variable for allocation
640  integer(I4B), intent(in) :: ncol !< number of columns
641  integer(I4B), intent(in) :: nrow !< number of rows
642  character(len=*), intent(in) :: name !< variable name
643  character(len=*), intent(in) :: mem_path !< path where variable is stored
644  ! -- local
645  type(memorytype), pointer :: mt
646  integer(I4B) :: istat
647  integer(I4B) :: isize
648  ! -- code
649  !
650  ! -- check the variable name length
651  call mem_check_length(name, lenvarname, "variable")
652  !
653  ! -- set isize
654  isize = ncol * nrow
655  !
656  ! -- allocate the integer array
657  allocate (aint(ncol, nrow), stat=istat, errmsg=errmsg)
658  if (istat /= 0) then
659  call allocate_error(name, mem_path, istat, isize)
660  end if
661  !
662  ! -- update the counter
663  nvalues_aint = nvalues_aint + isize
664  !
665  ! -- allocate memory type
666  allocate (mt)
667  !
668  ! -- set memory type
669  mt%aint2d => aint
670  mt%element_size = i4b
671  mt%isize = isize
672  mt%name = name
673  mt%path = mem_path
674  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'INTEGER', ncol, nrow
675  !
676  ! -- add memory type to the memory list
677  call memorystore%add(mt)
678  end subroutine allocate_int2d
679 
680  !> @brief Allocate a 3-dimensional integer array
681  !<
682  subroutine allocate_int3d(aint, ncol, nrow, nlay, name, mem_path)
683  integer(I4B), dimension(:, :, :), pointer, contiguous, intent(inout) :: aint !< variable for allocation
684  integer(I4B), intent(in) :: ncol !< number of columns
685  integer(I4B), intent(in) :: nrow !< number of rows
686  integer(I4B), intent(in) :: nlay !< number of layers
687  character(len=*), intent(in) :: name !< variable name
688  character(len=*), intent(in) :: mem_path !< path where variable is stored
689  ! -- local
690  type(memorytype), pointer :: mt
691  integer(I4B) :: istat
692  integer(I4B) :: isize
693  ! -- code
694  !
695  ! -- check variable name length
696  call mem_check_length(name, lenvarname, "variable")
697  !
698  ! -- set isize
699  isize = ncol * nrow * nlay
700  !
701  ! -- allocate integer array
702  allocate (aint(ncol, nrow, nlay), stat=istat, errmsg=errmsg)
703  if (istat /= 0) then
704  call allocate_error(name, mem_path, istat, isize)
705  end if
706  !
707  ! -- update counter
708  nvalues_aint = nvalues_aint + isize
709  !
710  ! -- allocate memory type
711  allocate (mt)
712  !
713  ! -- set memory type
714  mt%aint3d => aint
715  mt%element_size = i4b
716  mt%isize = isize
717  mt%name = name
718  mt%path = mem_path
719  write (mt%memtype, "(a,' (',i0,',',i0,',',i0,')')") 'INTEGER', ncol, &
720  nrow, nlay
721  !
722  ! -- add memory type to the memory list
723  call memorystore%add(mt)
724  end subroutine allocate_int3d
725 
726  !> @brief Allocate a real scalar
727  !<
728  subroutine allocate_dbl(sclr, name, mem_path)
729  real(DP), pointer, intent(inout) :: sclr !< variable for allocation
730  character(len=*), intent(in) :: name !< variable name
731  character(len=*), intent(in) :: mem_path !< path where variable is stored
732  ! -- local
733  type(memorytype), pointer :: mt
734  integer(I4B) :: istat
735  ! -- code
736  !
737  ! -- check variable name length
738  call mem_check_length(name, lenvarname, "variable")
739  !
740  ! -- allocate real scalar
741  allocate (sclr, stat=istat, errmsg=errmsg)
742  if (istat /= 0) then
743  call allocate_error(name, mem_path, istat, 1)
744  end if
745  !
746  ! -- update counter
748  !
749  ! -- allocate memory type
750  allocate (mt)
751  !
752  ! -- set memory type
753  mt%dblsclr => sclr
754  mt%element_size = dp
755  mt%isize = 1
756  mt%name = name
757  mt%path = mem_path
758  write (mt%memtype, "(a)") 'DOUBLE'
759  !
760  ! -- add memory type to the memory list
761  call memorystore%add(mt)
762  end subroutine allocate_dbl
763 
764  !> @brief Allocate a 1-dimensional real array
765  !<
766  subroutine allocate_dbl1d(adbl, nrow, name, mem_path)
767  real(DP), dimension(:), pointer, contiguous, intent(inout) :: adbl !< variable for allocation
768  integer(I4B), intent(in) :: nrow !< number of rows
769  character(len=*), intent(in) :: name !< variable name
770  character(len=*), intent(in) :: mem_path !< path where variable is stored
771  ! -- local
772  type(memorytype), pointer :: mt
773  integer(I4B) :: istat
774  integer(I4B) :: isize
775  ! -- code
776  !
777  ! -- check the variable name length
778  call mem_check_length(name, lenvarname, "variable")
779  !
780  ! -- set isize
781  isize = nrow
782  !
783  ! -- allocate the real array
784  allocate (adbl(nrow), stat=istat, errmsg=errmsg)
785  if (istat /= 0) then
786  call allocate_error(name, mem_path, istat, isize)
787  end if
788  !
789  ! -- update counter
790  nvalues_adbl = nvalues_adbl + isize
791  !
792  ! -- allocate memory type
793  allocate (mt)
794  !
795  ! -- set memory type
796  mt%adbl1d => adbl
797  mt%element_size = dp
798  mt%isize = isize
799  mt%name = name
800  mt%path = mem_path
801  write (mt%memtype, "(a,' (',i0,')')") 'DOUBLE', isize
802  !
803  ! -- add memory type to the memory list
804  call memorystore%add(mt)
805  end subroutine allocate_dbl1d
806 
807  !> @brief Allocate a 2-dimensional real array
808  !<
809  subroutine allocate_dbl2d(adbl, ncol, nrow, name, mem_path)
810  real(DP), dimension(:, :), pointer, contiguous, intent(inout) :: adbl !< variable for allocation
811  integer(I4B), intent(in) :: ncol !< number of columns
812  integer(I4B), intent(in) :: nrow !< number of rows
813  character(len=*), intent(in) :: name !< variable name
814  character(len=*), intent(in) :: mem_path !< path where variable is stored
815  ! -- local
816  type(memorytype), pointer :: mt
817  integer(I4B) :: istat
818  integer(I4B) :: isize
819  ! -- code
820  !
821  ! -- check the variable name length
822  call mem_check_length(name, lenvarname, "variable")
823  !
824  ! -- set isize
825  isize = ncol * nrow
826  !
827  ! -- allocate the real array
828  allocate (adbl(ncol, nrow), stat=istat, errmsg=errmsg)
829  if (istat /= 0) then
830  call allocate_error(name, mem_path, istat, isize)
831  end if
832  !
833  ! -- update counter
834  nvalues_adbl = nvalues_adbl + isize
835  !
836  ! -- allocate memory type
837  allocate (mt)
838  !
839  ! -- set memory type
840  mt%adbl2d => adbl
841  mt%element_size = dp
842  mt%isize = isize
843  mt%name = name
844  mt%path = mem_path
845  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'DOUBLE', ncol, nrow
846  !
847  ! -- add memory type to the memory list
848  call memorystore%add(mt)
849  end subroutine allocate_dbl2d
850 
851  !> @brief Allocate a 3-dimensional real array
852  !<
853  subroutine allocate_dbl3d(adbl, ncol, nrow, nlay, name, mem_path)
854  real(DP), dimension(:, :, :), pointer, contiguous, intent(inout) :: adbl !< variable for allocation
855  integer(I4B), intent(in) :: ncol !< number of columns
856  integer(I4B), intent(in) :: nrow !< number of rows
857  integer(I4B), intent(in) :: nlay !< number of layers
858  character(len=*), intent(in) :: name !< variable name
859  character(len=*), intent(in) :: mem_path !< path where variable is stored
860  ! -- local
861  type(memorytype), pointer :: mt
862  integer(I4B) :: istat
863  integer(I4B) :: isize
864  ! -- code
865  !
866  ! -- check the variable name length
867  call mem_check_length(name, lenvarname, "variable")
868  !
869  ! -- set isize
870  isize = ncol * nrow * nlay
871  !
872  ! -- allocate the real array
873  allocate (adbl(ncol, nrow, nlay), stat=istat, errmsg=errmsg)
874  if (istat /= 0) then
875  call allocate_error(name, mem_path, istat, isize)
876  end if
877  !
878  ! -- update the counter
879  nvalues_adbl = nvalues_adbl + isize
880  !
881  ! -- allocate memory type
882  allocate (mt)
883  !
884  ! -- set memory type
885  mt%adbl3d => adbl
886  mt%element_size = dp
887  mt%isize = isize
888  mt%name = name
889  mt%path = mem_path
890  write (mt%memtype, "(a,' (',i0,',',i0,',',i0,')')") 'DOUBLE', ncol, &
891  nrow, nlay
892  !
893  ! -- add memory type to the memory list
894  call memorystore%add(mt)
895  end subroutine allocate_dbl3d
896 
897  !> @brief Check in an existing 1d integer array with a new address (name + path)
898  !<
899  subroutine checkin_int1d(aint, name, mem_path, name2, mem_path2)
900  integer(I4B), dimension(:), pointer, contiguous, intent(in) :: aint !< the existing array
901  character(len=*), intent(in) :: name !< new variable name
902  character(len=*), intent(in) :: mem_path !< new path where variable is stored
903  character(len=*), intent(in) :: name2 !< existing variable name
904  character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored
905  ! --local
906  type(memorytype), pointer :: mt
907  integer(I4B) :: isize
908  ! -- code
909  !
910  ! -- check variable name length
911  call mem_check_length(name, lenvarname, "variable")
912  !
913  ! -- set isize
914  isize = size(aint)
915  !
916  ! -- allocate memory type
917  allocate (mt)
918  !
919  ! -- set memory type
920  mt%aint1d => aint
921  mt%element_size = i4b
922  mt%isize = isize
923  mt%name = name
924  mt%path = mem_path
925  write (mt%memtype, "(a,' (',i0,')')") 'INTEGER', isize
926  !
927  ! -- set master information
928  mt%master = .false.
929  mt%mastername = name2
930  mt%masterPath = mem_path2
931  !
932  ! -- add memory type to the memory list
933  call memorystore%add(mt)
934  end subroutine checkin_int1d
935 
936  !> @brief Check in an existing 2d integer array with a new address (name + path)
937  !<
938  subroutine checkin_int2d(aint2d, name, mem_path, name2, mem_path2)
939  integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint2d !< the existing 2d array
940  character(len=*), intent(in) :: name !< new variable name
941  character(len=*), intent(in) :: mem_path !< new path where variable is stored
942  character(len=*), intent(in) :: name2 !< existing variable name
943  character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored
944  ! -- local
945  type(memorytype), pointer :: mt
946  integer(I4B) :: ncol, nrow, isize
947  ! -- code
948  !
949  ! -- check the variable name length
950  call mem_check_length(name, lenvarname, "variable")
951  !
952  ! -- set isize
953  ncol = size(aint2d, dim=1)
954  nrow = size(aint2d, dim=2)
955  isize = ncol * nrow
956  !
957  ! -- allocate memory type
958  allocate (mt)
959  !
960  ! -- set memory type
961  mt%aint2d => aint2d
962  mt%isize = isize
963  mt%name = name
964  mt%path = mem_path
965  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'INTEGER', ncol, nrow
966  !
967  ! -- set master information
968  mt%master = .false.
969  mt%mastername = name2
970  mt%masterPath = mem_path2
971  !
972  ! -- add memory type to the memory list
973  call memorystore%add(mt)
974  end subroutine checkin_int2d
975 
976  !> @brief Check in an existing 1d double precision array with a new address (name + path)
977  !<
978  subroutine checkin_dbl1d(adbl, name, mem_path, name2, mem_path2)
979  real(DP), dimension(:), pointer, contiguous, intent(inout) :: adbl !< the existing array
980  character(len=*), intent(in) :: name !< new variable name
981  character(len=*), intent(in) :: mem_path !< new path where variable is stored
982  character(len=*), intent(in) :: name2 !< existing variable name
983  character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored
984  ! -- local
985  type(memorytype), pointer :: mt
986  integer(I4B) :: isize
987  ! -- code
988  !
989  ! -- check the variable name length
990  call mem_check_length(name, lenvarname, "variable")
991  !
992  ! -- set isize
993  isize = size(adbl)
994  !
995  ! -- allocate memory type
996  allocate (mt)
997  !
998  ! -- set memory type
999  mt%adbl1d => adbl
1000  mt%element_size = dp
1001  mt%isize = isize
1002  mt%name = name
1003  mt%path = mem_path
1004  write (mt%memtype, "(a,' (',i0,')')") 'DOUBLE', isize
1005  !
1006  ! -- set master information
1007  mt%master = .false.
1008  mt%mastername = name2
1009  mt%masterPath = mem_path2
1010  !
1011  ! -- add memory type to the memory list
1012  call memorystore%add(mt)
1013  end subroutine checkin_dbl1d
1014 
1015  !> @brief Check in an existing 2d double precision array with a new address (name + path)
1016  !<
1017  subroutine checkin_dbl2d(adbl2d, name, mem_path, name2, mem_path2)
1018  real(DP), dimension(:, :), pointer, contiguous, intent(inout) :: adbl2d !< the existing 2d array
1019  character(len=*), intent(in) :: name !< new variable name
1020  character(len=*), intent(in) :: mem_path !< new path where variable is stored
1021  character(len=*), intent(in) :: name2 !< existing variable name
1022  character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored
1023  ! -- local
1024  type(memorytype), pointer :: mt
1025  integer(I4B) :: ncol, nrow, isize
1026  ! -- code
1027  !
1028  ! -- check the variable name length
1029  call mem_check_length(name, lenvarname, "variable")
1030  !
1031  ! -- set isize
1032  ncol = size(adbl2d, dim=1)
1033  nrow = size(adbl2d, dim=2)
1034  isize = ncol * nrow
1035  !
1036  ! -- allocate memory type
1037  allocate (mt)
1038  !
1039  ! -- set memory type
1040  mt%adbl2d => adbl2d
1041  mt%isize = isize
1042  mt%name = name
1043  mt%path = mem_path
1044  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'DOUBLE', ncol, nrow
1045  !
1046  ! -- set master information
1047  mt%master = .false.
1048  mt%mastername = name2
1049  mt%masterPath = mem_path2
1050  !
1051  ! -- add memory type to the memory list
1052  call memorystore%add(mt)
1053  end subroutine checkin_dbl2d
1054 
1055  !> @brief Check in an existing 1d CharacterStringType array with a new address (name + path)
1056  !<
1057  subroutine checkin_charstr1d(acharstr1d, ilen, name, mem_path, name2, mem_path2)
1058  type(characterstringtype), dimension(:), &
1059  pointer, contiguous, intent(inout) :: acharstr1d !< the existing array
1060  integer(I4B), intent(in) :: ilen
1061  character(len=*), intent(in) :: name !< new variable name
1062  character(len=*), intent(in) :: mem_path !< new path where variable is stored
1063  character(len=*), intent(in) :: name2 !< existing variable name
1064  character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored
1065  ! --local
1066  type(memorytype), pointer :: mt
1067  integer(I4B) :: isize
1068  ! -- code
1069  !
1070  ! -- check variable name length
1071  call mem_check_length(name, lenvarname, "variable")
1072  !
1073  ! -- set isize
1074  isize = size(acharstr1d)
1075  !
1076  ! -- allocate memory type
1077  allocate (mt)
1078  !
1079  ! -- set memory type
1080  mt%acharstr1d => acharstr1d
1081  mt%element_size = ilen
1082  mt%isize = isize
1083  mt%name = name
1084  mt%path = mem_path
1085  write (mt%memtype, "(a,' LEN=',i0,' (',i0,')')") 'STRING', ilen, isize
1086  !
1087  ! -- set master information
1088  mt%master = .false.
1089  mt%mastername = name2
1090  mt%masterPath = mem_path2
1091  !
1092  ! -- add memory type to the memory list
1093  call memorystore%add(mt)
1094  end subroutine checkin_charstr1d
1095 
1096  !> @brief Reallocate a 1-dimensional defined length string array
1097  !<
1098  subroutine reallocate_str1d(astr, ilen, nrow, name, mem_path)
1099  integer(I4B), intent(in) :: ilen !< string length
1100  integer(I4B), intent(in) :: nrow !< number of rows
1101  character(len=ilen), dimension(:), pointer, contiguous, intent(inout) :: astr !< the reallocated string array
1102  character(len=*), intent(in) :: name !< variable name
1103  character(len=*), intent(in) :: mem_path !< path where variable is stored
1104  ! -- local
1105  type(memorytype), pointer :: mt
1106  logical(LGP) :: found
1107  character(len=ilen), dimension(:), allocatable :: astrtemp
1108  integer(I4B) :: istat
1109  integer(I4B) :: isize
1110  integer(I4B) :: isize_old
1111  integer(I4B) :: nrow_old
1112  integer(I4B) :: n
1113  !
1114  ! -- Find and assign mt
1115  call get_from_memorystore(name, mem_path, mt, found)
1116  !
1117  ! -- reallocate astr1d
1118  if (found) then
1119  isize_old = mt%isize
1120  if (isize_old > 0) then
1121  nrow_old = size(astr)
1122  else
1123  nrow_old = 0
1124  end if
1125  !
1126  ! -- calculate isize
1127  isize = nrow
1128  !
1129  ! -- allocate astrtemp
1130  allocate (astrtemp(nrow), stat=istat, errmsg=errmsg)
1131  if (istat /= 0) then
1132  call allocate_error(name, mem_path, istat, isize)
1133  end if
1134  !
1135  ! -- copy existing values
1136  do n = 1, nrow_old
1137  astrtemp(n) = astr(n)
1138  end do
1139  !
1140  ! -- fill new values with missing values
1141  do n = nrow_old + 1, nrow
1142  astrtemp(n) = ''
1143  end do
1144  !
1145  ! -- deallocate mt pointer, repoint, recalculate isize
1146  deallocate (astr)
1147  !
1148  ! -- allocate astr1d
1149  allocate (astr(nrow), stat=istat, errmsg=errmsg)
1150  if (istat /= 0) then
1151  call allocate_error(name, mem_path, istat, isize)
1152  end if
1153  !
1154  ! -- fill the reallocate character array
1155  do n = 1, nrow
1156  astr(n) = astrtemp(n)
1157  end do
1158  !
1159  ! -- deallocate temporary storage
1160  deallocate (astrtemp)
1161  !
1162  ! -- reset memory manager values
1163  mt%astr1d => astr
1164  mt%element_size = ilen
1165  mt%isize = isize
1166  mt%nrealloc = mt%nrealloc + 1
1167  mt%master = .true.
1168  nvalues_astr = nvalues_astr + isize - isize_old
1169  write (mt%memtype, "(a,' LEN=',i0,' (',i0,')')") 'STRING', ilen, nrow
1170  else
1171  errmsg = "Programming error, variable '"//trim(name)//"' from '"// &
1172  trim(mem_path)//"' is not defined in the memory manager. Use "// &
1173  "mem_allocate instead."
1174  call store_error(errmsg, terminate=.true.)
1175  end if
1176  end subroutine reallocate_str1d
1177 
1178  !> @brief Reallocate a 1-dimensional deferred length string array
1179  !<
1180  subroutine reallocate_charstr1d(acharstr1d, ilen, nrow, name, mem_path)
1181  type(characterstringtype), dimension(:), pointer, contiguous, &
1182  intent(inout) :: acharstr1d !< the reallocated charstring array
1183  integer(I4B), intent(in) :: ilen !< string length
1184  integer(I4B), intent(in) :: nrow !< number of rows
1185  character(len=*), intent(in) :: name !< variable name
1186  character(len=*), intent(in) :: mem_path !< path where variable is stored
1187  ! -- local
1188  type(memorytype), pointer :: mt
1189  logical(LGP) :: found
1190  type(characterstringtype), dimension(:), allocatable :: astrtemp
1191  character(len=ilen) :: string
1192  integer(I4B) :: istat
1193  integer(I4B) :: isize
1194  integer(I4B) :: isize_old
1195  integer(I4B) :: nrow_old
1196  integer(I4B) :: n
1197  !
1198  ! -- Initialize string
1199  string = ''
1200  !
1201  ! -- Find and assign mt
1202  call get_from_memorystore(name, mem_path, mt, found)
1203  !
1204  ! -- reallocate astr1d
1205  if (found) then
1206  isize_old = mt%isize
1207  if (isize_old > 0) then
1208  nrow_old = size(acharstr1d)
1209  else
1210  nrow_old = 0
1211  end if
1212  !
1213  ! -- calculate isize
1214  isize = nrow
1215  !
1216  ! -- allocate astrtemp
1217  allocate (astrtemp(nrow), stat=istat, errmsg=errmsg)
1218  if (istat /= 0) then
1219  call allocate_error(name, mem_path, istat, isize)
1220  end if
1221  !
1222  ! -- copy existing values
1223  do n = 1, nrow_old
1224  astrtemp(n) = acharstr1d(n)
1225  call acharstr1d(n)%destroy()
1226  end do
1227  !
1228  ! -- fill new values with missing values
1229  do n = nrow_old + 1, nrow
1230  astrtemp(n) = string
1231  end do
1232  !
1233  ! -- deallocate mt pointer, repoint, recalculate isize
1234  deallocate (acharstr1d)
1235  !
1236  ! -- allocate astr1d
1237  allocate (acharstr1d(nrow), stat=istat, errmsg=errmsg)
1238  if (istat /= 0) then
1239  call allocate_error(name, mem_path, istat, isize)
1240  end if
1241  !
1242  ! -- fill the reallocated character array
1243  do n = 1, nrow
1244  acharstr1d(n) = astrtemp(n)
1245  call astrtemp(n)%destroy()
1246  end do
1247  !
1248  ! -- deallocate temporary storage
1249  deallocate (astrtemp)
1250  !
1251  ! -- reset memory manager values
1252  mt%acharstr1d => acharstr1d
1253  mt%element_size = ilen
1254  mt%isize = isize
1255  mt%nrealloc = mt%nrealloc + 1
1256  mt%master = .true.
1257  nvalues_astr = nvalues_astr + isize - isize_old
1258  write (mt%memtype, "(a,' LEN=',i0,' (',i0,')')") 'STRING', ilen, nrow
1259  else
1260  errmsg = "Programming error, variable '"//trim(name)//"' from '"// &
1261  trim(mem_path)//"' is not defined in the memory manager. Use "// &
1262  "mem_allocate instead."
1263  call store_error(errmsg, terminate=.true.)
1264  end if
1265  end subroutine reallocate_charstr1d
1266 
1267  !> @brief Reallocate a 1-dimensional integer array
1268  !<
1269  subroutine reallocate_int1d(aint, nrow, name, mem_path)
1270  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: aint !< the reallocated integer array
1271  integer(I4B), intent(in) :: nrow !< number of rows
1272  character(len=*), intent(in) :: name !< variable name
1273  character(len=*), intent(in) :: mem_path !< path where variable is stored
1274  ! -- local
1275  type(memorytype), pointer :: mt
1276  logical(LGP) :: found
1277  integer(I4B) :: istat
1278  integer(I4B) :: isize
1279  integer(I4B) :: i
1280  integer(I4B) :: isizeold
1281  integer(I4B) :: ifill
1282  ! -- code
1283  !
1284  ! -- Find and assign mt
1285  call get_from_memorystore(name, mem_path, mt, found)
1286  !
1287  ! -- Allocate aint and then refill
1288  isize = nrow
1289  isizeold = size(mt%aint1d)
1290  ifill = min(isizeold, isize)
1291  allocate (aint(nrow), stat=istat, errmsg=errmsg)
1292  if (istat /= 0) then
1293  call allocate_error(name, mem_path, istat, isize)
1294  end if
1295  do i = 1, ifill
1296  aint(i) = mt%aint1d(i)
1297  end do
1298  !
1299  ! -- deallocate mt pointer, repoint, recalculate isize
1300  deallocate (mt%aint1d)
1301  mt%aint1d => aint
1302  mt%element_size = i4b
1303  mt%isize = isize
1304  mt%nrealloc = mt%nrealloc + 1
1305  mt%master = .true.
1306  nvalues_aint = nvalues_aint + isize - isizeold
1307  end subroutine reallocate_int1d
1308 
1309  !> @brief Reallocate a 2-dimensional integer array
1310  !<
1311  subroutine reallocate_int2d(aint, ncol, nrow, name, mem_path)
1312  integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint !< the reallocated 2d integer array
1313  integer(I4B), intent(in) :: ncol !< number of columns
1314  integer(I4B), intent(in) :: nrow !< number of rows
1315  character(len=*), intent(in) :: name !< variable name
1316  character(len=*), intent(in) :: mem_path !< path where variable is stored
1317  ! -- local
1318  type(memorytype), pointer :: mt
1319  logical(LGP) :: found
1320  integer(I4B) :: istat
1321  integer(I4B), dimension(2) :: ishape
1322  integer(I4B) :: i
1323  integer(I4B) :: j
1324  integer(I4B) :: isize
1325  integer(I4B) :: isizeold
1326  ! -- code
1327  !
1328  ! -- Find and assign mt
1329  call get_from_memorystore(name, mem_path, mt, found)
1330  !
1331  ! -- Allocate aint and then refill
1332  ishape = shape(mt%aint2d)
1333  isize = nrow * ncol
1334  isizeold = ishape(1) * ishape(2)
1335  allocate (aint(ncol, nrow), stat=istat, errmsg=errmsg)
1336  if (istat /= 0) then
1337  call allocate_error(name, mem_path, istat, isize)
1338  end if
1339  do i = 1, ishape(2)
1340  do j = 1, ishape(1)
1341  aint(j, i) = mt%aint2d(j, i)
1342  end do
1343  end do
1344  !
1345  ! -- deallocate mt pointer, repoint, recalculate isize
1346  deallocate (mt%aint2d)
1347  mt%aint2d => aint
1348  mt%element_size = i4b
1349  mt%isize = isize
1350  mt%nrealloc = mt%nrealloc + 1
1351  mt%master = .true.
1352  nvalues_aint = nvalues_aint + isize - isizeold
1353  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'INTEGER', ncol, nrow
1354  end subroutine reallocate_int2d
1355 
1356  !> @brief Reallocate a 1-dimensional real array
1357  !<
1358  subroutine reallocate_dbl1d(adbl, nrow, name, mem_path)
1359  real(DP), dimension(:), pointer, contiguous, intent(inout) :: adbl !< the reallocated 1d real array
1360  integer(I4B), intent(in) :: nrow !< number of rows
1361  character(len=*), intent(in) :: name !< variable name
1362  character(len=*), intent(in) :: mem_path !< path where variable is stored
1363  ! -- local
1364  type(memorytype), pointer :: mt
1365  integer(I4B) :: istat
1366  integer(I4B) :: isize
1367  integer(I4B) :: i
1368  integer(I4B) :: isizeold
1369  integer(I4B) :: ifill
1370  logical(LGP) :: found
1371  ! -- code
1372  !
1373  ! -- Find and assign mt
1374  call get_from_memorystore(name, mem_path, mt, found)
1375  !
1376  ! -- Allocate adbl and then refill
1377  isize = nrow
1378  isizeold = size(mt%adbl1d)
1379  ifill = min(isizeold, isize)
1380  allocate (adbl(nrow), stat=istat, errmsg=errmsg)
1381  if (istat /= 0) then
1382  call allocate_error(name, mem_path, istat, isize)
1383  end if
1384  do i = 1, ifill
1385  adbl(i) = mt%adbl1d(i)
1386  end do
1387  !
1388  ! -- deallocate mt pointer, repoint, recalculate isize
1389  deallocate (mt%adbl1d)
1390  mt%adbl1d => adbl
1391  mt%element_size = dp
1392  mt%isize = isize
1393  mt%nrealloc = mt%nrealloc + 1
1394  mt%master = .true.
1395  nvalues_adbl = nvalues_adbl + isize - isizeold
1396  write (mt%memtype, "(a,' (',i0,')')") 'DOUBLE', isize
1397  end subroutine reallocate_dbl1d
1398 
1399  !> @brief Reallocate a 2-dimensional real array
1400  !<
1401  subroutine reallocate_dbl2d(adbl, ncol, nrow, name, mem_path)
1402  real(DP), dimension(:, :), pointer, contiguous, intent(inout) :: adbl !< the reallocated 2d real array
1403  integer(I4B), intent(in) :: ncol !< number of columns
1404  integer(I4B), intent(in) :: nrow !< number of rows
1405  character(len=*), intent(in) :: name !< variable name
1406  character(len=*), intent(in) :: mem_path !< path where variable is stored
1407  ! -- local
1408  type(memorytype), pointer :: mt
1409  logical(LGP) :: found
1410  integer(I4B) :: istat
1411  integer(I4B), dimension(2) :: ishape
1412  integer(I4B) :: i
1413  integer(I4B) :: j
1414  integer(I4B) :: isize
1415  integer(I4B) :: isizeold
1416  ! -- code
1417  !
1418  ! -- Find and assign mt
1419  call get_from_memorystore(name, mem_path, mt, found)
1420  !
1421  ! -- Allocate adbl and then refill
1422  ishape = shape(mt%adbl2d)
1423  isize = nrow * ncol
1424  isizeold = ishape(1) * ishape(2)
1425  allocate (adbl(ncol, nrow), stat=istat, errmsg=errmsg)
1426  if (istat /= 0) then
1427  call allocate_error(name, mem_path, istat, isize)
1428  end if
1429  do i = 1, ishape(2)
1430  do j = 1, ishape(1)
1431  adbl(j, i) = mt%adbl2d(j, i)
1432  end do
1433  end do
1434  !
1435  ! -- deallocate mt pointer, repoint, recalculate isize
1436  deallocate (mt%adbl2d)
1437  mt%adbl2d => adbl
1438  mt%element_size = dp
1439  mt%isize = isize
1440  mt%nrealloc = mt%nrealloc + 1
1441  mt%master = .true.
1442  nvalues_adbl = nvalues_adbl + isize - isizeold
1443  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'DOUBLE', ncol, nrow
1444  end subroutine reallocate_dbl2d
1445 
1446  !> @brief Set pointer to a logical scalar
1447  !<
1448  subroutine setptr_logical(sclr, name, mem_path)
1449  logical(LGP), pointer, intent(inout) :: sclr !< pointer to logical scalar
1450  character(len=*), intent(in) :: name !< variable name
1451  character(len=*), intent(in) :: mem_path !< path where variable is stored
1452  ! -- local
1453  type(memorytype), pointer :: mt
1454  logical(LGP) :: found
1455  ! -- code
1456  call get_from_memorystore(name, mem_path, mt, found)
1457  sclr => mt%logicalsclr
1458  end subroutine setptr_logical
1459 
1460  !> @brief Set pointer to integer scalar
1461  !<
1462  subroutine setptr_int(sclr, name, mem_path)
1463  integer(I4B), pointer, intent(inout) :: sclr !< pointer to integer scalar
1464  character(len=*), intent(in) :: name !< variable name
1465  character(len=*), intent(in) :: mem_path !< path where variable is stored
1466  ! -- local
1467  type(memorytype), pointer :: mt
1468  logical(LGP) :: found
1469  ! -- code
1470  call get_from_memorystore(name, mem_path, mt, found)
1471  sclr => mt%intsclr
1472  end subroutine setptr_int
1473 
1474  !> @brief Set pointer to 1d integer array
1475  !<
1476  subroutine setptr_int1d(aint, name, mem_path)
1477  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: aint !< pointer to 1d integer array
1478  character(len=*), intent(in) :: name !< variable name
1479  character(len=*), intent(in) :: mem_path !< path where variable is stored
1480  ! -- local
1481  type(memorytype), pointer :: mt
1482  logical(LGP) :: found
1483  ! -- code
1484  call get_from_memorystore(name, mem_path, mt, found)
1485  aint => mt%aint1d
1486  end subroutine setptr_int1d
1487 
1488  !> @brief Set pointer to 2d integer array
1489  !<
1490  subroutine setptr_int2d(aint, name, mem_path)
1491  integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint !< pointer to 2d integer array
1492  character(len=*), intent(in) :: name !< variable name
1493  character(len=*), intent(in) :: mem_path !< path where variable is stored
1494  ! -- local
1495  type(memorytype), pointer :: mt
1496  logical(LGP) :: found
1497  ! -- code
1498  call get_from_memorystore(name, mem_path, mt, found)
1499  aint => mt%aint2d
1500  end subroutine setptr_int2d
1501 
1502  !> @brief Set pointer to 3d integer array
1503  !<
1504  subroutine setptr_int3d(aint, name, mem_path)
1505  integer(I4B), dimension(:, :, :), pointer, contiguous, intent(inout) :: aint !< pointer to 3d integer array
1506  character(len=*), intent(in) :: name !< variable name
1507  character(len=*), intent(in) :: mem_path !< path where variable is stored
1508  ! -- local
1509  type(memorytype), pointer :: mt
1510  logical(LGP) :: found
1511  ! -- code
1512  call get_from_memorystore(name, mem_path, mt, found)
1513  aint => mt%aint3d
1514  end subroutine setptr_int3d
1515 
1516  !> @brief Set pointer to a real scalar
1517  !<
1518  subroutine setptr_dbl(sclr, name, mem_path)
1519  real(DP), pointer, intent(inout) :: sclr !< pointer to a real scalar
1520  character(len=*), intent(in) :: name !< variable name
1521  character(len=*), intent(in) :: mem_path !< path where variable is stored
1522  ! -- local
1523  type(memorytype), pointer :: mt
1524  logical(LGP) :: found
1525  ! -- code
1526  call get_from_memorystore(name, mem_path, mt, found)
1527  sclr => mt%dblsclr
1528  end subroutine setptr_dbl
1529 
1530  !> @brief Set pointer to a 1d real array
1531  !<
1532  subroutine setptr_dbl1d(adbl, name, mem_path)
1533  real(DP), dimension(:), pointer, contiguous, intent(inout) :: adbl !< pointer to 1d real array
1534  character(len=*), intent(in) :: name !< variable name
1535  character(len=*), intent(in) :: mem_path !< path where variable is stored
1536  ! -- local
1537  type(memorytype), pointer :: mt
1538  logical(LGP) :: found
1539  ! -- code
1540  call get_from_memorystore(name, mem_path, mt, found)
1541  adbl => mt%adbl1d
1542  end subroutine setptr_dbl1d
1543 
1544  !> @brief Set pointer to a 2d real array
1545  !<
1546  subroutine setptr_dbl2d(adbl, name, mem_path)
1547  real(DP), dimension(:, :), pointer, contiguous, intent(inout) :: adbl !< pointer to 2d real array
1548  character(len=*), intent(in) :: name !< variable name
1549  character(len=*), intent(in) :: mem_path !< path where variable is stored
1550  ! -- local
1551  type(memorytype), pointer :: mt
1552  logical(LGP) :: found
1553  ! -- code
1554  call get_from_memorystore(name, mem_path, mt, found)
1555  adbl => mt%adbl2d
1556  end subroutine setptr_dbl2d
1557 
1558  !> @brief Set pointer to a 3d real array
1559  !<
1560  subroutine setptr_dbl3d(adbl, name, mem_path)
1561  real(DP), dimension(:, :, :), pointer, contiguous, intent(inout) :: adbl !< pointer to 3d real array
1562  character(len=*), intent(in) :: name !< variable name
1563  character(len=*), intent(in) :: mem_path !< path where variable is stored
1564  ! -- local
1565  type(memorytype), pointer :: mt
1566  logical(LGP) :: found
1567  ! -- code
1568  call get_from_memorystore(name, mem_path, mt, found)
1569  adbl => mt%adbl3d
1570  end subroutine setptr_dbl3d
1571 
1572  !> @brief Set pointer to a string (scalar)
1573  !<
1574  subroutine setptr_str(asrt, name, mem_path)
1575  character(len=:), pointer :: asrt !< pointer to the character string
1576  character(len=*), intent(in) :: name !< variable name
1577  character(len=*), intent(in) :: mem_path !< path where variable is stored
1578  ! -- local
1579  type(memorytype), pointer :: mt
1580  logical(LGP) :: found
1581  ! -- code
1582  call get_from_memorystore(name, mem_path, mt, found)
1583  asrt => mt%strsclr
1584  end subroutine setptr_str
1585 
1586  !> @brief Set pointer to a fixed-length string array
1587  !<
1588  subroutine setptr_str1d(astr1d, name, mem_path)
1589  character(len=:), dimension(:), &
1590  pointer, contiguous, intent(inout) :: astr1d !< pointer to the string array
1591  character(len=*), intent(in) :: name !< variable name
1592  character(len=*), intent(in) :: mem_path !< path where variable is stored
1593  ! -- local
1594  type(memorytype), pointer :: mt
1595  logical(LGP) :: found
1596  ! -- code
1597  call get_from_memorystore(name, mem_path, mt, found)
1598  select type (item => mt%astr1d)
1599  type is (character(*))
1600  astr1d => item
1601  class default
1602  astr1d => null()
1603  end select
1604  end subroutine setptr_str1d
1605 
1606  !> @brief Set pointer to an array of CharacterStringType
1607  !<
1608  subroutine setptr_charstr1d(acharstr1d, name, mem_path)
1609  type(characterstringtype), dimension(:), pointer, contiguous, &
1610  intent(inout) :: acharstr1d !< the reallocated charstring array
1611  character(len=*), intent(in) :: name !< variable name
1612  character(len=*), intent(in) :: mem_path !< path where variable is stored
1613  ! -- local
1614  type(memorytype), pointer :: mt
1615  logical(LGP) :: found
1616  ! -- code
1617  call get_from_memorystore(name, mem_path, mt, found)
1618  acharstr1d => mt%acharstr1d
1619  end subroutine setptr_charstr1d
1620 
1621  !> @brief Make a copy of a 1-dimensional integer array
1622  !<
1623  subroutine copyptr_int1d(aint, name, mem_path, mem_path_copy)
1624  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: aint !< returned copy of 1d integer array
1625  character(len=*), intent(in) :: name !< variable name
1626  character(len=*), intent(in) :: mem_path !< path where variable is stored
1627  character(len=*), intent(in), optional :: mem_path_copy !< optional path where the copy will be stored,
1628  !! if passed then the copy is added to the
1629  !! memory manager
1630  ! -- local
1631  type(memorytype), pointer :: mt
1632  logical(LGP) :: found
1633  integer(I4B) :: n
1634  ! -- code
1635  call get_from_memorystore(name, mem_path, mt, found)
1636  aint => null()
1637  ! -- check the copy into the memory manager
1638  if (present(mem_path_copy)) then
1639  call allocate_int1d(aint, size(mt%aint1d), mt%name, mem_path_copy)
1640  ! -- create a local copy
1641  else
1642  allocate (aint(size(mt%aint1d)))
1643  end if
1644  do n = 1, size(mt%aint1d)
1645  aint(n) = mt%aint1d(n)
1646  end do
1647  end subroutine copyptr_int1d
1648 
1649  !> @brief Make a copy of a 2-dimensional integer array
1650  !<
1651  subroutine copyptr_int2d(aint, name, mem_path, mem_path_copy)
1652  integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint !< returned copy of 2d integer array
1653  character(len=*), intent(in) :: name !< variable name
1654  character(len=*), intent(in) :: mem_path !< path where variable is stored
1655  character(len=*), intent(in), optional :: mem_path_copy !< optional path where the copy will be stored,
1656  !! if passed then the copy is added to the
1657  !! memory manager
1658  ! -- local
1659  type(memorytype), pointer :: mt
1660  logical(LGP) :: found
1661  integer(I4B) :: i
1662  integer(I4B) :: j
1663  integer(I4B) :: ncol
1664  integer(I4B) :: nrow
1665  ! -- code
1666  call get_from_memorystore(name, mem_path, mt, found)
1667  aint => null()
1668  ncol = size(mt%aint2d, dim=1)
1669  nrow = size(mt%aint2d, dim=2)
1670  ! -- check the copy into the memory manager
1671  if (present(mem_path_copy)) then
1672  call allocate_int2d(aint, ncol, nrow, mt%name, mem_path_copy)
1673  ! -- create a local copy
1674  else
1675  allocate (aint(ncol, nrow))
1676  end if
1677  do i = 1, nrow
1678  do j = 1, ncol
1679  aint(j, i) = mt%aint2d(j, i)
1680  end do
1681  end do
1682  end subroutine copyptr_int2d
1683 
1684  !> @brief Make a copy of a 1-dimensional real array
1685  !<
1686  subroutine copyptr_dbl1d(adbl, name, mem_path, mem_path_copy)
1687  real(DP), dimension(:), pointer, contiguous, intent(inout) :: adbl !< returned copy of 1d real array
1688  character(len=*), intent(in) :: name !< variable name
1689  character(len=*), intent(in) :: mem_path !< path where variable is stored
1690  character(len=*), intent(in), optional :: mem_path_copy !< optional path where the copy will be stored,
1691  !! if passed then the copy is added to the
1692  !! memory manager
1693  ! -- local
1694  type(memorytype), pointer :: mt
1695  logical(LGP) :: found
1696  integer(I4B) :: n
1697  ! -- code
1698  call get_from_memorystore(name, mem_path, mt, found)
1699  adbl => null()
1700  ! -- check the copy into the memory manager
1701  if (present(mem_path_copy)) then
1702  call allocate_dbl1d(adbl, size(mt%adbl1d), mt%name, mem_path_copy)
1703  ! -- create a local copy
1704  else
1705  allocate (adbl(size(mt%adbl1d)))
1706  end if
1707  do n = 1, size(mt%adbl1d)
1708  adbl(n) = mt%adbl1d(n)
1709  end do
1710  end subroutine copyptr_dbl1d
1711 
1712  !> @brief Make a copy of a 2-dimensional real array
1713  !<
1714  subroutine copyptr_dbl2d(adbl, name, mem_path, mem_path_copy)
1715  real(DP), dimension(:, :), pointer, contiguous, intent(inout) :: adbl !< returned copy of 2d real array
1716  character(len=*), intent(in) :: name !< variable name
1717  character(len=*), intent(in) :: mem_path !< path where variable is stored
1718  character(len=*), intent(in), optional :: mem_path_copy !< optional path where the copy will be stored,
1719  !! if passed then the copy is added to the
1720  !! memory manager
1721  ! -- local
1722  type(memorytype), pointer :: mt
1723  logical(LGP) :: found
1724  integer(I4B) :: i
1725  integer(I4B) :: j
1726  integer(I4B) :: ncol
1727  integer(I4B) :: nrow
1728  ! -- code
1729  call get_from_memorystore(name, mem_path, mt, found)
1730  adbl => null()
1731  ncol = size(mt%adbl2d, dim=1)
1732  nrow = size(mt%adbl2d, dim=2)
1733  ! -- check the copy into the memory manager
1734  if (present(mem_path_copy)) then
1735  call allocate_dbl2d(adbl, ncol, nrow, mt%name, mem_path_copy)
1736  ! -- create a local copy
1737  else
1738  allocate (adbl(ncol, nrow))
1739  end if
1740  do i = 1, nrow
1741  do j = 1, ncol
1742  adbl(j, i) = mt%adbl2d(j, i)
1743  end do
1744  end do
1745  end subroutine copyptr_dbl2d
1746 
1747  !> @brief Copy values from a 1-dimensional real array in the memory
1748  !< manager to a passed 1-dimensional real array
1749  subroutine copy_dbl1d(adbl, name, mem_path)
1750  real(dp), dimension(:), intent(inout) :: adbl !< target array
1751  character(len=*), intent(in) :: name !< variable name
1752  character(len=*), intent(in) :: mem_path !< path where variable is stored
1753  ! -- local
1754  type(memorytype), pointer :: mt
1755  logical(LGP) :: found
1756  integer(I4B) :: n
1757  ! -- code
1758  call get_from_memorystore(name, mem_path, mt, found)
1759  do n = 1, size(mt%adbl1d)
1760  adbl(n) = mt%adbl1d(n)
1761  end do
1762  end subroutine copy_dbl1d
1763 
1764  !> @brief Set the pointer for an integer scalar to
1765  !< a target array already stored in the memory manager
1766  subroutine reassignptr_int(sclr, name, mem_path, name_target, mem_path_target)
1767  integer(I4B), pointer, intent(inout) :: sclr !< pointer to integer scalar
1768  character(len=*), intent(in) :: name !< variable name
1769  character(len=*), intent(in) :: mem_path !< path where variable is stored
1770  character(len=*), intent(in) :: name_target !< name of target variable
1771  character(len=*), intent(in) :: mem_path_target !< path where target variable is stored
1772  ! -- local
1773  type(memorytype), pointer :: mt
1774  type(memorytype), pointer :: mt2
1775  logical(LGP) :: found
1776  ! -- code
1777  call get_from_memorystore(name, mem_path, mt, found)
1778  call get_from_memorystore(name_target, mem_path_target, mt2, found)
1779  if (associated(sclr)) then
1781  deallocate (sclr)
1782  end if
1783  sclr => mt2%intsclr
1784  mt%intsclr => sclr
1785  mt%element_size = i4b
1786  mt%isize = 1
1787  write (mt%memtype, "(a,' (',i0,')')") 'INTEGER', mt%isize
1788  !
1789  ! -- set master information
1790  mt%master = .false.
1791  mt%mastername = name_target
1792  mt%masterPath = mem_path_target
1793  end subroutine reassignptr_int
1794 
1795  !> @brief Set the pointer for a 1-dimensional integer array to
1796  !< a target array already stored in the memory manager
1797  subroutine reassignptr_int1d(aint, name, mem_path, name_target, mem_path_target)
1798  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: aint !< pointer to 1d integer array
1799  character(len=*), intent(in) :: name !< variable name
1800  character(len=*), intent(in) :: mem_path !< path where variable is stored
1801  character(len=*), intent(in) :: name_target !< name of target variable
1802  character(len=*), intent(in) :: mem_path_target !< path where target variable is stored
1803  ! -- local
1804  type(memorytype), pointer :: mt
1805  type(memorytype), pointer :: mt2
1806  logical(LGP) :: found
1807  ! -- code
1808  call get_from_memorystore(name, mem_path, mt, found)
1809  call get_from_memorystore(name_target, mem_path_target, mt2, found)
1810  if (size(aint) > 0) then
1811  nvalues_aint = nvalues_aint - size(aint)
1812  deallocate (aint)
1813  end if
1814  aint => mt2%aint1d
1815  mt%aint1d => aint
1816  mt%element_size = i4b
1817  mt%isize = size(aint)
1818  write (mt%memtype, "(a,' (',i0,')')") 'INTEGER', mt%isize
1819  !
1820  ! -- set master information
1821  mt%master = .false.
1822  mt%mastername = name_target
1823  mt%masterPath = mem_path_target
1824  end subroutine reassignptr_int1d
1825 
1826  !> @brief Set the pointer for a 2-dimensional integer array to
1827  !< a target array already stored in the memory manager
1828  subroutine reassignptr_int2d(aint, name, mem_path, name_target, mem_path_target)
1829  integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint !< pointer to 2d integer array
1830  character(len=*), intent(in) :: name !< variable name
1831  character(len=*), intent(in) :: mem_path !< path where variable is stored
1832  character(len=*), intent(in) :: name_target !< name of target variable
1833  character(len=*), intent(in) :: mem_path_target !< path where target variable is stored
1834  ! -- local
1835  type(memorytype), pointer :: mt
1836  type(memorytype), pointer :: mt2
1837  logical(LGP) :: found
1838  integer(I4B) :: ncol
1839  integer(I4B) :: nrow
1840  ! -- code
1841  call get_from_memorystore(name, mem_path, mt, found)
1842  call get_from_memorystore(name_target, mem_path_target, mt2, found)
1843  if (size(aint) > 0) then
1844  nvalues_aint = nvalues_aint - size(aint)
1845  deallocate (aint)
1846  end if
1847  aint => mt2%aint2d
1848  mt%aint2d => aint
1849  mt%element_size = i4b
1850  mt%isize = size(aint)
1851  ncol = size(aint, dim=1)
1852  nrow = size(aint, dim=2)
1853  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'INTEGER', ncol, nrow
1854  !
1855  ! -- set master information
1856  mt%master = .false.
1857  mt%mastername = name_target
1858  mt%masterPath = mem_path_target
1859  end subroutine reassignptr_int2d
1860 
1861  !> @brief Set the pointer for a 1-dimensional real array to
1862  !< a target array already stored in the memory manager
1863  subroutine reassignptr_dbl1d(adbl, name, mem_path, name_target, mem_path_target)
1864  real(DP), dimension(:), pointer, contiguous, intent(inout) :: adbl !< pointer to 1d real array
1865  character(len=*), intent(in) :: name !< variable name
1866  character(len=*), intent(in) :: mem_path !< path where variable is stored
1867  character(len=*), intent(in) :: name_target !< name of target variable
1868  character(len=*), intent(in) :: mem_path_target !< path where target variable is stored
1869  ! -- local
1870  type(memorytype), pointer :: mt
1871  type(memorytype), pointer :: mt2
1872  logical(LGP) :: found
1873  ! -- code
1874  call get_from_memorystore(name, mem_path, mt, found)
1875  call get_from_memorystore(name_target, mem_path_target, mt2, found)
1876  if (size(adbl) > 0) then
1877  nvalues_adbl = nvalues_adbl - size(adbl)
1878  deallocate (adbl)
1879  end if
1880  adbl => mt2%adbl1d
1881  mt%adbl1d => adbl
1882  mt%element_size = dp
1883  mt%isize = size(adbl)
1884  write (mt%memtype, "(a,' (',i0,')')") 'DOUBLE', mt%isize
1885  !
1886  ! -- set master information
1887  mt%master = .false.
1888  mt%mastername = name_target
1889  mt%masterPath = mem_path_target
1890  end subroutine reassignptr_dbl1d
1891 
1892  !> @brief Set the pointer for a 2-dimensional real array to
1893  !< a target array already stored in the memory manager
1894  subroutine reassignptr_dbl2d(adbl, name, mem_path, name_target, mem_path_target)
1895  real(DP), dimension(:, :), pointer, contiguous, intent(inout) :: adbl !< pointer to 2d real array
1896  character(len=*), intent(in) :: name !< variable name
1897  character(len=*), intent(in) :: mem_path !< path where variable is stored
1898  character(len=*), intent(in) :: name_target !< name of target variable
1899  character(len=*), intent(in) :: mem_path_target !< path where target variable is stored
1900  ! -- local
1901  type(memorytype), pointer :: mt
1902  type(memorytype), pointer :: mt2
1903  logical(LGP) :: found
1904  integer(I4B) :: ncol
1905  integer(I4b) :: nrow
1906  ! -- code
1907  call get_from_memorystore(name, mem_path, mt, found)
1908  call get_from_memorystore(name_target, mem_path_target, mt2, found)
1909  if (size(adbl) > 0) then
1910  nvalues_adbl = nvalues_adbl - size(adbl)
1911  deallocate (adbl)
1912  end if
1913  adbl => mt2%adbl2d
1914  mt%adbl2d => adbl
1915  mt%element_size = dp
1916  mt%isize = size(adbl)
1917  ncol = size(adbl, dim=1)
1918  nrow = size(adbl, dim=2)
1919  write (mt%memtype, "(a,' (',i0,',',i0,')')") 'DOUBLE', ncol, nrow
1920  !
1921  ! -- set master information
1922  mt%master = .false.
1923  mt%mastername = name_target
1924  mt%masterPath = mem_path_target
1925  end subroutine reassignptr_dbl2d
1926 
1927  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
1928  !<
1929  subroutine deallocate_str(sclr, name, mem_path)
1930  character(len=*), pointer, intent(inout) :: sclr !< pointer to string
1931  character(len=*), intent(in), optional :: name !< variable name
1932  character(len=*), intent(in), optional :: mem_path !< path where variable is stored
1933  ! -- code
1934  return
1935  end subroutine deallocate_str
1936 
1937  !> @brief Deallocate an array of defined-length character strings
1938  !!
1939  !<
1940  subroutine deallocate_str1d(astr1d, name, mem_path)
1941  character(len=*), dimension(:), pointer, contiguous, intent(inout) :: astr1d !< array of strings
1942  character(len=*), optional, intent(in) :: name !< variable name
1943  character(len=*), optional, intent(in) :: mem_path !< path where variable is stored
1944  ! -- code
1945  return
1946 
1947  end subroutine deallocate_str1d
1948 
1949  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
1950  !!
1951  !<
1952  subroutine deallocate_charstr1d(astr1d, name, mem_path)
1953  type(characterstringtype), dimension(:), pointer, contiguous, &
1954  intent(inout) :: astr1d !< array of strings
1955  character(len=*), optional, intent(in) :: name !< variable name
1956  character(len=*), optional, intent(in) :: mem_path !< path where variable is stored
1957  ! -- code
1958  return
1959  end subroutine deallocate_charstr1d
1960 
1961  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
1962  !<
1963  subroutine deallocate_logical(sclr)
1964  logical(LGP), pointer, intent(inout) :: sclr !< logical scalar to deallocate
1965  ! -- code
1966  return
1967  end subroutine deallocate_logical
1968 
1969  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
1970  !<
1971  subroutine deallocate_int(sclr)
1972  integer(I4B), pointer, intent(inout) :: sclr !< integer variable to deallocate
1973  ! -- code
1974  return
1975  end subroutine deallocate_int
1976 
1977  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
1978  !<
1979  subroutine deallocate_dbl(sclr)
1980  real(DP), pointer, intent(inout) :: sclr !< real variable to deallocate
1981  ! -- code
1982  return
1983  end subroutine deallocate_dbl
1984 
1985  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
1986  !<
1987  subroutine deallocate_int1d(aint, name, mem_path)
1988  integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: aint !< 1d integer array to deallocate
1989  character(len=*), optional :: name !< variable name
1990  character(len=*), optional :: mem_path !< path where variable is stored
1991  ! -- code
1992  return
1993  end subroutine deallocate_int1d
1994 
1995  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
1996  !<
1997  subroutine deallocate_int2d(aint, name, mem_path)
1998  integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint !< 2d integer array to deallocate
1999  character(len=*), optional :: name !< variable name
2000  character(len=*), optional :: mem_path !< path where variable is stored
2001  ! -- code
2002  return
2003  end subroutine deallocate_int2d
2004 
2005  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
2006  !<
2007  subroutine deallocate_int3d(aint, name, mem_path)
2008  integer(I4B), dimension(:, :, :), pointer, contiguous, intent(inout) :: aint !< 3d integer array to deallocate
2009  character(len=*), optional :: name !< variable name
2010  character(len=*), optional :: mem_path !< path where variable is stored
2011  ! -- code
2012  return
2013  end subroutine deallocate_int3d
2014 
2015  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
2016  !<
2017  subroutine deallocate_dbl1d(adbl, name, mem_path)
2018  real(DP), dimension(:), pointer, contiguous, intent(inout) :: adbl !< 1d real array to deallocate
2019  character(len=*), optional :: name !< variable name
2020  character(len=*), optional :: mem_path !< path where variable is stored
2021  ! -- code
2022  return
2023  end subroutine deallocate_dbl1d
2024 
2025  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
2026  !<
2027  subroutine deallocate_dbl2d(adbl, name, mem_path)
2028  real(DP), dimension(:, :), pointer, contiguous, intent(inout) :: adbl !< 2d real array to deallocate
2029  character(len=*), optional :: name !< variable name
2030  character(len=*), optional :: mem_path !< path where variable is stored
2031  ! -- code
2032  return
2033  end subroutine deallocate_dbl2d
2034 
2035  !> @brief DEPRECATED. The memory manager will handle the deallocation of the pointer.
2036  !<
2037  subroutine deallocate_dbl3d(adbl, name, mem_path)
2038  real(DP), dimension(:, :, :), pointer, contiguous, intent(inout) :: adbl !< 3d real array to deallocate
2039  character(len=*), optional :: name !< variable name
2040  character(len=*), optional :: mem_path !< path where variable is stored
2041  ! -- code
2042  return
2043  end subroutine deallocate_dbl3d
2044 
2045  !> @brief Set the memory print option
2046  !<
2047  subroutine mem_set_print_option(iout, keyword, error_msg)
2048  integer(I4B), intent(in) :: iout !< unit number for mfsim.lst
2049  character(len=*), intent(in) :: keyword !< memory print option
2050  character(len=*), intent(inout) :: error_msg !< returned error message if keyword is not valid option
2051  ! -- local
2052  ! -- format
2053  ! -- code
2054  select case (keyword)
2055  case ('NONE')
2056  iprmem = 0
2057  write (iout, '(4x, a)') &
2058  'LIMITED MEMORY INFORMATION WILL BE WRITTEN.'
2059  case ('SUMMARY')
2060  iprmem = 1
2061  write (iout, '(4x, a)') &
2062  'A SUMMARY OF SIMULATION MEMORY INFORMATION WILL BE WRITTEN.'
2063  case ('ALL')
2064  iprmem = 2
2065  write (iout, '(4x, a)') &
2066  'ALL SIMULATION MEMORY INFORMATION WILL BE WRITTEN.'
2067  case default
2068  error_msg = "Unknown memory print option '"//trim(keyword)//"."
2069  end select
2070  end subroutine mem_set_print_option
2071 
2072  !> @brief Create a table if memory_print_option is 'SUMMARY'
2073  !<
2074  subroutine mem_summary_table(iout, nrows, cunits)
2075  integer(I4B), intent(in) :: iout !< unit number for mfsim.lst
2076  integer(I4B), intent(in) :: nrows !< number of table rows
2077  character(len=*), intent(in) :: cunits !< memory units (bytes, kilobytes, megabytes, or gigabytes)
2078  ! -- local
2079  character(len=LINELENGTH) :: title
2080  character(len=LINELENGTH) :: text
2081  integer(I4B) :: nterms
2082  ! -- formats
2083  ! -- code
2084  nterms = 6
2085  !
2086  ! -- set up table title
2087  title = 'SUMMARY INFORMATION ON VARIABLES STORED IN THE MEMORY MANAGER, '// &
2088  'IN '//trim(cunits)
2089  !
2090  ! -- set up stage tableobj
2091  call table_cr(memtab, 'MEM SUM', title)
2092  call memtab%table_df(nrows, nterms, iout)
2093  !
2094  ! -- data type
2095  text = 'COMPONENT'
2096  call memtab%initialize_column(text, 20, alignment=tableft)
2097  !
2098  ! -- memory allocated for characters
2099  text = 'CHARACTER'
2100  call memtab%initialize_column(text, 15, alignment=tabcenter)
2101  !
2102  ! -- memory allocated for logical
2103  text = 'LOGICAL'
2104  call memtab%initialize_column(text, 15, alignment=tabcenter)
2105  !
2106  ! -- memory allocated for integers
2107  text = 'INTEGER'
2108  call memtab%initialize_column(text, 15, alignment=tabcenter)
2109  !
2110  ! -- memory allocated for reals
2111  text = 'REAL'
2112  call memtab%initialize_column(text, 15, alignment=tabcenter)
2113  !
2114  ! -- total memory allocated
2115  text = 'TOTAL'
2116  call memtab%initialize_column(text, 15, alignment=tabcenter)
2117  end subroutine mem_summary_table
2118 
2119  !> @brief Create a table if memory_print_option is 'ALL'
2120  !<
2121  subroutine mem_detailed_table(iout, nrows)
2122  integer(I4B), intent(in) :: iout !< unit number for mfsim.lst
2123  integer(I4B), intent(in) :: nrows !< number of table rows
2124  ! -- local
2125  character(len=LINELENGTH) :: title
2126  character(len=LINELENGTH) :: text
2127  integer(I4B) :: nterms
2128  ! -- formats
2129  ! -- code
2130  nterms = 5
2131  !
2132  ! -- set up table title
2133  title = 'DETAILED INFORMATION ON VARIABLES STORED IN THE MEMORY MANAGER'
2134  !
2135  ! -- set up stage tableobj
2136  call table_cr(memtab, 'MEM DET', title)
2137  call memtab%table_df(nrows, nterms, iout)
2138  !
2139  ! -- origin
2140  text = 'ORIGIN'
2141  call memtab%initialize_column(text, lenmempath, alignment=tableft)
2142  !
2143  ! -- variable
2144  text = 'VARIABLE NAME'
2145  call memtab%initialize_column(text, lenvarname, alignment=tableft)
2146  !
2147  ! -- data type
2148  text = 'DATA TYPE'
2149  call memtab%initialize_column(text, 16, alignment=tableft)
2150  !
2151  ! -- size
2152  text = 'NUMBER OF ITEMS'
2153  call memtab%initialize_column(text, 20, alignment=tabright)
2154  !
2155  ! -- is it a pointer
2156  text = 'ASSOCIATED VARIABLE'
2157  call memtab%initialize_column(text, lenmemaddress, alignment=tableft)
2158  end subroutine mem_detailed_table
2159 
2160  !> @brief Write a row for the memory_print_option 'SUMMARY' table
2161  !<
2162  subroutine mem_summary_line(component, rchars, rlog, rint, rreal, bytes)
2163  character(len=*), intent(in) :: component !< character defining the program component (e.g. solution)
2164  real(DP), intent(in) :: rchars !< allocated size of characters (in common units)
2165  real(DP), intent(in) :: rlog !< allocated size of logical (in common units)
2166  real(DP), intent(in) :: rint !< allocated size of integer variables (in common units)
2167  real(DP), intent(in) :: rreal !< allocated size of real variables (in common units)
2168  real(DP), intent(in) :: bytes !< total allocated memory in memory manager (in common units)
2169  ! -- formats
2170  ! -- code
2171  !
2172  ! -- write line
2173  call memtab%add_term(component)
2174  call memtab%add_term(rchars)
2175  call memtab%add_term(rlog)
2176  call memtab%add_term(rint)
2177  call memtab%add_term(rreal)
2178  call memtab%add_term(bytes)
2179  end subroutine mem_summary_line
2180 
2181  !> @brief Determine appropriate memory unit and conversion factor
2182  !<
2183  subroutine mem_units(bytes, fact, cunits)
2184  ! -- dummy
2185  real(DP), intent(in) :: bytes !< total nr. of bytes
2186  real(DP), intent(inout) :: fact !< conversion factor
2187  character(len=*), intent(inout) :: cunits !< string with memory unit
2188  ! -- local
2189  ! -- formats
2190  ! -- code
2191  !
2192  ! -- initialize factor and unit string
2193  cunits = 'UNKNOWN'
2194  fact = done
2195  !
2196  ! -- set factor
2197  if (bytes < dep3) then
2198  fact = done
2199  cunits = 'BYTES'
2200  else if (bytes < dep6) then
2201  fact = dem3
2202  cunits = 'KILOBYTES'
2203  else if (bytes < dep9) then
2204  fact = dem6
2205  cunits = 'MEGABYTES'
2206  else
2207  fact = dem9
2208  cunits = 'GIGABYTES'
2209  end if
2210  end subroutine mem_units
2211 
2212  !> @brief Create and fill a table with the total allocated memory
2213  !< in the memory manager
2214  subroutine mem_summary_total(iout, bytes)
2215  integer(I4B), intent(in) :: iout !< unit number for mfsim.lst
2216  real(DP), intent(in) :: bytes !< total number of bytes allocated in the memory manager
2217  ! -- local
2218  character(len=LINELENGTH) :: title
2219  character(len=LINELENGTH) :: text
2220  character(LEN=10) :: cunits
2221  integer(I4B) :: nterms
2222  integer(I4B) :: nrows
2223  real(DP) :: fact
2224  real(DP) :: smb
2225  ! -- formats
2226  ! -- code
2227  !
2228  ! -- calculate factor and memory units
2229  call mem_units(bytes, fact, cunits)
2230  !
2231  ! -- set table terms
2232  nterms = 2
2233  nrows = 6
2234  !
2235  ! -- set up table title
2236  title = 'MEMORY MANAGER TOTAL STORAGE BY DATA TYPE, IN '//trim(cunits)
2237  !
2238  ! -- set up stage tableobj
2239  call table_cr(memtab, 'MEM TOT', title)
2240  call memtab%table_df(nrows, nterms, iout)
2241  !
2242  ! -- data type
2243  text = 'DATA TYPE'
2244  call memtab%initialize_column(text, 15, alignment=tableft)
2245  !
2246  ! -- number of values
2247  text = 'ALLOCATED MEMORY'
2248  call memtab%initialize_column(text, 15, alignment=tabcenter)
2249  !
2250  ! -- write data
2251  !
2252  ! -- characters
2253  smb = real(nvalues_astr, dp) * fact
2254  call memtab%add_term('Character')
2255  call memtab%add_term(smb)
2256  !
2257  ! -- logicals
2258  smb = real(nvalues_alogical * lgp, dp) * fact
2259  call memtab%add_term('Logical')
2260  call memtab%add_term(smb)
2261  !
2262  ! -- integers
2263  smb = real(nvalues_aint * i4b, dp) * fact
2264  call memtab%add_term('Integer')
2265  call memtab%add_term(smb)
2266  !
2267  ! -- reals
2268  smb = real(nvalues_adbl * dp, dp) * fact
2269  call memtab%add_term('Real')
2270  call memtab%add_term(smb)
2271  !
2272  ! -- total memory usage
2273  call memtab%print_separator()
2274  smb = bytes * fact
2275  call memtab%add_term('Total')
2276  call memtab%add_term(smb)
2277  !
2278  ! -- Virtual memory
2279  smb = calc_virtual_mem() * fact
2280  call memtab%add_term('Virtual')
2281  call memtab%add_term(smb)
2282  !
2283  ! -- deallocate table
2284  call mem_cleanup_table()
2285  end subroutine mem_summary_total
2286 
2287  !> @brief Generic function to clean a memory manager table
2288  !<
2289  subroutine mem_cleanup_table()
2290  ! -- local
2291  ! -- formats
2292  ! -- code
2293  call memtab%table_da()
2294  deallocate (memtab)
2295  nullify (memtab)
2296  end subroutine mem_cleanup_table
2297 
2298  !> @brief Write memory manager memory usage based on the
2299  !! user-specified memory_print_option
2300  !!
2301  !! The total memory usage by data types (int, real, etc.)
2302  !! is written for every simulation.
2303  !<
2304  subroutine mem_write_usage(iout)
2305  integer(I4B), intent(in) :: iout !< unit number for mfsim.lst
2306  ! -- local
2307  class(memorytype), pointer :: mt
2308  character(len=LENMEMADDRESS), allocatable, dimension(:) :: cunique
2309  ! character(len=LENMEMPATH) :: mem_path
2310  character(len=LENMEMPATH) :: context
2311  character(len=LENCOMPONENTNAME) :: component
2312  character(len=LENCOMPONENTNAME) :: subcomponent
2313  character(len=LENMEMADDRESS) :: context_component
2314  character(LEN=10) :: cunits
2315  type(memorycontaineriteratortype), allocatable :: itr
2316  integer(I4B) :: icomp
2317  integer(I4B) :: ilen
2318  integer(I8B) :: nchars
2319  integer(I8B) :: nlog
2320  integer(I8B) :: nint
2321  integer(I8B) :: nreal
2322  real(dp) :: simbytes
2323  real(dp) :: fact
2324  real(dp) :: rchars
2325  real(dp) :: rlog
2326  real(dp) :: rint
2327  real(dp) :: rreal
2328  real(dp) :: bytes
2329  ! -- formats
2330  ! -- code
2331  !
2332  ! -- Calculate simulation memory allocation
2333  simbytes = (nvalues_astr + &
2334  nvalues_alogical * lgp + &
2335  nvalues_aint * i4b + &
2336  nvalues_adbl * dp)
2337  simbytes = real(simbytes, dp)
2338  !
2339  ! -- calculate factor and memory units
2340  call mem_units(simbytes, fact, cunits)
2341  !
2342  ! -- Write summary table for simulation components
2343  if (iprmem == 1) then
2344  !
2345  ! -- Find unique names of simulation components
2346  call mem_unique_origins(cunique)
2347  call mem_summary_table(iout, size(cunique), cunits)
2348  do icomp = 1, size(cunique)
2349  nchars = 0
2350  nlog = 0
2351  nint = 0
2352  nreal = 0
2353  bytes = dzero
2354  ilen = len_trim(cunique(icomp))
2355  itr = memorystore%iterator()
2356  do while (itr%has_next())
2357  call itr%next()
2358  mt => itr%value()
2359  call split_mem_path(mt%path, component, subcomponent)
2360  context = get_mem_path_context(mt%path)
2361  context_component = trim(context)//component
2362  if (cunique(icomp) /= context_component(1:ilen)) cycle
2363  if (.not. mt%master) cycle
2364  if (mt%memtype(1:6) == 'STRING') then
2365  nchars = nchars + mt%isize * mt%element_size
2366  else if (mt%memtype(1:7) == 'LOGICAL') then
2367  nlog = nlog + mt%isize
2368  else if (mt%memtype(1:7) == 'INTEGER') then
2369  nint = nint + mt%isize
2370  else if (mt%memtype(1:6) == 'DOUBLE') then
2371  nreal = nreal + mt%isize
2372  end if
2373  end do
2374  !
2375  ! -- calculate size of each data type in bytes
2376  rchars = real(nchars, dp) * fact
2377  rlog = real(nlog * lgp, dp) * fact
2378  rint = real(nint * i4b, dp) * fact
2379  rreal = real(nreal * dp, dp) * fact
2380  !
2381  ! -- calculate total storage in bytes
2382  bytes = rchars + rlog + rint + rreal
2383  !
2384  ! -- write data
2385  call mem_summary_line(cunique(icomp), rchars, rlog, rint, rreal, bytes)
2386  end do
2387  call mem_cleanup_table()
2388  end if
2389  !
2390  ! -- Write table with all variables for iprmem == 2
2391  if (iprmem == 2) then
2392  call mem_print_detailed(iout)
2393  end if
2394  !
2395  ! -- Write total memory allocation
2396  call mem_summary_total(iout, simbytes)
2397  end subroutine mem_write_usage
2398 
2399  subroutine mem_print_detailed(iout)
2400  integer(I4B) :: iout
2401  ! local
2402  class(memorytype), pointer :: mt
2403  type(memorycontaineriteratortype), allocatable :: itr
2404 
2405  call mem_detailed_table(iout, memorystore%count())
2406  itr = memorystore%iterator()
2407  do while (itr%has_next())
2408  call itr%next()
2409  mt => itr%value()
2410  call mt%table_entry(memtab)
2411  end do
2412  call mem_cleanup_table()
2413 
2414  end subroutine mem_print_detailed
2415 
2416  !> @brief Sum up virtual memory, i.e. memory
2417  !< that is owned by other processes
2418  function calc_virtual_mem() result(vmem_size)
2419  real(dp) :: vmem_size
2420  ! local
2421  type(memorycontaineriteratortype), allocatable :: itr
2422  type(memorytype), pointer :: mt
2423 
2424  vmem_size = dzero
2425  itr = memorystore%iterator()
2426  do while (itr%has_next())
2427  call itr%next()
2428  mt => itr%value()
2429  if (index(mt%path, "__P") == 1) then
2430  vmem_size = mt%element_size * mt%isize + vmem_size
2431  end if
2432  end do
2433 
2434  end function calc_virtual_mem
2435 
2436  !> @brief Deallocate memory in the memory manager
2437  !<
2438  subroutine mem_da()
2439  ! -- modules
2440  use versionmodule, only: idevelopmode
2441  ! -- local
2442  class(memorytype), pointer :: mt
2443  type(memorycontaineriteratortype), allocatable :: itr
2444  ! -- code
2445  itr = memorystore%iterator()
2446  do while (itr%has_next())
2447  call itr%next()
2448  mt => itr%value()
2449  call mt%mt_deallocate()
2450  if (idevelopmode == 1) call mem_da_check(mt)
2451  deallocate (mt)
2452  end do
2453 
2454  call memorystore%clear()
2455  if (count_errors() > 0) then
2456  call store_error('Could not clear memory list.', terminate=.true.)
2457  end if
2458  end subroutine mem_da
2459 
2460  subroutine mem_da_check(mt)
2461  ! -- modules
2462  use inputoutputmodule, only: upcase
2463  ! -- dummy
2464  class(memorytype), pointer :: mt
2465  ! -- local
2466  character(len=LINELENGTH) :: error_msg
2467  character(len=LENVARNAME) :: ucname
2468  !
2469  ! -- check if memory has been deallocated
2470  if (mt%mt_associated() .and. mt%element_size == -1) then
2471  error_msg = trim(adjustl(mt%path))//' '// &
2472  trim(adjustl(mt%name))//' has invalid element size'
2473  call store_error(trim(error_msg))
2474  end if
2475  !
2476  ! -- check if memory has been deallocated
2477  if (mt%mt_associated() .and. mt%isize > 0) then
2478  error_msg = trim(adjustl(mt%path))//' '// &
2479  trim(adjustl(mt%name))//' not deallocated'
2480  call store_error(trim(error_msg))
2481  end if
2482  !
2483  ! -- check case of varname
2484  ucname = mt%name
2485  call upcase(ucname)
2486  if (mt%name /= ucname) then
2487  error_msg = trim(adjustl(mt%path))//' '// &
2488  trim(adjustl(mt%name))//' not upper case'
2489  call store_error(trim(error_msg))
2490  end if
2491  end subroutine mem_da_check
2492 
2493  !> @brief Create a array with unique first components from all memory paths.
2494  !! Only the first component of the memory path is evaluated.
2495  !<
2496  subroutine mem_unique_origins(cunique)
2497  ! -- modules
2499  ! -- dummy
2500  character(len=LENMEMADDRESS), allocatable, dimension(:), intent(inout) :: &
2501  cunique !< array with unique first components
2502  ! -- local
2503  class(memorytype), pointer :: mt
2504  character(len=LENMEMPATH) :: context
2505  character(len=LENCOMPONENTNAME) :: component
2506  character(len=LENCOMPONENTNAME) :: subcomponent
2507  character(len=LENMEMADDRESS) :: context_component
2508  type(memorycontaineriteratortype), allocatable :: itr
2509  integer(I4B) :: ipa
2510  ! -- code
2511  !
2512  ! -- initialize cunique
2513  allocate (cunique(0))
2514  !
2515  ! -- find unique origins
2516  itr = memorystore%iterator()
2517  do while (itr%has_next())
2518  call itr%next()
2519  mt => itr%value()
2520  call split_mem_path(mt%path, component, subcomponent)
2521  context = get_mem_path_context(mt%path)
2522  context_component = trim(context)//component
2523  ipa = ifind(cunique, context_component)
2524  if (ipa < 1) then
2525  call expandarray(cunique, 1)
2526  cunique(size(cunique)) = context_component
2527  end if
2528  end do
2529  end subroutine mem_unique_origins
2530 
2531 end module memorymanagermodule
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
integer(i4b), parameter lencomponentname
maximum length of a component name
Definition: Constants.f90:18
@ tabcenter
centered table column
Definition: Constants.f90:172
@ tabright
right justified table column
Definition: Constants.f90:173
@ tableft
left justified table column
Definition: Constants.f90:171
integer(i4b), parameter lenmemaddress
maximum length of the full memory address, including variable name
Definition: Constants.f90:31
real(dp), parameter dep3
real constant 1000
Definition: Constants.f90:88
@ tabucstring
upper case string table data
Definition: Constants.f90:180
@ tabstring
string table data
Definition: Constants.f90:179
@ tabreal
real table data
Definition: Constants.f90:182
@ tabinteger
integer table data
Definition: Constants.f90:181
real(dp), parameter dep6
real constant 1000000
Definition: Constants.f90:89
integer(i4b), parameter lenmemseparator
maximum length of the memory path separator used, currently a '/'
Definition: Constants.f90:26
real(dp), parameter dep9
real constant 1e9
Definition: Constants.f90:90
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter, public lenmemtype
maximum length of a memory manager type
Definition: Constants.f90:62
real(dp), parameter dem3
real constant 1e-3
Definition: Constants.f90:106
real(dp), parameter dem6
real constant 1e-6
Definition: Constants.f90:109
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
real(dp), parameter dem9
real constant 1e-9
Definition: Constants.f90:112
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
real(dp), parameter done
real constant 1
Definition: Constants.f90:76
subroutine, public upcase(word)
Convert to upper case.
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function get_mem_path_context(mem_path)
Return the context from the memory path.
subroutine mem_check_length(name, max_length, description)
Generic routine to check the length of (parts of) the memory address.
subroutine strip_context_mem_path(mem_path, mem_path_no_context)
Remove the context from the memory path.
subroutine split_mem_path(mem_path, component, subcomponent)
Split the memory path into component(s)
subroutine reallocate_int2d(aint, ncol, nrow, name, mem_path)
Reallocate a 2-dimensional integer array.
subroutine allocate_logical(sclr, name, mem_path)
Allocate a logical scalar.
subroutine allocate_int2d(aint, ncol, nrow, name, mem_path)
Allocate a 2-dimensional integer array.
subroutine mem_summary_line(component, rchars, rlog, rint, rreal, bytes)
Write a row for the memory_print_option 'SUMMARY' table.
subroutine allocate_dbl3d(adbl, ncol, nrow, nlay, name, mem_path)
Allocate a 3-dimensional real array.
integer(i8b) nvalues_adbl
subroutine deallocate_str1d(astr1d, name, mem_path)
Deallocate an array of defined-length character strings.
subroutine deallocate_int(sclr)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
type(tabletype), pointer memtab
subroutine setptr_int3d(aint, name, mem_path)
Set pointer to 3d integer array.
subroutine mem_detailed_table(iout, nrows)
Create a table if memory_print_option is 'ALL'.
subroutine deallocate_charstr1d(astr1d, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine allocate_charstr1d(acharstr1d, ilen, nrow, name, mem_path)
Allocate a 1-dimensional array of deferred-length CharacterStringType.
subroutine reallocate_charstr1d(acharstr1d, ilen, nrow, name, mem_path)
Reallocate a 1-dimensional deferred length string array.
subroutine, public mem_write_usage(iout)
Write memory manager memory usage based on the user-specified memory_print_option.
subroutine reallocate_dbl2d(adbl, ncol, nrow, name, mem_path)
Reallocate a 2-dimensional real array.
integer(i8b) nvalues_aint
subroutine setptr_int(sclr, name, mem_path)
Set pointer to integer scalar.
subroutine checkin_charstr1d(acharstr1d, ilen, name, mem_path, name2, mem_path2)
Check in an existing 1d CharacterStringType array with a new address (name + path)
subroutine mem_cleanup_table()
Generic function to clean a memory manager table.
subroutine copyptr_int1d(aint, name, mem_path, mem_path_copy)
Make a copy of a 1-dimensional integer array.
subroutine deallocate_dbl1d(adbl, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine allocate_str1d(astr1d, ilen, nrow, name, mem_path)
Allocate a 1-dimensional defined length string array.
subroutine allocate_str(sclr, ilen, name, mem_path)
Allocate a character string.
subroutine, public get_mem_type(name, mem_path, var_type)
@ brief Get the variable memory type
subroutine setptr_int2d(aint, name, mem_path)
Set pointer to 2d integer array.
subroutine, public mem_da()
Deallocate memory in the memory manager.
subroutine deallocate_int1d(aint, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
integer(i8b) nvalues_astr
subroutine deallocate_dbl(sclr)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine copyptr_int2d(aint, name, mem_path, mem_path_copy)
Make a copy of a 2-dimensional integer array.
subroutine mem_da_check(mt)
subroutine allocate_dbl(sclr, name, mem_path)
Allocate a real scalar.
real(dp) function calc_virtual_mem()
Sum up virtual memory, i.e. memory.
subroutine copyptr_dbl2d(adbl, name, mem_path, mem_path_copy)
Make a copy of a 2-dimensional real array.
subroutine reassignptr_int2d(aint, name, mem_path, name_target, mem_path_target)
Set the pointer for a 2-dimensional integer array to.
subroutine setptr_dbl(sclr, name, mem_path)
Set pointer to a real scalar.
subroutine deallocate_int3d(aint, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine deallocate_int2d(aint, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine reassignptr_dbl1d(adbl, name, mem_path, name_target, mem_path_target)
Set the pointer for a 1-dimensional real array to.
subroutine allocate_int3d(aint, ncol, nrow, nlay, name, mem_path)
Allocate a 3-dimensional integer array.
subroutine, public get_mem_shape(name, mem_path, mem_shape)
@ brief Get the variable memory shape
subroutine deallocate_dbl2d(adbl, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine mem_units(bytes, fact, cunits)
Determine appropriate memory unit and conversion factor.
subroutine setptr_int1d(aint, name, mem_path)
Set pointer to 1d integer array.
subroutine setptr_str1d(astr1d, name, mem_path)
Set pointer to a fixed-length string array.
subroutine checkin_int2d(aint2d, name, mem_path, name2, mem_path2)
Check in an existing 2d integer array with a new address (name + path)
type(memorystoretype), public memorystore
subroutine reallocate_dbl1d(adbl, nrow, name, mem_path)
Reallocate a 1-dimensional real array.
subroutine setptr_dbl2d(adbl, name, mem_path)
Set pointer to a 2d real array.
subroutine deallocate_logical(sclr)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine checkin_dbl2d(adbl2d, name, mem_path, name2, mem_path2)
Check in an existing 2d double precision array with a new address (name + path)
subroutine deallocate_dbl3d(adbl, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine reallocate_int1d(aint, nrow, name, mem_path)
Reallocate a 1-dimensional integer array.
subroutine, public get_from_memorystore(name, mem_path, mt, found, check)
@ brief Get a memory type entry from the memory list
subroutine, public mem_print_detailed(iout)
subroutine reallocate_str1d(astr, ilen, nrow, name, mem_path)
Reallocate a 1-dimensional defined length string array.
subroutine copyptr_dbl1d(adbl, name, mem_path, mem_path_copy)
Make a copy of a 1-dimensional real array.
subroutine reassignptr_dbl2d(adbl, name, mem_path, name_target, mem_path_target)
Set the pointer for a 2-dimensional real array to.
subroutine allocate_int1d(aint, nrow, name, mem_path)
Allocate a 1-dimensional integer array.
subroutine allocate_int(sclr, name, mem_path)
Allocate a integer scalar.
subroutine reassignptr_int1d(aint, name, mem_path, name_target, mem_path_target)
Set the pointer for a 1-dimensional integer array to.
subroutine mem_summary_total(iout, bytes)
Create and fill a table with the total allocated memory.
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
subroutine allocate_dbl2d(adbl, ncol, nrow, name, mem_path)
Allocate a 2-dimensional real array.
subroutine deallocate_str(sclr, name, mem_path)
DEPRECATED. The memory manager will handle the deallocation of the pointer.
subroutine, public get_mem_rank(name, mem_path, rank)
@ brief Get the variable rank
subroutine checkin_dbl1d(adbl, name, mem_path, name2, mem_path2)
Check in an existing 1d double precision array with a new address (name + path)
subroutine checkin_int1d(aint, name, mem_path, name2, mem_path2)
Check in an existing 1d integer array with a new address (name + path)
subroutine reassignptr_int(sclr, name, mem_path, name_target, mem_path_target)
Set the pointer for an integer scalar to.
subroutine, public copy_dbl1d(adbl, name, mem_path)
Copy values from a 1-dimensional real array in the memory.
subroutine setptr_dbl3d(adbl, name, mem_path)
Set pointer to a 3d real array.
subroutine, public get_mem_elem_size(name, mem_path, size)
@ brief Get the memory size of a single element of the stored variable
subroutine setptr_dbl1d(adbl, name, mem_path)
Set pointer to a 1d real array.
subroutine setptr_str(asrt, name, mem_path)
Set pointer to a string (scalar)
integer(i8b) nvalues_alogical
subroutine setptr_charstr1d(acharstr1d, name, mem_path)
Set pointer to an array of CharacterStringType.
subroutine mem_unique_origins(cunique)
Create a array with unique first components from all memory paths. Only the first component of the me...
subroutine mem_summary_table(iout, nrows, cunits)
Create a table if memory_print_option is 'SUMMARY'.
subroutine setptr_logical(sclr, name, mem_path)
Set pointer to a logical scalar.
subroutine, public mem_set_print_option(iout, keyword, error_msg)
Set the memory print option.
subroutine allocate_dbl1d(adbl, nrow, name, mem_path)
Allocate a 1-dimensional real array.
subroutine allocate_error(varname, mem_path, istat, isize)
Issue allocation error message and stop program execution.
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
subroutine, public table_cr(this, name, title)
Definition: Table.f90:87
This module contains version information.
Definition: version.f90:7
integer(i4b), parameter idevelopmode
Definition: version.f90:19
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
An iterator used to iterate through a MemoryContainer.