OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
smumps_dynamic_memory_m Module Reference

Functions/Subroutines

subroutine smumps_dm_set_dynptr (cb_state, a, la, pamaster_or_ptrast, ixxd, ixxr, son_a, iachk, recsize)
subroutine smumps_dm_pamasterorptrast (n, slavef, myid, keep28, keep199, inode, cb_state, ixxd, step, dad, procnode_steps, rcurrent, pamaster, ptrast, is_pamaster, is_ptrast)
logical function smumps_dm_isband (xxstate)
logical function smumps_dm_is_dynamic (ixxd)
subroutine smumps_dm_fac_alloc_allowed (mem_count_to_allocate, keep8, iflag, ierror)
subroutine smumps_dm_cbstatic2dynamic (strategy, sizer_needed, skip_top_stack, myid, n, slavef, keep, keep8, iw, liw, iwposcb, iwpos, a, la, lrlu, iptrlu, lrlus, step, ptrast, pamaster, procnode_steps, dad, iflag, ierror)
subroutine smumps_dm_freealldynamiccb (myid, n, slavef, keep, keep8, iw, liw, iwposcb, iwpos, step, ptrast, pamaster, procnode_steps, dad, atomic_updates)
subroutine smumps_dm_set_ptr (address, sizfr8, cbptr)
subroutine smumps_dm_free_block (xxg_status, dynptr, sizfr8, atomic_updates, keep8)

Function/Subroutine Documentation

◆ smumps_dm_cbstatic2dynamic()

subroutine smumps_dynamic_memory_m::smumps_dm_cbstatic2dynamic ( integer, intent(in) strategy,
integer(8), intent(in) sizer_needed,
logical, intent(in) skip_top_stack,
integer, intent(in) myid,
integer, intent(in) n,
integer, intent(in) slavef,
integer, dimension(500), intent(in) keep,
integer(8), dimension(150), intent(inout) keep8,
integer, dimension( liw ), intent(inout) iw,
integer liw,
integer iwposcb,
integer iwpos,
real, dimension( la ), intent(in) a,
integer(8) la,
integer(8) lrlu,
integer(8) iptrlu,
integer(8) lrlus,
integer, dimension(n), intent(in) step,
integer(8), dimension(keep(28)), intent(inout) ptrast,
integer(8), dimension(keep(28)), intent(inout) pamaster,
integer, dimension(keep(28)), intent(in) procnode_steps,
integer, dimension(keep(28)), intent(in) dad,
integer, intent(inout) iflag,
integer, intent(inout) ierror )

Definition at line 136 of file sfac_mem_dynamic.F.

