OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cfac_front_LU_type1.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_fac1_lu_m
15 CONTAINS
16 SUBROUTINE cmumps_fac1_lu(
17 & N, INODE, IW, LIW, A,
18 & LA,
19 & IOLDPS, POSELT, IFLAG, IERROR, UU,
20 & NOFFW, NPVW, NBTINYW,
21 & DET_EXPW, DET_MANTW, DET_SIGNW,
22 & KEEP, KEEP8, STEP,
23 & PROCNODE_STEPS, MYID, SLAVEF, SEUIL,
24 & AVOID_DELAYED, ETATASS,
25 & DKEEP,PIVNUL_LIST,LPN_LIST,
26 & IWPOS
27 & , LRGROUPS
28 & , PERM
29 & )
30 USE cmumps_fac_front_aux_m
31 USE cmumps_ooc
32 USE cmumps_fac_lr
33 USE cmumps_lr_type
34 USE cmumps_lr_stats
35 USE cmumps_ana_lr, ONLY : get_cut
36 USE cmumps_lr_data_m
37#if defined(BLR_MT)
38#endif
39!$ USE OMP_LIB
40 IMPLICIT NONE
41 INTEGER(8) :: LA, POSELT
42 INTEGER N, INODE, LIW, IFLAG, IERROR
43 INTEGER, INTENT(INOUT) :: NOFFW, NPVW, NBTINYW
44 INTEGER, INTENT(INOUT) :: DET_EXPW, DET_SIGNW
45 COMPLEX, INTENT(INOUT) :: DET_MANTW
46 INTEGER IW( LIW )
47 COMPLEX A( LA )
48 INTEGER MYID, SLAVEF, IOLDPS
49 INTEGER KEEP( 500 )
50 INTEGER(8) KEEP8(150)
51 INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N)
52 REAL UU, SEUIL
53 LOGICAL AVOID_DELAYED
54 INTEGER ETATASS, IWPOS
55 INTEGER LPN_LIST
56 INTEGER PIVNUL_LIST(LPN_LIST)
57 REAL DKEEP(230)
58 INTEGER :: LRGROUPS(N), PERM(N)
59 INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK, IEND_BLOCK
60 INTEGER NASS, NBKJIB_ORIG, XSIZE
61 INTEGER NBLR_ORIG, IBEG_BLR, IEND_BLR
62 INTEGER Inextpiv
63 INTEGER LAST_ROW, LAST_COL, FIRST_COL
64 LOGICAL CALL_LTRSM, CALL_UTRSM
65 REAL UUTEMP
66 LOGICAL STATICMODE
67 REAL SEUIL_LOC
68 INTEGER PIVOT_OPTION
69 INTEGER LRTRSM_OPTION
70 INTEGER(8) :: LAFAC
71 INTEGER LIWFAC, STRAT, LNextPiv2beWritten,
72 & unextpiv2bewritten, iflag_ooc,
73 & pp_first2swap_l, pp_first2swap_u,
74 & pp_lastpivrptrfilled_l,
75 & pp_lastpivrptrfilled_u
76 INTEGER TYPEF_LOC
77 TYPE(io_block) :: MonBloc
78 LOGICAL LAST_CALL
79 INTEGER PARPIV_T1
80 INTEGER CURRENT_BLR
81 LOGICAL LR_ACTIVATED
82 LOGICAL COMPRESS_CB, COMPRESS_PANEL
83 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR,
84 & ooc_effective_on_front,
85 & ooc_eff_and_write_bypanel
86 INTEGER :: K473_LOC
87 INTEGER FIRST_BLOCK, LAST_BLOCK
88 INTEGER INFO_TMP(2), MAXI_RANK
89 INTEGER HF, NPARTSASS, NPARTSCB, NB_BLR
90 INTEGER MAXI_CLUSTER, LWORK, NELIM, NELIM_LOC
91 INTEGER :: IROW_L, NVSCHUR
92 INTEGER, POINTER, DIMENSION(:) :: PTDummy
93 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
94 TYPE(lrb_type), POINTER, DIMENSION(:,:) :: CB_LRB
95 TYPE(lrb_type), POINTER, DIMENSION(:) :: ACC_LUA
96 TYPE(lrb_type), POINTER, DIMENSION(:) :: BLR_U, BLR_L
97 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_TMP
98 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: BLR_PANEL
99 COMPLEX, POINTER, DIMENSION(:) :: DIAG
100 INTEGER :: DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, LorU, I, MEM, MEM_TOT
101 INTEGER(8) :: POSELT_DIAG
102 CHARACTER(len=1) :: DIR
103 COMPLEX, ALLOCATABLE :: WORK(:), TAU(:)
104 INTEGER, ALLOCATABLE :: JPVT(:)
105 REAL, ALLOCATABLE :: RWORK(:)
106 COMPLEX, ALLOCATABLE :: BLOCK(:,:)
107 INTEGER :: allocok,J
108 INTEGER :: OMP_NUM
109 INTEGER :: IP
110 INTEGER(8) :: UPOS, LPOS
111 INTEGER :: MY_NUM
112 TYPE(lrb_type), POINTER, DIMENSION(:) :: NEXT_BLR_U, NEXT_BLR_L
113 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_STATIC
114 COMPLEX :: ZERO
115 parameter(zero=(0.0e0,0.0e0))
116 include 'mumps_headers.h'
117 FIRST_BLOCK = -99999
118 LAST_BLOCK = -99999
119 IP=0
120.GE. IF (KEEP(206)1) THEN
121 Inextpiv = 1
122 ELSE
123 Inextpiv = 0
124 ENDIF
125 INOPV = 0
126 SEUIL_LOC = SEUIL
127.EQ. IF(KEEP(97) 0) THEN
128 STATICMODE = .FALSE.
129 ELSE
130 STATICMODE = .TRUE.
131 ENDIF
132 IF (AVOID_DELAYED) THEN
133 STATICMODE = .TRUE.
134 UUTEMP=UU
135 SEUIL_LOC = max(SEUIL,epsilon(SEUIL))
136 ELSE
137 UUTEMP=UU
138 ENDIF
139 PIVOT_OPTION = KEEP(468)
140 LRTRSM_OPTION = KEEP(475)
141 LAFAC = -9999_8
142 XSIZE = KEEP(IXSZ)
143 NFRONT = IW(IOLDPS+XSIZE)
144 NASS = iabs(IW(IOLDPS+2+XSIZE))
145 IW(IOLDPS+3+XSIZE) = -99999
146 LR_ACTIVATED = .FALSE.
147 COMPRESS_PANEL = .FALSE.
148 COMPRESS_CB = .FALSE.
149 NULLIFY(PTDummy)
150 NULLIFY(BEGS_BLR)
151 NULLIFY(CB_LRB)
152 NULLIFY(ACC_LUA)
153 NULLIFY(BLR_U)
154 NULLIFY(BLR_L)
155 NULLIFY(BEGS_BLR_TMP)
156 NULLIFY(BLR_PANEL)
157 NULLIFY(DIAG)
158.GE. COMPRESS_PANEL = (IW(IOLDPS+XXLR)2)
159.EQ..OR. COMPRESS_CB = ((IW(IOLDPS+XXLR)1)
160.EQ. & (IW(IOLDPS+XXLR)3))
161.GT. LR_ACTIVATED = (IW(IOLDPS+XXLR)0)
162.AND..NOT. IF (COMPRESS_CB(COMPRESS_PANEL)) THEN
163 K473_LOC = 1
164 ELSE
165 K473_LOC = KEEP(473)
166 ENDIF
167 K473_LOC = KEEP(473)
168 OOCWRITE_COMPATIBLE_WITH_BLR =
169.NOT..OR..NOT..OR. & ( LR_ACTIVATED(COMPRESS_PANEL)
170.NE. & (KEEP(486)2)
171 & )
172.EQ..AND. OOC_EFFECTIVE_ON_FRONT= ((KEEP(201)1)
173 & OOCWRITE_COMPATIBLE_WITH_BLR)
174 CALL CMUMPS_SET_PARPIVT1 ( INODE, NFRONT, NASS, KEEP,
175 & LR_ACTIVATED, PARPIV_T1)
176.EQ. IF (UUTEMPZERO) THEN
177 PIVOT_OPTION=0
178.NE. ELSE IF (PARPIV_T10) THEN
179 PIVOT_OPTION = min(PIVOT_OPTION,2)
180 ENDIF
181 IF (LR_ACTIVATED) THEN
182.EQ. IF (LRTRSM_OPTION3) THEN
183 PIVOT_OPTION = MIN(PIVOT_OPTION,1)
184.EQ. ELSEIF (LRTRSM_OPTION2) THEN
185 PIVOT_OPTION = MIN(PIVOT_OPTION, 2)
186 ENDIF
187 ENDIF
188.LE. IF (PIVOT_OPTION1) THEN
189 PARPIV_T1 = 0
190 ENDIF
191.LT. IF (NASSKEEP(4)) THEN
192 NBKJIB_ORIG = NASS
193.GT. ELSE IF (NASS KEEP(3)) THEN
194 NBKJIB_ORIG = min( KEEP(6), NASS )
195 ELSE
196 NBKJIB_ORIG = min( KEEP(5), NASS )
197 ENDIF
198.not. IF (LR_ACTIVATED) THEN
199 NBLR_ORIG = KEEP(420)
200 ELSE
201 NBLR_ORIG = -9999
202 ENDIF
203.EQ..AND. IF ((KEEP(114)1)
204.GT..AND..GT. & (KEEP(116)0) ((NFRONT-NASS-KEEP(253))0)
205 & ) THEN
206 IROW_L = IOLDPS+6+XSIZE+NASS
207 CALL CMUMPS_GET_SIZE_SCHUR_IN_FRONT (
208 & N,
209 & NFRONT-NASS-KEEP(253),
210 & KEEP(116),
211 & IW(IROW_L), PERM,
212 & NVSCHUR )
213 ELSE
214 NVSCHUR = 0
215 ENDIF
216 IEND_BLOCK = 0
217 IEND_BLR = 0
218 CURRENT_BLR = 0
219 CALL MUMPS_GETI8(LAFAC,IW(IOLDPS+XXR))
220 LIWFAC = IW(IOLDPS+XXI)
221 IF ( OOC_EFFECTIVE_ON_FRONT ) THEN
222 LNextPiv2beWritten = 1
223 UNextPiv2beWritten = 1
224 PP_FIRST2SWAP_L = LNextPiv2beWritten
225 PP_FIRST2SWAP_U = UNextPiv2beWritten
226 MonBloc%LastPanelWritten_L = 0
227 MonBloc%LastPanelWritten_U = 0
228 PP_LastPIVRPTRFilled_L = 0
229 PP_LastPIVRPTRFilled_U = 0
230 MonBloc%INODE = INODE
231 MonBloc%MASTER = .TRUE.
232 MonBloc%Typenode = 1
233 MonBloc%NROW = NFRONT
234 MonBloc%NCOL = NFRONT
235 MonBloc%NFS = NASS
236 MonBloc%Last = .FALSE.
237 MonBloc%LastPiv = -88877
238 NULLIFY(MonBloc%INDICES)
239 ENDIF
240 IF (LR_ACTIVATED) THEN
241.EQ. IF (KEEP(405) 1) THEN
242!$OMP ATOMIC UPDATE
243 CNT_NODES = CNT_NODES + 1
244!$OMP END ATOMIC
245 ELSE
246 CNT_NODES = CNT_NODES + 1
247 ENDIF
248.NE. ELSE IF (KEEP(486)0) THEN
249 ENDIF
250.GE..AND. OOC_EFF_AND_WRITE_BYPANEL = ( (PIVOT_OPTION3)
251 & OOC_EFFECTIVE_ON_FRONT )
252 HF = 6 + IW(IOLDPS+5+XSIZE)+XSIZE
253 IF (LR_ACTIVATED) THEN
254 CALL GET_CUT(IW(IOLDPS+HF:IOLDPS+HF+NFRONT-1), NASS,
255 & NFRONT-NASS, LRGROUPS, NPARTSCB,
256 & NPARTSASS, BEGS_BLR)
257 CALL REGROUPING2(BEGS_BLR, NPARTSASS, NASS, NPARTSCB,
258 & NFRONT-NASS, KEEP(488), .FALSE., KEEP(472))
259 NB_BLR = NPARTSASS + NPARTSCB
260 call MAX_CLUSTER(BEGS_BLR,NB_BLR,MAXI_CLUSTER)
261 MAXI_RANK = KEEP(479)*MAXI_CLUSTER
262 LWORK = MAXI_CLUSTER*MAXI_CLUSTER
263 OMP_NUM = 1
264#if defined(BLR_MT)
265!$ OMP_NUM = OMP_GET_MAX_THREADS()
266#endif
267 ALLOCATE(BLOCK(MAXI_CLUSTER, OMP_NUM*MAXI_CLUSTER),
268 & RWORK(2*MAXI_CLUSTER*OMP_NUM),
269 & TAU(MAXI_CLUSTER*OMP_NUM),
270 & JPVT(MAXI_CLUSTER*OMP_NUM),
271 & WORK(LWORK*OMP_NUM),
272 & stat=allocok)
273 IF (allocok > 0) THEN
274 IFLAG = -13
275 IERROR = OMP_NUM*(LWORK + MAXI_CLUSTER*(MAXI_CLUSTER+4))
276 GOTO 490
277 ENDIF
278 ALLOCATE(ACC_LUA(OMP_NUM),stat=allocok)
279 IF (allocok > 0) THEN
280 IFLAG = -13
281 IERROR = OMP_NUM
282 GOTO 490
283 ENDIF
284.GE. IF (KEEP(480)3) THEN
285 DO MY_NUM=1,OMP_NUM
286 CALL ALLOC_LRB(ACC_LUA(MY_NUM), MAXI_RANK,
287 & MAXI_CLUSTER, MAXI_CLUSTER, .TRUE.,
288 & IFLAG, IERROR, KEEP8)
289.LT. IF (IFLAG0) GOTO 490
290 ACC_LUA(MY_NUM)%K = 0
291 ENDDO
292 ENDIF
293 ENDIF
294.AND. IF (LR_ACTIVATED
295.NE. & (KEEP(480)0
296.OR. &
297 & (
298.EQ. & (KEEP(486)2)
299 & )
300.OR. & COMPRESS_CB
301 & )) THEN
302 INFO_TMP(1) = IFLAG
303 INFO_TMP(2) = IERROR
304 CALL CMUMPS_BLR_SAVE_INIT(IW(IOLDPS+XXF),
305 & .FALSE.,
306 & .FALSE.,
307 & .FALSE.,
308 & NPARTSASS,
309 & BEGS_BLR, PTDummy,
310 & huge(NPARTSASS),
311 & INFO_TMP)
312 IFLAG = INFO_TMP(1)
313 IERROR = INFO_TMP(2)
314.LT. IF (IFLAG0) GOTO 500
315 ENDIF
316.AND..GT. IF (COMPRESS_CBNPARTSCB0) THEN
317 allocate(CB_LRB(NPARTSCB,NPARTSCB),stat=allocok)
318 IF (allocok > 0) THEN
319 IFLAG = -13
320 IERROR = NPARTSCB*NPARTSCB
321 GOTO 490
322 ENDIF
323 CALL CMUMPS_BLR_SAVE_CB_LRB(IW(IOLDPS+XXF),CB_LRB)
324 ENDIF
325 DO WHILE (IEND_BLR < NASS )
326 CURRENT_BLR = CURRENT_BLR + 1
327 IBEG_BLR = IW(IOLDPS+1+KEEP(IXSZ)) + 1
328.NOT. IF ( LR_ACTIVATED) THEN
329 IEND_BLR = min(IEND_BLR + NBLR_ORIG, NASS)
330 ELSE
331 IEND_BLR = BEGS_BLR(CURRENT_BLR+1)-1
332 BEGS_BLR( CURRENT_BLR ) = IBEG_BLR
333.GT. IF ( IEND_BLR - IBEG_BLR + 1 MAXI_CLUSTER ) THEN
334 MAXI_CLUSTER = IEND_BLR - IBEG_BLR + 1
335 LWORK = MAXI_CLUSTER*MAXI_CLUSTER
336 DEALLOCATE(BLOCK, WORK, RWORK, TAU, JPVT)
337 ALLOCATE(BLOCK(MAXI_CLUSTER, OMP_NUM*MAXI_CLUSTER),
338 & RWORK(2*MAXI_CLUSTER*OMP_NUM),
339 & TAU(MAXI_CLUSTER*OMP_NUM),
340 & JPVT(MAXI_CLUSTER*OMP_NUM),
341 & WORK(LWORK*OMP_NUM),stat=allocok)
342 IF (allocok > 0) THEN
343 IFLAG = -13
344 IERROR = OMP_NUM*(LWORK + MAXI_CLUSTER*(MAXI_CLUSTER+4))
345 GOTO 490
346 ENDIF
347.GE. IF (KEEP(480)3) THEN
348 DO MY_NUM=1,OMP_NUM
349 CALL DEALLOC_LRB(ACC_LUA(MY_NUM), KEEP8, KEEP(34))
350 CALL ALLOC_LRB(ACC_LUA(MY_NUM), MAXI_RANK,
351 & MAXI_CLUSTER, MAXI_CLUSTER, .TRUE.,
352 & IFLAG, IERROR, KEEP8)
353.LT. IF (IFLAG0) GOTO 500
354 ACC_LUA(MY_NUM)%K = 0
355 ENDDO
356 ENDIF
357 ENDIF
358 ENDIF
359 IF (LR_ACTIVATED) THEN
360.GE. IF (KEEP(480)5) THEN
361.EQ. IF (CURRENT_BLR1) THEN
362 ALLOCATE(BLR_U(NB_BLR-CURRENT_BLR),stat=allocok)
363 IF (allocok > 0) THEN
364 IFLAG = -13
365 IERROR = NB_BLR-CURRENT_BLR
366 GOTO 490
367 ENDIF
368 ALLOCATE(BLR_L(NB_BLR-CURRENT_BLR),stat=allocok)
369 IF (allocok > 0) THEN
370 IFLAG = -13
371 IERROR = NB_BLR-CURRENT_BLR
372 GOTO 490
373 ENDIF
374.GT. IF (NB_BLRCURRENT_BLR) THEN
375 BLR_U(1:NB_BLR-CURRENT_BLR)%ISLR=.FALSE.
376 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
377 & IW(IOLDPS+XXF),
378 & 1,
379 & CURRENT_BLR, BLR_U)
380 BLR_L(1:NB_BLR-CURRENT_BLR)%ISLR=.FALSE.
381 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
382 & IW(IOLDPS+XXF),
383 & 0,
384 & CURRENT_BLR, BLR_L)
385 ENDIF
386 ELSE
387.GT. IF (NB_BLRCURRENT_BLR) THEN
388 CALL CMUMPS_BLR_RETRIEVE_PANEL_LORU(
389 & IW(IOLDPS+XXF),
390 & 1,
391 & CURRENT_BLR, BLR_U)
392 CALL CMUMPS_BLR_RETRIEVE_PANEL_LORU(
393 & IW(IOLDPS+XXF),
394 & 0,
395 & CURRENT_BLR, BLR_L)
396 ENDIF
397 ENDIF
398.LT. IF (CURRENT_BLRNPARTSASS) THEN
399 ALLOCATE(NEXT_BLR_U(NB_BLR-CURRENT_BLR-1),stat=allocok)
400 IF (allocok > 0) THEN
401 IFLAG = -13
402 IERROR = NB_BLR-CURRENT_BLR-1
403 GOTO 490
404 ENDIF
405 ALLOCATE(NEXT_BLR_L(NB_BLR-CURRENT_BLR-1),stat=allocok)
406 IF (allocok > 0) THEN
407 IFLAG = -13
408 IERROR = NB_BLR-CURRENT_BLR-1
409 GOTO 490
410 ENDIF
411.GT. IF (NB_BLRCURRENT_BLR+1) THEN
412 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
413 & IW(IOLDPS+XXF),
414 & 1,
415 & CURRENT_BLR+1, NEXT_BLR_U)
416 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
417 & IW(IOLDPS+XXF),
418 & 0,
419 & CURRENT_BLR+1, NEXT_BLR_L)
420 ENDIF
421 ENDIF
422 ELSE
423 ALLOCATE(BLR_U(NB_BLR-CURRENT_BLR),stat=allocok)
424 IF (allocok > 0) THEN
425 IFLAG = -13
426 IERROR = NB_BLR-CURRENT_BLR
427 GOTO 490
428 ENDIF
429 ALLOCATE(BLR_L(NB_BLR-CURRENT_BLR),stat=allocok)
430 IF (allocok > 0) THEN
431 IFLAG = -13
432 IERROR = NB_BLR-CURRENT_BLR
433 GOTO 490
434 ENDIF
435 ENDIF
436 ENDIF
437 DO WHILE (IEND_BLOCK < IEND_BLR )
438 IBEG_BLOCK = IW(IOLDPS+1+KEEP(IXSZ)) + 1
439.EQ. IF (KEEP(405)0) THEN
440 KEEP(425)=max(KEEP(425),IEND_BLOCK-IBEG_BLOCK)
441 ELSE
442!$OMP ATOMIC UPDATE
443 KEEP(425)=max(KEEP(425),IEND_BLOCK-IBEG_BLOCK)
444!$OMP END ATOMIC
445 ENDIF
446 IEND_BLOCK = min(IEND_BLOCK + NBKJIB_ORIG, IEND_BLR)
447 50 CONTINUE
448 CALL CMUMPS_FAC_I(NFRONT,NASS,NFRONT,
449 & IBEG_BLOCK,IEND_BLOCK,N,INODE,
450 & IW,LIW,A,LA,INOPV,NOFFW,NBTINYW,
451 & DET_EXPW, DET_MANTW, DET_SIGNW,
452 & IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8,
453 & DKEEP(1),PIVNUL_LIST(1),LPN_LIST,
454 & PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L,
455 & PP_LastPIVRPTRFilled_L,
456 & PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U,
457 & PP_LastPIVRPTRFilled_U,
458 & PIVOT_OPTION, LR_ACTIVATED, IEND_BLR,
459 & Inextpiv, OOC_EFFECTIVE_ON_FRONT,
460 & NVSCHUR, PARPIV_T1
461 & )
462.LT. IF (IFLAG0) GOTO 500
463.EQ. IF (INOPV1) THEN
464 IF(STATICMODE) THEN
465 INOPV = -1
466 GOTO 50
467 ENDIF
468.LE. ELSE IF ( INOPV0 ) THEN
469 INOPV = 0
470.GE. IF (PIVOT_OPTION3) THEN
471 LAST_COL = NFRONT
472.EQ. ELSEIF (PIVOT_OPTION2) THEN
473 LAST_COL = NASS
474 ELSE
475 LAST_COL = IEND_BLR
476 ENDIF
477 CALL CMUMPS_FAC_MQ(IBEG_BLOCK, IEND_BLOCK,
478 & NFRONT, NASS, IW(IOLDPS+1+XSIZE),
479 & LAST_COL, A, LA, POSELT, IFINB,
480 & LR_ACTIVATED
481 & )
482 IW(IOLDPS+1+XSIZE) = IW(IOLDPS+1+XSIZE) + 1
483.EQ. IF (IFINB0) THEN
484 GOTO 50
485 ENDIF
486 ENDIF
487 IF ( OOC_EFF_AND_WRITE_BYPANEL ) THEN
488 MonBloc%LastPiv= IW(IOLDPS+1+XSIZE)
489 STRAT = STRAT_TRY_WRITE
490 LAST_CALL = .FALSE.
491 CALL CMUMPS_OOC_IO_LU_PANEL
492 & ( STRAT, TYPEF_U,
493 & A(POSELT), LAFAC, MonBloc,
494 & LNextPiv2beWritten, UNextPiv2beWritten,
495 & IW(IOLDPS), LIWFAC,
496 & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
497 IF (IFLAG_OOC < 0 ) THEN
498 IFLAG=IFLAG_OOC
499 GOTO 500
500 ENDIF
501 ENDIF
502 NPIV = IW(IOLDPS+1+XSIZE)
503.GT. IF ( IEND_BLR IEND_BLOCK ) THEN
504.GE. IF (PIVOT_OPTION3) THEN
505 LAST_COL = NFRONT
506.EQ. ELSEIF (PIVOT_OPTION2) THEN
507 LAST_COL = NASS
508 ELSE
509 LAST_COL = IEND_BLR
510 ENDIF
511 CALL CMUMPS_FAC_SQ(IBEG_BLOCK, IEND_BLOCK,
512 & NPIV, NFRONT, IEND_BLR, LAST_COL,
513 & A, LA, POSELT,
514 & -66666,
515 & .TRUE., .FALSE., .TRUE.,
516 & .FALSE.,
517 & LR_ACTIVATED
518 & )
519 ENDIF
520 END DO
521 NPIV = IW(IOLDPS+1+XSIZE)
522.NOT. IF ( LR_ACTIVATED
523.OR..NOT. & ( COMPRESS_PANEL)
524 & ) THEN
525.EQ. IF (PIVOT_OPTION4) THEN
526 LAST_ROW = NFRONT
527 ELSE
528 LAST_ROW = NASS
529 ENDIF
530.GE. IF (PIVOT_OPTION3) THEN
531 LAST_COL = NFRONT
532 ELSE
533 LAST_COL = NASS
534 ENDIF
535.LT. IF (IEND_BLRLAST_ROW) THEN
536 CALL CMUMPS_FAC_SQ(IBEG_BLR, IEND_BLR,
537 & NPIV, NFRONT, LAST_ROW, LAST_COL,
538.LT. & A, LA, POSELT, IEND_BLR, .TRUE., (PIVOT_OPTION2),
539 & .TRUE., .FALSE.,
540 & LR_ACTIVATED)
541 ENDIF
542 ELSE
543 NELIM = IEND_BLR - NPIV
544.EQ. IF (NELIM IEND_BLR - IBEG_BLR + 1) THEN
545.GE. IF (KEEP(480)2
546.OR. &
547 & (
548.EQ. & (KEEP(486)2)
549 & )
550 & ) THEN
551 DO J=1,NB_BLR-CURRENT_BLR
552 BLR_U(J)%M=0
553 BLR_U(J)%N=0
554 BLR_U(J)%K=0
555 BLR_U(J)%ISLR=.FALSE.
556 NULLIFY(BLR_U(J)%Q)
557 NULLIFY(BLR_U(J)%R)
558 ENDDO
559 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
560 & IW(IOLDPS+XXF),
561 & 1,
562 & CURRENT_BLR, BLR_U)
563 DO J=1,NB_BLR-CURRENT_BLR
564 BLR_L(J)%M=0
565 BLR_L(J)%N=0
566 BLR_L(J)%K=0
567 BLR_L(J)%ISLR=.FALSE.
568 NULLIFY(BLR_L(J)%Q)
569 NULLIFY(BLR_L(J)%R)
570 ENDDO
571 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
572 & IW(IOLDPS+XXF),
573 & 0,
574 & CURRENT_BLR, BLR_L)
575 NULLIFY(BLR_L)
576 NULLIFY(BLR_U)
577.GE..AND..LT. IF (KEEP(480)2 IEND_BLRNASS) THEN
578.EQ. IF (LRTRSM_OPTION3) THEN
579 FIRST_BLOCK = 1
580 ELSE
581 FIRST_BLOCK = NPARTSASS-CURRENT_BLR
582 ENDIF
583#if defined(BLR_MT)
584!$OMP PARALLEL
585#endif
586 CALL CMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
587 & NFRONT, IW(IOLDPS+XXF), 0,
588 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
589 & NB_BLR, NPARTSASS, NELIM,
590 & 1, 0,
591 & .FALSE., IFLAG, IERROR, 0,
592 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
593 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
594 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
595 & KEEP(474), 0, BLR_U,
596 & KEEP8,
597 & FIRST_BLOCK=FIRST_BLOCK)
598.LT. IF (IFLAG0) GOTO 900
599 CALL CMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
600 & NFRONT, IW(IOLDPS+XXF), 1,
601 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
602 & NB_BLR, NPARTSASS, NELIM,
603 & 1, 0,
604 & .FALSE., IFLAG, IERROR, 0,
605 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
606 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
607 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
608 & KEEP(474), 0, BLR_U,
609 & KEEP8,
610 & FIRST_BLOCK=FIRST_BLOCK)
611 900 CONTINUE
612#if defined(BLR_MT)
613!$OMP END PARALLEL
614#endif
615.LT. IF (IFLAG0) GOTO 500
616 ENDIF
617 ENDIF
618.EQ. IF (KEEP(486)3) THEN
619.EQ. IF (KEEP(480)0) THEN
620 DEALLOCATE(BLR_U,BLR_L)
621 NULLIFY(BLR_L)
622 NULLIFY(BLR_U)
623 ENDIF
624 ENDIF
625 GOTO 100
626 ENDIF
627.GE. IF (PIVOT_OPTION3) THEN
628 FIRST_COL = NFRONT
629.EQ. ELSEIF (PIVOT_OPTION2) THEN
630 FIRST_COL = NASS
631 ELSE
632 FIRST_COL = IEND_BLR
633 ENDIF
634.EQ. IF (LRTRSM_OPTION3) THEN
635 LAST_COL = IEND_BLR
636.EQ. ELSEIF (LRTRSM_OPTION2) THEN
637 LAST_COL = NASS
638 ELSE
639 LAST_COL = NFRONT
640 ENDIF
641.EQ. CALL_LTRSM = (LRTRSM_OPTION0)
642.GT. CALL_UTRSM = (LAST_COL-FIRST_COL0)
643.LT..AND. IF ((IEND_BLRNFRONT)
644.OR. & (CALL_LTRSMCALL_UTRSM)) THEN
645 CALL CMUMPS_FAC_SQ(IBEG_BLR, IEND_BLR,
646 & NPIV, NFRONT, NFRONT,
647 & LAST_COL,
648 & A, LA, POSELT,
649 & FIRST_COL, CALL_LTRSM,
650 & CALL_UTRSM, .FALSE.,
651 & .FALSE.,
652 & LR_ACTIVATED)
653 ENDIF
654#if defined(BLR_MT)
655#endif
656#if defined(BLR_MT)
657!$OMP PARALLEL PRIVATE(UPOS,LPOS) FIRSTPRIVATE(FIRST_BLOCK,LAST_BLOCK)
658#endif
659 CALL CMUMPS_COMPRESS_PANEL(A, LA, POSELT, IFLAG,
660 & IERROR,
661 & NFRONT,
662 & BEGS_BLR, NB_BLR, DKEEP(8), KEEP(466), K473_LOC,
663 & BLR_U, CURRENT_BLR,
664 & 'h', WORK, TAU, JPVT, LWORK, RWORK,
665 & BLOCK, MAXI_CLUSTER, NELIM,
666 & .FALSE., 0, 0,
667 & 1, KEEP(483), KEEP8,
668 & K480=KEEP(480)
669 & )
670#if defined(BLR_MT)
671!$OMP BARRIER
672#endif
673.LT. IF (IFLAG0) GOTO 400
674 CALL CMUMPS_COMPRESS_PANEL(A, LA, POSELT, IFLAG, IERROR,
675 & NFRONT,
676 & BEGS_BLR, NB_BLR, DKEEP(8), KEEP(466), K473_LOC, BLR_L,
677 & CURRENT_BLR,
678 & 'v', WORK, TAU, JPVT, LWORK, RWORK,
679 & BLOCK, MAXI_CLUSTER, NELIM,
680 & .FALSE., 0, 0,
681 & 1, KEEP(483), KEEP8,
682 & K480=KEEP(480)
683 & )
684#if defined(BLR_MT)
685!$OMP BARRIER
686!$OMP MASTER
687#endif
688.NE. IF (KEEP(480)0
689.OR. &
690 & (
691.EQ. & (KEEP(486)2)
692 & )
693 & ) THEN
694.LT. IF (KEEP(480)5) THEN
695 CALL CMUMPS_BLR_SAVE_PANEL_LORU(
696 & IW(IOLDPS+XXF),
697 & 1,
698 & CURRENT_BLR, BLR_U)
699 CALL CMUMPS_BLR_SAVE_PANEL_LORU (
700 & IW(IOLDPS+XXF),
701 & 0,
702 & CURRENT_BLR, BLR_L)
703 ENDIF
704 ENDIF
705#if defined(BLR_MT)
706!$OMP END MASTER
707!$OMP BARRIER
708#endif
709.LT. IF (IFLAG0) GOTO 400
710.GT. IF (LRTRSM_OPTION0) THEN
711 CALL CMUMPS_BLR_PANEL_LRTRSM(A, LA, POSELT, NFRONT,
712 & IBEG_BLR,
713 & NB_BLR, BLR_L, CURRENT_BLR, CURRENT_BLR+1,
714 & NB_BLR, 1, 0, 0, .FALSE.)
715.LT..AND..GE. IF (PIVOT_OPTION3LRTRSM_OPTION2) THEN
716.LE..AND..EQ. IF (PIVOT_OPTION1LRTRSM_OPTION3) THEN
717 FIRST_BLOCK = CURRENT_BLR+1
718 ELSE
719 FIRST_BLOCK = NPARTSASS+1
720 ENDIF
721 CALL CMUMPS_BLR_PANEL_LRTRSM(A, LA, POSELT, NFRONT,
722 & IBEG_BLR, NB_BLR, BLR_U,
723 & CURRENT_BLR, FIRST_BLOCK, NB_BLR,
724 & 1, 0, 1, .FALSE.)
725#if defined(BLR_MT)
726!$OMP BARRIER
727#endif
728 CALL CMUMPS_BLR_UPD_NELIM_VAR_U(
729 & A, LA, POSELT, IFLAG, IERROR, NFRONT,
730 & BEGS_BLR, CURRENT_BLR, BLR_U, NB_BLR,
731 & FIRST_BLOCK, IBEG_BLR, NPIV, NELIM)
732 ENDIF
733 ENDIF
734#if defined(BLR_MT)
735!$OMP BARRIER
736#endif
737.LT. IF (IFLAG0) GOTO 400
738.GE. IF (KEEP(480)2) THEN
739 UPOS = POSELT+int(BEGS_BLR(CURRENT_BLR)-1,8)*int(NFRONT,8)
740 & +int(BEGS_BLR(CURRENT_BLR+1)-NELIM-1,8)
741 LPOS = POSELT+int(BEGS_BLR(CURRENT_BLR+1)-1,8)*int(NFRONT,8)
742 & +int(BEGS_BLR(CURRENT_BLR+1)-NELIM-1,8)
743 CALL CMUMPS_BLR_UPD_NELIM_VAR_L(A, LA, UPOS, A, LA,
744 & LPOS, IFLAG, IERROR, NFRONT, NFRONT,
745 & BEGS_BLR, CURRENT_BLR, BLR_L, NB_BLR,
746 & CURRENT_BLR+1, NELIM, 'n')
747.LT. IF (IFLAG0) GOTO 444
748.LT. IF (IEND_BLRNASS) THEN
749.EQ. IF (LRTRSM_OPTION3) THEN
750 FIRST_BLOCK = 1
751 ELSE
752 FIRST_BLOCK = NPARTSASS-CURRENT_BLR
753 ENDIF
754 CALL CMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
755 & NFRONT, IW(IOLDPS+XXF), 0,
756 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
757 & NB_BLR, NPARTSASS, NELIM,
758 & 1, 0,
759 & .FALSE., IFLAG, IERROR, 0,
760 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
761 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
762 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
763 & KEEP(474), 0, BLR_U,
764 & KEEP8,
765 & FIRST_BLOCK=FIRST_BLOCK)
766.LT. IF (IFLAG0) GOTO 442
767 CALL CMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
768 & NFRONT, IW(IOLDPS+XXF), 1,
769 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
770 & NB_BLR, NPARTSASS, NELIM,
771 & 1, 0,
772 & .FALSE., IFLAG, IERROR, 0,
773 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
774 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
775 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
776 & KEEP(474), 0, BLR_U,
777 & KEEP8,
778 & FIRST_BLOCK=FIRST_BLOCK)
779 442 CONTINUE
780 ENDIF
781 444 CONTINUE
782 ELSE
783 CALL CMUMPS_BLR_UPDATE_TRAILING(A, LA, POSELT,
784 & IFLAG, IERROR, NFRONT,
785 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, BLR_L, NB_BLR,
786 & BLR_U, NB_BLR,
787 & NELIM,.FALSE., 0,
788 & 1, 0,
789 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477)
790 & )
791 ENDIF
792#if defined(BLR_MT)
793!$OMP BARRIER
794#endif
795.LT. IF (IFLAG0) GOTO 400
796.NE. IF (KEEP(486)2) THEN
797 LAST_BLOCK = NB_BLR
798.GT. ELSEIF(UU0) THEN
799 LAST_BLOCK = NPARTSASS
800 ELSE
801 LAST_BLOCK = CURRENT_BLR
802 ENDIF
803.GT. IF (LRTRSM_OPTION0) THEN
804 FIRST_BLOCK = CURRENT_BLR+1
805 CALL CMUMPS_DECOMPRESS_PANEL(A, LA, POSELT, NFRONT,
806 & NFRONT, .TRUE.,
807 & BEGS_BLR(CURRENT_BLR),
808 & BEGS_BLR(CURRENT_BLR+1),
809 & NB_BLR, BLR_L, CURRENT_BLR, 'v', 1,
810 & BEG_I_IN=FIRST_BLOCK, END_I_IN=LAST_BLOCK)
811#if defined(BLR_MT)
812#endif
813 ENDIF
814.GE. IF (LRTRSM_OPTION2) THEN
815.EQ. IF (LRTRSM_OPTION2) THEN
816 FIRST_BLOCK = NPARTSASS+1
817 ELSE
818 FIRST_BLOCK = CURRENT_BLR+1
819 ENDIF
820 CALL CMUMPS_DECOMPRESS_PANEL(A, LA, POSELT, NFRONT,
821 & NFRONT, .TRUE.,
822 & BEGS_BLR(CURRENT_BLR),
823 & BEGS_BLR(CURRENT_BLR+1),
824 & NB_BLR, BLR_U, CURRENT_BLR, 'h', 1,
825 & BEG_I_IN=FIRST_BLOCK, END_I_IN=LAST_BLOCK)
826 ENDIF
827 400 CONTINUE
828#if defined(BLR_MT)
829!$OMP END PARALLEL
830#endif
831.LT. IF (IFLAG0) GOTO 500
832.EQ. IF (KEEP(486)3) THEN
833.EQ. IF (KEEP(480)0) THEN
834 CALL DEALLOC_BLR_PANEL(BLR_U, NB_BLR-CURRENT_BLR, KEEP8,
835 & KEEP(34))
836 CALL DEALLOC_BLR_PANEL(BLR_L, NB_BLR-CURRENT_BLR, KEEP8,
837 & KEEP(34))
838 DEALLOCATE(BLR_U,BLR_L)
839 ENDIF
840 ENDIF
841 NULLIFY(BLR_L)
842 NULLIFY(BLR_U)
843 ENDIF
844 IF ( OOC_EFF_AND_WRITE_BYPANEL ) THEN
845.LT. IF (PIVOT_OPTION4) THEN
846 TYPEF_LOC = TYPEF_U
847 ELSE
848 TYPEF_LOC = TYPEF_BOTH_LU
849 ENDIF
850 MonBloc%LastPiv= IW(IOLDPS+1+XSIZE)
851 STRAT = STRAT_TRY_WRITE
852 LAST_CALL = .FALSE.
853 CALL CMUMPS_OOC_IO_LU_PANEL
854 & ( STRAT, TYPEF_LOC,
855 & A(POSELT), LAFAC, MonBloc,
856 & LNextPiv2beWritten, UNextPiv2beWritten,
857 & IW(IOLDPS), LIWFAC,
858 & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
859 IF (IFLAG_OOC < 0 ) THEN
860 IFLAG=IFLAG_OOC
861 GOTO 500
862 ENDIF
863 ENDIF
864 100 CONTINUE
865 END DO
866 IF (LR_ACTIVATED) THEN
867 IBEG_BLR = IW(IOLDPS+1+KEEP(IXSZ)) + 1
868 BEGS_BLR( CURRENT_BLR + 1 ) = IBEG_BLR
869 IF (
870.EQ. & (KEEP(486)2)
871 & ) THEN
872 CALL CMUMPS_BLR_RETRIEVE_BEGSBLR_STA(IW(IOLDPS+XXF),
873 & BEGS_BLR_STATIC)
874.GT. IF (UU0) THEN
875 allocate(BEGS_BLR_TMP(NB_BLR+1),stat=allocok)
876 IF (allocok > 0) THEN
877 IFLAG = -13
878 IERROR = NB_BLR+1
879 GOTO 500
880 ENDIF
881 DO IP=1,NB_BLR+1
882 BEGS_BLR_TMP(IP) = BEGS_BLR_STATIC(IP)
883 ENDDO
884 ENDIF
885 ENDIF
886 MEM_TOT = 0
887#if defined(BLR_MT)
888!$OMP PARALLEL
889!$OMP& PRIVATE(IP, LorU, DIR, NELIM_LOC, BLR_PANEL)
890#endif
891 IF (
892.EQ. & (KEEP(486)2)
893 & ) THEN
894#if defined(BLR_MT)
895!$OMP DO PRIVATE(DIAG, DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, POSELT_DIAG, MEM,
896!$OMP& allocok)
897!$OMP& REDUCTION(+:MEM_TOT)
898#endif
899 DO IP=1,NPARTSASS
900.LT. IF (IFLAG0) CYCLE
901 DIAGSIZ_DYN = BEGS_BLR(IP+1)-BEGS_BLR(IP)
902 DIAGSIZ_STA = BEGS_BLR_STATIC(IP+1)-BEGS_BLR(IP)
903 MEM = DIAGSIZ_DYN*(2*DIAGSIZ_STA-DIAGSIZ_DYN)
904 MEM_TOT = MEM_TOT + MEM
905 ALLOCATE(DIAG(MEM), stat=allocok)
906 IF (allocok > 0) THEN
907 IFLAG = -13
908 IERROR = MEM
909 CYCLE
910 ENDIF
911 DPOS = 1
912 POSELT_DIAG = POSELT + int(BEGS_BLR(IP)-1,8)*int(NFRONT,8)
913 & + int(BEGS_BLR(IP)-1,8)
914 DO I=1,DIAGSIZ_STA
915.LE. IF (IDIAGSIZ_DYN) THEN
916 DIAG(DPOS:DPOS+DIAGSIZ_STA-1) =
917 & A(POSELT_DIAG:POSELT_DIAG+int(DIAGSIZ_STA-1,8))
918 DPOS = DPOS + DIAGSIZ_STA
919 ELSE
920 DIAG(DPOS:DPOS+DIAGSIZ_DYN-1) =
921 & A(POSELT_DIAG:POSELT_DIAG+int(DIAGSIZ_DYN-1,8))
922 DPOS = DPOS + DIAGSIZ_DYN
923 ENDIF
924 POSELT_DIAG = POSELT_DIAG + int(NFRONT,8)
925 ENDDO
926 CALL CMUMPS_BLR_SAVE_DIAG_BLOCK(
927 & IW(IOLDPS+XXF),
928 & IP, DIAG)
929 ENDDO
930#if defined(BLR_MT)
931!$OMP ENDDO
932!$OMP SINGLE
933#endif
934 CALL MUMPS_DM_FAC_UPD_DYN_MEMCNTS(int(MEM_TOT,8),
935.NE. & (KEEP(405)0), KEEP8, IFLAG, IERROR, .TRUE., .TRUE.)
936#if defined(BLR_MT)
937!$OMP END SINGLE
938#endif
939.LT. IF (IFLAG0) GOTO 447
940.GT. IF (UU0) THEN
941 DO IP=1,NPARTSASS
942 NELIM_LOC = BEGS_BLR_TMP(IP+1)-BEGS_BLR(IP+1)
943 DO LorU=0,1
944 CALL CMUMPS_BLR_RETRIEVE_PANEL_LORU(
945 & IW(IOLDPS+XXF), LorU, IP, BLR_PANEL)
946#if defined(BLR_MT)
947!$OMP SINGLE
948#endif
949 CALL DEALLOC_BLR_PANEL(BLR_PANEL, NPARTSASS-IP, KEEP8,
950 & KEEP(34))
951#if defined(BLR_MT)
952!$OMP END SINGLE
953#endif
954.EQ. IF (LorU0) THEN
955 DIR = 'v'
956 ELSE
957 DIR = 'h'
958 ENDIF
959 CALL cmumps_compress_panel(a, la, poselt, iflag,
960 & ierror, nfront, begs_blr_tmp,
961 & nb_blr, dkeep(8), keep(466), k473_loc,
962 & blr_panel, ip,
963 & dir, work, tau, jpvt, lwork, rwork,
964 & block, maxi_cluster, nelim_loc,
965 & .false., 0, 0,
966 & 1, keep(483), keep8,
967 & end_i_in=npartsass, frswap=.true.
968 & )
969#if defined(BLR_MT)
970!$OMP BARRIER
971#endif
972 IF (iflag.LT.0) GOTO 445
973 ENDDO
974#if defined(BLR_MT)
975!$OMP BARRIER
976!$OMP SINGLE
977#endif
978 begs_blr_tmp(ip+1) = begs_blr(ip+1)
979#if defined(BLR_MT)
980!$OMP END SINGLE
981#endif
982 ENDDO
983#if defined(BLR_MT)
984!$OMP BARRIER
985#endif
986 445 CONTINUE
987 ENDIF
988 447 CONTINUE
989 ENDIF
990 IF (iflag .LT. 0) GOTO 450
991 IF (keep(480) .GE. 2) THEN
992#if defined(BLR_MT)
993!$OMP SINGLE
994#endif
995 CALL cmumps_blr_retrieve_begsblr_sta(iw(ioldps+xxf),
996 & begs_blr_static)
997#if defined(BLR_MT)
998!$OMP END SINGLE
999#endif
1000 CALL cmumps_blr_upd_cb_left(a, la, poselt, nfront,
1001 & begs_blr_static, begs_blr_static,
1002 & npartscb, npartscb, npartsass, nass,
1003 & iw(ioldps+xxf),
1004 & 1, .false., iflag, ierror,
1005 & keep(481), dkeep(11), keep(466), keep(477),
1006 & acc_lua, keep(480),keep(479),keep(478),keep(476),
1007 & keep(484), maxi_cluster, maxi_rank,
1008 & keep(474), 0, blr_u,
1009 & .false.,
1010 & cb_lrb, keep8)
1011#if defined(BLR_MT)
1012!$OMP BARRIER
1013#endif
1014 ENDIF
1015 IF (iflag.LT.0) GOTO 450
1016#if defined(BLR_MT)
1017!$OMP MASTER
1018#endif
1019 IF (compress_cb
1020 & .OR.
1021 & (
1022 & (keep(486).EQ.2)
1023 & )
1024 & ) THEN
1025 CALL cmumps_blr_save_begs_blr_dyn(iw(ioldps+xxf),
1026 & begs_blr)
1027 ENDIF
1028 IF (compress_cb) THEN
1029 iend_blr = begs_blr(current_blr+2)
1030 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster ) THEN
1031 maxi_cluster = iend_blr - ibeg_blr + 1
1032 lwork = maxi_cluster*maxi_cluster
1033 DEALLOCATE(block, work, rwork, tau, jpvt)
1034 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
1035 & rwork(2*maxi_cluster*omp_num),
1036 & tau(maxi_cluster*omp_num),
1037 & jpvt(maxi_cluster*omp_num),
1038 & work(lwork*omp_num),stat=allocok)
1039 IF (allocok > 0) THEN
1040 iflag = -13
1041 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
1042 ENDIF
1043 ENDIF
1044 ENDIF
1045#if defined(BLR_MT)
1046!$OMP END MASTER
1047!$OMP BARRIER
1048#endif
1049 IF (iflag.LT.0) GOTO 450
1050 IF (compress_cb) THEN
1051 CALL cmumps_compress_cb(a, la, poselt, nfront,
1052 & begs_blr, begs_blr, npartscb, npartscb, npartsass,
1053 & nfront-nass, nfront-nass, inode,
1054 & iw(ioldps+xxf), 0, 1, iflag, ierror,
1055 & dkeep(12), keep(466), keep(484), keep(489), cb_lrb,
1056 & work, tau, jpvt, lwork, rwork, block,
1057 & maxi_cluster, keep8,
1058 & -9999, -9999, -9999, keep(1),
1059 & nelim=nelim)
1060#if defined(BLR_MT)
1061!$OMP BARRIER
1062#endif
1063 ENDIF
1064 450 CONTINUE
1065#if defined(BLR_MT)
1066!$OMP END PARALLEL
1067#endif
1068 IF (
1069 & (
1070 & (keep(486).EQ.2)
1071 & )
1072 & .AND.uu.GT.0
1073 & ) THEN
1074 deallocate(begs_blr_tmp)
1075 ENDIF
1076 IF (iflag.LT.0) GOTO 500
1077 CALL upd_mry_lu_fr(nass, nfront-nass, 0, nass-npiv)
1078 DO ip=1,npartsass
1079 DO loru=0,1
1080 CALL cmumps_blr_retrieve_panel_loru(
1081 & iw(ioldps+xxf), loru, ip, blr_panel)
1082 CALL upd_mry_lu_lrgain(blr_panel, nb_blr-ip
1083 & )
1084 ENDDO
1085 ENDDO
1086 CALL upd_flop_facto_fr(nfront, nass, npiv, 0, 1)
1087 ENDIF
1088 IF ( (pivot_option.LT.4) .AND. (.NOT.lr_activated) ) THEN
1089 CALL cmumps_fac_fr_update_cbrows( inode,
1090 & nfront, nass, (pivot_option.LT.3), a, la, lafac, poselt,
1091 & iw, liw, ioldps, monbloc, myid, noffw,
1092 & det_expw, det_mantw, det_signw,
1093 & liwfac,
1094 & pp_first2swap_l, pp_first2swap_u,
1095 & lnextpiv2bewritten, unextpiv2bewritten,
1096 & pp_lastpivrptrfilled_l, pp_lastpivrptrfilled_u,
1097 &
1098 & xsize, seuil, uu, dkeep, keep8, keep, iflag,
1099 & ooc_effective_on_front, nvschur )
1100 ENDIF
1101 IF (keep(486).NE.0) THEN
1102 IF (.NOT.lr_activated) THEN
1103 CALL upd_flop_frfronts(nfront, npiv, nass, 0, 1)
1104 ENDIF
1105 ENDIF
1106 IF ( ooc_effective_on_front ) THEN
1107 strat = strat_write_max
1108 monbloc%Last = .true.
1109 monbloc%LastPiv = iw(ioldps+1+xsize)
1110 last_call = .true.
1111 CALL cmumps_ooc_io_lu_panel
1112 & ( strat, typef_both_lu,
1113 & a(poselt), lafac, monbloc,
1114 & lnextpiv2bewritten, unextpiv2bewritten,
1115 & iw(ioldps), liwfac,
1116 & myid, keep8(31), iflag_ooc, last_call )
1117 IF (iflag_ooc < 0 ) THEN
1118 iflag=iflag_ooc
1119 GOTO 500
1120 ENDIF
1121 CALL cmumps_ooc_pp_tryrelease_space (iwpos,
1122 & ioldps, iw, liw, monbloc , nfront, keep)
1123 ENDIF
1124 GOTO 600
1125 490 CONTINUE
1126 500 CONTINUE
1127 600 CONTINUE
1128 IF (lr_activated) THEN
1129 IF (allocated(work)) deallocate(work)
1130 IF (allocated(rwork)) DEALLOCATE(rwork)
1131 IF (allocated(tau)) deallocate(tau)
1132 IF (allocated(jpvt)) deallocate(jpvt)
1133 IF (allocated(block)) deallocate(block)
1134 IF (associated(acc_lua)) THEN
1135 IF (keep(480).GE.3) THEN
1136 DO my_num=1,omp_num
1137 CALL dealloc_lrb(acc_lua(my_num), keep8, keep(34))
1138 ENDDO
1139 ENDIF
1140 DEALLOCATE(acc_lua)
1141 NULLIFY(acc_lua)
1142 ENDIF
1143 IF (associated(begs_blr)) THEN
1144 DEALLOCATE(begs_blr)
1145 NULLIFY(begs_blr)
1146 ENDIF
1147 ENDIF
1148 IF (lr_activated.AND.(keep(480).NE.0)) THEN
1149 IF (.NOT.
1150 & (
1151 & (keep(486).EQ.2)
1152 & )
1153 & ) THEN
1154 CALL cmumps_blr_free_all_panels(iw(ioldps+xxf), 2,
1155 & keep8, keep(34))
1156 ENDIF
1157 ENDIF
1158 IF (lr_activated) THEN
1159 IF (.NOT.
1160 & (
1161 & (keep(486).EQ.2)
1162 & )
1163 & .AND..NOT.compress_cb) THEN
1164 CALL cmumps_blr_end_front(iw(ioldps+xxf), iflag, keep8,
1165 & keep(34), mtk405=keep(405))
1166 ENDIF
1167 ENDIF
1168 npvw = npvw + iw(ioldps+1+xsize)
1169 END SUBROUTINE cmumps_fac1_lu
1170 END MODULE cmumps_fac1_lu_m
cmumps_ooc_pp_tryrelease_space
subroutine cmumps_ooc_pp_tryrelease_space(iwpos, ioldps, iw, liw, monbloc, nfront, keep)
Definition cooc_panel_piv.F:235
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_fac1_lu_m
Definition cfac_front_LU_type1.F:14
cmumps_fac1_lu_m::cmumps_fac1_lu
subroutine cmumps_fac1_lu(n, inode, iw, liw, a, la, ioldps, poselt, iflag, ierror, uu, noffw, npvw, nbtinyw, det_expw, det_mantw, det_signw, keep, keep8, step, procnode_steps, myid, slavef, seuil, avoid_delayed, etatass, dkeep, pivnul_list, lpn_list, iwpos, lrgroups, perm)
Definition cfac_front_LU_type1.F:30
cmumps_fac_front_aux_m
Definition cfac_front_aux.F:14
cmumps_fac_front_aux_m::cmumps_fac_fr_update_cbrows
subroutine cmumps_fac_fr_update_cbrows(inode, nfront, nass, call_utrsm, a, la, lafac, poselt, iw, liw, ioldps, monbloc, myid, noffw, det_expw, det_mantw, det_signw, liwfac, pp_first2swap_l, pp_first2swap_u, lnextpiv2bewritten, unextpiv2bewritten, pp_lastpivrptrfilled_l, pp_lastpivrptrfilled_u xsize, seuil, uu, dkeep, keep8, keep, iflag, ooc_effective_on_front, nvschur)
Definition cfac_front_aux.F:628
cmumps_fac_lr
Definition cfac_lr.F:14
cmumps_fac_lr::cmumps_compress_panel
subroutine cmumps_compress_panel(a, la, poselt, iflag, ierror, nfront, begs_blr, nb_blr, toleps, tol_opt, k473, blr_panel, current_blr, dir, work, tau, jpvt, lwork, rwork, block, maxi_cluster, nelim, lbandslave, npiv, ishift, niv, kpercent, keep8, k480, beg_i_in, end_i_in, frswap)
Definition cfac_lr.F:2199
cmumps_fac_lr::cmumps_blr_upd_cb_left
subroutine cmumps_blr_upd_cb_left(a, la, poselt, nfront, begs_blr, begs_blr_u, nb_rows, nb_incb, nb_inasm, nass, iwhandler, niv, lbandslave, iflag, ierror, midblk_compress, toleps, tol_opt, kpercent_rmb, acc_lua, k480, k479, k478, kpercent_lua, kpercent, maxi_cluster, maxi_rank, k474, fsorcb, blr_u_col, compress_cb, cb_lrb, keep8)
Definition cfac_lr.F:1428
cmumps_fac_lr::cmumps_compress_cb
subroutine cmumps_compress_cb(a, la, poselt, lda, begs_blr, begs_blr_u, nb_rows, nb_cols, nb_inasm, nrows, ncols, inode, iwhandler, sym, niv, iflag, ierror, toleps, tol_opt, kpercent, k489, cb_lrb, work, tau, jpvt, lwork, rwork, block, maxi_cluster, keep8, nfs4father, npiv, nvschur_k253, keep, m_array, nelim, nbrowsinf)
Definition cfac_lr.F:1951
cmumps_lr_data_m
Definition cmumps_lr_data_m.F:14
cmumps_lr_data_m::cmumps_blr_save_begs_blr_dyn
subroutine, public cmumps_blr_save_begs_blr_dyn(iwhandler, begs_blr_dynamic)
Definition cmumps_lr_data_m.F:588
cmumps_lr_data_m::cmumps_blr_retrieve_panel_loru
subroutine, public cmumps_blr_retrieve_panel_loru(iwhandler, loru, ipanel, thelrbpanel)
Definition cmumps_lr_data_m.F:750
cmumps_lr_data_m::cmumps_blr_retrieve_begsblr_sta
subroutine, public cmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
Definition cmumps_lr_data_m.F:622
cmumps_lr_data_m::cmumps_blr_end_front
subroutine, public cmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
Definition cmumps_lr_data_m.F:342
cmumps_lr_data_m::cmumps_blr_free_all_panels
subroutine, public cmumps_blr_free_all_panels(iwhandler, loru, keep8, k34)
Definition cmumps_lr_data_m.F:1003
cmumps_lr_stats
Definition clr_stats.F:14
cmumps_lr_stats::upd_flop_facto_fr
subroutine upd_flop_facto_fr(nfront, nass, npiv, sym, niv)
Definition clr_stats.F:469
cmumps_lr_stats::upd_mry_lu_fr
subroutine upd_mry_lu_fr(nass, ncb, sym, nelim)
Definition clr_stats.F:410
cmumps_lr_stats::upd_mry_lu_lrgain
subroutine upd_mry_lu_lrgain(blr_panel, nbblocks)
Definition clr_stats.F:452
cmumps_lr_stats::upd_flop_frfronts
subroutine upd_flop_frfronts(nfront, npiv, nass, sym, niv)
Definition clr_stats.F:501
cmumps_lr_type
Definition clr_type.F:14
cmumps_lr_type::dealloc_lrb
subroutine dealloc_lrb(lrb_out, keep8, k34)
Definition clr_type.F:25
cmumps_ooc
Definition cmumps_ooc.F:14
cmumps_ooc::cmumps_ooc_io_lu_panel
subroutine, public cmumps_ooc_io_lu_panel(strat, typefile, afac, lafac, monbloc, lnextpiv2bewritten, unextpiv2bewritten, iw, liwfac, myid, filesize, ierr, last_call)
Definition cmumps_ooc.F:3032
cmumps_ooc::typef_both_lu
integer, parameter, public typef_both_lu
Definition cmumps_ooc.F:64
cmumps_lr_type::lrb_type
Definition clr_type.F:16