28 character(len=*),
intent(in) :: component
29 character(len=*),
intent(in),
optional :: subcomponent
30 character(len=*),
intent(in),
optional :: context
31 character(len=LENMEMPATH) :: memory_path
34 logical(LGP) :: removed
43 if (mt%path == memory_path .and. mt%mt_associated())
then
44 call mt%mt_deallocate()
55 logical(LGP),
pointer,
intent(inout) :: p_mem
56 character(len=*),
intent(in) :: varname
57 character(len=*),
intent(in) :: memory_path
58 logical(LGP),
intent(inout) :: found
60 logical(LGP) :: checkfail = .false.
63 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'INTEGER')
then
64 if (mt%intsclr == 0)
then
75 integer(I4B),
pointer,
intent(inout) :: p_mem
76 character(len=*),
intent(in) :: varname
77 character(len=*),
intent(in) :: memory_path
78 logical(LGP),
intent(inout) :: found
80 logical(LGP) :: checkfail = .false.
83 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'INTEGER')
then
89 integer(I4B),
pointer,
intent(inout) :: p_mem
90 character(len=*),
intent(in) :: varname
91 character(len=*),
intent(in) :: memory_path
92 integer(I4B),
intent(in) :: setval
93 logical(LGP),
intent(inout) :: found
95 logical(LGP) :: checkfail = .false.
105 integer(I4B),
pointer,
intent(inout) :: p_mem
106 character(len=*),
intent(in) :: varname
107 character(len=*),
intent(in) :: memory_path
108 character(len=*),
dimension(:),
intent(in) :: str_list
109 logical(LGP),
intent(inout) :: found
111 logical(LGP) :: checkfail = .false.
115 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'STRING')
then
116 do i = 1,
size(str_list)
117 if (mt%strsclr == str_list(i))
then
127 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: p_mem
128 character(len=*),
intent(in) :: varname
129 character(len=*),
intent(in) :: memory_path
130 logical(LGP),
intent(inout) :: found
132 logical(LGP) :: checkfail = .false.
136 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'INTEGER')
then
137 if (
size(mt%aint1d) /=
size(p_mem))
then
138 call store_error(
'mem_set_value() size mismatch int1d, varname='//&
139 &trim(varname), terminate=.true.)
141 do n = 1,
size(mt%aint1d)
142 p_mem(n) = mt%aint1d(n)
151 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(inout) :: p_mem
152 character(len=*),
intent(in) :: varname
153 character(len=*),
intent(in) :: memory_path
154 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(in) :: map
155 logical(LGP),
intent(inout) :: found
157 logical(LGP) :: checkfail = .false.
161 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'INTEGER')
then
162 if (
associated(map))
then
163 do n = 1,
size(p_mem)
164 p_mem(n) = mt%aint1d(map(n))
167 if (
size(mt%aint1d) /=
size(p_mem))
then
168 call store_error(
'mem_set_value() size mismatch int1d, varname='//&
169 &trim(varname), terminate=.true.)
171 do n = 1,
size(mt%aint1d)
172 p_mem(n) = mt%aint1d(n)
181 integer(I4B),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: p_mem
182 character(len=*),
intent(in) :: varname
183 character(len=*),
intent(in) :: memory_path
184 logical(LGP),
intent(inout) :: found
186 logical(LGP) :: checkfail = .false.
190 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'INTEGER')
then
191 if (
size(mt%aint2d, dim=1) /=
size(p_mem, dim=1) .or. &
192 size(mt%aint2d, dim=2) /=
size(p_mem, dim=2))
then
193 call store_error(
'mem_set_value() size mismatch int2d, varname='//&
194 &trim(varname), terminate=.true.)
196 do j = 1,
size(mt%aint2d, dim=2)
197 do i = 1,
size(mt%aint2d, dim=1)
198 p_mem(i, j) = mt%aint2d(i, j)
207 integer(I4B),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: p_mem
208 character(len=*),
intent(in) :: varname
209 character(len=*),
intent(in) :: memory_path
210 logical(LGP),
intent(inout) :: found
212 logical(LGP) :: checkfail = .false.
213 integer(I4B) :: i, j, k
216 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'INTEGER')
then
217 if (
size(mt%aint3d, dim=1) /=
size(p_mem, dim=1) .or. &
218 size(mt%aint3d, dim=2) /=
size(p_mem, dim=2) .or. &
219 size(mt%aint3d, dim=3) /=
size(p_mem, dim=3))
then
220 call store_error(
'mem_set_value() size mismatch int3d, varname='//&
221 &trim(varname), terminate=.true.)
223 do k = 1,
size(mt%aint3d, dim=3)
224 do j = 1,
size(mt%aint3d, dim=2)
225 do i = 1,
size(mt%aint3d, dim=1)
226 p_mem(i, j, k) = mt%aint3d(i, j, k)
236 real(DP),
pointer,
intent(inout) :: p_mem
237 character(len=*),
intent(in) :: varname
238 character(len=*),
intent(in) :: memory_path
239 logical(LGP),
intent(inout) :: found
241 logical(LGP) :: checkfail = .false.
244 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'DOUBLE')
then
252 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: p_mem
253 character(len=*),
intent(in) :: varname
254 character(len=*),
intent(in) :: memory_path
255 logical(LGP),
intent(inout) :: found
257 logical(LGP) :: checkfail = .false.
261 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'DOUBLE')
then
262 if (
size(mt%adbl1d) /=
size(p_mem))
then
263 call store_error(
'mem_set_value() size mismatch dbl1d, varname='//&
264 &trim(varname), terminate=.true.)
266 do n = 1,
size(mt%adbl1d)
267 p_mem(n) = mt%adbl1d(n)
276 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: p_mem
277 character(len=*),
intent(in) :: varname
278 character(len=*),
intent(in) :: memory_path
279 integer(I4B),
dimension(:),
pointer,
contiguous,
intent(in) :: map
280 logical(LGP),
intent(inout) :: found
282 logical(LGP) :: checkfail = .false.
286 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'DOUBLE')
then
287 if (
associated(map))
then
288 do n = 1,
size(p_mem)
289 p_mem(n) = mt%adbl1d(map(n))
292 if (
size(mt%adbl1d) /=
size(p_mem))
then
293 call store_error(
'mem_set_value() size mismatch dbl1d, varname='//&
294 &trim(varname), terminate=.true.)
296 do n = 1,
size(mt%adbl1d)
297 p_mem(n) = mt%adbl1d(n)
306 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(inout) :: p_mem
307 character(len=*),
intent(in) :: varname
308 character(len=*),
intent(in) :: memory_path
309 logical(LGP),
intent(inout) :: found
311 logical(LGP) :: checkfail = .false.
315 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'DOUBLE')
then
316 if (
size(mt%adbl2d, dim=1) /=
size(p_mem, dim=1) .or. &
317 size(mt%adbl2d, dim=2) /=
size(p_mem, dim=2))
then
318 call store_error(
'mem_set_value() size mismatch dbl2d, varname='//&
319 &trim(varname), terminate=.true.)
321 do j = 1,
size(mt%adbl2d, dim=2)
322 do i = 1,
size(mt%adbl2d, dim=1)
323 p_mem(i, j) = mt%adbl2d(i, j)
332 real(DP),
dimension(:, :, :),
pointer,
contiguous,
intent(inout) :: p_mem
333 character(len=*),
intent(in) :: varname
334 character(len=*),
intent(in) :: memory_path
335 logical(LGP),
intent(inout) :: found
337 logical(LGP) :: checkfail = .false.
338 integer(I4B) :: i, j, k
341 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'DOUBLE')
then
342 if (
size(mt%adbl3d, dim=1) /=
size(p_mem, dim=1) .or. &
343 size(mt%adbl3d, dim=2) /=
size(p_mem, dim=2) .or. &
344 size(mt%adbl3d, dim=3) /=
size(p_mem, dim=3))
then
345 call store_error(
'mem_set_value() size mismatch dbl3d, varname='//&
346 &trim(varname), terminate=.true.)
348 do k = 1,
size(mt%adbl3d, dim=3)
349 do j = 1,
size(mt%adbl3d, dim=2)
350 do i = 1,
size(mt%adbl3d, dim=1)
351 p_mem(i, j, k) = mt%adbl3d(i, j, k)
359 character(len=*),
intent(inout) :: p_mem
360 character(len=*),
intent(in) :: varname
361 character(len=*),
intent(in) :: memory_path
362 logical(LGP),
intent(inout) :: found
364 logical(LGP) :: checkfail = .false.
367 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'STRING')
then
375 pointer,
contiguous,
intent(inout) :: p_mem
376 character(len=*),
intent(in) :: varname
377 character(len=*),
intent(in) :: memory_path
378 logical(LGP),
intent(inout) :: found
380 logical(LGP) :: checkfail = .false.
384 if (found .and. mt%memtype(1:index(mt%memtype,
' ')) ==
'STRING')
then
385 do n = 1,
size(mt%acharstr1d)
386 p_mem(n) = mt%acharstr1d(n)
This module contains simulation constants.
integer(i4b), parameter lenmempath
maximum length of the memory path
This module defines variable data types.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine mem_set_value_logical(p_mem, varname, memory_path, found)
Set pointer to value of memory list logical variable.
subroutine, public memorylist_remove(component, subcomponent, context)
subroutine mem_set_value_dbl3d(p_mem, varname, memory_path, found)
Set pointer to value of memory list 3d dbl array variable.
subroutine mem_set_value_dbl(p_mem, varname, memory_path, found)
Set pointer to value of memory list double variable.
subroutine mem_set_value_int(p_mem, varname, memory_path, found)
Set pointer to value of memory list int variable.
subroutine mem_set_value_charstr1d(p_mem, varname, memory_path, found)
subroutine mem_set_value_str_mapped_int(p_mem, varname, memory_path, str_list, found)
subroutine mem_set_value_int_setval(p_mem, varname, memory_path, setval, found)
subroutine mem_set_value_int2d(p_mem, varname, memory_path, found)
Set pointer to value of memory list 2d int array variable.
subroutine mem_set_value_int3d(p_mem, varname, memory_path, found)
Set pointer to value of memory list 3d int array variable.
subroutine mem_set_value_str(p_mem, varname, memory_path, found)
subroutine mem_set_value_int1d_mapped(p_mem, varname, memory_path, map, found)
Set pointer to value of memory list 1d int array variable with mapping.
subroutine mem_set_value_dbl2d(p_mem, varname, memory_path, found)
Set pointer to value of memory list 2d dbl array variable.
subroutine mem_set_value_dbl1d(p_mem, varname, memory_path, found)
Set pointer to value of memory list 1d dbl array variable.
subroutine mem_set_value_int1d(p_mem, varname, memory_path, found)
Set pointer to value of memory list 1d int array variable.
subroutine mem_set_value_dbl1d_mapped(p_mem, varname, memory_path, map, found)
Set pointer to value of memory list 1d dbl array variable with mapping.
subroutine, public get_from_memorylist(name, mem_path, mt, found, check)
@ brief Get a memory type entry from the memory list
type(memorylisttype), public memorylist
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
This class is used to store a single deferred-length character string. It was designed to work in an ...