144!$ USE OMP_LIB
146 IMPLICIT NONE
147 INTEGER, INTENT(in) :: STRATEGY
148 INTEGER(8), INTENT(in) :: SIZER_NEEDED
149 LOGICAL, INTENT(in) :: SKIP_TOP_STACK
150 INTEGER, INTENT(in) :: N, SLAVEF, KEEP(500)
151 INTEGER, INTENT(in) :: MYID
152 INTEGER(8), INTENT(inout) :: KEEP8(150)
153 INTEGER :: IWPOS, IWPOSCB, LIW
154 INTEGER, INTENT(inout) :: IW( LIW )
155 INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS
156 REAL, INTENT(in) :: A( LA )
157 INTEGER, INTENT(in) :: STEP(N)
158 INTEGER(8), INTENT(inout) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28))
159 INTEGER, INTENT(in) :: PROCNODE_STEPS(KEEP(28)), DAD(KEEP(28))
160 INTEGER, INTENT(inout) :: IFLAG, IERROR
161 include 'mumps_headers.h'
162 INTEGER :: ICURRENT, INODE, TYPEINODE, CB_STATE
163 INTEGER(8) :: RCURRENT, RCURRENT_SIZE, SIZEHOLE
164 INTEGER(8) :: KEEP8TMPCOPY
165 LOGICAL :: MOVE2DYNAMIC
166 LOGICAL :: SSARBRDAD
167 INTEGER(8) :: TMP_ADDRESS, ITMP8
168 INTEGER(8) :: I8
169 REAL, DIMENSION(:), POINTER :: DYNAMIC_CB
170 LOGICAL :: IS_PAMASTER, IS_PTRAST
171 INTEGER :: allocok
172!$ INTEGER(8) :: CHUNK8
173!$ LOGICAL :: OMP_FLAG
174!$ INTEGER :: NOMP
175 LOGICAL :: IFLAG_M13_OCCURED, IFLAG_M19_OCCURED
176 INTEGER(8) :: MIN_SIZE_M13, MIN_SIZE_M19
177 INTEGER, EXTERNAL :: MUMPS_TYPENODE
178 IF ( strategy .EQ. 0 ) THEN
179 IF (lrlus.LT.sizer_needed) THEN
180 iflag = -9
181 CALL mumps_set_ierror(sizer_needed-lrlus, ierror)
182 ENDIF
183 RETURN
184 ENDIF
185 iflag_m13_occured = .false.
186 min_size_m13 = huge(min_size_m13)
187 iflag_m19_occured = .false.
188 min_size_m19 = huge(min_size_m19)
189!$ NOMP = OMP_GET_MAX_THREADS()
190 icurrent = iwposcb + 1
191 rcurrent = iptrlu + 1
192 IF (strategy.EQ.1 .AND. sizer_needed.LE.lrlus) GOTO 500
193 IF (( keep8(73) + sizer_needed-lrlus).GT.
194 & keep8(75)) THEN
195 iflag = -19
197 & (keep8(73) + sizer_needed-lrlus-keep8(75), ierror)
198 GOTO 500
199 ENDIF
200 DO WHILE (icurrent .NE. liw-keep(ixsz)+1)
201 inode = iw(icurrent+xxn)
202 cb_state = iw(icurrent+xxs)
203 CALL mumps_geti8( rcurrent_size, iw(icurrent+xxr))
204 CALL smumps_dm_pamasterorptrast( n, slavef, myid, keep(28),
205 & keep(199), inode, cb_state,
206 & iw(icurrent+xxd:icurrent+xxd+1),
207 & step, dad, procnode_steps,
208 & rcurrent, pamaster, ptrast,
209 & is_pamaster, is_ptrast )
210 IF ( cb_state .NE. s_free .AND.
211 & .NOT. smumps_dm_is_dynamic(iw(icurrent+xxd)) ) THEN
212 typeinode = mumps_typenode(procnode_steps(step(inode)),
213 & keep(199))
214 IF (strategy .EQ. -1) THEN
215 move2dynamic = .false.
216 move2dynamic = move2dynamic .OR.
217 & cb_state .EQ. s_nolcbcontig .OR.
218 & cb_state .EQ. s_nolcbnocontig .OR.
219 & cb_state .EQ. s_nolcleaned .OR.
220 & cb_state .EQ. s_all .OR.
221 & cb_state .EQ. s_active
222 ELSE IF (strategy .EQ. 2 .OR. strategy .EQ. 3) THEN
223 move2dynamic = .true.
224 move2dynamic = move2dynamic .AND. (typeinode.NE.3)
225 ELSE IF (strategy .EQ. 1) THEN
226 move2dynamic = .false.
227 IF (lrlus.GT.sizer_needed) GOTO 500
228 IF (typeinode.EQ.3) GOTO 100
229 move2dynamic = move2dynamic.OR..true.
230 ELSE
231 WRITE(*,*) "Internal error in SMUMPS_DM_CBSTATIC2DYNAMIC",
232 & move2dynamic
233 CALL mumps_abort()
234 ENDIF
235 move2dynamic = move2dynamic .AND. (rcurrent_size .NE. 0_8)
236 move2dynamic = move2dynamic .AND.
237 & .NOT. ((icurrent.EQ.iwposcb + 1).AND.(skip_top_stack))
238 IF (strategy .NE. 3) THEN
239 IF ( keep(405) .EQ. 1 ) THEN
240!$OMP ATOMIC READ
241 keep8tmpcopy = keep8(73)
242!$OMP END ATOMIC
243 ELSE
244 keep8tmpcopy = keep8(73)
245 ENDIF
246 IF ( rcurrent_size + keep8tmpcopy .GT. keep8(75) ) THEN
247 iflag_m19_occured= .true.
248 min_size_m19 = min( min_size_m19,
249 & rcurrent_size+keep8(73)-keep8(75) )
250 move2dynamic = .false.
251 ENDIF
252 ENDIF
253 IF ( move2dynamic ) THEN
254#if defined(MUMPS_ALLOC_FROM_C)
255 CALL mumps_malloc_c( tmp_address,
256 & rcurrent_size * keep(35) )
257 IF (tmp_address .EQ. 0_8) THEN
258 allocok=1
259 ELSE
260 allocok=0
261 ENDIF
262#else
263 ALLOCATE(dynamic_cb(rcurrent_size), stat=allocok)
264#endif
265 IF (allocok .GT. 0) THEN
266 IF ( (strategy .NE. 1).OR.
267 & (sizer_needed-lrlus).GE.rcurrent_size) THEN
268 iflag = -13
269 CALL mumps_set_ierror(sizer_needed-lrlus, ierror)
270 GOTO 500
271 ENDIF
272 iflag_m13_occured = .true.
273 min_size_m13 = min(min_size_m13, rcurrent_size)
274 GOTO 100
275 ENDIF
276 sizehole=0_8
277 IF (keep(216).NE.3) THEN
278 CALL smumps_sizefreeinrec( iw(icurrent),
279 & liw-icurrent+1, sizehole, keep(ixsz))
280 ENDIF
281 CALL mumps_storei8(rcurrent_size,iw(icurrent+xxd))
282#if defined(MUMPS_ALLOC_FROM_C)
283 CALL smumps_dm_set_ptr( tmp_address, rcurrent_size,
284 & dynamic_cb )
285#else
286 CALL mumps_addr_c(dynamic_cb(1), tmp_address)
287#endif
288 IF (is_ptrast) THEN
289 ptrast(step(inode)) = tmp_address
290 ELSE IF (is_pamaster) THEN
291 pamaster(step(inode)) = tmp_address
292 ELSE
293 WRITE(*,*)
294 & "Internal error 3 in SMUMPS_DM_CBSTATIC2DYNAMIC",
295 & rcurrent, ptrast(step(inode)), pamaster(step(inode))
296 CALL mumps_abort()
297 ENDIF
298 itmp8 = (rcurrent_size-sizehole)
299 lrlus = lrlus + itmp8
300 IF (keep(405).EQ.1) THEN
301 IF (sizehole .NE. 0_8) THEN
302!$OMP ATOMIC CAPTURE
303 keep8(69) = keep8(69) + sizehole
304 keep8tmpcopy = keep8(69)
305!$OMP END ATOMIC
306!$OMP ATOMIC UPDATE
307 keep8(68) = max( keep8(68), keep8tmpcopy )
308!$OMP END ATOMIC
309 ENDIF
310 ELSE
311 keep8(69) = keep8(69) + sizehole
312 keep8(68) = max( keep8(68), keep8(69) )
313 ENDIF
314 CALL mumps_set_ssarbr_dad(ssarbrdad, inode,
315 & dad, n, keep(28),
316 & step, procnode_steps, keep(199))
317 CALL smumps_load_mem_update( ssarbrdad, .false.,
318 & la - lrlus, 0_8, -(rcurrent_size-sizehole),
319 & keep, keep8, lrlus)
320 IF (icurrent .EQ. iwposcb+1) THEN
321 iptrlu = iptrlu + rcurrent_size
322 lrlu = lrlu + rcurrent_size
323 CALL mumps_storei8(0_8, iw(icurrent+xxr))
324 ENDIF
325 IF (strategy .NE. 3) THEN
327 & rcurrent_size, keep(405).EQ.1, keep8,
328 & iflag, ierror, .false., .false.)
329 IF (iflag.LT.0) GOTO 500
330 ENDIF
331!$ CHUNK8 = max( int(KEEP(361),8),
332!$ & (RCURRENT_SIZE+NOMP-1) / NOMP)
333!$ OMP_FLAG = ( (RCURRENT_SIZE > int(KEEP(361),8))
334!$ & .AND.(NOMP.GT.1)
335!$ & )
336!$OMP PARALLEL DO PRIVATE(I8) SCHEDULE(STATIC, CHUNK8)
337!$OMP& IF (OMP_FLAG)
338 DO i8=1_8, rcurrent_size
339 dynamic_cb(i8) = a(rcurrent+i8-1_8)
340 ENDDO
341!$OMP END PARALLEL DO
342 ENDIF
343 ENDIF
344 100 CONTINUE
345 rcurrent = rcurrent + rcurrent_size
346 icurrent = icurrent + iw(icurrent+xxi)
347 END DO
348 IF (lrlus.LT.sizer_needed) THEN
349 IF (iflag_m19_occured) THEN
350 iflag = -19
351 CALL mumps_set_ierror(min_size_m19, ierror)
352 ELSE IF (iflag_m13_occured) THEN
353 iflag = -13
354 CALL mumps_set_ierror(min_size_m13, ierror)
355 ELSE
356 iflag = -9
357 CALL mumps_set_ierror(sizer_needed-lrlus, ierror)
358 ENDIF
359 ENDIF
360 500 CONTINUE
361 RETURN
#define mumps_abort
Definition VE_Metis.h:25
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
subroutine, public smumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
integer, save, private myid
Definition smumps_load.F:57
subroutine smumps_sizefreeinrec(iw, lrec, size_free, xsize)
subroutine mumps_storei8(i8, int_array)
integer function mumps_typenode(procinfo_inode, k199)
subroutine mumps_set_ierror(size8, ierror)
subroutine mumps_set_ssarbr_dad(ssarbr, inode, dad, n, keep28, step, procnode_steps, k199)
subroutine mumps_geti8(i8, int_array)
subroutine mumps_dm_fac_upd_dyn_memcnts(mem_count_allocated, atomic_updates, keep8, iflag, ierror, k69upd, k71upd)

