OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cfac_front_LDLT_type2.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 MODULE cmumps_fac2_ldlt_m
15 CONTAINS
16 SUBROUTINE cmumps_fac2_ldlt( COMM_LOAD, ASS_IRECV,
17 & N, INODE, FPERE, IW, LIW, A, LA,
18 & UU, NNEGW, NPVW, NB22T2W, NBTINYW,
19 & DET_EXPW, DET_MANTW, DET_SIGNW,
20 & COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF,
21 & IFLAG, IERROR, IPOOL,LPOOL,
22 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
23 & LRLUS, COMP,
24 & PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP,
25 & PIMASTER, PAMASTER,
26 & NSTK_S,PERM,PROCNODE_STEPS, root,
27 & OPASSW, OPELIW, ITLOC, RHS_MUMPS,
28 & FILS, DAD, PTRARW, PTRAIW,
29 & INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
30 & LPTRAR, NELT, FRTPTR, FRTELT, SEUIL,
31 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, AVOID_DELAYED,
32 & DKEEP,PIVNUL_LIST,LPN_LIST
33 & , LRGROUPS
34 & )
35 USE cmumps_fac_front_aux_m
36 USE cmumps_fac_front_type2_aux_m
37 USE cmumps_ooc
38 USE cmumps_fac_lr
39 USE cmumps_lr_type
40 USE cmumps_lr_stats
41 USE cmumps_ana_lr, ONLY : get_cut
42 USE cmumps_lr_data_m
43!$ USE OMP_LIB
44 USE cmumps_struc_def, ONLY : cmumps_root_struc
45 USE cmumps_buf, ONLY : cmumps_buf_test
46 IMPLICIT NONE
47 INTEGER COMM_LOAD, ASS_IRECV
48 INTEGER N, INODE, FPERE, LIW
49 INTEGER, intent(inout) :: NNEGW, NPVW, NB22T2W, NBTINYW
50 INTEGER, intent(inout) :: DET_EXPW, DET_SIGNW
51 COMPLEX, intent(inout) :: DET_MANTW
52 INTEGER(8) :: LA
53 INTEGER, TARGET :: IW( LIW )
54 COMPLEX A( LA )
55 REAL UU, SEUIL
56 TYPE (CMUMPS_ROOT_STRUC) :: root
57 INTEGER COMM, MYID, LBUFR, LBUFR_BYTES
58 INTEGER LPTRAR, NELT
59 INTEGER ICNTL(60), KEEP(500)
60 INTEGER(8) KEEP8(150)
61 INTEGER NBFIN, SLAVEF,
62 & iflag, ierror, leaf, lpool
63 INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS
64 INTEGER IWPOS, IWPOSCB, COMP
65 INTEGER NB_BLOC_FAC
66 INTEGER FRTPTR( N + 1 ), FRTELT( NELT )
67 INTEGER BUFR( LBUFR ), IPOOL(LPOOL),
68 & itloc(n+keep(253)), fils(n), dad( keep(28) ),
69 & nd( keep(28) ), frere( keep(28) )
70 INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
71 COMPLEX :: RHS_MUMPS(KEEP(255))
72 INTEGER(8) :: PTRAST(KEEP(28))
73 INTEGER(8) :: PTRFAC(KEEP(28))
74 INTEGER(8) :: PAMASTER(KEEP(28))
75 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),
76 & step(n), pimaster(keep(28)),
77 & nstk_s(keep(28)), perm(n),
78 & procnode_steps(keep(28))
79 INTEGER ISTEP_TO_INIV2(KEEP(71)),
80 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
81 DOUBLE PRECISION OPASSW, OPELIW
82 COMPLEX DBLARR(KEEP8(26))
83 INTEGER INTARR(KEEP8(27))
84 LOGICAL AVOID_DELAYED
85 INTEGER LPN_LIST
86 INTEGER PIVNUL_LIST(LPN_LIST)
87 REAL DKEEP(230)
88 INTEGER :: LRGROUPS(N)
89 INTEGER(8) :: POSELT
90 INTEGER IOLDPS, allocok, K263,J
91 INTEGER INOPV, IFINB, NFRONT, NPIV, IEND_BLOCK
92 INTEGER NASS, LDAFS, IBEG_BLOCK
93 INTEGER :: NB_POSTPONED
94 INTEGER :: IBEG_BLOCK_FOR_IPIV
95 LOGICAL LASTBL, LR_ACTIVATED, COMPRESS_PANEL
96 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR,
97 & ooc_effective_on_front,
98 & ooc_eff_and_write_bypanel
99 INTEGER NBLR_ORIG, IBEG_BLR, IEND_BLR, CURRENT_BLR
100 INTEGER Inextpiv
101 LOGICAL RESET_TO_ONE
102 INTEGER K109_SAVE
103 INTEGER XSIZE, NBKJIB_ORIG
104 REAL UUTEMP
105 include 'mumps_headers.h'
106 INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV
107 REAL , ALLOCATABLE, DIMENSION ( : ) :: DIAG_ORIG
108 INTEGER :: SIZEDIAG_ORIG
109 INTEGER(8) :: LAFAC
110 INTEGER LIWFAC, STRAT, TYPEFile, NextPiv2beWritten,
111 & idummy, nelim
112 TYPE(io_block) :: MonBloc
113 LOGICAL LAST_CALL
114 INTEGER PP_FIRST2SWAP_L, IFLAG_OOC
115 INTEGER PP_LastPIVRPTRFilled
116 INTEGER INFO_TMP(2)
117 INTEGER :: MAXI_RANK
118 INTEGER HF, NPARTSASS, NPARTSCB, NB_BLR
119 INTEGER MAXI_CLUSTER, LWORK
120 TYPE(lrb_type), DIMENSION(1), TARGET :: BLR_DUMMY
121 INTEGER, POINTER, DIMENSION(:) :: PTDummy
122 TYPE(lrb_type), POINTER, DIMENSION(:) :: ACC_LUA
123 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
124 TYPE(lrb_type), POINTER, DIMENSION(:) :: BLR_L, BLR_SEND
125 COMPLEX, POINTER, DIMENSION(:) :: DIAG
126 TYPE(lrb_type), POINTER, DIMENSION(:) :: BLR_PANEL
127 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_TMP, BEGS_BLR_STATIC
128 INTEGER :: DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, I, IP, MEM, MEM_TOT
129 INTEGER(8) :: POSELT_DIAG, APOSMAX
130 COMPLEX, ALLOCATABLE :: WORK(:), TAU(:)
131 INTEGER, ALLOCATABLE :: JPVT(:)
132 REAL, ALLOCATABLE :: RWORK(:)
133 COMPLEX, ALLOCATABLE :: BLOCK(:,:)
134 INTEGER :: OMP_NUM
135 INTEGER :: MY_NUM
136 INTEGER PIVOT_OPTION
137 INTEGER LAST_ROW
138 EXTERNAL cmumps_bdc_error
139 LOGICAL STATICMODE
140 REAL SEUIL_LOC
141 REAL GW_FACTCUMUL
142 INTEGER PIVSIZ,IWPOSPIV
143 COMPLEX ONE
144 parameter(one=(1.0e0,0.0e0))
145 NULLIFY(ptdummy)
146 NULLIFY(acc_lua)
147 NULLIFY(begs_blr)
148 NULLIFY(blr_l)
149 NULLIFY(blr_send)
150 NULLIFY(diag)
151 NULLIFY(blr_panel)
152 NULLIFY(begs_blr_tmp)
153 NULLIFY(begs_blr_static)
154 IF (keep(206).GE.1) THEN
155 inextpiv = 1
156 ELSE
157 inextpiv = 0
158 ENDIF
159 inopv = 0
160 IF(keep(97) .EQ. 0) THEN
161 staticmode = .false.
162 ELSE
163 staticmode = .true.
164 ENDIF
165 IF (avoid_delayed) THEN
166 staticmode = .true.
167 uutemp=uu
168 seuil_loc = max(seuil,epsilon(seuil))
169 ELSE
170 seuil_loc=seuil
171 uutemp=uu
172 ENDIF
173 reset_to_one = ((keep(110).GT.0).AND.(dkeep(2).LE.0.0e0))
174 IF (reset_to_one) THEN
175 k109_save = keep(109)
176 ENDIF
177 ibeg_block = 1
178 nb_bloc_fac = 0
179 xsize = keep(ixsz)
180 ioldps = ptlust_s(step( inode ))
181 poselt = ptrast(step( inode ))
182 nfront = iw(ioldps+xsize)
183 nass = iabs(iw(ioldps+2+xsize))
184 ldafs = nass
185 IF ((keep(219).EQ.1).AND.(keep(207).EQ.1).AND.(keep(50).EQ.2)
186 & ) THEN
187 aposmax = poselt + int(ldafs,8)*int(ldafs,8)
188 nb_postponed = max(nfront - nd(step(inode)),0)
189 CALL cmumps_update_parpiv_entries ( inode,
190 & keep, a(aposmax), nass, nb_postponed)
191 ENDIF
192 iw(ioldps+3+xsize) = -99999
193 lr_activated= .false.
194 lr_activated = (iw(ioldps+xxlr).GT.0)
195 compress_panel = (iw(ioldps+xxlr).GE.2)
196 oocwrite_compatible_with_blr =
197 & ( .NOT.lr_activated.OR. (.NOT.compress_panel).OR.
198 & (keep(486).NE.2)
199 & )
200 ooc_effective_on_front= ((keep(201).EQ.1).AND.
201 & oocwrite_compatible_with_blr)
202 IF (nass.LT.keep(4)) THEN
203 nbkjib_orig = nass
204 ELSE IF (nass .GT. keep(3)) THEN
205 nbkjib_orig = min( keep(6), nass )
206 ELSE
207 nbkjib_orig = min( keep(5), nass )
208 ENDIF
209 IF (.not.lr_activated) THEN
210 nblr_orig = keep(420)
211 ELSE
212 nblr_orig = -9999
213 ENDIF
214 IF (lr_activated) THEN
215 k263 = 1
216 ELSE
217 k263 = keep(263)
218 IF (k263 .NE. 0 .AND. nass/nblr_orig < 4) THEN
219 IF ( nblr_orig .GT. nbkjib_orig * 4 ) THEN
220 nblr_orig = max(nbkjib_orig, (nass+3)/4)
221 ELSE
222 k263 = 0
223 ENDIF
224 ENDIF
225 ENDIF
226 pivot_option = min(2,keep(468))
227 IF ((uutemp == 0.0e0) .AND. ooc_effective_on_front) THEN
228 IF (k263.EQ.1.AND.(.NOT.lr_activated)) THEN
229 pivot_option = 0
230 ENDIF
231 ENDIF
232 iend_block = 0
233 iend_blr = 0
234 current_blr = 0
235 ALLOCATE( ipiv( nass ), stat = allocok )
236 IF ( allocok .GT. 0 ) THEN
237 WRITE(*,*) myid, ' : CMUMPS_FAC2_LDLT failed to allocate ',
238 & nass, ' integers'
239 IFLAG = -13
240 IERROR=NASS
241 GO TO 500
242 END IF
243.GE. IF (KEEP(219)3) THEN
244 SIZEDIAG_ORIG = NASS
245 ELSE
246 SIZEDIAG_ORIG = 1
247 ENDIF
248 ALLOCATE ( DIAG_ORIG(SIZEDIAG_ORIG), stat = allocok )
249.GT. IF ( allocok 0 ) THEN
250 WRITE(*,*) MYID,
251 & ' : fac_niv2 failed to allocate ',
252 & NASS, ' real/COMPLEX entries'
253 IFLAG=-13
254 IERROR=NASS
255 GO TO 500
256 END IF
257 CALL MUMPS_GETI8(LAFAC,IW(IOLDPS+XXR))
258 LIWFAC = IW(IOLDPS+XXI)
259 IF (OOC_EFFECTIVE_ON_FRONT) THEN
260 IDUMMY = -9876
261 TYPEFile = TYPEF_L
262 NextPiv2beWritten = 1
263 PP_FIRST2SWAP_L = NextPiv2beWritten
264 MonBloc%LastPanelWritten_L = 0
265 MonBloc%INODE = INODE
266 MonBloc%MASTER = .TRUE.
267 MonBloc%Typenode = 2
268 MonBloc%NROW = NASS
269 MonBloc%NCOL = NASS
270 MonBloc%NFS = NASS
271 MonBloc%Last = .FALSE.
272 MonBloc%LastPiv = -66666
273 MonBloc%INDICES =>
274 & IW(IOLDPS+6+NFRONT+XSIZE+IW(IOLDPS+5+XSIZE)
275 & :IOLDPS+5+2*NFRONT+XSIZE+IW(IOLDPS+5+XSIZE))
276 ENDIF
277 IF (LR_ACTIVATED) THEN
278.EQ. IF (KEEP(475)3) THEN
279 IF (UUTEMP == 0.0E0) THEN
280 PIVOT_OPTION = 0
281 ELSE
282 PIVOT_OPTION = 1
283 ENDIF
284 ENDIF
285 CNT_NODES = CNT_NODES + 1
286 ENDIF
287 HF = 6 + IW(IOLDPS+5+XSIZE)+XSIZE
288.GE..AND. OOC_EFF_AND_WRITE_BYPANEL = ( (PIVOT_OPTION2)
289 & OOC_EFFECTIVE_ON_FRONT )
290 IF (LR_ACTIVATED) THEN
291 CALL GET_CUT(IW(IOLDPS+HF:IOLDPS+HF+NFRONT-1), NASS,
292 & 0, LRGROUPS, NPARTSCB,
293 & NPARTSASS, BEGS_BLR)
294 CALL REGROUPING2(BEGS_BLR, NPARTSASS, NASS, NPARTSCB,
295 & 0, KEEP(488), .FALSE., KEEP(472))
296 NB_BLR = NPARTSASS + NPARTSCB
297 call MAX_CLUSTER(BEGS_BLR,NB_BLR,MAXI_CLUSTER)
298 MAXI_RANK = KEEP(479)*MAXI_CLUSTER
299 LWORK = MAXI_CLUSTER*MAXI_CLUSTER
300 OMP_NUM = 1
301#if defined(BLR_MT)
302!$ OMP_NUM = OMP_GET_MAX_THREADS()
303#endif
304 ALLOCATE(BLOCK(MAXI_CLUSTER, OMP_NUM*MAXI_CLUSTER),
305 & RWORK(2*MAXI_CLUSTER*OMP_NUM),
306 & TAU(MAXI_CLUSTER*OMP_NUM),
307 & JPVT(MAXI_CLUSTER*OMP_NUM),
308 & WORK(LWORK*OMP_NUM),stat=allocok)
309 IF (allocok > 0) THEN
310 IFLAG = -13
311 IERROR = OMP_NUM*(LWORK + MAXI_CLUSTER*(MAXI_CLUSTER+4))
312 GOTO 480
313 ENDIF
314 ALLOCATE(ACC_LUA(OMP_NUM),stat=allocok)
315 IF (allocok > 0) THEN
316 IFLAG = -13
317 IERROR = OMP_NUM
318 GOTO 480
319 ENDIF
320.GE. IF (KEEP(480)3) THEN
321 DO MY_NUM=1,OMP_NUM
322 CALL ALLOC_LRB(ACC_LUA(MY_NUM), MAXI_RANK,
323 & MAXI_CLUSTER, MAXI_CLUSTER, .TRUE.,
324 & IFLAG, IERROR, KEEP8)
325.LT. IF (IFLAG0) GOTO 480
326 ACC_LUA(MY_NUM)%K = 0
327 ENDDO
328 ENDIF
329 ENDIF
330.AND..NE. IF (LR_ACTIVATED(KEEP(480)0
331.OR. &
332 & (
333.EQ. & (KEEP(486)2)
334 & )
335 & )) THEN
336 INFO_TMP(1) = IFLAG
337 INFO_TMP(2) = IERROR
338 CALL CMUMPS_BLR_INIT_FRONT(IW(IOLDPS+XXF), INFO_TMP)
339 IFLAG = INFO_TMP(1)
340 IERROR = INFO_TMP(2)
341.LT. IF (IFLAG0) GOTO 500
342 CALL CMUMPS_BLR_SAVE_INIT(IW(IOLDPS+XXF),
343 & .TRUE.,
344 & .TRUE.,
345 & .FALSE.,
346 & NPARTSASS,
347 & BEGS_BLR, PTDummy,
348 & huge(NPARTSASS),
349 & INFO_TMP)
350 IFLAG = INFO_TMP(1)
351 IERROR = INFO_TMP(2)
352.LT. IF (IFLAG0) GOTO 500
353 ENDIF
354 LASTBL = .FALSE.
355 DO WHILE (IEND_BLR < NASS )
356 CURRENT_BLR = CURRENT_BLR + 1
357 IBEG_BLR = IW(IOLDPS+1+KEEP(IXSZ)) + 1
358.NOT. IF ( LR_ACTIVATED)THEN
359 IEND_BLR = min(IEND_BLR + NBLR_ORIG, NASS)
360 ELSE
361 IEND_BLR = BEGS_BLR(CURRENT_BLR+1)-1
362 BEGS_BLR( CURRENT_BLR ) = IBEG_BLR
363.GT. IF ( IEND_BLR - IBEG_BLR + 1 MAXI_CLUSTER ) THEN
364 MAXI_CLUSTER = IEND_BLR - IBEG_BLR + 1
365 LWORK = MAXI_CLUSTER*MAXI_CLUSTER
366 DEALLOCATE(BLOCK, WORK, RWORK, TAU, JPVT)
367 ALLOCATE(BLOCK(MAXI_CLUSTER, OMP_NUM*MAXI_CLUSTER),
368 & RWORK(2*MAXI_CLUSTER*OMP_NUM),
369 & TAU(MAXI_CLUSTER*OMP_NUM),
370 & JPVT(MAXI_CLUSTER*OMP_NUM),
371 & WORK(LWORK*OMP_NUM),stat=allocok)
372 IF (allocok > 0) THEN
373 IFLAG = -13
374 IERROR = OMP_NUM*(LWORK + MAXI_CLUSTER*(MAXI_CLUSTER+4))
375 GOTO 480
376 ENDIF
377.GE. IF (KEEP(480)3) THEN
378 DO MY_NUM=1,OMP_NUM
379 CALL DEALLOC_LRB(ACC_LUA(MY_NUM), KEEP8, KEEP(34))
380 CALL ALLOC_LRB(ACC_LUA(MY_NUM), MAXI_RANK,
381 & MAXI_CLUSTER, MAXI_CLUSTER, .TRUE.,
382 & IFLAG, IERROR, KEEP8)
383.LT. IF (IFLAG0) GOTO 480
384 ACC_LUA(MY_NUM)%K = 0
385 ENDDO
386 ENDIF
387 ENDIF
388 ENDIF
389 DO WHILE (IEND_BLOCK < IEND_BLR )
390 IBEG_BLOCK = IW(IOLDPS+1+KEEP(IXSZ)) + 1
391.EQ. IF (KEEP(405)0) THEN
392 KEEP(425)=max(KEEP(425),IEND_BLOCK-IBEG_BLOCK)
393 ELSE
394!$OMP ATOMIC UPDATE
395 KEEP(425)=max(KEEP(425),IEND_BLOCK-IBEG_BLOCK)
396!$OMP END ATOMIC
397 ENDIF
398 IEND_BLOCK = min(IEND_BLOCK + NBKJIB_ORIG, IEND_BLR)
399 50 CONTINUE
400.EQ. IF (K2630) THEN
401 IBEG_BLOCK_FOR_IPIV = IBEG_BLOCK
402 ELSE
403 IBEG_BLOCK_FOR_IPIV = IBEG_BLR
404 ENDIF
405 CALL CMUMPS_FAC_I_LDLT_NIV2(
406 & DIAG_ORIG, SIZEDIAG_ORIG, GW_FACTCUMUL,
407 & NFRONT,NASS,IBEG_BLOCK_FOR_IPIV,
408 & IBEG_BLOCK, IEND_BLOCK,
409 & NASS, IPIV,
410 & N,INODE,IW,LIW,A,LA,
411 & NNEGW,NB22T2W,NBTINYW,
412 & DET_EXPW, DET_MANTW, DET_SIGNW,
413 & INOPV,
414 & IFLAG,IOLDPS,POSELT,UU, SEUIL_LOC,
415 & KEEP,KEEP8,PIVSIZ,
416 & DKEEP(1),PIVNUL_LIST(1),LPN_LIST,
417 & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L,
418 & PP_LastPIVRPTRFilled,
419 & PIVOT_OPTION,
420 & Inextpiv, IEND_BLR, LR_ACTIVATED,
421 & OOC_EFFECTIVE_ON_FRONT)
422.LT. IF (IFLAG0) GOTO 500
423.EQ. IF (INOPV 1) THEN
424 IF (STATICMODE) THEN
425 INOPV = -1
426 GOTO 50
427 ENDIF
428 LASTBL = .TRUE.
429.LE. ELSE IF (INOPV 0) THEN
430 INOPV = 0
431 NPVW = NPVW + PIVSIZ
432 CALL CMUMPS_FAC_MQ_LDLT_NIV2(IEND_BLOCK,
433 & NASS, IW(IOLDPS+1+XSIZE), INODE,A,LA,
434 & LDAFS, POSELT,IFINB,
435 & PIVSIZ,
436 & KEEP(219),
437 & PIVOT_OPTION, IEND_BLR, LR_ACTIVATED)
438.EQ. IF(PIVSIZ 2) THEN
439 IWPOSPIV = IOLDPS+XSIZE+IW(IOLDPS+1+XSIZE)+6+
440 & IW(IOLDPS+5+XSIZE)
441 IW(IWPOSPIV+NFRONT) = -IW(IWPOSPIV+NFRONT)
442 ENDIF
443 IW(IOLDPS+1+XSIZE) = IW(IOLDPS+1+XSIZE) + PIVSIZ
444.EQ. IF (IFINB0) THEN
445 GOTO 50
446.EQ. ELSE IF (IFINB -1) THEN
447 LASTBL = .TRUE.
448 ENDIF
449 ENDIF
450 NPIV = IW(IOLDPS+1+XSIZE)
451 IF ( OOC_EFF_AND_WRITE_BYPANEL ) THEN
452.NOT..OR..EQ. IF (RESET_TO_ONEK109_SAVEKEEP(109)) THEN
453 MonBloc%Last = .FALSE.
454 MonBloc%LastPiv= NPIV
455 LAST_CALL=.FALSE.
456 CALL CMUMPS_OOC_IO_LU_PANEL(
457 & STRAT_TRY_WRITE,
458 & TYPEFile, A(POSELT),
459 & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS),
460 & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
461.LT. IF (IFLAG_OOC 0 ) IFLAG = IFLAG_OOC
462.LT. IF (IFLAG 0) GOTO 500
463 ENDIF
464 ENDIF
465.eq. IF (K2630) THEN
466 NELIM = IEND_BLR - NPIV
467 CALL CMUMPS_SEND_FACTORED_BLK( COMM_LOAD, ASS_IRECV,
468 & N, INODE, FPERE, IW, LIW,
469 & IOLDPS, POSELT, A, LA, LDAFS,
470 & IBEG_BLOCK, NPIV, IPIV, NASS,LASTBL, NB_BLOC_FAC,
471 & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF,
472 & IFLAG, IERROR, IPOOL,LPOOL,
473 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
474 & LRLUS, COMP, PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP,
475 & PIMASTER, PAMASTER,
476 & NSTK_S,PERM,PROCNODE_STEPS, root,
477 & OPASSW, OPELIW, ITLOC, RHS_MUMPS,
478 & FILS, DAD, PTRARW, PTRAIW,
479 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,
480 & LPTRAR, NELT, FRTPTR, FRTELT,
481 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
482 & , NELIM, .FALSE.
483 & , NPARTSASS, CURRENT_BLR, BLR_DUMMY, LRGROUPS
484 & )
485.LT. IF ( IFLAG 0 ) GOTO 500
486.AND..LT. IF (RESET_TO_ONEK109_SAVEKEEP(109)) THEN
487 CALL CMUMPS_RESET_TO_ONE(
488 & IW(IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6),
489 & NPIV, IBEG_BLOCK,
490 & K109_SAVE, KEEP(109), PIVNUL_LIST, LPN_LIST,
491 & A, POSELT, LA, LDAFS)
492 ENDIF
493 IF ( OOC_EFF_AND_WRITE_BYPANEL) THEN
494 MonBloc%Last = .FALSE.
495 MonBloc%LastPiv= NPIV
496 LAST_CALL=.FALSE.
497 CALL CMUMPS_OOC_IO_LU_PANEL(
498 & STRAT_TRY_WRITE,
499 & TYPEFile, A(POSELT),
500 & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS),
501 & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
502.LT. IF (IFLAG_OOC 0 ) THEN
503 IFLAG = IFLAG_OOC
504.LT. IF (IFLAG 0) GOTO 500
505 ENDIF
506 ENDIF
507 ENDIF
508.GT. IF ( IEND_BLR IEND_BLOCK ) THEN
509.EQ. IF (PIVOT_OPTION2) THEN
510 LAST_ROW = NASS
511 ELSE
512 LAST_ROW = IEND_BLR
513 ENDIF
514 CALL CMUMPS_FAC_SQ_LDLT(IBEG_BLOCK,IEND_BLOCK,NPIV,
515 & NASS,NASS,INODE,A,LA,
516 & LDAFS, POSELT,
517 & KEEP,KEEP8,
518 & -6666, -6666,
519 & IEND_BLR, LAST_ROW,
520 & .FALSE., .TRUE., LR_ACTIVATED,
521 & IW, LIW, -6666
522 & )
523 ENDIF
524 CALL CMUMPS_BUF_TEST()
525 END DO
526 NPIV = IW(IOLDPS+1+XSIZE)
527 IF (LR_ACTIVATED) THEN
528 ALLOCATE(BLR_L(NB_BLR-CURRENT_BLR),stat=allocok)
529 IF (allocok > 0) THEN
530 IFLAG = -13
531 IERROR = NB_BLR-CURRENT_BLR
532 GOTO 500
533 ENDIF
534 NELIM = IEND_BLOCK - NPIV
535.NE. IF (IEND_BLRIEND_BLOCK) THEN
536 WRITE(*,*) "Internal error 1 in CMUMPS_FAC2_LDLT",
537 & IEND_BLR, IEND_BLOCK
538 CALL MUMPS_ABORT()
539 ENDIF
540.EQ. IF (NELIM IEND_BLR - IBEG_BLR + 1) THEN
541.GE. IF (KEEP(480)2
542.OR. &
543 & (
544.EQ. & (KEEP(486)2)
545 & )
546 & ) THEN
547 DO J=1,NB_BLR-CURRENT_BLR
548 BLR_L(J)%M=0
549 BLR_L(J)%N=0
550 BLR_L(J)%K=0
551 BLR_L(J)%ISLR=.FALSE.
552 NULLIFY(BLR_L(J)%Q)
553 NULLIFY(BLR_L(J)%R)
554 ENDDO
555 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
556 & IW(IOLDPS+XXF),
557 & 0,
558 & CURRENT_BLR, BLR_L)
559 NULLIFY(BLR_L)
560 ENDIF
561 GOTO 101
562 ENDIF
563#if defined(BLR_MT)
564!$OMP PARALLEL
565#endif
566 CALL CMUMPS_COMPRESS_PANEL(A, LA, POSELT, IFLAG, IERROR, NASS,
567 & BEGS_BLR, NB_BLR, DKEEP(8), KEEP(466), KEEP(473),
568 & BLR_L,
569 & CURRENT_BLR, 'V', WORK, TAU, JPVT, LWORK, RWORK,
570 & BLOCK, MAXI_CLUSTER, NELIM,
571 & .FALSE., 0, 0,
572 & 2, KEEP(483), KEEP8
573 & )
574#if defined(BLR_MT)
575!$OMP BARRIER
576#endif
577.LT. IF (IFLAG0) GOTO 400
578.LT. IF (PIVOT_OPTION2) THEN
579 CALL CMUMPS_BLR_PANEL_LRTRSM(A, LA, POSELT, NFRONT,
580 & IBEG_BLR,
581 & NB_BLR, BLR_L, CURRENT_BLR, CURRENT_BLR+1,
582 & NB_BLR, 2, 1, 0, .FALSE.,
583 & IW, OFFSET_IW=IOLDPS+6+XSIZE+NFRONT+IBEG_BLR-1,
584 & NASS=NASS)
585#if defined(BLR_MT)
586!$OMP BARRIER
587#endif
588 ENDIF
589 400 CONTINUE
590#if defined(BLR_MT)
591!$OMP END PARALLEL
592#endif
593.LT. IF (IFLAG0) GOTO 480
594.NE. IF (KEEP(480)0
595.OR. &
596 & (
597.EQ. & (KEEP(486)2)
598 & )
599 & ) THEN
600.LT. IF (KEEP(480)5) THEN
601 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
602 & IW(IOLDPS+XXF),
603 & 0,
604 & CURRENT_BLR, BLR_L)
605 ENDIF
606 ENDIF
607 ENDIF
608 101 CONTINUE
609.NOT. IF ( LR_ACTIVATED) THEN
610 CALL CMUMPS_FAC_SQ_LDLT(IBEG_BLR,IEND_BLR,NPIV,
611 & NASS, NASS, INODE, A, LA,
612 & LDAFS, POSELT,
613 & KEEP, KEEP8,
614 & IEND_BLR, NASS,
615 & -6666, -6666,
616.LE. & (PIVOT_OPTION1), .FALSE., LR_ACTIVATED,
617 & IW, LIW, IOLDPS+6+XSIZE+NFRONT+IBEG_BLR-1)
618 ENDIF
619.NE. IF (K2630) THEN
620 NELIM = IEND_BLR-NPIV
621 BLR_SEND=>BLR_DUMMY
622 IF (associated(BLR_L)) THEN
623 BLR_SEND=>BLR_L
624 ENDIF
625 CALL CMUMPS_SEND_FACTORED_BLK( COMM_LOAD, ASS_IRECV,
626 & N, INODE, FPERE, IW, LIW,
627 & IOLDPS, POSELT, A, LA, LDAFS,
628 & IBEG_BLR, NPIV, IPIV, NASS,LASTBL, NB_BLOC_FAC,
629 &
630 & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF,
631 & IFLAG, IERROR, IPOOL,LPOOL,
632 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
633 & LRLUS, COMP, PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP,
634 & PIMASTER, PAMASTER,
635 & NSTK_S,PERM,PROCNODE_STEPS, root,
636 & OPASSW, OPELIW, ITLOC, RHS_MUMPS,
637 & FILS, DAD, PTRARW, PTRAIW,
638 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,
639 & LPTRAR, NELT, FRTPTR, FRTELT,
640 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
641 & , NELIM, LR_ACTIVATED
642 & , NPARTSASS, CURRENT_BLR , BLR_SEND , LRGROUPS
643 & )
644.LT. IF ( IFLAG 0 ) GOTO 500
645.AND..LT. IF (RESET_TO_ONEK109_SAVEKEEP(109)) THEN
646 CALL CMUMPS_RESET_TO_ONE(
647 & IW(IOLDPS+KEEP(IXSZ)+IW(IOLDPS+5+KEEP(IXSZ))+6),
648 & NPIV, IBEG_BLR,
649 & K109_SAVE, KEEP(109), PIVNUL_LIST, LPN_LIST,
650 & A, POSELT, LA, LDAFS)
651 ENDIF
652 IF ( OOC_EFF_AND_WRITE_BYPANEL ) THEN
653 MonBloc%Last = .FALSE.
654 MonBloc%LastPiv= NPIV
655 LAST_CALL=.FALSE.
656 CALL CMUMPS_OOC_IO_LU_PANEL(
657 & STRAT_TRY_WRITE,
658 & TYPEFile, A(POSELT),
659 & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS),
660 & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
661.LT. IF (IFLAG_OOC 0 ) THEN
662 IFLAG = IFLAG_OOC
663.LT. IF (IFLAG 0) GOTO 500
664 ENDIF
665 ENDIF
666 ENDIF
667.NOT. IF ( LR_ACTIVATED) THEN
668.EQ. IF (PIVOT_OPTION2) THEN
669 LAST_ROW = NASS
670 ELSE
671 LAST_ROW = IEND_BLR
672 ENDIF
673 CALL CMUMPS_FAC_SQ_LDLT(IBEG_BLR,IEND_BLR,NPIV,
674 & NASS,NASS,INODE,A,LA,
675 & LDAFS, POSELT,
676 & KEEP,KEEP8,
677 & -6666, -6666,
678 & NASS, LAST_ROW,
679 & .FALSE., .TRUE., LR_ACTIVATED,
680 & IW, LIW, -6666
681 & )
682 ELSE
683 NELIM = IEND_BLOCK - NPIV
684.NE. IF (IEND_BLRIEND_BLOCK) THEN
685 CALL MUMPS_ABORT()
686 ENDIF
687#if defined(BLR_MT)
688!$OMP PARALLEL
689#endif
690.GE. IF (KEEP(480)2) THEN
691.LT. IF (IEND_BLRNASS) THEN
692 CALL CMUMPS_BLR_UPD_PANEL_LEFT_LDLT(A, LA, POSELT,
693 & NASS, IW(IOLDPS+XXF),
694 & BEGS_BLR, CURRENT_BLR, NB_BLR, NPARTSASS,
695 & NELIM,
696 & IW(HF+IOLDPS+NFRONT), BLOCK,
697 & ACC_LUA, MAXI_CLUSTER, MAXI_RANK,
698 & 2, IFLAG, IERROR,
699 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
700 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
701 & KEEP(483), KEEP8)
702 ENDIF
703 ENDIF
704.EQ. IF (NELIM IEND_BLR - IBEG_BLR + 1) GOTO 450
705.LT. IF (KEEP(480)2) THEN
706 CALL CMUMPS_BLR_UPDATE_TRAILING_LDLT(A, LA, POSELT,
707 & IFLAG, IERROR, NASS,
708 & BEGS_BLR, NB_BLR, CURRENT_BLR, BLR_L, NELIM,
709 & IW(HF+IOLDPS+NFRONT+IBEG_BLR-1), BLOCK,
710 & MAXI_CLUSTER, NPIV,
711 & 2,
712 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477)
713 & )
714 ENDIF
715#if defined(BLR_MT)
716!$OMP BARRIER
717#endif
718.LT. IF (IFLAG0) GOTO 450
719.LT. IF (PIVOT_OPTION2) THEN
720.GT..OR..NE. IF ((UU0)(KEEP(486)2)) THEN
721 CALL CMUMPS_DECOMPRESS_PANEL(A, LA, POSELT, NASS, NASS,
722 & .TRUE.,
723 & BEGS_BLR(CURRENT_BLR),
724 & BEGS_BLR(CURRENT_BLR+1), NB_BLR, BLR_L, CURRENT_BLR,
725 & 'V', 1)
726 ENDIF
727 ENDIF
728 450 CONTINUE
729#if defined(BLR_MT)
730!$OMP END PARALLEL
731#endif
732.LT. IF (IFLAG0) GOTO 480
733.EQ. IF (NELIM IEND_BLR - IBEG_BLR + 1) THEN
734.EQ. IF (KEEP(486)3) THEN
735.EQ. IF (KEEP(480)0) THEN
736 DEALLOCATE(BLR_L)
737 NULLIFY(BLR_L)
738 ENDIF
739 ENDIF
740 GOTO 100
741 ENDIF
742.EQ. IF (KEEP(486)3) THEN
743.EQ. IF (KEEP(480)0) THEN
744 CALL DEALLOC_BLR_PANEL(BLR_L, NB_BLR-CURRENT_BLR, KEEP8,
745 & KEEP(34))
746 DEALLOCATE(BLR_L)
747 ENDIF
748 NULLIFY(BLR_L)
749 ENDIF
750 ENDIF
751 IF ( OOC_EFF_AND_WRITE_BYPANEL ) THEN
752 MonBloc%Last = .FALSE.
753 MonBloc%LastPiv= NPIV
754 LAST_CALL=.FALSE.
755 CALL CMUMPS_OOC_IO_LU_PANEL(
756 & STRAT_TRY_WRITE,
757 & TYPEFile, A(POSELT),
758 & LAFAC, MonBloc, NextPiv2beWritten, IDUMMY, IW(IOLDPS),
759 & LIWFAC, MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
760 IF (IFLAG_OOC < 0 ) THEN
761 IFLAG = IFLAG_OOC
762 GOTO 500
763 ENDIF
764 ENDIF
765 100 CONTINUE
766 END DO
767 IF (LR_ACTIVATED) THEN
768 IBEG_BLR = IW(IOLDPS+1+KEEP(IXSZ)) + 1
769 BEGS_BLR( CURRENT_BLR + 1 ) = IBEG_BLR
770 IF
771 & (
772.EQ. & (KEEP(486)2)
773 & )
774 & THEN
775 CALL CMUMPS_BLR_RETRIEVE_BEGSBLR_STA(IW(IOLDPS+XXF),
776 & BEGS_BLR_STATIC)
777.GT. IF (UU0) THEN
778 allocate(BEGS_BLR_TMP(NB_BLR+1),stat=allocok)
779 IF (allocok > 0) THEN
780 IFLAG = -13
781 IERROR = NB_BLR+1
782 GOTO 500
783 ENDIF
784 DO J=1,NB_BLR+1
785 BEGS_BLR_TMP(J) = BEGS_BLR_STATIC(J)
786 ENDDO
787 ENDIF
788 ENDIF
789 IF (
790.EQ. & (KEEP(486)2)
791 &
792 & ) THEN
793 MEM_TOT = 0
794#if defined(BLR_MT)
795!$OMP PARALLEL
796!$OMP& PRIVATE(IP, NELIM)
797#endif
798#if defined(BLR_MT)
799!$OMP DO PRIVATE(DIAG, DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, POSELT_DIAG, MEM,
800!$OMP& allocok)
801!$OMP& REDUCTION(+:MEM_TOT)
802#endif
803 DO IP=1,NPARTSASS
804.LT. IF (IFLAG0) CYCLE
805 DIAGSIZ_DYN = BEGS_BLR(IP+1)-BEGS_BLR(IP)
806 DIAGSIZ_STA = BEGS_BLR_STATIC(IP+1)-BEGS_BLR(IP)
807 MEM = DIAGSIZ_DYN*DIAGSIZ_STA
808 MEM_TOT = MEM_TOT + MEM
809 ALLOCATE(DIAG(MEM),stat=allocok)
810 IF (allocok > 0) THEN
811 IFLAG = -13
812 IERROR = MEM
813 CYCLE
814 ENDIF
815 DPOS = 1
816 POSELT_DIAG = POSELT + int(BEGS_BLR(IP)-1,8)*int(LDAFS,8)
817 & + int(BEGS_BLR(IP)-1,8)
818 DO I=1,DIAGSIZ_STA
819 DIAG(DPOS:DPOS+DIAGSIZ_DYN-1) =
820 & A(POSELT_DIAG:POSELT_DIAG+int(DIAGSIZ_DYN-1,8))
821 DPOS = DPOS + DIAGSIZ_DYN
822 POSELT_DIAG = POSELT_DIAG + int(LDAFS,8)
823 ENDDO
824 CALL CMUMPS_BLR_SAVE_DIAG_BLOCK(
825 & IW(IOLDPS+XXF),
826 & IP, DIAG)
827 ENDDO
828#if defined(BLR_MT)
829!$OMP ENDDO
830!$OMP SINGLE
831#endif
832 CALL MUMPS_DM_FAC_UPD_DYN_MEMCNTS(int(MEM_TOT,8),
833 & .FALSE., KEEP8, IFLAG, IERROR, .TRUE., .TRUE.)
834#if defined(BLR_MT)
835!$OMP END SINGLE
836#endif
837.LT. IF (IFLAG0) GOTO 460
838.GT. IF (UU0) THEN
839 DO IP=1,NPARTSASS
840 NELIM = BEGS_BLR_TMP(IP+1)-BEGS_BLR(IP+1)
841#if defined(BLR_MT)
842!$OMP SINGLE
843#endif
844 CALL CMUMPS_BLR_RETRIEVE_PANEL_LORU(
845 & IW(IOLDPS+XXF), 0, IP, BLR_PANEL)
846 CALL DEALLOC_BLR_PANEL(BLR_PANEL, NPARTSASS-IP, KEEP8,
847 & KEEP(34))
848#if defined(BLR_MT)
849!$OMP END SINGLE
850#endif
851 CALL CMUMPS_COMPRESS_PANEL(A, LA, POSELT, IFLAG,
852 & IERROR, LDAFS, BEGS_BLR_TMP,
853 & NB_BLR, DKEEP(8), KEEP(466), KEEP(473),
854 & BLR_PANEL, IP,
855 & 'V', WORK, TAU, JPVT, LWORK, RWORK,
856 & BLOCK, MAXI_CLUSTER, NELIM,
857 & .FALSE., 0, 0,
858 & 2, KEEP(483), KEEP8,
859 & END_I_IN=NPARTSASS, FRSWAP=.TRUE.
860 & )
861#if defined(BLR_MT)
862!$OMP BARRIER
863#endif
864.LT. IF (IFLAG0) GOTO 440
865#if defined(BLR_MT)
866!$OMP SINGLE
867#endif
868 BEGS_BLR_TMP(IP+1) = BEGS_BLR(IP+1)
869#if defined(BLR_MT)
870!$OMP END SINGLE
871#endif
872 ENDDO
873#if defined(BLR_MT)
874!$OMP BARRIER
875#endif
876 440 CONTINUE
877 ENDIF
878 460 CONTINUE
879#if defined(BLR_MT)
880!$OMP END PARALLEL
881#endif
882.GT. IF (UU0) THEN
883 deallocate(BEGS_BLR_TMP)
884 ENDIF
885.LT. IF (IFLAG0) GOTO 500
886 ENDIF
887 IF (
888.EQ. & (KEEP(486)2)
889 &
890 & ) THEN
891 CALL CMUMPS_BLR_SAVE_BEGS_BLR_DYN(IW(IOLDPS+XXF),
892 & BEGS_BLR)
893 ENDIF
894 ENDIF
895 IF (OOC_EFFECTIVE_ON_FRONT) THEN
896 STRAT = STRAT_WRITE_MAX
897 MonBloc%Last = .TRUE.
898 MonBloc%LastPiv = IW(IOLDPS+1+XSIZE)
899 LAST_CALL = .TRUE.
900 CALL CMUMPS_OOC_IO_LU_PANEL
901 & ( STRAT, TYPEFile,
902 & A(POSELT), LAFAC, MonBloc,
903 & NextPiv2beWritten, IDUMMY,
904 & IW(IOLDPS), LIWFAC,
905 & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL )
906.LT. IF (IFLAG_OOC 0 ) THEN
907 IFLAG = IFLAG_OOC
908.LT. IF (IFLAG 0) GOTO 500
909 ENDIF
910 CALL CMUMPS_OOC_PP_TRYRELEASE_SPACE (IWPOS,
911 & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP)
912 ENDIF
913 GOTO 600
914 480 CONTINUE
915 500 CONTINUE
916 CALL CMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
917 600 CONTINUE
918 IF(allocated(IPIV)) DEALLOCATE( IPIV )
919 IF (allocated(DIAG_ORIG)) DEALLOCATE(DIAG_ORIG)
920 IF (LR_ACTIVATED) THEN
921.GE. IF (IFLAG0) THEN
922 CALL UPD_MRY_LU_FR(NASS, NFRONT-NASS, 1, NELIM)
923 DO IP=1,NPARTSASS
924 CALL CMUMPS_BLR_RETRIEVE_PANEL_LORU(
925 & IW(IOLDPS+XXF), 0, IP, BLR_PANEL)
926 CALL UPD_MRY_LU_LRGAIN(BLR_PANEL, NPARTSASS-IP
927 & )
928 ENDDO
929 CALL UPD_FLOP_FACTO_FR(NFRONT, NASS, NASS-NELIM, 2, 2)
930 ENDIF
931 IF (allocated(RWORK)) DEALLOCATE(RWORK)
932 IF (allocated(WORK)) DEALLOCATE(WORK)
933 IF (allocated(TAU)) DEALLOCATE(TAU)
934 IF (allocated(JPVT)) DEALLOCATE(JPVT)
935 IF (allocated(BLOCK)) DEALLOCATE(BLOCK)
936 IF (associated(ACC_LUA)) THEN
937.GE. IF (KEEP(480)3) THEN
938 DO MY_NUM=1,OMP_NUM
939 CALL DEALLOC_LRB(ACC_LUA(MY_NUM), KEEP8, KEEP(34))
940 ENDDO
941 ENDIF
942 DEALLOCATE(ACC_LUA)
943 ENDIF
944 IF (associated(BEGS_BLR)) THEN
945 DEALLOCATE(BEGS_BLR)
946 NULLIFY(BEGS_BLR)
947 ENDIF
948 ENDIF
949.NE. IF (KEEP(486)0) THEN
950.NOT. IF (LR_ACTIVATED) THEN
951 CALL UPD_FLOP_FRFRONTS(NFRONT, NPIV, NASS, KEEP(50), 2)
952 ENDIF
953 ENDIF
954.AND..NE. IF (LR_ACTIVATEDKEEP(480)0) THEN
955.NOT. IF (
956 & (
957.EQ. & (KEEP(486)2)
958 & )
959 & ) THEN
960 CALL CMUMPS_BLR_FREE_ALL_PANELS(IW(IOLDPS+XXF), 0,
961 & KEEP8, KEEP(34))
962 ENDIF
963 ENDIF
964 IF (LR_ACTIVATED) THEN
965.NOT. IF (
966 & (
967.EQ. & (KEEP(486)2)
968 & )
969 & ) THEN
970 CALL CMUMPS_BLR_END_FRONT(IW(IOLDPS+XXF), IFLAG, KEEP8,
971 & KEEP(34))
972 ENDIF
973 ENDIF
974 RETURN
975 END SUBROUTINE CMUMPS_FAC2_LDLT
976 SUBROUTINE CMUMPS_RESET_TO_ONE(FRONT_INDEX_LIST, NPIV,
977 & IBEG_BLOCK, K109_SAVE, K109, PIVNUL_LIST, LPN_LIST,
978 & A, POSELT, LA, LDAFS)
979 INTEGER, INTENT(IN) :: NPIV, IBEG_BLOCK
980 INTEGER, INTENT(IN) :: FRONT_INDEX_LIST(NPIV)
981 INTEGER, INTENT(IN) :: K109
982 INTEGER, INTENT(INOUT) :: K109_SAVE
983 INTEGER, INTENT(IN) :: LPN_LIST
984 INTEGER, INTENT(IN) :: PIVNUL_LIST(LPN_LIST)
985 INTEGER(8), INTENT(IN) :: POSELT, LA
986 INTEGER, INTENT(IN) :: LDAFS
987 COMPLEX, INTENT(INOUT) :: A(LA)
988 LOGICAL :: TO_UPDATE
989 INTEGER :: I, JJ, K
990 COMPLEX ONE
991 PARAMETER (ONE=(1.0E0,0.0E0))
992 DO K = K109_SAVE+1, K109
993 TO_UPDATE = .FALSE.
994 I = PIVNUL_LIST(K)
995 DO JJ=IBEG_BLOCK, NPIV
996.EQ. IF (FRONT_INDEX_LIST(JJ) I) THEN
997 TO_UPDATE=.TRUE.
998 EXIT
999 ENDIF
1000 ENDDO
1001 IF (TO_UPDATE) THEN
1002 A(POSELT+int(JJ,8)+int(LDAFS,8)*int(JJ-1,8))= ONE
1003 TO_UPDATE=.FALSE.
1004 ELSE
1005 write(*,*) ' Internal error related ',
1006 & 'to null pivot row detection'
1007 CALL mumps_abort()
1008 ENDIF
1009 ENDDO
1010 k109_save = k109
1011 RETURN
1012 END SUBROUTINE cmumps_reset_to_one
1013 END MODULE cmumps_fac2_ldlt_m
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
cmumps_bdc_error
subroutine cmumps_bdc_error(myid, slavef, comm, keep)
Definition cbcast_int.F:38
cmumps_update_parpiv_entries
subroutine cmumps_update_parpiv_entries(inode, keep, parpiv, lparpiv, nb_postponed)
Definition cfac_asm.F:901
min
#define min(a, b)
Definition macros.h:20
cmumps_ana_lr
Definition cana_lr.F:14
cmumps_ana_lr::get_cut
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
Definition cana_lr.F:25
cmumps_buf
Definition cmumps_comm_buffer.F:14
cmumps_buf::cmumps_buf_test
subroutine, public cmumps_buf_test()
Definition cmumps_comm_buffer.F:689
cmumps_fac2_ldlt_m
Definition cfac_front_LDLT_type2.F:14
cmumps_fac2_ldlt_m::cmumps_fac2_ldlt
subroutine cmumps_fac2_ldlt(comm_load, ass_irecv, n, inode, fpere, iw, liw, a, la, uu, nnegw, npvw, nb22t2w, nbtinyw, det_expw, det_mantw, det_signw, comm, myid, bufr, lbufr, lbufr_bytes, nbfin, leaf, iflag, ierror, ipool, lpool, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, comp, ptrist, ptrast, ptlust_s, ptrfac, step, pimaster, pamaster, nstk_s, perm, procnode_steps, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, nd, frere, lptrar, nelt, frtptr, frtelt, seuil, istep_to_iniv2, tab_pos_in_pere, avoid_delayed, dkeep, pivnul_list, lpn_list, lrgroups)
Definition cfac_front_LDLT_type2.F:35
cmumps_fac2_ldlt_m::cmumps_reset_to_one
subroutine cmumps_reset_to_one(front_index_list, npiv, ibeg_block, k109_save, k109, pivnul_list, lpn_list, a, poselt, la, ldafs)
Definition cfac_front_LDLT_type2.F:979
cmumps_fac_front_aux_m
Definition cfac_front_aux.F:14
cmumps_fac_front_type2_aux_m
Definition cfac_front_type2_aux.F:14
cmumps_fac_lr
Definition cfac_lr.F:14
cmumps_lr_data_m
Definition cmumps_lr_data_m.F:14
cmumps_lr_stats
Definition clr_stats.F:14
cmumps_lr_type
Definition clr_type.F:14
cmumps_ooc
Definition cmumps_ooc.F:14
cmumps_struc_def
Definition cmumps_struc_def.F:14
cmumps_lr_type::lrb_type
Definition clr_type.F:16