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

Functions/Subroutines

subroutine zmumps_dm_set_dynptr (cb_state, a, la, pamaster_or_ptrast, ixxd, ixxr, son_a, iachk, recsize)
subroutine zmumps_dm_pamasterorptrast (n, slavef, myid, keep28, keep199, inode, cb_state, ixxd, step, dad, procnode_steps, rcurrent, pamaster, ptrast, is_pamaster, is_ptrast)
logical function zmumps_dm_isband (xxstate)
logical function zmumps_dm_is_dynamic (ixxd)
subroutine zmumps_dm_fac_alloc_allowed (mem_count_to_allocate, keep8, iflag, ierror)
subroutine zmumps_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 zmumps_dm_freealldynamiccb (myid, n, slavef, keep, keep8, iw, liw, iwposcb, iwpos, step, ptrast, pamaster, procnode_steps, dad, atomic_updates)
subroutine zmumps_dm_set_ptr (address, sizfr8, cbptr)
subroutine zmumps_dm_free_block (xxg_status, dynptr, sizfr8, atomic_updates, keep8)

Function/Subroutine Documentation

◆ zmumps_dm_cbstatic2dynamic()

subroutine zmumps_dynamic_memory_m::zmumps_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,
complex(kind=8), 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 zfac_mem_dynamic.F.

144!$ USE OMP_LIB
145 USE zmumps_load, ONLY : zmumps_load_mem_update
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 COMPLEX(kind=8), 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 COMPLEX(kind=8), 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
196 CALL mumps_set_ierror
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 zmumps_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. zmumps_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 ZMUMPS_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 zmumps_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 zmumps_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 ZMUMPS_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 zmumps_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
326 CALL mumps_dm_fac_upd_dyn_memcnts (
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
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
zmumps_load
Definition zmumps_load.F:14
zmumps_load::myid
integer, save, private myid
Definition zmumps_load.F:57
zmumps_load::zmumps_load_mem_update
subroutine, public zmumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
Definition zmumps_load.F:920
mumps_storei8
subroutine mumps_storei8(i8, int_array)
Definition tools_common.F:871
mumps_typenode
integer function mumps_typenode(procinfo_inode, k199)
Definition tools_common.F:90
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
mumps_set_ssarbr_dad
subroutine mumps_set_ssarbr_dad(ssarbr, inode, dad, n, keep28, step, procnode_steps, k199)
Definition tools_common.F:230
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888
mumps_dm_fac_upd_dyn_memcnts
subroutine mumps_dm_fac_upd_dyn_memcnts(mem_count_allocated, atomic_updates, keep8, iflag, ierror, k69upd, k71upd)
Definition tools_common.F:1476
zmumps_sizefreeinrec
subroutine zmumps_sizefreeinrec(iw, lrec, size_free, xsize)
Definition zfac_mem_compress_cb.F:15

◆ zmumps_dm_fac_alloc_allowed()

subroutine zmumps_dynamic_memory_m::zmumps_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 zfac_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

◆ zmumps_dm_free_block()

subroutine zmumps_dynamic_memory_m::zmumps_dm_free_block ( integer xxg_status,
complex(kind=8), dimension(:), pointer dynptr,
integer(8) sizfr8,
logical, intent(in) atomic_updates,
integer(8), dimension(150) keep8 )

Definition at line 431 of file zfac_mem_dynamic.F.

433 IMPLICIT NONE
434 include 'mumps_headers.h'
435 INTEGER :: XXG_STATUS
436 COMPLEX(kind=8), 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)
447 CALL mumps_dm_fac_upd_dyn_memcnts (
448 & -sizfr8, atomic_updates, keep8, idummy, idummy,
449 & .true., .false.)
450 RETURN

◆ zmumps_dm_freealldynamiccb()