◆ smumps_dm_fac_alloc_allowed()

subroutine smumps_dynamic_memory_m::smumps_dm_fac_alloc_allowed ( integer(8), intent(in) mem_count_to_allocate,
integer(8), dimension(150), intent(inout) keep8,
integer, intent(inout) iflag,
integer, intent(inout) ierror )

Definition at line 120 of file sfac_mem_dynamic.F.

123 IMPLICIT NONE
124 INTEGER(8), INTENT(IN) :: MEM_COUNT_TO_ALLOCATE
125 INTEGER(8), INTENT(INOUT) :: KEEP8(150)
126 INTEGER, INTENT(INOUT) :: IFLAG, IERROR
127 IF ( keep8(73) + mem_count_to_allocate
128 & .GT. keep8(75) ) THEN
129 iflag = -19
130 CALL mumps_set_ierror(
131 & keep8(73) + mem_count_to_allocate -keep8(75),
132 & ierror )
133 ENDIF
134 RETURN

◆ smumps_dm_free_block()

subroutine smumps_dynamic_memory_m::smumps_dm_free_block ( integer xxg_status,
real, dimension(:), pointer dynptr,
integer(8) sizfr8,
logical, intent(in) atomic_updates,
integer(8), dimension(150) keep8 )

Definition at line 431 of file sfac_mem_dynamic.F.

