OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sfac_front_LU_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 smumps_fac2_lu_m
15 CONTAINS
16 SUBROUTINE smumps_fac2_lu( COMM_LOAD, ASS_IRECV,
17 & N, INODE, FPERE, IW, LIW, A, LA,
18 & UU, NOFFW, NPVW, 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 OMP_LIB
36 USE smumps_fac_front_aux_m
37 USE smumps_fac_front_type2_aux_m
38 USE smumps_ooc
39 USE smumps_buf, ONLY : smumps_buf_test
40 USE smumps_fac_lr
41 USE smumps_lr_core
42 USE smumps_lr_type
43 USE smumps_lr_stats
44 USE smumps_ana_lr, ONLY : get_cut
45 USE smumps_lr_data_m
46!$ USE OMP_LIB
47 USE smumps_struc_def, ONLY : smumps_root_struc
48 IMPLICIT NONE
49 INTEGER COMM_LOAD, ASS_IRECV
50 INTEGER N, INODE, FPERE, LIW
51 INTEGER, intent(inout) :: NOFFW, NPVW, NBTINYW
52 INTEGER, intent(inout) :: DET_EXPW, DET_SIGNW
53 REAL, intent(inout) :: DET_MANTW
54 INTEGER(8) :: LA
55 INTEGER IW( LIW )
56 REAL A( LA )
57 REAL UU, SEUIL
58 TYPE (SMUMPS_ROOT_STRUC) :: root
59 INTEGER COMM, MYID, LBUFR, LBUFR_BYTES
60 INTEGER LPTRAR, NELT
61 INTEGER ICNTL(60), KEEP(500)
62 INTEGER(8) KEEP8(150)
63 INTEGER NBFIN, SLAVEF,
64 & IFLAG, IERROR, LEAF, LPOOL
65 INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS
66 INTEGER IWPOS, IWPOSCB, COMP
67 INTEGER FRTPTR( N + 1 ), FRTELT( NELT )
68 INTEGER BUFR( LBUFR ), IPOOL(LPOOL),
69 & itloc(n+keep(253)), fils(n), dad( keep(28) ),
70 & nd( keep(28) ), frere( keep(28) )
71 INTEGER(8), INTENT(IN) :: PTRARW(LPTRAR), PTRAIW(LPTRAR)
72 REAL :: RHS_MUMPS(KEEP(255))
73 INTEGER(8) :: PTRAST(KEEP(28))
74 INTEGER(8) :: PTRFAC(KEEP(28))
75 INTEGER(8) :: PAMASTER(KEEP(28))
76 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),
77 & step(n), pimaster(keep(28)),
78 & nstk_s(keep(28)), perm(n),
79 & procnode_steps(keep(28))
80 INTEGER ISTEP_TO_INIV2(KEEP(71)),
81 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
82 DOUBLE PRECISION OPASSW, OPELIW
83 REAL DBLARR(KEEP8(26))
84 INTEGER INTARR(KEEP8(27))
85 LOGICAL AVOID_DELAYED
86 INTEGER LPN_LIST
87 INTEGER PIVNUL_LIST(LPN_LIST)
88 REAL DKEEP(230)
89 INTEGER :: LRGROUPS(N)
90 INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK, IEND_BLOCK
91 INTEGER :: IBEG_BLOCK_FOR_IPIV
92 INTEGER NASS, NBKJIB_ORIG, XSIZE
93 INTEGER NBLR_ORIG, IBEG_BLR, IEND_BLR
94 INTEGER Inextpiv
95 LOGICAL LASTBL
96 INTEGER(8) :: POSELT
97 INTEGER IOLDPS, allocok, K263,J
98 INTEGER idummy
99 REAL UUTEMP
100 LOGICAL STATICMODE
101 REAL SEUIL_LOC
102 INTEGER , ALLOCATABLE, DIMENSION ( : ) :: IPIV
103 INTEGER(8) :: LAFAC
104 INTEGER LIWFAC, STRAT, LNextPiv2beWritten,
105 & unextpiv2bewritten, iflag_ooc,
106 & pp_first2swap_l, pp_first2swap_u,
107 & pp_lastpivrptrfilled_l,
108 & pp_lastpivrptrfilled_u
109 TYPE(io_block) :: MonBloc
110 LOGICAL LAST_CALL
111 INTEGER CURRENT_BLR, NELIM
112 LOGICAL LR_ACTIVATED, COMPRESS_PANEL
113 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR,
114 & ooc_effective_on_front,
115 & ooc_eff_and_write_bypanel
116 INTEGER :: IROW_L, NVSCHUR, NSLAVES
117 INTEGER :: PIVOT_OPTION, LAST_COL, FIRST_COL
118 INTEGER :: PARPIV_T1
119 INTEGER FIRST_BLOCK, LAST_BLOCK
120 INTEGER :: INFO_TMP(2)
121 INTEGER :: MAXI_RANK
122 INTEGER HF, NPARTSASS, NPARTSCB, NB_BLR, END_I
123 INTEGER MAXI_CLUSTER, LWORK
124 TYPE(LRB_TYPE), DIMENSION(1), TARGET :: BLR_DUMMY
125 INTEGER, POINTER, DIMENSION(:) :: PTDummy
126 TYPE(LRB_TYPE), POINTER, DIMENSION(:) :: ACC_LUA
127 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
128 TYPE(lrb_type), POINTER, DIMENSION(:) :: BLR_L, BLR_U, BLR_SEND
129 REAL, POINTER, DIMENSION(:) :: DIAG
130 TYPE(lrb_type), POINTER, DIMENSION(:) :: BLR_PANEL
131 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR_TMP, BEGS_BLR_STATIC
132 INTEGER :: DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, LorU, I, IP, MEM,
133 & MEM_TOT
134 INTEGER(8) :: POSELT_DIAG
135 CHARACTER(len=1) :: DIR
136 REAL, ALLOCATABLE :: WORK(:), TAU(:)
137 INTEGER, ALLOCATABLE :: JPVT(:)
138 REAL, ALLOCATABLE :: RWORK(:)
139 REAL, ALLOCATABLE :: BLOCK(:,:)
140 INTEGER :: OMP_NUM
141 INTEGER(8) :: UPOS, LPOS
142 INTEGER :: MY_NUM
143 include 'mumps_headers.h'
144 NULLIFY(blr_l,blr_u)
145 NULLIFY(ptdummy)
146 NULLIFY(acc_lua)
147 NULLIFY(begs_blr)
148 NULLIFY(blr_l, blr_u, blr_send)
149 NULLIFY(diag)
150 NULLIFY(blr_panel)
151 NULLIFY( begs_blr_tmp, begs_blr_static)
152 IF (keep(206).GE.1) THEN
153 inextpiv = 1
154 ELSE
155 inextpiv = 0
156 ENDIF
157 idummy = 0
158 ioldps = ptlust_s(step( inode ))
159 poselt = ptrast(step( inode ))
160 xsize = keep(ixsz)
161 nfront = iw(ioldps+xsize)
162 nass = iabs(iw(ioldps+2+xsize))
163 iw(ioldps+3+xsize) = -99999
164 lr_activated = (iw(ioldps+xxlr).GT.0)
165 compress_panel = (iw(ioldps+xxlr).GE.2)
166 oocwrite_compatible_with_blr =
167 & ( .NOT.lr_activated.OR. (.NOT.compress_panel).OR.
168 & (keep(486).NE.2)
169 & )
170 ooc_effective_on_front= ((keep(201).EQ.1).AND.
171 & oocwrite_compatible_with_blr)
172 parpiv_t1 = 0
173 inopv = 0
174 seuil_loc = seuil
175 IF(keep(97) .EQ. 0) THEN
176 staticmode = .false.
177 ELSE
178 staticmode = .true.
179 ENDIF
180 IF (avoid_delayed) THEN
181 staticmode = .true.
182 uutemp=uu
183 seuil_loc = max(seuil,epsilon(seuil))
184 ELSE
185 uutemp=uu
186 ENDIF
187 CALL smumps_set_innerblocksize( nbkjib_orig, nass, keep)
188 IF (.not.lr_activated) THEN
189 nblr_orig = keep(420)
190 ELSE
191 nblr_orig = -9999
192 ENDIF
193 IF ((keep(114).EQ.1) .AND.
194 & (keep(116).GT.0) .AND. ((nfront-nass-keep(253)).GT.0)
195 & ) THEN
196 nslaves = iw(ioldps+5+xsize)
197 irow_l = ioldps+6+xsize+nslaves+nass
198 CALL smumps_get_size_schur_in_front (
199 & n,
200 & nfront-nass-keep(253),
201 & keep(116),
202 & iw(irow_l), perm,
203 & nvschur )
204 ELSE
205 nvschur = 0
206 ENDIF
207 IF (lr_activated) THEN
208 k263 = 1
209 ELSE
210 k263 = keep(263)
211 IF (k263 .NE. 0 .AND. nass/nblr_orig < 4) THEN
212 IF ( nblr_orig .GT. nbkjib_orig * 4 ) THEN
213 nblr_orig = max(nbkjib_orig, (nass+3)/4)
214 ELSE
215 k263 = 0
216 ENDIF
217 ENDIF
218 ENDIF
219 pivot_option = keep(468)
220 IF ( uutemp == 0.0e0 .AND.
221 & .NOT.(
222 & ooc_effective_on_front
223 & )
224 & ) THEN
225 IF (k263.EQ.1.AND.(.NOT.lr_activated)) THEN
226 pivot_option = 0
227 ENDIF
228 ENDIF
229 iend_block = 0
230 iend_blr = 0
231 current_blr = 0
232 ALLOCATE( ipiv( nass ), stat = allocok )
233 IF ( allocok .GT. 0 ) THEN
234 WRITE(*,*) myid,' : SMUMPS_FAC2_LU :failed to allocate ',
235 & nass, ' integers'
236 iflag = -13
237 ierror =nass
238 GO TO 500
239 END IF
240 CALL mumps_geti8(lafac,iw(ioldps+xxr))
241 liwfac = iw(ioldps+xxi)
242 IF ( ooc_effective_on_front ) THEN
243 lnextpiv2bewritten = 1
244 unextpiv2bewritten = 1
245 pp_first2swap_l = lnextpiv2bewritten
246 pp_first2swap_u = unextpiv2bewritten
247 monbloc%LastPanelWritten_L = 0
248 monbloc%LastPanelWritten_U = 0
249 monbloc%INODE = inode
250 monbloc%MASTER = .true.
251 monbloc%Typenode = 2
252 monbloc%NROW = nass
253 monbloc%NCOL = nfront
254 monbloc%NFS = nass
255 monbloc%Last = .false.
256 monbloc%LastPiv = -68877
257 NULLIFY(monbloc%INDICES)
258 ENDIF
259 IF (lr_activated) THEN
260 pivot_option = 4
261 IF (keep(475).EQ.1) THEN
262 pivot_option = 3
263 ELSEIF (keep(475).EQ.2) THEN
264 pivot_option = 2
265 ELSEIF (keep(475).EQ.3) THEN
266 IF (uutemp == 0.0e0) THEN
267 pivot_option = 0
268 ELSE
269 pivot_option = 1
270 ENDIF
271 ENDIF
272 cnt_nodes = cnt_nodes + 1
273 ENDIF
274 hf = 6 + iw(ioldps+5+xsize)+xsize
275 ooc_eff_and_write_bypanel = ( (pivot_option.GE.3) .AND.
276 & ooc_effective_on_front )
277 IF (lr_activated) THEN
278 CALL get_cut(iw(ioldps+hf:ioldps+hf+nfront-1), nass,
279 & nfront-nass, lrgroups, npartscb,
280 & npartsass, begs_blr)
281 CALL regrouping2(begs_blr, npartsass, nass, npartscb,
282 & nfront-nass, keep(488), .false., keep(472))
283 nb_blr = npartsass + npartscb
284 call max_cluster(begs_blr,nb_blr,maxi_cluster)
285 maxi_rank = keep(479)*maxi_cluster
286 lwork = maxi_cluster*maxi_cluster
287 omp_num = 1
288#if defined(BLR_MT)
289!$ OMP_NUM = OMP_GET_MAX_THREADS()
290#endif
291 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
292 & rwork(2*maxi_cluster*omp_num),
293 & tau(maxi_cluster*omp_num),
294 & jpvt(maxi_cluster*omp_num),
295 & work(lwork*omp_num),stat=allocok)
296 IF (allocok > 0) THEN
297 iflag = -13
298 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
299 GOTO 480
300 ENDIF
301 ALLOCATE(acc_lua(omp_num),stat=allocok)
302 IF (allocok > 0) THEN
303 iflag = -13
304 ierror = omp_num
305 GOTO 480
306 ENDIF
307 IF (keep(480).GE.3) THEN
308 DO my_num=1,omp_num
309 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
310 & maxi_cluster, maxi_cluster, .true.,
311 & iflag, ierror, keep8)
312 IF (iflag.LT.0) GOTO 500
313 acc_lua(my_num)%K = 0
314 ENDDO
315 ENDIF
316 ENDIF
317 IF (lr_activated.AND.
318 & (keep(480).NE.0
319 & .OR.
320 & (
321 & (keep(486).EQ.2)
322 & )
323 & )
324 & ) THEN
325 info_tmp(1) = iflag
326 info_tmp(2) = ierror
327 CALL smumps_blr_init_front(iw(ioldps+xxf), info_tmp)
328 iflag = info_tmp(1)
329 ierror = info_tmp(2)
330 IF (iflag.LT.0) GOTO 500
331 CALL smumps_blr_save_init(iw(ioldps+xxf),
332 & .false.,
333 & .true.,
334 & .false.,
335 & npartsass,
336 & begs_blr, ptdummy,
337 & huge(npartsass),
338 & info_tmp)
339 iflag = info_tmp(1)
340 ierror = info_tmp(2)
341 IF (iflag.LT.0) GOTO 500
342 ENDIF
343 lastbl = .false.
344 DO WHILE (iend_blr < nass )
345 current_blr = current_blr + 1
346 ibeg_blr = iw(ioldps+1+keep(ixsz)) + 1
347 IF (.NOT. lr_activated)THEN
348 iend_blr = min(iend_blr + nblr_orig, nass)
349 ELSE
350 iend_blr = begs_blr(current_blr+1)-1
351 begs_blr( current_blr ) = ibeg_blr
352 IF ( iend_blr - ibeg_blr + 1 .GT. maxi_cluster ) THEN
353 maxi_cluster = iend_blr - ibeg_blr + 1
354 lwork = maxi_cluster*maxi_cluster
355 DEALLOCATE(block, work, rwork, tau, jpvt)
356 ALLOCATE(block(maxi_cluster, omp_num*maxi_cluster),
357 & rwork(2*maxi_cluster*omp_num),
358 & tau(maxi_cluster*omp_num),
359 & jpvt(maxi_cluster*omp_num),
360 & work(lwork*omp_num),stat=allocok)
361 IF (allocok > 0) THEN
362 iflag = -13
363 ierror = omp_num*(lwork + maxi_cluster*(maxi_cluster+4))
364 GOTO 500
365 ENDIF
366 IF (keep(480).GE.3) THEN
367 DO my_num=1,omp_num
368 CALL dealloc_lrb(acc_lua(my_num), keep8, keep(34))
369 CALL alloc_lrb(acc_lua(my_num), maxi_rank,
370 & maxi_cluster, maxi_cluster, .true.,
371 & iflag, ierror, keep8)
372 IF (iflag.LT.0) GOTO 500
373 acc_lua(my_num)%K = 0
374 ENDDO
375 ENDIF
376 ENDIF
377 ENDIF
378 DO WHILE (iend_block < iend_blr )
379 ibeg_block = iw(ioldps+1+keep(ixsz)) + 1
380 IF (keep(405).EQ.0) THEN
381 keep(425)=max(keep(425),iend_block-ibeg_block)
382 ELSE
383!$OMP ATOMIC UPDATE
384 keep(425)=max(keep(425),iend_block-ibeg_block)
385!$OMP END ATOMIC
386 ENDIF
387 iend_block = min(iend_block + nbkjib_orig, iend_blr)
388 50 CONTINUE
389 IF (k263.EQ.0) THEN
390 ibeg_block_for_ipiv = ibeg_block
391 ELSE
392 ibeg_block_for_ipiv = ibeg_blr
393 ENDIF
394 CALL smumps_fac_i(nfront,nass,nass,
395 & ibeg_block_for_ipiv,iend_block,n,inode,
396 & iw,liw,a,la,inopv,noffw,nbtinyw,
397 & det_expw, det_mantw, det_signw,
398 & iflag,ioldps,poselt,uu,seuil_loc,keep,keep8,
399 & dkeep(1),pivnul_list(1),lpn_list,
400 & pp_first2swap_l, monbloc%LastPanelWritten_L,
401 & pp_lastpivrptrfilled_l,
402 & pp_first2swap_u, monbloc%LastPanelWritten_U,
403 & pp_lastpivrptrfilled_u,
404 & pivot_option, lr_activated, iend_blr,
405 & inextpiv, ooc_effective_on_front,
406 & nvschur, parpiv_t1,
407 & tipiv=ipiv
408 & )
409 IF (iflag.LT.0) GOTO 500
410 IF (inopv.EQ.1) THEN
411 IF (staticmode) THEN
412 inopv = -1
413 GOTO 50
414 ENDIF
415 lastbl = .true.
416 ELSE IF (inopv .LE. 0) THEN
417 inopv = 0
418 IF (pivot_option.GE.3) THEN
419 last_col = nfront
420 ELSEIF (pivot_option.EQ.2) THEN
421 last_col = nass
422 ELSE
423 last_col = iend_blr
424 ENDIF
425 CALL smumps_fac_mq(ibeg_block, iend_block,
426 & nfront, nass, iw(ioldps+1+xsize),
427 & last_col, a, la, poselt, ifinb,
428 & lr_activated)
429 iw(ioldps+1+xsize) = iw(ioldps+1+xsize) + 1
430 npvw = npvw + 1
431 IF (ifinb.EQ.0) THEN
432 GOTO 50
433 ELSE IF (ifinb .EQ. -1) THEN
434 lastbl = .true.
435 ENDIF
436 ENDIF
437 npiv = iw(ioldps+1+xsize)
438 IF (k263.EQ.0) THEN
439 nelim = iend_blr - npiv
440 CALL smumps_send_factored_blk( comm_load, ass_irecv,
441 & n, inode, fpere, iw, liw, ioldps, poselt, a, la,
442 & nfront, ibeg_block, npiv, ipiv, nass,lastbl, idummy,
443 & comm, myid, bufr, lbufr, lbufr_bytes,nbfin,leaf,
444 & iflag, ierror, ipool,lpool,
445 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
446 & lrlus, comp, ptrist, ptrast, ptlust_s, ptrfac, step,
447 & pimaster, pamaster, nstk_s,perm,procnode_steps,
448 & root, opassw, opeliw, itloc, rhs_mumps,
449 & fils, dad, ptrarw, ptraiw, intarr,dblarr,
450 & icntl,keep,keep8,
451 & dkeep,nd,frere, lptrar, nelt, frtptr, frtelt,
452 & istep_to_iniv2, tab_pos_in_pere
453 & , nelim, .false.
454 & , npartsass, current_blr
455 & , blr_dummy, lrgroups
456 & )
457 END IF
458 IF ( iflag .LT. 0 ) GOTO 500
459 IF ( ooc_eff_and_write_bypanel ) THEN
460 monbloc%LastPiv= iw(ioldps+1+xsize)
461 strat = strat_try_write
462 last_call = .false.
463 CALL smumps_ooc_io_lu_panel
464 & ( strat, typef_u,
465 & a(poselt), lafac, monbloc,
466 & lnextpiv2bewritten, unextpiv2bewritten,
467 & iw(ioldps), liwfac,
468 & myid, keep8(31), iflag_ooc,last_call )
469 IF (iflag_ooc < 0 ) THEN
470 iflag=iflag_ooc
471 GOTO 500
472 ENDIF
473 ENDIF
474 npiv = iw(ioldps+1+xsize)
475 IF ( iend_blr .GT. iend_block ) THEN
476 CALL smumps_buf_test()
477 IF (pivot_option.GE.3) THEN
478 last_col = nfront
479 ELSEIF (pivot_option.EQ.2) THEN
480 last_col = nass
481 ELSE
482 last_col = iend_blr
483 ENDIF
484 CALL smumps_fac_sq(ibeg_block, iend_block,
485 & npiv, nfront, iend_blr, last_col,
486 & a, la, poselt,
487 & -77777,
488 & .true., .false., .true.,
489 & .false.,
490 & lr_activated)
491 ENDIF
492 CALL smumps_buf_test()
493 END DO
494 npiv = iw(ioldps+1+xsize)
495 IF (lr_activated) THEN
496 ALLOCATE(blr_u(nb_blr-current_blr),stat=allocok)
497 IF (allocok > 0) THEN
498 iflag = -13
499 ierror = nb_blr-current_blr
500 GOTO 500
501 ENDIF
502 ALLOCATE(blr_l(npartsass-current_blr),stat=allocok)
503 IF (allocok > 0) THEN
504 iflag = -13
505 ierror = npartsass-current_blr
506 GOTO 500
507 ENDIF
508 nelim = iend_blr - npiv
509 IF (nelim .EQ. iend_blr - ibeg_blr + 1) THEN
510 IF (keep(480).GE.2
511 & .OR.
512 & (
513 & (keep(486).EQ.2)
514 & )
515 & ) THEN
516 DO j=1,nb_blr-current_blr
517 blr_u(j)%M=0
518 blr_u(j)%N=0
519 blr_u(j)%K=0
520 blr_u(j)%ISLR=.false.
521 NULLIFY(blr_u(j)%Q)
522 NULLIFY(blr_u(j)%R)
523 ENDDO
524 CALL smumps_blr_save_panel_loru (
525 & iw(ioldps+xxf),
526 & 1,
527 & current_blr, blr_u)
528 DO j=1,npartsass-current_blr
529 blr_l(j)%M=0
530 blr_l(j)%N=0
531 blr_l(j)%K=0
532 blr_l(j)%ISLR=.false.
533 NULLIFY(blr_l(j)%Q)
534 NULLIFY(blr_l(j)%R)
535 ENDDO
536 CALL smumps_blr_save_panel_loru (
537 & iw(ioldps+xxf),
538 & 0,
539 & current_blr, blr_l)
540 NULLIFY(blr_l)
541 NULLIFY(blr_u)
542 ENDIF
543 GOTO 101
544 ENDIF
545 end_i=nb_blr
546#if defined(BLR_MT)
547!$OMP PARALLEL PRIVATE(FIRST_BLOCK,LAST_BLOCK)
548#endif
549 CALL smumps_compress_panel(a, la, poselt, iflag, ierror,
550 & nfront,
551 & begs_blr, nb_blr, dkeep(8), keep(466), keep(473), blr_u,
552 & current_blr,
553 & 'h', WORK, TAU, JPVT, LWORK, RWORK,
554 & BLOCK, MAXI_CLUSTER, NELIM,
555 & .FALSE., 0, 0, 2, KEEP(483), KEEP8,
556 & END_I_IN=END_I
557 & )
558.LT. IF (IFLAG0) GOTO 300
559.NE..AND..GT. IF ((KEEP(480)0NB_BLRCURRENT_BLR)
560.OR. &
561 & (
562.EQ. & (KEEP(486)2)
563 & )
564 & ) THEN
565.LT. IF (KEEP(480)5) THEN
566 CALL SMUMPS_BLR_SAVE_PANEL_LORU(
567 & IW(IOLDPS+XXF),
568 & 1,
569 & CURRENT_BLR, BLR_U)
570 ENDIF
571 ENDIF
572#if defined(BLR_MT)
573!$OMP BARRIER
574#endif
575.LT. IF (PIVOT_OPTION3) THEN
576.LT. IF (PIVOT_OPTION2) THEN
577 FIRST_BLOCK = CURRENT_BLR+1
578 ELSE
579 FIRST_BLOCK = NPARTSASS+1
580 ENDIF
581 LAST_BLOCK=NB_BLR
582 CALL SMUMPS_BLR_PANEL_LRTRSM(A, LA, POSELT, NFRONT,
583 & IBEG_BLR,
584 & NB_BLR, BLR_U, CURRENT_BLR,
585 & FIRST_BLOCK, LAST_BLOCK, 2, 0, 1,
586 & .FALSE.)
587 ENDIF
588 300 CONTINUE
589#if defined(BLR_MT)
590!$OMP END PARALLEL
591#endif
592 ENDIF
593 101 CONTINUE
594.OR..NE..AND..GE. IF (LR_ACTIVATED (K2630PIVOT_OPTION3)) THEN
595 NELIM = IEND_BLR - NPIV
596 BLR_SEND=>BLR_DUMMY
597 IF (associated(BLR_U)) THEN
598 BLR_SEND=>BLR_U
599 ENDIF
600 CALL SMUMPS_SEND_FACTORED_BLK( COMM_LOAD, ASS_IRECV,
601 & N, INODE, FPERE, IW, LIW, IOLDPS, POSELT, A, LA, NFRONT,
602 & IBEG_BLR, NPIV, IPIV, NASS,LASTBL, idummy,
603 & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF,
604 & IFLAG, IERROR, IPOOL,LPOOL,
605 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
606 & LRLUS, COMP, PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP,
607 & PIMASTER, PAMASTER, NSTK_S,PERM,PROCNODE_STEPS,
608 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
609 & FILS, DAD, PTRARW, PTRAIW,
610 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,
611 & LPTRAR, NELT, FRTPTR, FRTELT,
612 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
613 & , NELIM, LR_ACTIVATED
614 & , NPARTSASS, CURRENT_BLR
615 & , BLR_SEND, LRGROUPS
616 & )
617 ENDIF
618.NOT. IF ( LR_ACTIVATED) THEN
619 LAST_COL = NFRONT
620.EQ. IF (PIVOT_OPTION2) THEN
621 FIRST_COL = NASS
622 ELSE
623 FIRST_COL = NPIV
624 ENDIF
625.LT..OR..LT. IF (IEND_BLRNASS PIVOT_OPTION3) THEN
626 CALL SMUMPS_FAC_SQ(IBEG_BLR, IEND_BLR,
627 & NPIV, NFRONT, NASS, LAST_COL,
628.LT. & A, LA, POSELT, FIRST_COL, .TRUE., (PIVOT_OPTION3),
629.EQ. & .TRUE., (KEEP(377)1),
630 & LR_ACTIVATED)
631 ENDIF
632.NE..AND..LT. IF (K2630 PIVOT_OPTION3) THEN
633 NELIM = IEND_BLR - NPIV
634 BLR_SEND=>BLR_DUMMY
635 IF (associated(BLR_U)) THEN
636 BLR_SEND=>BLR_U
637 ENDIF
638 CALL SMUMPS_SEND_FACTORED_BLK( COMM_LOAD, ASS_IRECV,
639 & N, INODE, FPERE, IW, LIW, IOLDPS, POSELT, A, LA,
640 & NFRONT, IBEG_BLR, NPIV, IPIV, NASS,LASTBL, idummy,
641 & COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,NBFIN,LEAF,
642 & IFLAG, IERROR, IPOOL,LPOOL,
643 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
644 & LRLUS, COMP, PTRIST, PTRAST, PTLUST_S, PTRFAC, STEP,
645 & PIMASTER, PAMASTER, NSTK_S,PERM,PROCNODE_STEPS,
646 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
647 & FILS, DAD, PTRARW, PTRAIW,
648 & INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,
649 & LPTRAR, NELT, FRTPTR, FRTELT,
650 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
651 & , NELIM, LR_ACTIVATED
652 & , NPARTSASS, CURRENT_BLR
653 & , BLR_SEND, LRGROUPS
654 & )
655 ENDIF
656 ELSE
657 NELIM = IEND_BLR - NPIV
658.EQ. IF (NELIM IEND_BLR - IBEG_BLR + 1) THEN
659.GE. IF (KEEP(480)2) THEN
660.LT. IF (IEND_BLRNASS) THEN
661#if defined(BLR_MT)
662!$OMP PARALLEL
663#endif
664 CALL SMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
665 & NFRONT, IW(IOLDPS+XXF), 0,
666 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
667 & NB_BLR, NPARTSASS, NELIM,
668 & 2, 0,
669 & .FALSE., IFLAG, IERROR, 0,
670 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
671 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
672 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
673 & KEEP(474), 0, BLR_U, KEEP8
674 & )
675.LT. IF (IFLAG0) GOTO 600
676 CALL SMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
677 & NFRONT, IW(IOLDPS+XXF), 1,
678 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
679 & NB_BLR, NPARTSASS, NELIM,
680 & 2, 0,
681 & .FALSE., IFLAG, IERROR, 0,
682 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
683 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
684 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
685 & KEEP(474), 0, BLR_U, KEEP8,
686 & END_I_IN=END_I
687 & )
688 600 CONTINUE
689#if defined(BLR_MT)
690!$OMP END PARALLEL
691#endif
692.LT. IF (IFLAG0) GOTO 500
693 ENDIF
694 ENDIF
695.EQ. IF (KEEP(486)3) THEN
696.EQ. IF (KEEP(480)0) THEN
697 DEALLOCATE(BLR_U,BLR_L)
698 NULLIFY(BLR_L)
699 NULLIFY(BLR_U)
700 ENDIF
701 ENDIF
702 GOTO 100
703 ENDIF
704.EQ. IF (KEEP(475)0) THEN
705.LT. IF (IEND_BLRNFRONT) THEN
706 CALL SMUMPS_FAC_SQ(IBEG_BLR, IEND_BLR,
707 & NPIV, NFRONT, NASS,
708 & -77777,
709 & A, LA, POSELT,
710 & -77777,
711 & .TRUE., .FALSE., .FALSE.,
712 & .FALSE.,
713 & LR_ACTIVATED)
714 ENDIF
715 ENDIF
716#if defined(BLR_MT)
717!$OMP PARALLEL PRIVATE(UPOS,LPOS,FIRST_BLOCK,LAST_BLOCK)
718#endif
719 CALL SMUMPS_COMPRESS_PANEL(A, LA, POSELT, IFLAG, IERROR,
720 & NFRONT,
721 & BEGS_BLR, NPARTSASS, DKEEP(8), KEEP(466), KEEP(473),
722 & BLR_L,
723 & CURRENT_BLR, 'v', WORK, TAU, JPVT, LWORK, RWORK,
724 & BLOCK, MAXI_CLUSTER, NELIM,
725 & .FALSE., 0, 0,
726 & 2, KEEP(483), KEEP8
727 & )
728#if defined(BLR_MT)
729!$OMP MASTER
730#endif
731.NE..AND..GT. IF ((KEEP(480)0NB_BLRCURRENT_BLR)
732.OR. &
733 & (
734.EQ. & (KEEP(486)2)
735 & )
736 & ) THEN
737.LT. IF (KEEP(480)5) THEN
738 CALL SMUMPS_BLR_SAVE_PANEL_LORU (
739 & IW(IOLDPS+XXF),
740 & 0,
741 & CURRENT_BLR, BLR_L)
742 ENDIF
743 ENDIF
744#if defined(BLR_MT)
745!$OMP END MASTER
746!$OMP BARRIER
747#endif
748.LT. IF (IFLAG0) GOTO 400
749.GT. IF (KEEP(475)0) THEN
750 CALL SMUMPS_BLR_PANEL_LRTRSM(A, LA, POSELT, NFRONT,
751 & IBEG_BLR,
752 & NPARTSASS, BLR_L, CURRENT_BLR, CURRENT_BLR+1,
753 & NPARTSASS, 2, 0, 0, .FALSE.)
754#if defined(BLR_MT)
755!$OMP BARRIER
756#endif
757 ENDIF
758.GE. IF (KEEP(480)2) THEN
759 UPOS = POSELT+int(BEGS_BLR(CURRENT_BLR)-1,8)*int(NFRONT,8)
760 & +int(BEGS_BLR(CURRENT_BLR+1)-NELIM-1,8)
761 LPOS = POSELT+int(BEGS_BLR(CURRENT_BLR+1)-1,8)*int(NFRONT,8)
762 & +int(BEGS_BLR(CURRENT_BLR+1)-NELIM-1,8)
763 CALL SMUMPS_BLR_UPD_NELIM_VAR_L(A, LA, UPOS, A, LA, LPOS,
764 & IFLAG, IERROR, NFRONT, NFRONT,
765 & BEGS_BLR, CURRENT_BLR, BLR_L, NPARTSASS,
766 & CURRENT_BLR+1, NELIM, 'n')
767.LT. IF (IFLAG0) GOTO 444
768.LT. IF (IEND_BLRNASS) THEN
769 CALL SMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
770 & NFRONT, IW(IOLDPS+XXF), 0,
771 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
772 & NB_BLR, NPARTSASS, NELIM,
773 & 2, 0,
774 & .FALSE., IFLAG, IERROR, 0,
775 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
776 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
777 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
778 & KEEP(474), 0, BLR_U, KEEP8
779 & )
780.LT. IF (IFLAG0) GOTO 442
781 CALL SMUMPS_BLR_UPD_PANEL_LEFT(A, LA, POSELT,
782 & NFRONT, IW(IOLDPS+XXF), 1,
783 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, ACC_LUA,
784 & NB_BLR, NPARTSASS, NELIM,
785 & 2, 0,
786 & .FALSE., IFLAG, IERROR, 0,
787 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477),
788 & KEEP(480), KEEP(479), KEEP(478), KEEP(476),
789 & KEEP(483), MAXI_CLUSTER, MAXI_RANK,
790 & KEEP(474), 0, BLR_U, KEEP8,
791 & END_I_IN=END_I
792 & )
793 442 CONTINUE
794 ENDIF
795 444 CONTINUE
796 ELSE
797 CALL SMUMPS_BLR_UPDATE_TRAILING(A, LA, POSELT,
798 & IFLAG, IERROR, NFRONT,
799 & BEGS_BLR, BEGS_BLR, CURRENT_BLR, BLR_L, NPARTSASS,
800 & BLR_U, NB_BLR, NELIM, .FALSE., 0,
801 & 2, 0,
802 & KEEP(481), DKEEP(11), KEEP(466), KEEP(477)
803 & )
804 ENDIF
805#if defined(BLR_MT)
806!$OMP BARRIER
807#endif
808.LT. IF (IFLAG0) GOTO 400
809.GT. IF (KEEP(475)0) THEN
810 FIRST_BLOCK = CURRENT_BLR+1
811.EQ..AND..EQ. IF (KEEP(486)2UU0) THEN
812 LAST_BLOCK = CURRENT_BLR
813 ELSE
814 LAST_BLOCK = NPARTSASS
815 ENDIF
816 CALL SMUMPS_DECOMPRESS_PANEL(A, LA, POSELT, NFRONT,
817 & NFRONT, .TRUE.,
818 & BEGS_BLR(CURRENT_BLR),
819 & BEGS_BLR(CURRENT_BLR+1), NPARTSASS, BLR_L, CURRENT_BLR, 'v',
820 & 1,
821 & BEG_I_IN=FIRST_BLOCK, END_I_IN=LAST_BLOCK)
822#if defined(BLR_MT)
823#endif
824 ENDIF
825.GE. IF (KEEP(475)2) THEN
826.EQ. IF (KEEP(475)2) THEN
827 FIRST_BLOCK = NPARTSASS+1
828 ELSE
829 FIRST_BLOCK = CURRENT_BLR+1
830 ENDIF
831.NE. IF (KEEP(486)2) THEN
832 LAST_BLOCK = END_I
833.GT. ELSEIF(UU0) THEN
834 LAST_BLOCK = NPARTSASS
835 ELSE
836 LAST_BLOCK = CURRENT_BLR
837 ENDIF
838 CALL SMUMPS_DECOMPRESS_PANEL(A, LA, POSELT, NFRONT,
839 & NFRONT, .TRUE.,
840 & BEGS_BLR(CURRENT_BLR),
841 & BEGS_BLR(CURRENT_BLR+1), NB_BLR, BLR_U, CURRENT_BLR, 'h',
842 & 1,
843 & BEG_I_IN=FIRST_BLOCK, END_I_IN=LAST_BLOCK)
844 ENDIF
845 400 CONTINUE
846#if defined(BLR_MT)
847!$OMP END PARALLEL
848#endif
849.LT. IF (IFLAG0) GOTO 500
850.EQ. IF (KEEP(486)3) THEN
851.EQ..OR..EQ. IF (KEEP(480)0NB_BLRCURRENT_BLR) THEN
852 CALL DEALLOC_BLR_PANEL(BLR_U, NB_BLR-CURRENT_BLR,
853 & KEEP8, KEEP(34))
854 CALL DEALLOC_BLR_PANEL(BLR_L, NPARTSASS-CURRENT_BLR,
855 & KEEP8, KEEP(34))
856 DEALLOCATE(BLR_U,BLR_L)
857 ENDIF
858 ENDIF
859 NULLIFY(BLR_L)
860 NULLIFY(BLR_U)
861 ENDIF
862 IF ( OOC_EFFECTIVE_ON_FRONT ) THEN
863 STRAT = STRAT_TRY_WRITE
864 MonBloc%LastPiv = NPIV
865 LAST_CALL= .FALSE.
866 CALL SMUMPS_OOC_IO_LU_PANEL
867 & ( STRAT, TYPEF_BOTH_LU,
868 & A(POSELT), LAFAC, MonBloc,
869 & LNextPiv2beWritten, UNextPiv2beWritten,
870 & IW(IOLDPS), LIWFAC,
871 & MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
872 IF (IFLAG_OOC < 0 ) THEN
873 IFLAG=IFLAG_OOC
874 GOTO 500
875 ENDIF
876 ENDIF
877 100 CONTINUE
878 END DO
879 IF (LR_ACTIVATED) THEN
880 IBEG_BLR = IW(IOLDPS+1+XSIZE) + 1
881 BEGS_BLR( CURRENT_BLR + 1 ) = IBEG_BLR
882.EQ. IF ( (KEEP(486)2)
883 & ) THEN
884 CALL SMUMPS_BLR_RETRIEVE_BEGSBLR_STA(IW(IOLDPS+XXF),
885 & BEGS_BLR_STATIC)
886.GT. IF (UU0) THEN
887 allocate(BEGS_BLR_TMP(NB_BLR+1),stat=allocok)
888 IF (allocok > 0) THEN
889 IFLAG = -13
890 IERROR = NB_BLR+1
891 GOTO 500
892 ENDIF
893 DO IP=1,NB_BLR+1
894 BEGS_BLR_TMP(IP) = BEGS_BLR_STATIC(IP)
895 ENDDO
896 ENDIF
897 ENDIF
898 IF (
899.EQ. & (KEEP(486)2)
900 & ) THEN
901 MEM_TOT = 0
902#if defined(BLR_MT)
903!$OMP PARALLEL
904!$OMP& PRIVATE(IP, LorU, DIR, NELIM)
905#endif
906#if defined(BLR_MT)
907!$OMP DO PRIVATE(DIAG, DIAGSIZ_STA, DIAGSIZ_DYN, DPOS, POSELT_DIAG, MEM,
908!$OMP& allocok)
909!$OMP& REDUCTION(+:MEM_TOT)
910#endif
911 DO IP=1,NPARTSASS
912.LT. IF (IFLAG0) CYCLE
913 DIAGSIZ_DYN = BEGS_BLR(IP+1)-BEGS_BLR(IP)
914 DIAGSIZ_STA = BEGS_BLR_STATIC(IP+1)-BEGS_BLR(IP)
915 MEM = DIAGSIZ_DYN*(2*DIAGSIZ_STA-DIAGSIZ_DYN)
916 MEM_TOT = MEM_TOT + MEM
917 ALLOCATE(DIAG(MEM), stat=allocok)
918 IF (allocok > 0) THEN
919 IFLAG = -13
920 IERROR = MEM
921 CYCLE
922 ENDIF
923 DPOS = 1
924 POSELT_DIAG = POSELT + int(BEGS_BLR(IP)-1,8)*int(NFRONT,8)
925 & + int(BEGS_BLR(IP)-1,8)
926 DO I=1,DIAGSIZ_STA
927.LE. IF (IDIAGSIZ_DYN) THEN
928 DIAG(DPOS:DPOS+DIAGSIZ_STA-1) =
929 & A(POSELT_DIAG:POSELT_DIAG+int(DIAGSIZ_STA-1,8))
930 DPOS = DPOS + DIAGSIZ_STA
931 ELSE
932 DIAG(DPOS:DPOS+DIAGSIZ_DYN-1) =
933 & A(POSELT_DIAG:POSELT_DIAG+int(DIAGSIZ_DYN-1,8))
934 DPOS = DPOS + DIAGSIZ_DYN
935 ENDIF
936 POSELT_DIAG = POSELT_DIAG + int(NFRONT,8)
937 ENDDO
938 CALL SMUMPS_BLR_SAVE_DIAG_BLOCK(
939 & IW(IOLDPS+XXF),
940 & IP, DIAG)
941 ENDDO
942#if defined(BLR_MT)
943!$OMP ENDDO
944!$OMP SINGLE
945#endif
946 CALL MUMPS_DM_FAC_UPD_DYN_MEMCNTS(int(MEM_TOT,8),
947 & .FALSE., KEEP8, IFLAG, IERROR, .TRUE., .TRUE.)
948#if defined(BLR_MT)
949!$OMP END SINGLE
950#endif
951.LT. IF (IFLAG0) GOTO 460
952.GT. IF (UU0) THEN
953 DO IP=1,NPARTSASS
954 NELIM = BEGS_BLR_TMP(IP+1)-BEGS_BLR(IP+1)
955 DO LorU=0,1
956#if defined(BLR_MT)
957!$OMP SINGLE
958#endif
959 CALL SMUMPS_BLR_RETRIEVE_PANEL_LORU(
960 & IW(IOLDPS+XXF), LorU, IP, BLR_PANEL)
961 CALL DEALLOC_BLR_PANEL(BLR_PANEL, NPARTSASS-IP, KEEP8,
962 & KEEP(34))
963#if defined(BLR_MT)
964!$OMP END SINGLE
965#endif
966.EQ. IF (LorU0) THEN
967 DIR = 'v'
968 ELSE
969 DIR = 'h'
970 ENDIF
971 CALL SMUMPS_COMPRESS_PANEL(A, LA, POSELT, IFLAG,
972 & IERROR, NFRONT, BEGS_BLR_TMP,
973 & NB_BLR, DKEEP(8), KEEP(466), KEEP(473),
974 & BLR_PANEL, IP,
975 & DIR, WORK, TAU, JPVT, LWORK, RWORK,
976 & BLOCK, MAXI_CLUSTER, NELIM,
977 & .FALSE., 0, 0,
978 & 2, KEEP(483), KEEP8,
979 & END_I_IN=NPARTSASS, FRSWAP=.TRUE.
980 & )
981#if defined(BLR_MT)
982!$OMP BARRIER
983#endif
984.LT. IF (IFLAG0) GOTO 440
985 ENDDO
986#if defined(BLR_MT)
987!$OMP BARRIER
988!$OMP SINGLE
989#endif
990 BEGS_BLR_TMP(IP+1) = BEGS_BLR(IP+1)
991#if defined(BLR_MT)
992!$OMP END SINGLE
993#endif
994 ENDDO
995#if defined(BLR_MT)
996!$OMP BARRIER
997#endif
998 440 CONTINUE
999 ENDIF
1000 460 CONTINUE
1001#if defined(BLR_MT)
1002!$OMP END PARALLEL
1003#endif
1004.GT. IF (UU0) THEN
1005 deallocate(BEGS_BLR_TMP)
1006 ENDIF
1007 ENDIF
1008.LT. IF (IFLAG0) GOTO 500
1009.EQ. IF ( (KEEP(486)2)
1010 & ) THEN
1011 CALL SMUMPS_BLR_SAVE_BEGS_BLR_DYN(IW(IOLDPS+XXF),
1012 & BEGS_BLR)
1013 ENDIF
1014.GE. IF (IFLAG0) THEN
1015 CALL UPD_MRY_LU_FR(NASS, NFRONT-NASS, 0, NELIM)
1016 DO IP=1,NPARTSASS
1017 CALL SMUMPS_BLR_RETRIEVE_PANEL_LORU(
1018 & IW(IOLDPS+XXF), 0, IP, BLR_PANEL)
1019 CALL UPD_MRY_LU_LRGAIN(BLR_PANEL, NPARTSASS-IP
1020 & )
1021 CALL SMUMPS_BLR_RETRIEVE_PANEL_LORU(
1022 & IW(IOLDPS+XXF), 1, IP, BLR_PANEL)
1023 CALL UPD_MRY_LU_LRGAIN(BLR_PANEL, NB_BLR-IP
1024 & )
1025 ENDDO
1026 CALL UPD_FLOP_FACTO_FR(NFRONT, NASS, NASS-NELIM, 0, 2)
1027 ENDIF
1028 ENDIF
1029.NE. IF (KEEP(486)0) THEN
1030.NOT. IF (LR_ACTIVATED) THEN
1031 CALL UPD_FLOP_FRFRONTS(NFRONT, NPIV, NASS, 0, 2)
1032 ENDIF
1033 ENDIF
1034.LT. IF (IFLAG0) GOTO 500
1035 IF ( OOC_EFFECTIVE_ON_FRONT ) THEN
1036 STRAT = STRAT_WRITE_MAX
1037 MonBloc%Last = .TRUE.
1038 MonBloc%LastPiv = IW(IOLDPS+1+XSIZE)
1039 LAST_CALL = .TRUE.
1040 CALL SMUMPS_OOC_IO_LU_PANEL
1041 & ( STRAT, TYPEF_BOTH_LU,
1042 & A(POSELT), LAFAC, MonBloc,
1043 & LNextPiv2beWritten, UNextPiv2beWritten,
1044 & IW(IOLDPS), LIWFAC,
1045 & MYID, KEEP8(31), IFLAG_OOC, LAST_CALL )
1046 IF (IFLAG_OOC < 0 ) THEN
1047 IFLAG=IFLAG_OOC
1048 GOTO 500
1049 ENDIF
1050 CALL SMUMPS_OOC_PP_TRYRELEASE_SPACE (IWPOS,
1051 & IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP)
1052 ENDIF
1053 GOTO 700
1054 480 CONTINUE
1055 500 CONTINUE
1056 CALL SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
1057 700 CONTINUE
1058 IF (LR_ACTIVATED) THEN
1059 IF (allocated(RWORK)) DEALLOCATE(RWORK)
1060 IF (allocated(WORK)) DEALLOCATE(WORK)
1061 IF (allocated(TAU)) DEALLOCATE(TAU)
1062 IF (allocated(JPVT)) DEALLOCATE(JPVT)
1063 IF (allocated(BLOCK)) DEALLOCATE(BLOCK)
1064 IF (associated(ACC_LUA)) THEN
1065.GE. IF (KEEP(480)3) THEN
1066 DO MY_NUM=1,OMP_NUM
1067 CALL DEALLOC_LRB(ACC_LUA(MY_NUM), KEEP8, KEEP(34))
1068 ENDDO
1069 ENDIF
1070 DEALLOCATE(ACC_LUA)
1071 ENDIF
1072 IF (associated(BEGS_BLR)) THEN
1073 DEALLOCATE(BEGS_BLR)
1074 NULLIFY(BEGS_BLR)
1075 ENDIF
1076 ENDIF
1077.AND..NE. IF (LR_ACTIVATEDKEEP(480)0) THEN
1078.NOT. IF (
1079 & (
1080.EQ. & (KEEP(486)2)
1081 & )
1082 & )
1083 & THEN
1084 CALL SMUMPS_BLR_FREE_ALL_PANELS(IW(IOLDPS+XXF), 2,
1085 & KEEP8, KEEP(34))
1086 ENDIF
1087 ENDIF
1088 IF (LR_ACTIVATED) THEN
1089.NOT. IF (
1090 & (
1091.EQ. & (KEEP(486)2)
1092 & )
1093 & ) THEN
1094 CALL SMUMPS_BLR_END_FRONT(IW(IOLDPS+XXF), IFLAG, KEEP8,
1095 & KEEP(34))
1096 ENDIF
1097 ENDIF
1098 DEALLOCATE( IPIV )
1099 RETURN
1100 END SUBROUTINE SMUMPS_FAC2_LU
1101 END MODULE SMUMPS_FAC2_LU_M
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
smumps_ana_lr
Definition sana_lr.F:14
smumps_ana_lr::get_cut
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
Definition sana_lr.F:25
smumps_buf
Definition smumps_comm_buffer.F:14
smumps_buf::smumps_buf_test
subroutine, public smumps_buf_test()
Definition smumps_comm_buffer.F:689
smumps_fac2_lu_m
Definition sfac_front_LU_type2.F:14
smumps_fac2_lu_m::smumps_fac2_lu
subroutine smumps_fac2_lu(comm_load, ass_irecv, n, inode, fpere, iw, liw, a, la, uu, noffw, npvw, 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 sfac_front_LU_type2.F:35
smumps_fac_front_aux_m
Definition sfac_front_aux.F:14
smumps_fac_front_aux_m::smumps_fac_mq
subroutine smumps_fac_mq(ibeg_block, iend_block, nfront, nass, npiv, last_col, a, la, poselt, ifinb, lr_activated)
Definition sfac_front_aux.F:573
smumps_fac_front_aux_m::smumps_fac_sq
subroutine smumps_fac_sq(ibeg_block, iend_block, npiv, nfront, last_row, last_col, a, la, poselt, first_col, call_ltrsm, call_utrsm, call_gemm, with_comm_thread, lr_activated)
Definition sfac_front_aux.F:443
smumps_fac_front_aux_m::smumps_fac_i
subroutine smumps_fac_i(nfront, nass, last_row, ibeg_block, iend_block, n, inode, iw, liw, a, la, inopv, noffw, nbtinyw, det_expw, det_mantw, det_signw, iflag, ioldps, poselt, uu, seuil, keep, keep8, dkeep, pivnul_list, lpn_list pp_first2swap_l, pp_lastpanelondisk_l, pp_lastpivrptrfilled_l, pp_first2swap_u, pp_lastpanelondisk_u, pp_lastpivrptrfilled_u, pivot_option, lr_activated, iend_blr, inextpiv, ooc_effective_on_front, nvschur, parpiv_t1, tipiv)
Definition sfac_front_aux.F:720
smumps_fac_front_aux_m::smumps_get_size_schur_in_front
subroutine smumps_get_size_schur_in_front(n, ncb, size_schur, row_indices, perm, nvschur)
Definition sfac_front_aux.F:2505
smumps_fac_front_type2_aux_m
Definition sfac_front_type2_aux.F:14
smumps_fac_front_type2_aux_m::smumps_send_factored_blk
subroutine smumps_send_factored_blk(comm_load, ass_irecv, n, inode, fpere, iw, liw, ioldps, poselt, a, la, lda_fs, ibeg_block, iend, tipiv, lpiv, lastbl, nb_bloc_fac, 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, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, nelim, lr_activated, npartsass, current_blr_panel, blr_loru, lrgroups)
Definition sfac_front_type2_aux.F:696
smumps_fac_lr
Definition sfac_lr.F:14
smumps_fac_lr::smumps_compress_panel
subroutine smumps_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 sfac_lr.F:2199
smumps_lr_core
Definition slr_core.F:18
smumps_lr_core::max_cluster
subroutine max_cluster(cut, cut_size, maxi_cluster)
Definition slr_core.F:1304
smumps_lr_core::alloc_lrb
subroutine alloc_lrb(lrb_out, k, m, n, islr, iflag, ierror, keep8)
Definition slr_core.F:111
smumps_lr_core::regrouping2
subroutine regrouping2(cut, npartsass, nass, npartscb, ncb, ibcksz, onlycb, k472)
Definition slr_core.F:184
smumps_lr_data_m
Definition smumps_lr_data_m.F:14
smumps_lr_data_m::smumps_blr_save_panel_loru
subroutine, public smumps_blr_save_panel_loru(iwhandler, loru, ipanel, lrb_panel)
Definition smumps_lr_data_m.F:512
smumps_lr_data_m::smumps_blr_save_init
subroutine, public smumps_blr_save_init(iwhandler, issym, ist2, isslave, nb_panels, begs_blr_l, begs_blr_col, nb_accesses_init, info)
Definition smumps_lr_data_m.F:235
smumps_lr_data_m::smumps_blr_init_front
subroutine, public smumps_blr_init_front(iwhandler, info, mtk405)
Definition smumps_lr_data_m.F:175
smumps_lr_stats
Definition slr_stats.F:14
smumps_lr_stats::cnt_nodes
integer cnt_nodes
Definition slr_stats.F:23
smumps_lr_type
Definition slr_type.F:14
smumps_lr_type::dealloc_lrb
subroutine dealloc_lrb(lrb_out, keep8, k34)
Definition slr_type.F:25
smumps_ooc
Definition smumps_ooc.F:14
smumps_ooc::smumps_ooc_io_lu_panel
subroutine, public smumps_ooc_io_lu_panel(strat, typefile, afac, lafac, monbloc, lnextpiv2bewritten, unextpiv2bewritten, iw, liwfac, myid, filesize, ierr, last_call)
Definition smumps_ooc.F:3032
smumps_struc_def
Definition smumps_struc_def.F:14
smumps_set_innerblocksize
subroutine smumps_set_innerblocksize(size_inner, nass, keep)
Definition stools.F:2142
smumps_lr_type::lrb_type
Definition slr_type.F:16
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888