subroutine zmumps_dynamic_memory_m::zmumps_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 zfac_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 COMPLEX(kind=8), 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 zmumps_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 ZMUMPS_DM_FREEALLDYNAMICCB"
402 & , is_ptrast, is_pamaster
403 ENDIF
404 CALL zmumps_dm_set_ptr(tmp_address, dyn_size, tmp_ptr)
405 CALL zmumps_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

◆ zmumps_dm_is_dynamic()

logical function zmumps_dynamic_memory_m::zmumps_dm_is_dynamic ( integer, dimension(2) ixxd)

Definition at line 113 of file zfac_mem_dynamic.F.

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

◆ zmumps_dm_isband()

logical function zmumps_dynamic_memory_m::zmumps_dm_isband ( integer, intent(in) xxstate)

Definition at line 94 of file zfac_mem_dynamic.F.

95 INTEGER, INTENT(IN) :: XXSTATE
96 include 'mumps_headers.h'
97 SELECT CASE (xxstate)
98 CASE(s_notfree, s_cb1comp);
99 zmumps_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 zmumps_dm_isband = .true.
105 CASE(s_free);
106 zmumps_dm_isband = .false.
107 CASE DEFAULT;
108 WRITE(*,*) "Wrong state during ZMUMPS_DM_ISBAND", xxstate
109 CALL mumps_abort()
110 END SELECT
111 RETURN

◆ zmumps_dm_pamasterorptrast()

subroutine zmumps_dynamic_memory_m::zmumps_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 zfac_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.
74 & mumps_procnode(
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 (zmumps_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
mumps_procnode
integer function mumps_procnode(procinfo_inode, k199)
Definition tools_common.F:151

◆ zmumps_dm_set_dynptr()

subroutine zmumps_dynamic_memory_m::zmumps_dm_set_dynptr ( integer, intent(in) cb_state,
complex(kind=8), 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,
complex(kind=8), dimension(:), pointer son_a,
integer(8), intent(out) iachk,
integer(8), intent(out) recsize )

Definition at line 16 of file zfac_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 COMPLEX(kind=8), INTENT(IN), TARGET :: A( LA )
24#if defined(MUMPS_F2003)
25 COMPLEX(kind=8), POINTER, DIMENSION(:), INTENT(OUT) :: SON_A
26#else
27 COMPLEX(kind=8), POINTER, DIMENSION(:) :: SON_A
28#endif
29 INTEGER(8), INTENT(OUT) :: IACHK, RECSIZE
30 IF ( zmumps_dm_is_dynamic( ixxd ) ) THEN
31 CALL mumps_geti8(recsize, ixxd)
32 CALL zmumps_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

◆ zmumps_dm_set_ptr()

subroutine zmumps_dynamic_memory_m::zmumps_dm_set_ptr ( integer(8), intent(in) address,
integer(8), intent(in) sizfr8,
complex(kind=8), dimension(:), pointer cbptr )

Definition at line 416 of file zfac_mem_dynamic.F.

417 USE zmumps_static_ptr_m, ONLY : zmumps_get_tmp_ptr
418 IMPLICIT NONE
419 INTEGER(8), INTENT(IN) :: ADDRESS, SIZFR8
420#if defined(MUMPS_F2003)
421 COMPLEX(kind=8), DIMENSION(:), POINTER, INTENT(out) :: CBPTR
422#else
423 COMPLEX(kind=8), DIMENSION(:), POINTER :: CBPTR
424#endif
425!$OMP CRITICAL(STATIC_PTR_ACCESS)
426 CALL zmumps_set_tmp_ptr_c( address, sizfr8 )
427 CALL zmumps_get_tmp_ptr( cbptr )
428!$OMP END CRITICAL(STATIC_PTR_ACCESS)
429 RETURN
zmumps_static_ptr_m
Definition zstatic_ptr_m.F:14
zmumps_static_ptr_m::zmumps_get_tmp_ptr
subroutine, public zmumps_get_tmp_ptr(ptr)
Definition zstatic_ptr_m.F:24