433 IMPLICIT NONE
434 include 'mumps_headers.h'
435 INTEGER :: XXG_STATUS
436 REAL, POINTER, DIMENSION(:) :: DYNPTR
437 INTEGER(8) :: SIZFR8
438 LOGICAL, INTENT(IN) :: ATOMIC_UPDATES
439 INTEGER(8) :: KEEP8(150)
440 INTEGER IDUMMY
441#if defined(MUMPS_ALLOC_FROM_C)
442 CALL mumps_free_c(dynptr(1))
443#else
444 DEALLOCATE(dynptr)
445#endif
446 NULLIFY(dynptr)
448 & -sizfr8, atomic_updates, keep8, idummy, idummy,
449 & .true., .false.)
450 RETURN

◆ smumps_dm_freealldynamiccb()

subroutine smumps_dynamic_memory_m::smumps_dm_freealldynamiccb ( integer, intent(in) myid,
integer, intent(in) n,
integer, intent(in) slavef,
integer, dimension(500), intent(in) keep,
integer(8), dimension(150), intent(inout) keep8,
integer, dimension( liw ), intent(inout) iw,
integer liw,
integer iwposcb,
integer iwpos,
integer, dimension(n), intent(in) step,
integer(8), dimension(keep(28)), intent(in) ptrast,
integer(8), dimension(keep(28)), intent(in) pamaster,
integer, dimension(keep(28)), intent(in) procnode_steps,
integer, dimension(keep(28)), intent(in) dad,
logical, intent(in) atomic_updates )

