35 IMPLICIT NONE
36 TYPE (SMUMPS_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 REAL 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 REAL A(LA)
53 INTEGER, intent(in) :: LRGROUPS(N)
54 DOUBLE PRECISION OPASSW, OPELIW
55 REAL 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 REAL :: 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
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
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
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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_LOAD_UPDATE(0,.FALSE.,FLOP1,KEEP,KEEP8)
224 ELSE
225 CALL SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 & SMUMPS_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 & SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
627 ENDIF
628 RETURN
integer, save, private myid
1.15.0