OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dfac_mem_stack.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 SUBROUTINE dmumps_fac_stack(COMM_LOAD, ASS_IRECV,
15 & N, INODE, TYPE, TYPEF,
16 & LA, IW, LIW, A,
17 & IFLAG, IERROR, OPELIW, NELVAW, NMAXNPIV,
18 & PTRIST, PTLUST_S,
19 & PTRFAC, PTRAST,
20 & STEP, PIMASTER, PAMASTER, NE,
21 & POSFAC, LRLU, LRLUS, LRLUSM, IPTRLU, ICNTL, KEEP,KEEP8,DKEEP,
22 & COMP, IWPOS, IWPOSCB, PROCNODE_STEPS, SLAVEF,
23 & FPERE, COMM, MYID, IPOOL, LPOOL, LEAF, NSTK_S,
24 & PERM, BUFR, LBUFR, LBUFR_BYTES, NBFIN, root,
25 & OPASSW, ITLOC, RHS_MUMPS,
26 & FILS, DAD, PTRARW, PTRAIW, INTARR, DBLARR,
27 & ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
28 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
29 & , LRGROUPS
30 & , FLOP_ESTIM_ACC
31 & )
32 USE dmumps_buf
33 USE dmumps_load
34 USE dmumps_struc_def, ONLY : dmumps_root_struc
35 IMPLICIT NONE
36 TYPE (dmumps_root_struc) :: root
37 INTEGER COMM_LOAD, ASS_IRECV
38 INTEGER COMM, MYID, TYPE, TYPEF
39 INTEGER N, LIW, INODE,IFLAG,IERROR
40 INTEGER ICNTL(60), KEEP(500)
41 DOUBLE PRECISION DKEEP(230)
42 INTEGER(8) KEEP8(150)
43 INTEGER(8) :: LA, POSFAC, LRLU, LRLUS, LRLUSM, IPTRLU
44 INTEGER IWPOSCB, IWPOS,
45 & FPERE, SLAVEF, NELVAW, NMAXNPIV
46 INTEGER IW(LIW),PROCNODE_STEPS(KEEP(28))
47 INTEGER(8) :: PTRAST (KEEP(28))
48 INTEGER(8) :: PTRFAC (KEEP(28))
49 INTEGER(8) :: PAMASTER(KEEP(28))
50 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
51 INTEGER STEP(N), PIMASTER(KEEP(28)), NE(KEEP(28))
52 DOUBLE PRECISION A(LA)
53 INTEGER, intent(in) :: LRGROUPS(N)
54 DOUBLE PRECISION OPASSW, OPELIW
55 DOUBLE PRECISION DBLARR(KEEP8(26))
56 INTEGER INTARR(KEEP8(27))
57 INTEGER ITLOC( N + KEEP(253) ), FILS( N ), DAD( KEEP(28) ),
58 & nd( keep(28) ), frere( keep(28) )
59 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
60 INTEGER ISTEP_TO_INIV2(KEEP(71)),
61 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
62 INTEGER NELT, LPTRAR
63 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
64 INTEGER(8), INTENT(IN) :: PTRAIW( LPTRAR ), PTRARW( LPTRAR )
65 INTEGER LPOOL, LEAF, COMP
66 INTEGER IPOOL( LPOOL )
67 INTEGER NSTK_S( KEEP(28) )
68 INTEGER PERM(N)
69 INTEGER LBUFR, LBUFR_BYTES
70 INTEGER BUFR( LBUFR )
71 INTEGER NBFIN
72 INTEGER NFRONT_ESTIM,NELIM_ESTIM
73 DOUBLE PRECISION FLOP_ESTIM_ACC
74 INTEGER MUMPS_PROCNODE
75 EXTERNAL MUMPS_PROCNODE
76 include 'mpif.h'
77 include 'mumps_tags.h'
78 INTEGER :: STATUS(MPI_STATUS_SIZE)
79 INTEGER LP
80 INTEGER NBROWS_ALREADY_SENT
81 INTEGER(8) :: POSELT, OPSFAC
82 INTEGER(8) :: IOLD, INEW, FACTOR_POS
83 INTEGER NSLAVES, NCB,
84 & h_inode, ierr, nbcol, nbrow, nbrow_send,
85 & nelim
86 INTEGER NBROW_STACK, NBROW_INDICES, NBCOL_STACK
87 INTEGER NCBROW_ALREADY_MOVED, NCBROW_PREVIOUSLY_MOVED,
88 &ncbrow_newly_moved
89 INTEGER(8) :: LAST_ALLOWED_POS
90 INTEGER(8) :: LREQCB, MIN_SPACE_IN_PLACE
91 INTEGER(8) :: SHIFT_VAL_SON
92 INTEGER SHIFT_LIST_ROW_SON,
93 & shift_list_col_son,
94 & list_row_son, list_col_son, list_slaves
95 INTEGER IOLDPS,NFRONT,NPIV,NASS,IOLDP1,PTROWEND,
96 & lreqi, lcont
97 INTEGER I,LDA, INIV2
98 INTEGER MSGDEST, MSGTAG, CHK_LOAD
99 include 'mumps_headers.h'
100 LOGICAL MUST_COMPACT_FACTORS
101 LOGICAL PACKED_CB, COMPRESS_PANEL, COMPRESS_CB, LR_SOLVE
102 LOGICAL INPLACE
103 INTEGER(8) :: SIZE_INPLACE, FAC_ENTRIES, COUNT_EXTRA_IP_COPIES
104 INTEGER INTSIZ
105 DOUBLE PRECISION FLOP1, FLOP1_EFFECTIVE
106 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
107 LOGICAL SSARBR, SSARBR_ROOT, MUMPS_INSSARBR,
108 & mumps_in_or_root_ssarbr, mumps_rootssarbr
109 EXTERNAL mumps_inssarbr, mumps_in_or_root_ssarbr,
110 & mumps_rootssarbr
111 lp = icntl(1)
112 IF (icntl(4) .LE. 0) lp = -1
113 inplace = .false.
114 min_space_in_place = 0_8
115 ioldps = ptlust_s(step(inode))
116 intsiz = iw(ioldps+xxi)
117 nfront = iw(ioldps+keep(ixsz))
118 npiv = iw(ioldps + 1+keep(ixsz))
119 nmaxnpiv = max(npiv, nmaxnpiv)
120 nass = iabs(iw(ioldps + 2+keep(ixsz)))
121 nslaves= iw(ioldps+5+keep(ixsz))
122 h_inode= 6 + nslaves + keep(ixsz)
123 lcont = nfront - npiv
124 nbcol = lcont
125 ssarbr = mumps_inssarbr(procnode_steps(step(inode)),keep(199))
126 ssarbr_root = mumps_in_or_root_ssarbr
127 & (procnode_steps(step(inode)),keep(199))
128 lreqcb = 0_8
129 inplace = .false.
130 packed_cb = ((keep(215).EQ.0)
131 & .AND.(keep(50).NE.0)
132 & .AND.(typef.EQ.1
133 & .OR.typef.EQ.2
134 & )
135 & .AND.(type.EQ.1))
136 compress_panel = (iw(ioldps+xxlr).GE.2)
137 compress_cb = (iw(ioldps+xxlr).EQ.1.OR.iw(ioldps+xxlr).EQ.3)
138 lr_solve = (keep(486).EQ.2)
139 must_compact_factors = .true.
140 IF (keep(201).EQ.1 .OR. keep(201).EQ.-1
141 & .OR. (compress_panel.AND.lr_solve)
142 & ) THEN
143 must_compact_factors = .false.
144 ENDIF
145 IF ((fpere.EQ.0).AND.(nass.NE.npiv)) THEN
146 iflag = -10
147 GOTO 600
148 ENDIF
149 nbrow = lcont
150 IF (type.EQ.2) nbrow = nass - npiv
151 IF ((keep(50).NE.0).AND.(type.EQ.2)) THEN
152 lda = nass
153 ELSE
154 lda = nfront
155 ENDIF
156 nbrow_send = nbrow
157 nelim = nass-npiv
158 IF (typef.EQ.2) nbrow_send = nelim
159 poselt = ptrast(step(inode))
160 IF (poselt .ne. ptrfac(step(inode))) THEN
161 WRITE(*,*) myid,":error 1 in dmumps_fac_stack:"
162 WRITE(*,*) "inode, ptrast, ptrfac =",
163 & INODE, PTRAST(STEP(INODE)), PTRFAC(STEP(INODE))
164 WRITE(*,*) "packed_cb, nfront, npiv, nass, nslaves",
165 & PACKED_CB, NFRONT, NPIV, NASS, NSLAVES
166 WRITE(*,*) "TYPE, typef, fpere ",
167 & TYPE, TYPEF, FPERE
168 CALL MUMPS_ABORT()
169 END IF
170 NELVAW = NELVAW + NASS - NPIV
171.eq. IF (KEEP(50) 0) THEN
172 FAC_ENTRIES = int(NPIV,8) * int(NFRONT,8)
173 ELSE
174 FAC_ENTRIES = ( int(NPIV,8)*int(NPIV+1,8) )/ 2_8
175 ENDIF
176 FAC_ENTRIES = FAC_ENTRIES + int(NBROW,8) * int(NPIV,8)
177.EQ. IF ( KEEP(405) 0 ) THEN
178 KEEP8(10) = KEEP8(10) + FAC_ENTRIES
179 KEEP(429) = KEEP(429) - 1
180 ELSE
181!$OMP ATOMIC UPDATE
182 KEEP8(10) = KEEP8(10) + FAC_ENTRIES
183!$OMP END ATOMIC
184 ENDIF
185 CALL MUMPS_GET_FLOPS_COST( NFRONT, NPIV, NASS,
186 & KEEP(50), TYPE,FLOP1 )
187.NOT..and. IF ( ( SSARBR_ROOT) TYPE == 1) THEN
188 IF (NE(STEP(INODE))==0) THEN
189 CHK_LOAD=0
190 ELSE
191 CHK_LOAD=1
192 ENDIF
193 CALL DMUMPS_LOAD_UPDATE(CHK_LOAD, .FALSE., -FLOP1,
194 & KEEP,KEEP8)
195 ENDIF
196 FLOP1_EFFECTIVE = FLOP1
197 OPELIW = OPELIW + FLOP1
198.NE. IF ( NPIV NASS ) THEN
199 CALL MUMPS_GET_FLOPS_COST( NFRONT, NASS, NASS,
200 & KEEP(50), TYPE,FLOP1 )
201.NOT. IF ( SSARBR_ROOT ) THEN
202 IF (NE(STEP(INODE))==0) THEN
203 CHK_LOAD=0
204 ELSE
205 CHK_LOAD=1
206 ENDIF
207 CALL DMUMPS_LOAD_UPDATE(CHK_LOAD, .FALSE.,
208 & FLOP1_EFFECTIVE-FLOP1,
209 & KEEP,KEEP8)
210 ENDIF
211 END IF
212 IF ( SSARBR_ROOT ) THEN
213 NFRONT_ESTIM=ND(STEP(INODE)) + KEEP(253)
214 NELIM_ESTIM=NASS-(NFRONT-NFRONT_ESTIM)
215 CALL MUMPS_GET_FLOPS_COST(NFRONT_ESTIM,NELIM_ESTIM,NELIM_ESTIM,
216 & KEEP(50),1,FLOP1)
217 END IF
218 FLOP1=-FLOP1
219.GT. IF (KEEP(400)0) THEN
220 FLOP_ESTIM_ACC = FLOP_ESTIM_ACC + FLOP1
221 ENDIF
222 IF (SSARBR_ROOT) THEN
223 CALL DMUMPS_LOAD_UPDATE(0,.FALSE.,FLOP1,KEEP,KEEP8)
224 ELSE
225 CALL DMUMPS_LOAD_UPDATE(2,.FALSE.,FLOP1,KEEP,KEEP8)
226 ENDIF
227.EQ. IF ( FPERE 0 ) THEN
228.NE..AND..NE. IF ( KEEP(253) 0 KEEP(201)-1
229.AND..NE. & KEEP(201)1
230.AND..NOT..OR..NOT. & (COMPRESS_PANELLR_SOLVE)
231 & ) THEN
232 MUST_COMPACT_FACTORS = .TRUE.
233 GOTO 190
234.NE..AND..GT. ELSE IF ( KEEP(50) 0 KEEP(459)1) THEN
235 MUST_COMPACT_FACTORS = .TRUE.
236 GOTO 190
237 ELSE
238 MUST_COMPACT_FACTORS = .FALSE.
239 GOTO 190
240 ENDIF
241 ENDIF
242.EQ. IF ( FPEREKEEP(38) ) THEN
243 NCB = NFRONT - NASS
244 SHIFT_LIST_ROW_SON = H_INODE + NASS
245 SHIFT_LIST_COL_SON = H_INODE + NFRONT + NASS
246 SHIFT_VAL_SON = int(NASS,8)*int(NFRONT+1,8)
247.EQ. IF (TYPE1) THEN
248 CALL DMUMPS_BUILD_AND_SEND_CB_ROOT(
249 & COMM_LOAD, ASS_IRECV,
250 & N, INODE, FPERE,
251 & PTLUST_S, PTRAST,
252 & root, NCB, NCB, SHIFT_LIST_ROW_SON,
253 & SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT,
254 & ROOT_CONT_STATIC, MYID, COMM,
255 &
256 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
257 & IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
258 & PTRIST, PTLUST_S, PTRFAC,
259 & PTRAST, STEP, PIMASTER, PAMASTER,
260 & NSTK_S, COMP, IFLAG, IERROR, PERM,
261 & IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
262 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD, PTRARW, PTRAIW,
263 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,.FALSE., ND, FRERE,
264 & LPTRAR, NELT, FRTPTR, FRTELT,
265 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
266 & , LRGROUPS
267 & )
268 IF (IFLAG < 0 ) GOTO 500
269 ENDIF
270 MSGDEST= MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)),KEEP(199))
271 IOLDPS = PTLUST_S(STEP(INODE))
272 LIST_ROW_SON = IOLDPS + H_INODE + NPIV
273 LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV
274 LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ)
275.EQ. IF (MSGDESTMYID) THEN
276 CALL DMUMPS_PROCESS_RTNELIND( root,
277 & INODE, NELIM, NSLAVES, IW(LIST_ROW_SON),
278 & IW(LIST_COL_SON), IW(LIST_SLAVES),
279 &
280 & PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU,
281 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
282 & PTLUST_S, PTRFAC,
283 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S,
284 & ITLOC, RHS_MUMPS, COMP,
285 & IFLAG, IERROR,
286 & IPOOL, LPOOL, LEAF, MYID, SLAVEF,
287 & KEEP, KEEP8, DKEEP,
288 & COMM, COMM_LOAD, FILS, DAD, ND)
289.LT. IF (IFLAG0) GOTO 600
290 ELSE
291 IERR = -1
292.EQ. DO WHILE (IERR-1)
293 CALL DMUMPS_BUF_SEND_RTNELIND( INODE, NELIM,
294 & IW(LIST_ROW_SON), IW(LIST_COL_SON), NSLAVES,
295 & IW(LIST_SLAVES), MSGDEST, COMM, KEEP, IERR)
296.EQ. IF ( IERR -1 ) THEN
297 BLOCKING =.FALSE.
298 SET_IRECV =.TRUE.
299 MESSAGE_RECEIVED = .FALSE.
300 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV,
301 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
302 & MPI_ANY_SOURCE, MPI_ANY_TAG, STATUS,
303 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
304 & IWPOS, IWPOSCB, IPTRLU,
305 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC,
306 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
307 & IFLAG, IERROR, COMM, PERM,
308 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
309 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
310 & FILS, DAD, PTRARW, PTRAIW,
311 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP,
312 & ND, FRERE, LPTRAR, NELT,
313 & FRTPTR, FRTELT,
314 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
315 & .TRUE., LRGROUPS
316 & )
317.LT. IF ( IFLAG 0 ) GOTO 500
318 IOLDPS = PTLUST_S(STEP(INODE))
319 LIST_ROW_SON = IOLDPS + H_INODE + NPIV
320 LIST_COL_SON = IOLDPS + H_INODE + NFRONT + NPIV
321 LIST_SLAVES = IOLDPS + 6 + KEEP(IXSZ)
322 ENDIF
323 ENDDO
324.EQ. IF ( IERR -2 ) THEN
325 IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 )
326 IFLAG = - 17
327 GOTO 600
328.EQ. ELSE IF ( IERR -3 ) THEN
329 IERROR = ( 3 + NSLAVES + 2 * NELIM ) * KEEP( 34 )
330 IFLAG = -20
331 GOTO 600
332 ENDIF
333 ENDIF
334.EQ. IF (NELIM0) THEN
335 POSELT = PTRAST(STEP(INODE))
336 OPSFAC = POSELT + int(NPIV,8) * int(NFRONT,8) + int(NPIV,8)
337 GOTO 190
338 ELSE
339 GOTO 500
340 ENDIF
341 ENDIF
342 OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8)
343 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)),
344.NE. & KEEP(199)) MYID ) THEN
345 MSGTAG =NOEUD
346 MSGDEST=MUMPS_PROCNODE( PROCNODE_STEPS(STEP(FPERE)), KEEP(199) )
347 IERR = -1
348 NBROWS_ALREADY_SENT = 0
349.EQ. DO WHILE (IERR-1)
350.EQ..AND..EQ. IF ( (TYPE1) (TYPEF1) ) THEN
351 CALL DMUMPS_BUF_SEND_CB( NBROWS_ALREADY_SENT,
352 & INODE, FPERE, NFRONT,
353 & LCONT, NASS, NPIV, IW( IOLDPS + H_INODE + NPIV ),
354 & IW( IOLDPS + H_INODE + NPIV + NFRONT ),
355 & A( OPSFAC ), PACKED_CB,
356 & MSGDEST, MSGTAG, COMM, KEEP, IERR )
357 ELSE
358.EQ. IF ( TYPE2 ) THEN
359 INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) )
360 ELSE
361 INIV2 = -9999
362 ENDIF
363 CALL DMUMPS_BUF_SEND_MAITRE2( NBROWS_ALREADY_SENT,
364 & FPERE, INODE,
365 & NBROW_SEND, IW(IOLDPS + H_INODE + NPIV ),
366 & NBCOL, IW(IOLDPS + H_INODE + NPIV + NFRONT ),
367 & A(OPSFAC), LDA, NELIM, TYPE,
368 & NSLAVES, IW(IOLDPS+6+KEEP(IXSZ)), MSGDEST,
369 & COMM, IERR,
370 &
371 & SLAVEF, KEEP,KEEP8, INIV2, TAB_POS_IN_PERE )
372 END IF
373.EQ. IF ( IERR -1 ) THEN
374 BLOCKING = .FALSE.
375 SET_IRECV = .TRUE.
376 MESSAGE_RECEIVED = .FALSE.
377 CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV,
378 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
379 & MPI_ANY_SOURCE, MPI_ANY_TAG,
380 & STATUS,
381 & BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
382 & IWPOS, IWPOSCB, IPTRLU,
383 & LRLU, LRLUS, N, IW, LIW, A, LA,
384 & PTRIST, PTLUST_S, PTRFAC,
385 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
386 & IFLAG, IERROR, COMM,
387 & PERM, IPOOL, LPOOL, LEAF,
388 & NBFIN, MYID, SLAVEF,
389 &
390 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
391 & FILS, DAD, PTRARW, PTRAIW,
392 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
393 & LPTRAR, NELT, FRTPTR, FRTELT,
394 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
395 & , LRGROUPS )
396.LT. IF ( IFLAG 0 ) GOTO 500
397 ENDIF
398 IOLDPS = PTLUST_S(STEP( INODE ))
399 OPSFAC = POSELT + int(NPIV,8) * int(LDA,8) + int(NPIV,8)
400 END DO
401.EQ..OR..EQ. IF ( IERR -2 IERR -3 ) THEN
402.EQ..AND..EQ. IF ( (TYPE1) (TYPEF1) ) THEN
403 IERROR = ( 2*LCONT + 9 ) * KEEP( 34 ) +
404 & LCONT*LCONT * KEEP( 35 )
405.ne..AND..eq. ELSE IF (KEEP(50)0 TYPE 2 ) THEN
406 IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES)
407 & * KEEP( 34 ) +
408 & NBROW_SEND*NBROW_SEND*KEEP( 35 )
409 ELSE
410 IERROR = ( NBROW_SEND + NBCOL+ 5 + NSLAVES) * KEEP( 34 ) +
411 & NBROW_SEND*NBCOL*KEEP( 35 )
412 ENDIF
413.EQ. IF (IERR -2) THEN
414 IFLAG = -17
415 IF ( LP > 0 ) THEN
416 WRITE(LP, *) MYID,
417 & ": failure, send buffer too small during
418 & dmumps_fac_stack", TYPE, TYPEF
419 ENDIF
420 ENDIF
421.EQ. IF (IERR -3) THEN
422 IFLAG = -20
423 IF ( LP > 0 ) THEN
424 WRITE(LP, *) MYID,
425 & ": failure, recv buffer too small during
426 & dmumps_fac_stack", TYPE, TYPEF
427 ENDIF
428 ENDIF
429 GOTO 600
430 ENDIF
431 ENDIF
432 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)),
433.EQ. & KEEP(199)) MYID ) THEN
434 NBROW_SEND = 0
435 LREQI = 2 + KEEP(IXSZ)
436 NBROW_STACK = NBROW
437 NBROW_INDICES = NBROW
438.NE..AND..EQ. IF ((KEEP(50)0)(TYPE2)) THEN
439 NBCOL_STACK = NELIM
440 ELSE
441 NBCOL_STACK = NBCOL
442 ENDIF
443 IF (COMPRESS_CB) THEN
444 NBROW_STACK=NELIM
445.NE. IF (KEEP(50)0) NBCOL_STACK = NELIM
446 ENDIF
447 ELSE
448 NBROW_STACK = NBROW-NBROW_SEND
449 NBROW_INDICES = NBROW-NBROW_SEND
450 NBCOL_STACK = NBCOL
451 IF (COMPRESS_CB) THEN
452 NBROW_STACK = 0
453 NBCOL_STACK = 0
454 ENDIF
455 LREQI = 6 + NBROW_INDICES + NBCOL + KEEP(IXSZ)
456.NOT..EQ..AND..EQ. IF ( (TYPE1 TYPEF2 ) ) GOTO 190
457.EQ. IF (FPERE0) GOTO 190
458 ENDIF
459 IF (PACKED_CB) THEN
460.EQ..OR..EQ. IF (NBROW_STACK0NBCOL_STACK0) THEN
461 LREQCB = 0
462 ELSE
463 LREQCB = ( int(NBCOL_STACK,8) * int( NBCOL_STACK + 1, 8) ) / 2_8
464 & - ( int(NBROW_SEND ,8) * int( NBROW_SEND + 1, 8) ) / 2_8
465 ENDIF
466 ELSE
467 LREQCB = int(NBROW_STACK,8) * int(NBCOL_STACK,8)
468 ENDIF
469.NE. INPLACE = ( KEEP(234)0 )
470.NE..AND..EQ. IF (KEEP(50)0 TYPE 2) INPLACE = .FALSE.
471.OR..NOT. INPLACE = INPLACE MUST_COMPACT_FACTORS
472.AND. INPLACE = INPLACE
473.EQ. & ( PTLUST_S(STEP(INODE)) + INTSIZ IWPOS )
474 MIN_SPACE_IN_PLACE = 0_8
475.AND..eq..AND. IF ( INPLACE KEEP(50) 0
476 & MUST_COMPACT_FACTORS) THEN
477 MIN_SPACE_IN_PLACE = int(NBCOL_STACK,8)
478 ENDIF
479.GT. IF ( MIN_SPACE_IN_PLACE LREQCB ) THEN
480 INPLACE = .FALSE.
481 ENDIF
482 CALL DMUMPS_ALLOC_CB( INPLACE, MIN_SPACE_IN_PLACE,
483 & SSARBR, .FALSE.,
484 & MYID,N,KEEP,KEEP8,DKEEP,IW, LIW, A, LA,
485 & LRLU, IPTRLU,IWPOS,IWPOSCB, SLAVEF, PROCNODE_STEPS, DAD,
486 & PTRIST,PTRAST,STEP, PIMASTER,PAMASTER,
487 & LREQI, LREQCB, INODE, S_NOTFREE, .TRUE.,
488 & COMP, LRLUS, LRLUSM, IFLAG, IERROR )
489.LT. IF (IFLAG0) GOTO 600
490 IW(IWPOSCB+1+XXF) = IW(IOLDPS+XXF)
491 IW(IWPOSCB+1+XXLR) = IW(IOLDPS+XXLR)
492 PTRIST(STEP(INODE)) = IWPOSCB+1
493 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)),
494.EQ. & KEEP(199)) MYID ) THEN
495 PIMASTER (STEP(INODE)) = PTLUST_S(STEP(INODE))
496 PAMASTER(STEP(INODE)) = IPTRLU + 1_8
497 PTRAST(STEP(INODE)) = -99999999_8
498 IW(IWPOSCB+1+KEEP(IXSZ)) = min(-NBCOL_STACK,-1)
499 IW(IWPOSCB+2+KEEP(IXSZ)) = NBROW_STACK
500 IF (PACKED_CB) IW(IWPOSCB+1+XXS) = S_CB1COMP
501 ELSE
502 PTRAST(STEP(INODE)) = IPTRLU+1_8
503 IF (PACKED_CB) IW(IWPOSCB+1+XXS)=S_CB1COMP
504 IW(IWPOSCB+1+KEEP(IXSZ)) = NBCOL
505 IW(IWPOSCB+2+KEEP(IXSZ)) = 0
506 IW(IWPOSCB+3+KEEP(IXSZ)) = NBROW_STACK
507 IW(IWPOSCB+4+KEEP(IXSZ)) = 0
508 IW(IWPOSCB+5+KEEP(IXSZ)) = 1
509 IW(IWPOSCB+6+KEEP(IXSZ)) = 0
510 IOLDP1 = PTLUST_S(STEP(INODE))+H_INODE
511 PTROWEND = IWPOSCB+6+NBROW_STACK+KEEP(IXSZ)
512 DO I = 1, NBROW_STACK
513 IW(IWPOSCB+7+KEEP(IXSZ)+I-1) =
514 & IW(IOLDP1+NFRONT-NBROW_STACK+I-1)
515 ENDDO
516 DO I = 1, NBCOL
517 IW(PTROWEND+I)=IW(IOLDP1+NFRONT+NPIV+I-1)
518 ENDDO
519 END IF
520.NE..AND..EQ. IF ( KEEP(50)0 TYPE 1
521.AND. & MUST_COMPACT_FACTORS ) THEN
522 POSELT = PTRFAC(STEP(INODE))
523 CALL DMUMPS_COMPACT_FACTORS( A(POSELT), LDA,
524 & NPIV, NBROW, KEEP,
525 & int(LDA,8)*int(NBROW+NPIV,8),
526 & IW( PTLUST_S(STEP(INODE)) + H_INODE + NFRONT ) )
527 MUST_COMPACT_FACTORS = .FALSE.
528 ENDIF
529.AND..EQ. IF (COMPRESS_CB(LREQCB0)) GOTO 190
530.EQ..AND. IF ( KEEP(50)0 MUST_COMPACT_FACTORS )
531 & THEN
532 LAST_ALLOWED_POS = POSELT + int(LDA,8)*int(NPIV+NBROW-1,8)
533 & + int(NPIV,8)
534 ELSE
535 LAST_ALLOWED_POS = -1_8
536 ENDIF
537 NCBROW_ALREADY_MOVED = 0
538 COUNT_EXTRA_IP_COPIES = 0_8
539 10 CONTINUE
540 NCBROW_PREVIOUSLY_MOVED = NCBROW_ALREADY_MOVED
541.LT. IF (IPTRLU POSFAC ) THEN
542 CALL DMUMPS_COPY_CB_RIGHT_TO_LEFT( A, LA, LDA,
543 & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK,
544 & NBROW_SEND, LREQCB, KEEP, PACKED_CB,
545 & LAST_ALLOWED_POS, NCBROW_ALREADY_MOVED )
546 ELSE
547 CALL DMUMPS_COPY_CB_LEFT_TO_RIGHT( A, LA, LDA,
548 & POSELT, IPTRLU, NPIV, NBCOL_STACK, NBROW_STACK,
549 & NBROW_SEND, LREQCB, KEEP, PACKED_CB )
550 NCBROW_ALREADY_MOVED = NBROW_STACK
551 ENDIF
552.NE. IF (LAST_ALLOWED_POS -1_8) THEN
553 MUST_COMPACT_FACTORS =.FALSE.
554.EQ. IF ( NCBROW_ALREADY_MOVED NBROW_STACK ) THEN
555 IF (COMPRESS_CB) THEN
556 NCBROW_ALREADY_MOVED = NBROW
557 ELSE
558 NCBROW_ALREADY_MOVED = NCBROW_ALREADY_MOVED + NBROW_SEND
559 ENDIF
560 ENDIF
561 NCBROW_NEWLY_MOVED = NCBROW_ALREADY_MOVED
562 & - NCBROW_PREVIOUSLY_MOVED
563 FACTOR_POS = POSELT +
564 & int(LDA,8)*int(NPIV+NBROW-NCBROW_ALREADY_MOVED,8)
565 CALL DMUMPS_COMPACT_FACTORS_UNSYM( A(FACTOR_POS), LDA, NPIV,
566 & NCBROW_NEWLY_MOVED,
567 & int(NCBROW_NEWLY_MOVED,8) * int(LDA,8) )
568 INEW = FACTOR_POS + int(NPIV,8) * int(NCBROW_NEWLY_MOVED,8)
569 IOLD = INEW + int(NCBROW_NEWLY_MOVED,8) * int(NBCOL_STACK,8)
570 DO I = 1, NCBROW_PREVIOUSLY_MOVED*NPIV
571 A(INEW) = A(IOLD)
572 IOLD = IOLD + 1_8
573 INEW = INEW + 1_8
574 ENDDO
575 COUNT_EXTRA_IP_COPIES = COUNT_EXTRA_IP_COPIES +
576 & int(NCBROW_PREVIOUSLY_MOVED,8)
577 & * int(NPIV,8)
578 LAST_ALLOWED_POS = INEW
579.LT. IF (NCBROW_ALREADY_MOVEDNBROW_STACK) THEN
580 GOTO 10
581 ENDIF
582 ENDIF
583.GT. IF ( COUNT_EXTRA_IP_COPIES 0_8 ) THEN
584!$OMP ATOMIC UPDATE
585 KEEP8(8) = KEEP8(8) + COUNT_EXTRA_IP_COPIES
586!$OMP END ATOMIC
587 COUNT_EXTRA_IP_COPIES = 0_8
588 ENDIF
589 190 CONTINUE
590 IF (MUST_COMPACT_FACTORS) THEN
591 POSELT = PTRFAC(STEP(INODE))
592 CALL DMUMPS_COMPACT_FACTORS( A(POSELT), LDA,
593 & NPIV, NBROW, KEEP,
594 & int(LDA,8)*int(NBROW+NPIV,8),
595 & IW( PTLUST_S(STEP(INODE)) + H_INODE + NFRONT ) )
596 MUST_COMPACT_FACTORS = .FALSE.
597 ENDIF
598 IOLDPS = PTLUST_S(STEP(INODE))
599 IW(IOLDPS+KEEP(IXSZ)) = NBCOL
600 IW(IOLDPS + 1+KEEP(IXSZ)) = NASS - NPIV
601.EQ. IF (TYPE2) THEN
602 IW(IOLDPS + 2+KEEP(IXSZ)) = NASS
603 ELSE
604 IW(IOLDPS + 2+KEEP(IXSZ)) = NFRONT
605 ENDIF
606 IW(IOLDPS + 3+KEEP(IXSZ)) = NPIV
607 IF (INPLACE) THEN
608 SIZE_INPLACE = LREQCB - MIN_SPACE_IN_PLACE
609 ELSE
610 SIZE_INPLACE = 0_8
611 ENDIF
612 CALL DMUMPS_COMPRESS_LU(SIZE_INPLACE,MYID,N,IOLDPS,TYPE, IW, LIW,
613 & A, LA, POSFAC, LRLU, LRLUS,
614 & IWPOS, PTRAST, PTRFAC, STEP, KEEP,KEEP8, SSARBR,INODE,IERR
615 & , LRGROUPS, NASS
616 & )
617.LT. IF(IERR0)THEN
618 IFLAG=IERR
619 IERROR=0
620 GOTO 600
621 ENDIF
622 500 CONTINUE
623 RETURN
624 600 CONTINUE
625.NE..AND..EQ. IF (IFLAG -1 KEEP(405) 0) THEN
626 CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
627 ENDIF
628 RETURN
629 END SUBROUTINE DMUMPS_FAC_STACK
dmumps_fac_stack
subroutine dmumps_fac_stack(comm_load, ass_irecv, n, inode, type, typef, la, iw, liw, a, iflag, ierror, opeliw, nelvaw, nmaxnpiv, ptrist, ptlust_s, ptrfac, ptrast, step, pimaster, pamaster, ne, posfac, lrlu, lrlus, lrlusm, iptrlu, icntl, keep, keep8, dkeep, comp, iwpos, iwposcb, procnode_steps, slavef, fpere, comm, myid, ipool, lpool, leaf, nstk_s, perm, bufr, lbufr, lbufr_bytes, nbfin, root, opassw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups, flop_estim_acc)
Definition dfac_mem_stack.F:32
max
#define max(a, b)
Definition macros.h:21
dmumps_buf
Definition dmumps_comm_buffer.F:14
dmumps_load
Definition dmumps_load.F:14
dmumps_load::myid
integer, save, private myid
Definition dmumps_load.F:57
dmumps_struc_def
Definition dmumps_struc_def.F:14
mumps_in_or_root_ssarbr
logical function mumps_in_or_root_ssarbr(procinfo_inode, k199)
Definition tools_common.F:214
mumps_rootssarbr
logical function mumps_rootssarbr(procinfo_inode, k199)
Definition tools_common.F:189