Definition at line 363 of file sfac_mem_dynamic.F.

367 INTEGER, INTENT(in) :: N, SLAVEF, KEEP(500)
368 INTEGER, INTENT(in) :: MYID
369 INTEGER(8), INTENT(inout) :: KEEP8(150)
370 INTEGER :: IWPOS, IWPOSCB, LIW
371 INTEGER, INTENT(inout) :: IW( LIW )
372 INTEGER, INTENT(in) :: STEP(N)
373 INTEGER(8), INTENT(in) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28))
374 INTEGER, INTENT(in) :: PROCNODE_STEPS(KEEP(28)), DAD(KEEP(28))
375 LOGICAL, INTENT(in) :: ATOMIC_UPDATES
376 include 'mumps_headers.h'
377 INTEGER :: ICURRENT, INODE
378 INTEGER :: CB_STATE
379 INTEGER(8) :: DYN_SIZE, TMP_ADDRESS
380 INTEGER(8), PARAMETER :: RDUMMY = -987654
381 LOGICAL :: IS_PAMASTER, IS_PTRAST
382 REAL, DIMENSION(:), POINTER :: TMP_PTR
383 icurrent = iwposcb + 1
384 IF (keep8(73) .NE. 0_8) THEN
385 DO WHILE (icurrent .LT. liw-keep(ixsz)+1)
386 inode = iw(icurrent+xxn)
387 cb_state = iw(icurrent+xxs)
388 IF (cb_state.NE.s_free) THEN
389 CALL mumps_geti8( dyn_size, iw(icurrent+xxd) )
390 IF (dyn_size .GT. 0_8) THEN
391 CALL smumps_dm_pamasterorptrast( n, slavef, myid, keep(28),
392 & keep(199), inode, cb_state, iw(icurrent+xxd),
393 & step, dad, procnode_steps,
394 & rdummy, pamaster, ptrast,
395 & is_pamaster, is_ptrast )
396 IF (is_pamaster) THEN
397 tmp_address = pamaster(step(inode))
398 ELSE IF (is_ptrast) THEN
399 tmp_address = ptrast(step(inode))
400 ELSE
401 WRITE(*,*) "Internal error 1 in SMUMPS_DM_FREEALLDYNAMICCB"
402 & , is_ptrast, is_pamaster
403 ENDIF
404 CALL smumps_dm_set_ptr(tmp_address, dyn_size, tmp_ptr)
405 CALL smumps_dm_free_block( iw(icurrent+xxg),
406 & tmp_ptr, dyn_size,
407 & atomic_updates, keep8 )
408 CALL mumps_storei8(0_8, iw(icurrent+xxd))
409 ENDIF
410 ENDIF
411 icurrent = icurrent + iw(icurrent+xxi)
412 ENDDO
413 ENDIF
414 RETURN

