146 character(len=*),
intent(in) :: name
147 character(len=*),
intent(in) :: mem_path
148 character(len=LENMEMTYPE),
intent(out) :: var_type
151 logical(LGP) :: found
157 var_type = mt%memtype
166 character(len=*),
intent(in) :: name
167 character(len=*),
intent(in) :: mem_path
168 integer(I4B),
intent(out) :: rank
171 logical(LGP) :: found
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
202 character(len=*),
intent(in) :: name
203 character(len=*),
intent(in) :: mem_path
204 integer(I4B),
intent(out) :: size
207 logical(LGP) :: found
218 size = mt%element_size
228 character(len=*),
intent(in) :: name
229 character(len=*),
intent(in) :: mem_path
230 integer(I4B),
dimension(:),
intent(out) :: mem_shape
233 logical(LGP) :: found
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)
265 character(len=*),
intent(in) :: name
266 character(len=*),
intent(in) :: mem_path
267 integer(I4B),
intent(out) :: isize
270 logical(LGP) :: found
271 logical(LGP) :: terminate
295 character(len=*),
intent(in) :: name
296 character(len=*),
intent(in) :: mem_path
297 type(
memorytype),
pointer,
intent(inout) :: mt
298 logical(LGP),
intent(out) :: found
299 logical(LGP),
intent(in),
optional :: check
302 logical(LGP) check_opt
305 found =
associated(mt)
308 if (
present(check))
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."
324 character(len=*),
intent(in) :: varname
325 character(len=*),
intent(in) :: mem_path
326 integer(I4B),
intent(in) :: istat
327 integer(I4B),
intent(in) :: isize
329 character(len=20) :: csize
330 character(len=20) :: cstat
334 write (csize,
'(i0)') isize
335 write (cstat,
'(i0)') istat
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)//
'.'
350 logical(LGP),
pointer,
intent(inout) :: sclr
351 character(len=*),
intent(in) :: name
352 character(len=*),
intent(in) :: mem_path
354 integer(I4B) :: istat
374 mt%logicalsclr => sclr
375 mt%element_size = lgp
379 write (mt%memtype,
"(a)")
'LOGICAL'
388 integer(I4B),
intent(in) :: ilen
389 character(len=ilen),
pointer,
intent(inout) :: sclr
390 character(len=*),
intent(in) :: name
391 character(len=*),
intent(in) :: mem_path
393 integer(I4B) :: istat
400 errmsg =
'Programming error in allocate_str. ILEN must be greater than 0.'
408 allocate (
character(len=ilen) :: sclr, stat=istat,
errmsg=
errmsg)
424 mt%element_size = ilen
428 write (mt%memtype,
"(a,' LEN=',i0)")
'STRING', ilen
437 integer(I4B),
intent(in) :: ilen
438 character(len=ilen),
dimension(:), &
439 pointer,
contiguous,
intent(inout) :: astr1d
440 integer(I4B),
intent(in) :: nrow
441 character(len=*),
intent(in) :: name
442 character(len=*),
intent(in) :: mem_path
445 character(len=ilen) :: string
447 integer(I4B) :: istat
448 integer(I4B) :: isize
456 errmsg =
'Programming error in allocate_str1d. '// &
457 'ILEN must be greater than 0.'
468 allocate (
character(len=ilen) :: astr1d(nrow), stat=istat,
errmsg=
errmsg)
488 mt%element_size = ilen
492 write (mt%memtype,
"(a,' LEN=',i0,' (',i0,')')")
'STRING', ilen, nrow
502 pointer,
contiguous,
intent(inout) :: acharstr1d
503 integer(I4B),
intent(in) :: ilen
504 integer(I4B),
intent(in) :: nrow
505 character(len=*),
intent(in) :: name
506 character(len=*),
intent(in) :: mem_path
508 character(len=ilen) :: string
511 integer(I4B) :: istat
512 integer(I4B) :: isize
534 acharstr1d(n) = string
544 mt%acharstr1d => acharstr1d
545 mt%element_size = ilen
549 write (mt%memtype,
"(a,' LEN=',i0,' (',i0,')')")
'STRING', ilen, nrow
558 integer(I4B),
pointer,
intent(inout) :: sclr
559 character(len=*),
intent(in) :: name
560 character(len=*),
intent(in) :: mem_path
563 integer(I4B) :: istat
583 mt%element_size = i4b
587 write (mt%memtype,
"(a)")
'INTEGER'
596 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: aint
597 integer(I4B),
intent(in) :: nrow
598 character(len=*),
intent(in) :: name
599 character(len=*),
intent(in) :: mem_path
602 integer(I4B) :: istat
603 integer(I4B) :: isize
626 mt%element_size = i4b
630 write (mt%memtype,
"(a,' (',i0,')')")
'INTEGER', isize
639 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: aint
640 integer(I4B),
intent(in) :: ncol
641 integer(I4B),
intent(in) :: nrow
642 character(len=*),
intent(in) :: name
643 character(len=*),
intent(in) :: mem_path
646 integer(I4B) :: istat
647 integer(I4B) :: isize
670 mt%element_size = i4b
674 write (mt%memtype,
"(a,' (',i0,',',i0,')')")
'INTEGER', ncol, nrow
683 integer(I4B),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: aint
684 integer(I4B),
intent(in) :: ncol
685 integer(I4B),
intent(in) :: nrow
686 integer(I4B),
intent(in) :: nlay
687 character(len=*),
intent(in) :: name
688 character(len=*),
intent(in) :: mem_path
691 integer(I4B) :: istat
692 integer(I4B) :: isize
699 isize = ncol * nrow * nlay
702 allocate (aint(ncol, nrow, nlay), stat=istat,
errmsg=
errmsg)
715 mt%element_size = i4b
719 write (mt%memtype,
"(a,' (',i0,',',i0,',',i0,')')")
'INTEGER', ncol, &
729 real(DP),
pointer,
intent(inout) :: sclr
730 character(len=*),
intent(in) :: name
731 character(len=*),
intent(in) :: mem_path
734 integer(I4B) :: istat
758 write (mt%memtype,
"(a)")
'DOUBLE'
767 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: adbl
768 integer(I4B),
intent(in) :: nrow
769 character(len=*),
intent(in) :: name
770 character(len=*),
intent(in) :: mem_path
773 integer(I4B) :: istat
774 integer(I4B) :: isize
801 write (mt%memtype,
"(a,' (',i0,')')")
'DOUBLE', isize
810 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: adbl
811 integer(I4B),
intent(in) :: ncol
812 integer(I4B),
intent(in) :: nrow
813 character(len=*),
intent(in) :: name
814 character(len=*),
intent(in) :: mem_path
817 integer(I4B) :: istat
818 integer(I4B) :: isize
845 write (mt%memtype,
"(a,' (',i0,',',i0,')')")
'DOUBLE', ncol, nrow
854 real(DP),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: adbl
855 integer(I4B),
intent(in) :: ncol
856 integer(I4B),
intent(in) :: nrow
857 integer(I4B),
intent(in) :: nlay
858 character(len=*),
intent(in) :: name
859 character(len=*),
intent(in) :: mem_path
862 integer(I4B) :: istat
863 integer(I4B) :: isize
870 isize = ncol * nrow * nlay
873 allocate (adbl(ncol, nrow, nlay), stat=istat,
errmsg=
errmsg)
890 write (mt%memtype,
"(a,' (',i0,',',i0,',',i0,')')")
'DOUBLE', ncol, &
900 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(in) :: aint
901 character(len=*),
intent(in) :: name
902 character(len=*),
intent(in) :: mem_path
903 character(len=*),
intent(in) :: name2
904 character(len=*),
intent(in) :: mem_path2
907 integer(I4B) :: isize
921 mt%element_size = i4b
925 write (mt%memtype,
"(a,' (',i0,')')")
'INTEGER', isize
929 mt%mastername = name2
930 mt%masterPath = mem_path2
939 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: aint2d
940 character(len=*),
intent(in) :: name
941 character(len=*),
intent(in) :: mem_path
942 character(len=*),
intent(in) :: name2
943 character(len=*),
intent(in) :: mem_path2
946 integer(I4B) :: ncol, nrow, isize
953 ncol =
size(aint2d, dim=1)
954 nrow =
size(aint2d, dim=2)
965 write (mt%memtype,
"(a,' (',i0,',',i0,')')")
'INTEGER', ncol, nrow
969 mt%mastername = name2
970 mt%masterPath = mem_path2
979 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: adbl
980 character(len=*),
intent(in) :: name
981 character(len=*),
intent(in) :: mem_path
982 character(len=*),
intent(in) :: name2
983 character(len=*),
intent(in) :: mem_path2
986 integer(I4B) :: isize
1000 mt%element_size = dp
1004 write (mt%memtype,
"(a,' (',i0,')')")
'DOUBLE', isize
1008 mt%mastername = name2
1009 mt%masterPath = mem_path2
1018 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: adbl2d
1019 character(len=*),
intent(in) :: name
1020 character(len=*),
intent(in) :: mem_path
1021 character(len=*),
intent(in) :: name2
1022 character(len=*),
intent(in) :: mem_path2
1025 integer(I4B) :: ncol, nrow, isize
1032 ncol =
size(adbl2d, dim=1)
1033 nrow =
size(adbl2d, dim=2)
1044 write (mt%memtype,
"(a,' (',i0,',',i0,')')")
'DOUBLE', ncol, nrow
1048 mt%mastername = name2
1049 mt%masterPath = mem_path2
1059 pointer,
contiguous,
intent(inout) :: acharstr1d
1060 integer(I4B),
intent(in) :: ilen
1061 character(len=*),
intent(in) :: name
1062 character(len=*),
intent(in) :: mem_path
1063 character(len=*),
intent(in) :: name2
1064 character(len=*),
intent(in) :: mem_path2
1067 integer(I4B) :: isize
1074 isize =
size(acharstr1d)
1080 mt%acharstr1d => acharstr1d
1081 mt%element_size = ilen
1085 write (mt%memtype,
"(a,' LEN=',i0,' (',i0,')')")
'STRING', ilen, isize
1089 mt%mastername = name2
1090 mt%masterPath = mem_path2
1099 integer(I4B),
intent(in) :: ilen
1100 integer(I4B),
intent(in) :: nrow
1101 character(len=ilen),
dimension(:),
pointer,
contiguous,
intent(inout) :: astr
1102 character(len=*),
intent(in) :: name
1103 character(len=*),
intent(in) :: mem_path
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
1119 isize_old = mt%isize
1120 if (isize_old > 0)
then
1121 nrow_old =
size(astr)
1131 if (istat /= 0)
then
1137 astrtemp(n) = astr(n)
1141 do n = nrow_old + 1, nrow
1150 if (istat /= 0)
then
1156 astr(n) = astrtemp(n)
1160 deallocate (astrtemp)
1164 mt%element_size = ilen
1166 mt%nrealloc = mt%nrealloc + 1
1169 write (mt%memtype,
"(a,' LEN=',i0,' (',i0,')')")
'STRING', ilen, nrow
1171 errmsg =
"Programming error, variable '"//trim(name)//
"' from '"// &
1172 trim(mem_path)//
"' is not defined in the memory manager. Use "// &
1173 "mem_allocate instead."
1182 intent(inout) :: acharstr1d
1183 integer(I4B),
intent(in) :: ilen
1184 integer(I4B),
intent(in) :: nrow
1185 character(len=*),
intent(in) :: name
1186 character(len=*),
intent(in) :: mem_path
1189 logical(LGP) :: found
1191 character(len=ilen) :: string
1192 integer(I4B) :: istat
1193 integer(I4B) :: isize
1194 integer(I4B) :: isize_old
1195 integer(I4B) :: nrow_old
1206 isize_old = mt%isize
1207 if (isize_old > 0)
then
1208 nrow_old =
size(acharstr1d)
1218 if (istat /= 0)
then
1224 astrtemp(n) = acharstr1d(n)
1225 call acharstr1d(n)%destroy()
1229 do n = nrow_old + 1, nrow
1230 astrtemp(n) = string
1234 deallocate (acharstr1d)
1238 if (istat /= 0)
then
1244 acharstr1d(n) = astrtemp(n)
1245 call astrtemp(n)%destroy()
1249 deallocate (astrtemp)
1252 mt%acharstr1d => acharstr1d
1253 mt%element_size = ilen
1255 mt%nrealloc = mt%nrealloc + 1
1258 write (mt%memtype,
"(a,' LEN=',i0,' (',i0,')')")
'STRING', ilen, nrow
1260 errmsg =
"Programming error, variable '"//trim(name)//
"' from '"// &
1261 trim(mem_path)//
"' is not defined in the memory manager. Use "// &
1262 "mem_allocate instead."
1270 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: aint
1271 integer(I4B),
intent(in) :: nrow
1272 character(len=*),
intent(in) :: name
1273 character(len=*),
intent(in) :: mem_path
1276 logical(LGP) :: found
1277 integer(I4B) :: istat
1278 integer(I4B) :: isize
1280 integer(I4B) :: isizeold
1281 integer(I4B) :: ifill
1289 isizeold =
size(mt%aint1d)
1290 ifill = min(isizeold, isize)
1292 if (istat /= 0)
then
1296 aint(i) = mt%aint1d(i)
1300 deallocate (mt%aint1d)
1302 mt%element_size = i4b
1304 mt%nrealloc = mt%nrealloc + 1
1312 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: aint
1313 integer(I4B),
intent(in) :: ncol
1314 integer(I4B),
intent(in) :: nrow
1315 character(len=*),
intent(in) :: name
1316 character(len=*),
intent(in) :: mem_path
1319 logical(LGP) :: found
1320 integer(I4B) :: istat
1321 integer(I4B),
dimension(2) :: ishape
1324 integer(I4B) :: isize
1325 integer(I4B) :: isizeold
1332 ishape = shape(mt%aint2d)
1334 isizeold = ishape(1) * ishape(2)
1336 if (istat /= 0)
then
1341 aint(j, i) = mt%aint2d(j, i)
1346 deallocate (mt%aint2d)
1348 mt%element_size = i4b
1350 mt%nrealloc = mt%nrealloc + 1
1353 write (mt%memtype,
"(a,' (',i0,',',i0,')')")
'INTEGER', ncol, nrow
1359 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: adbl
1360 integer(I4B),
intent(in) :: nrow
1361 character(len=*),
intent(in) :: name
1362 character(len=*),
intent(in) :: mem_path
1365 integer(I4B) :: istat
1366 integer(I4B) :: isize
1368 integer(I4B) :: isizeold
1369 integer(I4B) :: ifill
1370 logical(LGP) :: found
1378 isizeold =
size(mt%adbl1d)
1379 ifill = min(isizeold, isize)
1381 if (istat /= 0)
then
1385 adbl(i) = mt%adbl1d(i)
1389 deallocate (mt%adbl1d)
1391 mt%element_size = dp
1393 mt%nrealloc = mt%nrealloc + 1
1396 write (mt%memtype,
"(a,' (',i0,')')")
'DOUBLE', isize
1402 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: adbl
1403 integer(I4B),
intent(in) :: ncol
1404 integer(I4B),
intent(in) :: nrow
1405 character(len=*),
intent(in) :: name
1406 character(len=*),
intent(in) :: mem_path
1409 logical(LGP) :: found
1410 integer(I4B) :: istat
1411 integer(I4B),
dimension(2) :: ishape
1414 integer(I4B) :: isize
1415 integer(I4B) :: isizeold
1422 ishape = shape(mt%adbl2d)
1424 isizeold = ishape(1) * ishape(2)
1426 if (istat /= 0)
then
1431 adbl(j, i) = mt%adbl2d(j, i)
1436 deallocate (mt%adbl2d)
1438 mt%element_size = dp
1440 mt%nrealloc = mt%nrealloc + 1
1443 write (mt%memtype,
"(a,' (',i0,',',i0,')')")
'DOUBLE', ncol, nrow
1449 logical(LGP),
pointer,
intent(inout) :: sclr
1450 character(len=*),
intent(in) :: name
1451 character(len=*),
intent(in) :: mem_path
1454 logical(LGP) :: found
1457 sclr => mt%logicalsclr
1463 integer(I4B),
pointer,
intent(inout) :: sclr
1464 character(len=*),
intent(in) :: name
1465 character(len=*),
intent(in) :: mem_path
1468 logical(LGP) :: found
1477 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: aint
1478 character(len=*),
intent(in) :: name
1479 character(len=*),
intent(in) :: mem_path
1482 logical(LGP) :: found
1491 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: aint
1492 character(len=*),
intent(in) :: name
1493 character(len=*),
intent(in) :: mem_path
1496 logical(LGP) :: found
1505 integer(I4B),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: aint
1506 character(len=*),
intent(in) :: name
1507 character(len=*),
intent(in) :: mem_path
1510 logical(LGP) :: found
1519 real(DP),
pointer,
intent(inout) :: sclr
1520 character(len=*),
intent(in) :: name
1521 character(len=*),
intent(in) :: mem_path
1524 logical(LGP) :: found
1533 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: adbl
1534 character(len=*),
intent(in) :: name
1535 character(len=*),
intent(in) :: mem_path
1538 logical(LGP) :: found
1547 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: adbl
1548 character(len=*),
intent(in) :: name
1549 character(len=*),
intent(in) :: mem_path
1552 logical(LGP) :: found
1561 real(DP),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: adbl
1562 character(len=*),
intent(in) :: name
1563 character(len=*),
intent(in) :: mem_path
1566 logical(LGP) :: found
1575 character(len=:),
pointer :: asrt
1576 character(len=*),
intent(in) :: name
1577 character(len=*),
intent(in) :: mem_path
1580 logical(LGP) :: found
1589 character(len=:),
dimension(:), &
1590 pointer,
contiguous,
intent(inout) :: astr1d
1591 character(len=*),
intent(in) :: name
1592 character(len=*),
intent(in) :: mem_path
1595 logical(LGP) :: found
1598 select type (item => mt%astr1d)
1599 type is (
character(*))
1610 intent(inout) :: acharstr1d
1611 character(len=*),
intent(in) :: name
1612 character(len=*),
intent(in) :: mem_path
1615 logical(LGP) :: found
1618 acharstr1d => mt%acharstr1d
1624 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: aint
1625 character(len=*),
intent(in) :: name
1626 character(len=*),
intent(in) :: mem_path
1627 character(len=*),
intent(in),
optional :: mem_path_copy
1632 logical(LGP) :: found
1638 if (
present(mem_path_copy))
then
1639 call allocate_int1d(aint,
size(mt%aint1d), mt%name, mem_path_copy)
1642 allocate (aint(
size(mt%aint1d)))
1644 do n = 1,
size(mt%aint1d)
1645 aint(n) = mt%aint1d(n)
1652 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: aint
1653 character(len=*),
intent(in) :: name
1654 character(len=*),
intent(in) :: mem_path
1655 character(len=*),
intent(in),
optional :: mem_path_copy
1660 logical(LGP) :: found
1663 integer(I4B) :: ncol
1664 integer(I4B) :: nrow
1668 ncol =
size(mt%aint2d, dim=1)
1669 nrow =
size(mt%aint2d, dim=2)
1671 if (
present(mem_path_copy))
then
1675 allocate (aint(ncol, nrow))
1679 aint(j, i) = mt%aint2d(j, i)
1687 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: adbl
1688 character(len=*),
intent(in) :: name
1689 character(len=*),
intent(in) :: mem_path
1690 character(len=*),
intent(in),
optional :: mem_path_copy
1695 logical(LGP) :: found
1701 if (
present(mem_path_copy))
then
1702 call allocate_dbl1d(adbl,
size(mt%adbl1d), mt%name, mem_path_copy)
1705 allocate (adbl(
size(mt%adbl1d)))
1707 do n = 1,
size(mt%adbl1d)
1708 adbl(n) = mt%adbl1d(n)
1715 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: adbl
1716 character(len=*),
intent(in) :: name
1717 character(len=*),
intent(in) :: mem_path
1718 character(len=*),
intent(in),
optional :: mem_path_copy
1723 logical(LGP) :: found
1726 integer(I4B) :: ncol
1727 integer(I4B) :: nrow
1731 ncol =
size(mt%adbl2d, dim=1)
1732 nrow =
size(mt%adbl2d, dim=2)
1734 if (
present(mem_path_copy))
then
1738 allocate (adbl(ncol, nrow))
1742 adbl(j, i) = mt%adbl2d(j, i)
1750 real(dp),
dimension(:),
intent(inout) :: adbl
1751 character(len=*),
intent(in) :: name
1752 character(len=*),
intent(in) :: mem_path
1755 logical(LGP) :: found
1759 do n = 1,
size(mt%adbl1d)
1760 adbl(n) = mt%adbl1d(n)
1767 integer(I4B),
pointer,
intent(inout) :: sclr
1768 character(len=*),
intent(in) :: name
1769 character(len=*),
intent(in) :: mem_path
1770 character(len=*),
intent(in) :: name_target
1771 character(len=*),
intent(in) :: mem_path_target
1775 logical(LGP) :: found
1779 if (
associated(sclr))
then
1785 mt%element_size = i4b
1787 write (mt%memtype,
"(a,' (',i0,')')")
'INTEGER', mt%isize
1791 mt%mastername = name_target
1792 mt%masterPath = mem_path_target
1798 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: aint
1799 character(len=*),
intent(in) :: name
1800 character(len=*),
intent(in) :: mem_path
1801 character(len=*),
intent(in) :: name_target
1802 character(len=*),
intent(in) :: mem_path_target
1806 logical(LGP) :: found
1810 if (
size(aint) > 0)
then
1816 mt%element_size = i4b
1817 mt%isize =
size(aint)
1818 write (mt%memtype,
"(a,' (',i0,')')")
'INTEGER', mt%isize
1822 mt%mastername = name_target
1823 mt%masterPath = mem_path_target
1829 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: aint
1830 character(len=*),
intent(in) :: name
1831 character(len=*),
intent(in) :: mem_path
1832 character(len=*),
intent(in) :: name_target
1833 character(len=*),
intent(in) :: mem_path_target
1837 logical(LGP) :: found
1838 integer(I4B) :: ncol
1839 integer(I4B) :: nrow
1843 if (
size(aint) > 0)
then
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
1857 mt%mastername = name_target
1858 mt%masterPath = mem_path_target
1864 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: adbl
1865 character(len=*),
intent(in) :: name
1866 character(len=*),
intent(in) :: mem_path
1867 character(len=*),
intent(in) :: name_target
1868 character(len=*),
intent(in) :: mem_path_target
1872 logical(LGP) :: found
1876 if (
size(adbl) > 0)
then
1882 mt%element_size = dp
1883 mt%isize =
size(adbl)
1884 write (mt%memtype,
"(a,' (',i0,')')")
'DOUBLE', mt%isize
1888 mt%mastername = name_target
1889 mt%masterPath = mem_path_target
1895 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: adbl
1896 character(len=*),
intent(in) :: name
1897 character(len=*),
intent(in) :: mem_path
1898 character(len=*),
intent(in) :: name_target
1899 character(len=*),
intent(in) :: mem_path_target
1903 logical(LGP) :: found
1904 integer(I4B) :: ncol
1905 integer(I4b) :: nrow
1909 if (
size(adbl) > 0)
then
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
1923 mt%mastername = name_target
1924 mt%masterPath = mem_path_target
1930 character(len=*),
pointer,
intent(inout) :: sclr
1931 character(len=*),
intent(in),
optional :: name
1932 character(len=*),
intent(in),
optional :: mem_path
1941 character(len=*),
dimension(:),
pointer,
contiguous,
intent(inout) :: astr1d
1942 character(len=*),
optional,
intent(in) :: name
1943 character(len=*),
optional,
intent(in) :: mem_path
1954 intent(inout) :: astr1d
1955 character(len=*),
optional,
intent(in) :: name
1956 character(len=*),
optional,
intent(in) :: mem_path
1964 logical(LGP),
pointer,
intent(inout) :: sclr
1972 integer(I4B),
pointer,
intent(inout) :: sclr
1980 real(DP),
pointer,
intent(inout) :: sclr
1988 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: aint
1989 character(len=*),
optional :: name
1990 character(len=*),
optional :: mem_path
1998 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: aint
1999 character(len=*),
optional :: name
2000 character(len=*),
optional :: mem_path
2008 integer(I4B),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: aint
2009 character(len=*),
optional :: name
2010 character(len=*),
optional :: mem_path
2018 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: adbl
2019 character(len=*),
optional :: name
2020 character(len=*),
optional :: mem_path
2028 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: adbl
2029 character(len=*),
optional :: name
2030 character(len=*),
optional :: mem_path
2038 real(DP),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: adbl
2039 character(len=*),
optional :: name
2040 character(len=*),
optional :: mem_path
2048 integer(I4B),
intent(in) :: iout
2049 character(len=*),
intent(in) :: keyword
2050 character(len=*),
intent(inout) :: error_msg
2054 select case (keyword)
2057 write (iout,
'(4x, a)') &
2058 'LIMITED MEMORY INFORMATION WILL BE WRITTEN.'
2061 write (iout,
'(4x, a)') &
2062 'A SUMMARY OF SIMULATION MEMORY INFORMATION WILL BE WRITTEN.'
2065 write (iout,
'(4x, a)') &
2066 'ALL SIMULATION MEMORY INFORMATION WILL BE WRITTEN.'
2068 error_msg =
"Unknown memory print option '"//trim(keyword)//
"."
2075 integer(I4B),
intent(in) :: iout
2076 integer(I4B),
intent(in) :: nrows
2077 character(len=*),
intent(in) :: cunits
2079 character(len=LINELENGTH) :: title
2080 character(len=LINELENGTH) :: text
2081 integer(I4B) :: nterms
2087 title =
'SUMMARY INFORMATION ON VARIABLES STORED IN THE MEMORY MANAGER, '// &
2092 call memtab%table_df(nrows, nterms, iout)
2122 integer(I4B),
intent(in) :: iout
2123 integer(I4B),
intent(in) :: nrows
2125 character(len=LINELENGTH) :: title
2126 character(len=LINELENGTH) :: text
2127 integer(I4B) :: nterms
2133 title =
'DETAILED INFORMATION ON VARIABLES STORED IN THE MEMORY MANAGER'
2137 call memtab%table_df(nrows, nterms, iout)
2144 text =
'VARIABLE NAME'
2152 text =
'NUMBER OF ITEMS'
2156 text =
'ASSOCIATED VARIABLE'
2163 character(len=*),
intent(in) :: component
2164 real(DP),
intent(in) :: rchars
2165 real(DP),
intent(in) :: rlog
2166 real(DP),
intent(in) :: rint
2167 real(DP),
intent(in) :: rreal
2168 real(DP),
intent(in) :: bytes
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)
2185 real(DP),
intent(in) :: bytes
2186 real(DP),
intent(inout) :: fact
2187 character(len=*),
intent(inout) :: cunits
2197 if (bytes <
dep3)
then
2200 else if (bytes <
dep6)
then
2202 cunits =
'KILOBYTES'
2203 else if (bytes <
dep9)
then
2205 cunits =
'MEGABYTES'
2208 cunits =
'GIGABYTES'
2215 integer(I4B),
intent(in) :: iout
2216 real(DP),
intent(in) :: bytes
2218 character(len=LINELENGTH) :: title
2219 character(len=LINELENGTH) :: text
2220 character(LEN=10) :: cunits
2221 integer(I4B) :: nterms
2222 integer(I4B) :: nrows
2236 title =
'MEMORY MANAGER TOTAL STORAGE BY DATA TYPE, IN '//trim(cunits)
2240 call memtab%table_df(nrows, nterms, iout)
2247 text =
'ALLOCATED MEMORY'
2254 call memtab%add_term(
'Character')
2255 call memtab%add_term(smb)
2259 call memtab%add_term(
'Logical')
2260 call memtab%add_term(smb)
2264 call memtab%add_term(
'Integer')
2265 call memtab%add_term(smb)
2269 call memtab%add_term(
'Real')
2270 call memtab%add_term(smb)
2273 call memtab%print_separator()
2275 call memtab%add_term(
'Total')
2276 call memtab%add_term(smb)
2280 call memtab%add_term(
'Virtual')
2281 call memtab%add_term(smb)
2305 integer(I4B),
intent(in) :: iout
2308 character(len=LENMEMADDRESS),
allocatable,
dimension(:) :: cunique
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
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
2337 simbytes = real(simbytes, dp)
2348 do icomp = 1,
size(cunique)
2354 ilen = len_trim(cunique(icomp))
2356 do while (itr%has_next())
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
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
2382 bytes = rchars + rlog + rint + rreal
2400 integer(I4B) :: iout
2407 do while (itr%has_next())
2410 call mt%table_entry(
memtab)
2419 real(dp) :: vmem_size
2426 do while (itr%has_next())
2429 if (index(mt%path,
"__P") == 1)
then
2430 vmem_size = mt%element_size * mt%isize + vmem_size
2446 do while (itr%has_next())
2449 call mt%mt_deallocate()
2456 call store_error(
'Could not clear memory list.', terminate=.true.)
2466 character(len=LINELENGTH) :: error_msg
2467 character(len=LENVARNAME) :: ucname
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'
2477 if (mt%mt_associated() .and. mt%isize > 0)
then
2478 error_msg = trim(adjustl(mt%path))//
' '// &
2479 trim(adjustl(mt%name))//
' not deallocated'
2486 if (mt%name /= ucname)
then
2487 error_msg = trim(adjustl(mt%path))//
' '// &
2488 trim(adjustl(mt%name))//
' not upper case'
2500 character(len=LENMEMADDRESS),
allocatable,
dimension(:),
intent(inout) :: &
2504 character(len=LENMEMPATH) :: context
2505 character(len=LENCOMPONENTNAME) :: component
2506 character(len=LENCOMPONENTNAME) :: subcomponent
2507 character(len=LENMEMADDRESS) :: context_component
2513 allocate (cunique(0))
2517 do while (itr%has_next())
2522 context_component = trim(context)//component
2523 ipa =
ifind(cunique, context_component)
2526 cunique(
size(cunique)) = context_component
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lencomponentname
maximum length of a component name
@ tabcenter
centered table column
@ tabright
right justified table column
@ tableft
left justified table column
integer(i4b), parameter lenmemaddress
maximum length of the full memory address, including variable name
real(dp), parameter dep3
real constant 1000
@ tabucstring
upper case string table data
@ tabstring
string table data
@ tabinteger
integer table data
real(dp), parameter dep6
real constant 1000000
integer(i4b), parameter lenmemseparator
maximum length of the memory path separator used, currently a '/'
real(dp), parameter dep9
real constant 1e9
integer(i4b), parameter lenvarname
maximum length of a variable name
integer(i4b), parameter, public lenmemtype
maximum length of a memory manager type
real(dp), parameter dem3
real constant 1e-3
real(dp), parameter dem6
real constant 1e-6
real(dp), parameter dzero
real constant zero
real(dp), parameter dem9
real constant 1e-9
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter done
real constant 1
This module defines variable data types.
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.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
subroutine, public table_cr(this, name, title)
This module contains version information.
integer(i4b), parameter idevelopmode
This class is used to store a single deferred-length character string. It was designed to work in an ...
An iterator used to iterate through a MemoryContainer.