◆ smumps_dm_is_dynamic()

logical function smumps_dynamic_memory_m::smumps_dm_is_dynamic ( integer, dimension(2) ixxd)

Definition at line 113 of file sfac_mem_dynamic.F.

114 INTEGER :: IXXD(2)
115 INTEGER(8) :: DYN_SIZE
116 CALL mumps_geti8( dyn_size, ixxd )
117 smumps_dm_is_dynamic = dyn_size > 0_8
118 RETURN

◆ smumps_dm_isband()

logical function smumps_dynamic_memory_m::smumps_dm_isband ( integer, intent(in) xxstate)

Definition at line 94 of file sfac_mem_dynamic.F.

95 INTEGER, INTENT(IN) :: XXSTATE
96 include 'mumps_headers.h'
97 SELECT CASE (xxstate)
98 CASE(s_notfree, s_cb1comp);
99 smumps_dm_isband = .false.
100 CASE(s_active, s_all,
101 & s_nolcbcontig, s_nolcbnocontig, s_nolcleaned,
102 & s_nolcbnocontig38, s_nolcbcontig38, s_nolcleaned38,
103 & s_nolnocb, s_nolnocbcleaned);
104 smumps_dm_isband = .true.
105 CASE(s_free);
106 smumps_dm_isband = .false.
107 CASE DEFAULT;
108 WRITE(*,*) "Wrong state during SMUMPS_DM_ISBAND", xxstate
109 CALL mumps_abort()
110 END SELECT
111 RETURN

◆ smumps_dm_pamasterorptrast()

subroutine smumps_dynamic_memory_m::smumps_dm_pamasterorptrast ( integer, intent(in) n,
integer, intent(in) slavef,
integer, intent(in) myid,
integer, intent(in) keep28,
integer, intent(in) keep199,
integer, intent(in) inode,
integer, intent(in) cb_state,
integer, dimension(2), intent(in) ixxd,
integer, dimension(n), intent(in) step,
integer, dimension(keep28), intent(in) dad,
integer, dimension(keep28), intent(in) procnode_steps,
integer(8), intent(in) rcurrent,
integer(8), dimension(keep28), intent(in) pamaster,
integer(8), dimension(keep28), intent(in) ptrast,
logical, intent(out) is_pamaster,
logical, intent(out) is_ptrast )

Definition at line 41 of file sfac_mem_dynamic.F.

46 IMPLICIT NONE
47 INTEGER, INTENT(in) :: KEEP28, N, SLAVEF, MYID, INODE, CB_STATE
48 INTEGER, INTENT(in) :: KEEP199
49 INTEGER, INTENT(in) :: IXXD(2)
50 INTEGER, INTENT(in) :: DAD(KEEP28)
51 INTEGER, INTENT(in) :: STEP(N)
52 INTEGER, INTENT(in) :: PROCNODE_STEPS(KEEP28)
53 LOGICAL, INTENT(out) :: IS_PAMASTER, IS_PTRAST
54 INTEGER(8), INTENT(in) :: PAMASTER(KEEP28), PTRAST(KEEP28)
55 INTEGER(8), INTENT(in) :: RCURRENT
56 LOGICAL :: DAD_TYPE2_NOT_ON_MYID
57 INTEGER :: NODETYPE, DADTYPE
58 include 'mumps_headers.h'
59 INTEGER, EXTERNAL :: MUMPS_TYPENODE
60 INTEGER, EXTERNAL :: MUMPS_PROCNODE
61 is_pamaster = .false.
62 is_ptrast = .false.
63 IF (cb_state .EQ. s_free) THEN
64 RETURN
65 ENDIF
66 nodetype = mumps_typenode(procnode_steps(step(inode)), keep199)
67 dadtype=-99999
68 dad_type2_not_on_myid = .false.
69 IF (dad(step(inode)) .NE. 0) THEN
70 dadtype= mumps_typenode(
71 & procnode_steps(step(dad(step(inode)))),
72 & keep199)
73 IF (dadtype .EQ. 2 .AND.
75 & procnode_steps(step(dad(step(inode)))),
76 & keep199).NE.myid
77 & ) THEN
78 dad_type2_not_on_myid = .true.
79 ENDIF
80 ENDIF
81 IF (smumps_dm_isband(cb_state)) THEN
82 is_ptrast=.true.
83 ELSE IF (nodetype.EQ.1
84 & .AND. mumps_procnode(procnode_steps(step(inode)),
85 & keep199).EQ.myid
86 & .AND. dad_type2_not_on_myid)
87 & THEN
88 is_ptrast=.true.
89 ELSE
90 is_pamaster=.true.
91 ENDIF
92 RETURN
integer function mumps_procnode(procinfo_inode, k199)

◆ smumps_dm_set_dynptr()

subroutine smumps_dynamic_memory_m::smumps_dm_set_dynptr ( integer, intent(in) cb_state,
real, dimension( la ), intent(in), target a,
integer(8), intent(in) la,
integer(8), intent(in) pamaster_or_ptrast,
integer, dimension(2), intent(in) ixxd,
integer, dimension(2), intent(in) ixxr,
real, dimension(:), pointer son_a,
integer(8), intent(out) iachk,
integer(8), intent(out) recsize )

Definition at line 16 of file sfac_mem_dynamic.F.

19 IMPLICIT NONE
20 INTEGER, INTENT(IN) :: CB_STATE
21 INTEGER, INTENT(IN) :: IXXR(2), IXXD(2)
22 INTEGER(8), INTENT(IN) :: LA, PAMASTER_OR_PTRAST
23 REAL, INTENT(IN), TARGET :: A( LA )
24#if defined(MUMPS_F2003)
25 REAL, POINTER, DIMENSION(:), INTENT(OUT) :: SON_A
26#else
27 REAL, POINTER, DIMENSION(:) :: SON_A
28#endif
29 INTEGER(8), INTENT(OUT) :: IACHK, RECSIZE
30 IF ( smumps_dm_is_dynamic( ixxd ) ) THEN
31 CALL mumps_geti8(recsize, ixxd)
32 CALL smumps_dm_set_ptr( pamaster_or_ptrast, recsize, son_a )
33 iachk = 1_8
34 ELSE
35 CALL mumps_geti8(recsize, ixxr)
36 iachk = pamaster_or_ptrast
37 son_a => a
38 ENDIF
39 RETURN

◆ smumps_dm_set_ptr()

subroutine smumps_dynamic_memory_m::smumps_dm_set_ptr ( integer(8), intent(in) address,
integer(8), intent(in) sizfr8,
real, dimension(:), pointer cbptr )

Definition at line 416 of file sfac_mem_dynamic.F.

418 IMPLICIT NONE
419 INTEGER(8), INTENT(IN) :: ADDRESS, SIZFR8
420#if defined(MUMPS_F2003)
421 REAL, DIMENSION(:), POINTER, INTENT(out) :: CBPTR
422#else
423 REAL, DIMENSION(:), POINTER :: CBPTR
424#endif
425!$OMP CRITICAL(STATIC_PTR_ACCESS)
426 CALL smumps_set_tmp_ptr_c( address, sizfr8 )
427 CALL smumps_get_tmp_ptr( cbptr )
428!$OMP END CRITICAL(STATIC_PTR_ACCESS)
429 RETURN
subroutine, public smumps_get_tmp_ptr(ptr)