OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sfac_asm_master_ELT_m.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_fac_asm_master_elt_m
15 CONTAINS
16 SUBROUTINE smumps_fac_asm_niv1_elt( COMM_LOAD, ASS_IRECV,
17 & NELT, FRT_PTR, FRT_ELT,
18 & N, INODE, IW, LIW, A, LA, INFO, ND,
19 & FILS, FRERE, DAD, MAXFRW, root,
20 & OPASSW, OPELIW, PTRIST, PTLUST, PTRFAC, PTRAST,
21 & STEP, PIMASTER, PAMASTER,PTRARW,
22 & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS, SON_LEVEL2,
23 & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS, LRLUSM,
24 & ICNTL, KEEP,KEEP8,DKEEP,INTARR,LINTARR,DBLARR,LDBLARR,
25 &
26 & NSTK_S,PROCNODE_STEPS, SLAVEF, COMM,MYID,
27 & BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF,
28 & PERM,
29 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
30 & , LRGROUPS
31 & , MUMPS_TPS_ARR, SMUMPS_TPS_ARR, L0_OMP_MAPPING
32 & )
33!$ USE OMP_LIB
34 USE mumps_tps_m
35 USE smumps_tps_m
36 USE smumps_dynamic_memory_m, ONLY : smumps_dm_set_ptr,
37 & smumps_dm_free_block
38 USE mumps_build_sort_index_elt_m
39 USE smumps_buf
40 USE smumps_load
41 USE smumps_lr_core, ONLY : is_front_blr_candidate,
42 & smumps_blr_asm_niv1
43 USE smumps_lr_data_m, ONLY : smumps_blr_init_front,
44 & smumps_blr_save_nfs4father
45 USE smumps_struc_def, ONLY : smumps_root_struc
46 USE smumps_ana_lr, ONLY : get_cut
47 USE smumps_lr_core, ONLY : max_cluster
48 USE mumps_lr_common, ONLY : compute_blr_vcs
49 IMPLICIT NONE
50 TYPE (SMUMPS_ROOT_STRUC) :: root
51 INTEGER COMM_LOAD, ASS_IRECV
52 INTEGER IZERO
53 PARAMETER (IZERO=0)
54 INTEGER N, NSTEPS
55 INTEGER NELT
56 INTEGER(8) LA, LRLU, LRLUS, LRLUSM, IPTRLU, POSFAC
57 INTEGER KEEP(500), ICNTL(60)
58 INTEGER(8) KEEP8(150)
59 REAL DKEEP(230)
60 INTEGER, INTENT(INOUT) :: INFO(2)
61 INTEGER INODE,MAXFRW,
62 & iwposcb, comp
63 INTEGER, TARGET :: IWPOS, LIW
64 TYPE (MUMPS_TPS_T), TARGET, OPTIONAL :: MUMPS_TPS_ARR(:)
65 TYPE (SMUMPS_TPS_T), TARGET, OPTIONAL :: SMUMPS_TPS_ARR(:)
66 INTEGER, INTENT(IN), OPTIONAL :: L0_OMP_MAPPING(:)
67 INTEGER IDUMMY(1)
68 INTEGER, PARAMETER :: LIDUMMY = 1
69 INTEGER, TARGET :: IW(LIW)
70 INTEGER(8), INTENT(IN) :: PTRARW(NELT+1), PTRAIW(NELT+1)
71 INTEGER ITLOC(N+KEEP(253)),
72 & nd(keep(28)), perm(n),
73 & fils(n), frere(keep(28)), dad(keep(28)),
74 & ptrist(keep(28)), ptlust(keep(28)),
75 & step(n), pimaster(keep(28))
76 REAL :: RHS_MUMPS(KEEP(255))
77 INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)),
78 & PAMASTER(KEEP(28))
79 INTEGER COMM, NBFIN, SLAVEF, MYID
80 INTEGER ISTEP_TO_INIV2(KEEP(71)),
81 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
82 INTEGER FRT_PTR(N+1), FRT_ELT(NELT)
83 INTEGER ETATASS
84 LOGICAL SON_LEVEL2
85 REAL, TARGET :: A(LA)
86 INTEGER, INTENT(IN) :: LRGROUPS(N)
87 DOUBLE PRECISION OPASSW, OPELIW
88 INTEGER(8), INTENT(IN) :: LINTARR, LDBLARR
89 REAL DBLARR(LDBLARR)
90 INTEGER INTARR(LINTARR)
91 INTEGER LPOOL, LEAF
92 INTEGER LBUFR, LBUFR_BYTES
93 INTEGER IPOOL( LPOOL )
94 INTEGER NSTK_S(KEEP(28))
95 INTEGER PROCNODE_STEPS(KEEP(28))
96 INTEGER BUFR( LBUFR )
97 LOGICAL PACKED_CB, IS_CB_LR
98 INTEGER, EXTERNAL :: MUMPS_TYPENODE
99 INTEGER, EXTERNAL :: MUMPS_PROCNODE
100 include 'mpif.h'
101 INTEGER :: IERR
102 INTEGER :: STATUS(MPI_STATUS_SIZE)
103!$ INTEGER :: NOMP
104 include 'mumps_headers.h'
105 INTEGER LP, HS, HF
106 LOGICAL LPOK
107 INTEGER NBPANELS_L, NBPANELS_U
108 INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL
109 INTEGER NFS4FATHER, ESTIM_NFS4FATHER_ATSON
110 INTEGER IFATH
111 INTEGER PARPIV_T1
112 INTEGER(8) NFRONT8, LAELL8, KEEP8TMPCOPY
113 INTEGER NFRONT,NFRONT_EFF,ISTCHK,ISTCHK_CB_RIGHT,LSTK,LREQ
114 INTEGER LREQ_OOC
115 INTEGER :: SON_XXS, SON_XXLR, SON_XXG
116 INTEGER(8) LSTK8, SIZFR8
117 LOGICAL :: IS_DYNAMIC_CB
118 INTEGER(8) :: DYN_SIZE
119 INTEGER SIZFI, NCB
120 INTEGER NCOLS, NROWS, LDA_SON
121 INTEGER NELIM, IORG, IBROT
122 INTEGER :: J253
123#if ! defined(ZERO_TRIANGLE)
124 INTEGER(8) :: NUMROWS, JJ3
125#endif
126 INTEGER :: TOPDIAG
127!$ INTEGER :: CHUNK
128!$ INTEGER(8) :: CHUNK8
129 INTEGER(8) APOS, APOS2, LAPOS2
130 INTEGER(8) POSELT, POSEL1, ICT12, ICT21
131 INTEGER(8) IACHK
132 INTEGER(8) JJ2
133 INTEGER(8) :: JJ8, J18, J28
134 INTEGER(8) :: AINPUT8, AII8
135 INTEGER :: K1, K2, K3, KK, KK1
136 INTEGER JPOS,ICT11, IJROW
137 INTEGER Pos_First_NUMORG,NUMORG,IOLDPS,
138 & numelt, elbeg
139 INTEGER :: J
140 INTEGER NSLAVES, NSLSON, NPIVS, NPIV_ANA, NPIV
141 INTEGER PTRCOL, ISLAVE, PDEST,LEVEL
142 LOGICAL LEVEL1, NIV1
143 INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX
144 INTEGER ELTI
145 INTEGER(8) :: SIZE_ELTI8
146 INTEGER(8) :: II8
147 INTEGER :: I
148 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
149 INTEGER LRSTATUS
150 LOGICAL COMPRESS_PANEL, LR_ACTIVATED, COMPRESS_CB,
151 & oocwrite_compatible_with_blr
152 INTEGER :: ITHREAD
153 INTEGER, POINTER :: SON_IWPOS, SON_LIW
154 INTEGER, POINTER, DIMENSION(:) :: SON_IW
155 REAL, POINTER, DIMENSION(:) :: SON_A
156 INTEGER NCBSON
157 LOGICAL SAME_PROC
158 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
159 INTEGER :: NB_BLR, NPARTSCB, NPARTSASS, MAXI_CLUSTER,
160 & ibcksz2, minsize
161 REAL ZERO
162 parameter( zero = 0.0e0 )
163 LOGICAL MUMPS_INSSARBR, SSARBR
164 EXTERNAL mumps_inssarbr
165 DOUBLE PRECISION FLOP1,FLOP1_EFF
166 EXTERNAL mumps_in_or_root_ssarbr
167 LOGICAL MUMPS_IN_OR_ROOT_SSARBR
168!$ NOMP = OMP_GET_MAX_THREADS()
169 lp = icntl(1)
170 lpok = ((lp.GT.0).AND.(icntl(4).GE.1))
171 nfs4father = -1
172 etatass = 0
173 packed_cb = .false.
174 is_cb_lr = .false.
175 in = inode
176 level = mumps_typenode(procnode_steps(step(inode)),keep(199))
177 IF (level.NE.1) THEN
178 WRITE(*,*) 'INTERNAL ERROR 1 in SMUMPS_FAC_ASM_NIV1_ELT '
179 CALL mumps_abort()
180 END IF
181 nslaves = 0
182 hf = 6 + nslaves + keep(ixsz)
183 numelt = frt_ptr(inode+1) - frt_ptr(inode)
184 IF ( numelt .ne. 0 ) THEN
185 elbeg = frt_ptr(inode)
186 ELSE
187 elbeg = 1
188 END IF
189 numorg = 0
190 DO WHILE (in.GT.0)
191 numorg = numorg + 1
192 in = fils(in)
193 END DO
194 npiv_ana=numorg
195 nsteps = nsteps + 1
196 numstk = 0
197 nass = 0
198 ifson = -in
199 ison = ifson
200 IF (ison .NE. 0) THEN
201 DO WHILE (ison .GT. 0)
202 numstk = numstk + 1
203 son_iw => iw
204 IF (keep(400).GT.0) THEN
205 IF (present(l0_omp_mapping)) THEN
206 ithread=l0_omp_mapping(step(ison))
207 IF (ithread .NE.0) THEN
208 son_iw=>mumps_tps_arr(ithread)%IW
209 ENDIF
210 ENDIF
211 ENDIF
212 nass = nass + son_iw(pimaster(step(ison))+1+keep(ixsz))
213 ison = frere(step(ison))
214 END DO
215 ENDIF
216 nfront = nd(step(inode)) + nass + keep(253)
217 nass1 = nass + numorg
218 CALL is_front_blr_candidate(inode, 1, nd(step(inode)),
219 & numorg, keep(486),
220 & keep(489), keep(490), keep(491), keep(492),
221 & keep(20), keep(60), dad(step(inode)), keep(38),
222 & lrstatus, n, lrgroups)
223 IF (dad(step(inode)).NE.0) THEN
224 IF ( mumps_procnode(procnode_steps(step(dad(step(inode)))),
225 & keep(199) )
226 & .NE. myid
227 & .AND.
228 & mumps_typenode(procnode_steps(step(dad(step(inode)))),
229 & keep(199))
230 & .EQ.1
231 & ) THEN
232 IF (lrstatus.EQ.1 .OR. lrstatus.EQ.3) THEN
233 lrstatus = lrstatus-1
234 ENDIF
235 ENDIF
236 ENDIF
237 compress_panel = (lrstatus.GE.2)
238 compress_cb = ((lrstatus.EQ.1).OR.
239 & (lrstatus.EQ.3))
240 lr_activated = (lrstatus.GT.0)
241 IF (compress_cb.AND.(.NOT.compress_panel)) THEN
242 compress_panel = .true.
243 lrstatus = 3
244 ENDIF
245 oocwrite_compatible_with_blr =
246 & ( .NOT.lr_activated.OR.(.NOT.compress_panel).OR.
247 & (keep(486).NE.2)
248 & )
249 lreq_ooc = 0
250 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
251 CALL smumps_ooc_get_pp_sizes(keep(50), nfront, nfront, nass1,
252 & nbpanels_l, nbpanels_u, lreq_ooc)
253 ENDIF
254 lreq = hf + 2 * nfront + lreq_ooc
255 IF ((iwpos + lreq -1) .GT. iwposcb) THEN
256 CALL smumps_compre_new(n, keep,
257 & iw, liw, a, la,
258 & lrlu, iptrlu,
259 & iwpos, iwposcb, ptrist, ptrast,
260 & step, pimaster, pamaster, lrlus,
261 & keep(ixsz), comp, dkeep(97), myid, slavef,
262 & procnode_steps, dad)
263 IF (lrlu .NE. lrlus) THEN
264 WRITE( *, * ) 'PB compress SMUMPS_FAC_ASM_NIV1_ELT'
265 WRITE( *, * ) 'LRLU,LRLUS=',lrlu,lrlus
266 GOTO 270
267 END IF
268 IF ((iwpos + lreq -1) .GT. iwposcb) GOTO 270
269 END IF
270 ioldps = iwpos
271 iwpos = iwpos + lreq
272 niv1 = .true.
273 IF (.NOT. present(mumps_tps_arr).AND.
274 & .NOT. present(l0_omp_mapping) ) THEN
275 CALL mumps_elt_build_sort(
276 & numelt, frt_elt(elbeg),
277 & myid, inode, n, ioldps, hf,
278 & nfront, nfront_eff, perm,
279 & nass1, nass, numstk, numorg, iwposcb, iwpos,
280 & ifson, step, pimaster, ptrist, ptraiw, nelt, iw, liw,
281 & intarr, lintarr, itloc, fils, frere,
282 & keep,
283 & son_level2, niv1, info(1),
284 & dad,procnode_steps, slavef,
285 & frt_ptr, frt_elt, pos_first_numorg,
286 & idummy, lidummy )
287 ELSE
288 CALL mumps_elt_build_sort(
289 & numelt, frt_elt(elbeg),
290 & myid, inode, n, ioldps, hf,
291 & nfront, nfront_eff, perm,
292 & nass1, nass, numstk, numorg, iwposcb, iwpos,
293 & ifson, step, pimaster, ptrist, ptraiw, nelt, iw, liw,
294 & intarr, lintarr, itloc, fils, frere,
295 & keep,
296 & son_level2, niv1, info(1),
297 & dad,procnode_steps, slavef,
298 & frt_ptr, frt_elt, pos_first_numorg,
299 & idummy, lidummy
300 & , mumps_tps_arr, l0_omp_mapping )
301 ENDIF
302 IF (info(1).LT.0) GOTO 300
303 IF (nfront_eff.NE.nfront) THEN
304 IF (nfront.GT.nfront_eff) THEN
305 IF(mumps_in_or_root_ssarbr(procnode_steps(step(inode)),
306 & keep(199)))THEN
307 npiv=nass1-(nfront_eff-nd(step(inode)))
308 CALL mumps_get_flops_cost(nd(step(inode))+keep(253),
309 & npiv,npiv,
310 & keep(50),1,flop1)
311 npiv=npiv_ana
312 CALL mumps_get_flops_cost(nd(step(inode))+keep(253),
313 & npiv,npiv,
314 & keep(50),1,flop1_eff)
315 CALL smumps_load_update(0,.false.,flop1-flop1_eff,
316 & keep,keep8)
317 ENDIF
318 iwpos = iwpos - ((2*nfront)-(2*nfront_eff))
319 nfront = nfront_eff
320 lreq = hf + 2 * nfront + lreq_ooc
321 ELSE
322 IF (lpok) THEN
323 WRITE(lp,*)
324 & ' ERROR 1 during ass_niv1_ELT', nfront, nfront_eff
325 ENDIF
326 GOTO 270
327 ENDIF
328 ENDIF
329 IF (keep(201).EQ.1.AND.keep(50).NE.1.AND.
330 & oocwrite_compatible_with_blr) THEN
331 CALL smumps_ooc_pp_set_ptr(keep(50),
332 & nbpanels_l, nbpanels_u, nass1,
333 & ioldps + hf + 2 * nfront, iw, liw)
334 ENDIF
335 ncb = nfront - nass1
336 maxfrw = max0(maxfrw, nfront)
337 ict11 = ioldps + hf - 1 + nfront
338 CALL smumps_set_parpivt1 ( inode, nfront, nass1, keep,
339 & lr_activated, parpiv_t1)
340 nfront8=int(nfront,8)
341 laell8 = nfront8 * nfront8
342 IF(parpiv_t1.NE.0) THEN
343 laell8 = laell8+int(nass1,8)
344 ENDIF
345 CALL smumps_get_size_needed
346 & (0, laell8, .false.,
347 & keep(1), keep8(1),
348 & n,iw,liw,a,la,
349 & lrlu,iptrlu,iwpos,iwposcb,
350 & ptrist,ptrast,
351 & step, pimaster,pamaster,lrlus,
352 & keep(ixsz), comp, dkeep(97), myid,
353 & slavef, procnode_steps, dad,
354 & info(1), info(2))
355 IF (info(1).LT.0) GOTO 490
356 lrlu = lrlu - laell8
357 lrlus = lrlus - laell8
358 lrlusm = min( lrlus, lrlusm )
359 IF (keep(405).EQ.0) THEN
360 keep8(69) = keep8(69) + laell8
361 keep8(68) = max(keep8(69), keep8(68))
362 ELSE
363!$OMP ATOMIC CAPTURE
364 keep8(69) = keep8(69) + laell8
365 keep8tmpcopy = keep8(69)
366!$OMP END ATOMIC
367!$OMP ATOMIC UPDATE
368 keep8(68) = max(keep8(68), keep8tmpcopy)
369!$OMP END ATOMIC
370 ENDIF
371 poselt = posfac
372 posfac = posfac + laell8
373 ssarbr=mumps_inssarbr(procnode_steps(step(inode)),keep(199))
374 CALL smumps_load_mem_update(ssarbr,.false.,
375 & la-lrlus,
376 & 0_8,
377 & laell8,
378 & keep,keep8,
379 & lrlus)
380 IF (keep(405).EQ.0) keep(429)= keep(429)+1
381#if defined(ZERO_TRIANGLE)
382 lapos2 = poselt + laell8 - 1_8
383 a(poselt:lapos2) = zero
384#else
385 IF ( keep(50) .eq. 0 .OR. nfront .LT. keep(63) ) THEN
386 lapos2 = poselt + laell8 - 1_8
387!$ CHUNK8=int(KEEP(361),8)
388!$omp parallel DO private(jj8) schedule(static, chunk8)
389!$OMP& IF (LAPOS2 - POSELT + 1_8 > int(KEEP(361),8) .AND. NOMP .GT. 1)
390#if defined(__ve__)
391!NEC$ IVDEP
392#endif
393 DO jj8 = poselt, lapos2
394 a( jj8 ) = zero
395 ENDDO
396!$OMP END PARALLEL DO
397 ELSE
398 topdiag = max(keep(7), keep(8), keep(218))-1
399 IF (lr_activated) THEN
400 NULLIFY(begs_blr)
401 CALL get_cut(iw(ioldps+hf:ioldps+hf+nfront-1), nass1,
402 & ncb, lrgroups, npartscb,
403 & npartsass, begs_blr)
404 nb_blr = npartsass + npartscb
405 CALL max_cluster(begs_blr,nb_blr,maxi_cluster)
406 DEALLOCATE(begs_blr)
407 CALL compute_blr_vcs(keep(472), ibcksz2, keep(488), nass1)
408 minsize = int(ibcksz2 / 2)
409 topdiag = max(2*minsize + maxi_cluster-1,topdiag)
410 ENDIF
411 numrows = nfront8
412!$ CHUNK = max(KEEP(360)/2,
413!$ & ( ((int(NUMROWS)+NOMP-1) / NOMP + 2) / 3) )
414#if defined(__ve__)
415!NEC$ IVDEP
416#endif
417!$omp parallel DO private(apos,jj3) schedule(static, chunk )
418!$OMP& IF (int(NUMROWS - 1) .GT. KEEP(360) .AND. NOMP .GT. 1)
419 DO jj8 = 0_8, numrows - 1_8
420 apos = poselt + jj8 * nfront8
421 jj3 = min( nfront8 - 1_8, jj8 + topdiag )
422 a(apos:apos + jj3) = zero
423 ENDDO
424!$OMP END PARALLEL DO
425 END IF
426#endif
427 ptrast(step(inode)) = poselt
428 ptrfac(step(inode)) = poselt
429 ptlust(step(inode)) = ioldps
430 iw(ioldps+xxi) = lreq
431 CALL mumps_storei8(laell8,iw(ioldps+xxr))
432 CALL mumps_storei8(0_8,iw(ioldps+xxd))
433 iw(ioldps+xxs) = -9999
434 iw(ioldps+xxn) = -99999
435 iw(ioldps+xxp) = -99999
436 iw(ioldps+xxa) = -99999
437 iw(ioldps+xxf) = -99999
438 iw(ioldps+xxlr) = lrstatus
439 iw(ioldps + keep(ixsz)) = nfront
440 iw(ioldps + keep(ixsz)+ 1) = 0
441 iw(ioldps + keep(ixsz) + 2) = -nass1
442 iw(ioldps + keep(ixsz) + 3) = -nass1
443 iw(ioldps + keep(ixsz) + 4) = step(inode)
444 iw(ioldps + keep(ixsz) + 5) = nslaves
445 IF (lr_activated.AND.
446 & (keep(480).NE.0
447 & .OR.
448 & (
449 & (keep(486).EQ.2)
450 & )
451 & .OR.compress_cb
452 & )) THEN
453 CALL smumps_blr_init_front (iw(ioldps+xxf), info,
454 & mtk405=keep(405))
455 IF (info(1).LT.0) GOTO 500
456 ENDIF
457 estim_nfs4father_atson = -9999
458 IF (keep(219).NE.0.AND.keep(50).EQ.2) THEN
459 ifath = dad( step( inode) )
460 IF (ifath.NE.0) THEN
461 IF (compress_cb.AND.
462 & mumps_typenode(procnode_steps(step(ifath)),keep(199))
463 & .EQ. 2 ) THEN
464 ioldps = ptlust(step(inode))
465 CALL smumps_compute_estim_nfs4father (
466 & n, inode, ifath, fils, perm, keep,
467 & ioldps, hf, iw, liw, nfront, nass1,
468 & estim_nfs4father_atson
469 & )
470 CALL smumps_blr_save_nfs4father ( iw(ioldps+xxf),
471 & estim_nfs4father_atson )
472 ENDIF
473 ENDIF
474 ENDIF
475 IF (numstk.NE.0) THEN
476 ison = ifson
477 DO 220 iell = 1, numstk
478 istchk = pimaster(step(ison))
479 son_iw => iw
480 son_liw => liw
481 son_iwpos => iwpos
482 son_a => a
483 ithread = 0
484 IF (keep(400).GT.0) THEN
485 IF (present(l0_omp_mapping)) THEN
486 ithread=l0_omp_mapping(step(ison))
487 IF (ithread .NE.0) THEN
488 son_liw => mumps_tps_arr(ithread)%LIW
489 son_iw => mumps_tps_arr(ithread)%IW
490 son_iwpos => mumps_tps_arr(ithread)%IWPOS
491 son_a => smumps_tps_arr(ithread)%A
492 ENDIF
493 ENDIF
494 ENDIF
495 lstk = son_iw(istchk + keep(ixsz))
496 lstk8 = int(lstk,8)
497 nelim = son_iw(istchk + keep(ixsz) + 1)
498 npivs = son_iw(istchk + keep(ixsz) + 3)
499 IF ( npivs .LT. 0 ) npivs = 0
500 nslson = son_iw(istchk + keep(ixsz) + 5)
501 hs = 6 + keep(ixsz) + nslson
502 ncols = npivs + lstk
503 same_proc = (istchk.LT.son_iwpos)
504 IF ( same_proc ) THEN
505 istchk_cb_right = ptrist(step(ison))
506 ELSE
507 istchk_cb_right = istchk
508 ENDIF
509 son_xxs = son_iw(istchk_cb_right+xxs)
510 son_xxlr = son_iw(istchk_cb_right+xxlr)
511 son_xxg = son_iw(istchk_cb_right+xxg)
512 packed_cb = ( son_xxs .EQ. s_cb1comp )
513 is_cb_lr = ( son_xxlr.EQ.1 .OR. son_xxlr.EQ.3 )
514 & .AND. (keep(489).EQ.1.OR.keep(489).EQ.3)
515 level1 = nslson.EQ.0
516 IF (.NOT.same_proc) THEN
517 nrows = son_iw( istchk + keep(ixsz) + 2)
518 ELSE
519 nrows = ncols
520 ENDIF
521 sizfi = hs + nrows + ncols
522 k1 = istchk + hs + nrows + npivs
523 IF ( .NOT. level1 .AND. nelim.EQ.0 ) GOTO 205
524 IF (level1 .AND. .NOT. is_cb_lr) THEN
525 k2 = k1 + lstk - 1
526 IF (packed_cb) THEN
527 sizfr8 = (lstk8*(lstk8+1_8)/2_8)
528 ELSE
529 sizfr8 = lstk8*lstk8
530 ENDIF
531 ELSE
532 IF ( keep(50).eq.0 ) THEN
533 sizfr8 = int(nelim,8) * lstk8
534 ELSE
535 IF (packed_cb) THEN
536 sizfr8 = int(nelim,8) * int(nelim+1,8)/2_8
537 ELSE
538 sizfr8 = int(nelim,8) * int(nelim,8)
539 ENDIF
540 END IF
541 k2 = k1 + nelim - 1
542 ENDIF
543 IF (level1 .AND. .NOT. is_cb_lr) THEN
544 IF (keep(50).EQ.0) THEN
545 opassw = opassw + lstk8*lstk8
546 ELSE
547 opassw = opassw + lstk8*(lstk8+1)/2_8
548 ENDIF
549 ELSE
550 IF (keep(50).EQ.0) THEN
551 opassw = opassw + int(nelim,8)*lstk8
552 ELSE
553 opassw = opassw + int(nelim,8)*int(nelim,8)/2_8
554 ENDIF
555 ENDIF
556 CALL mumps_geti8(dyn_size, son_iw(istchk_cb_right+xxd))
557 is_dynamic_cb = dyn_size .GT. 0_8
558 IF ( is_dynamic_cb ) THEN
559 CALL smumps_dm_set_ptr( pamaster(step(ison)), dyn_size,
560 & son_a )
561 iachk = 1_8
562 ELSE
563 iachk = pamaster(step(ison))
564 ENDIF
565 IF (is_cb_lr .AND. level1) THEN
566 posel1 = ptrast(step(inode))
567 CALL smumps_blr_asm_niv1 (a, la,
568 & posel1, nfront, nass1, son_iw(istchk+xxf),
569 & son_iw, son_liw,
570 & lstk, nelim, k1, k1+lstk-1, keep(50),
571 & keep, keep8, opassw)
572 ENDIF
573 IF ( keep(50) .eq. 0 ) THEN
574 posel1 = ptrast(step(inode)) - nfront8
575 IF (k2.GE.k1) THEN
576#if defined(__ve__)
577!NEC$ IVDEP
578#endif
579 DO 170 kk = k1, k2
580 apos = posel1 + int(son_iw(kk),8) * nfront8
581#if defined(__ve__)
582!NEC$ IVDEP
583#endif
584 DO 160 kk1 = 1, lstk
585 jj2 = apos + int(son_iw(k1 + kk1 - 1) - 1,8)
586 a(jj2) = a(jj2) + son_a(iachk + int(kk1 - 1,8))
587 160 CONTINUE
588 iachk = iachk + lstk8
589 170 CONTINUE
590 END IF
591 ELSE
592 IF (level1 .AND. .NOT. is_cb_lr) THEN
593 lda_son = lstk
594 ELSE
595 lda_son = nelim
596 ENDIF
597 IF (sizfr8 .GT. 0) THEN
598 CALL smumps_ldlt_asm_niv12(a, la, son_a(iachk),
599 & ptrast(step( inode )), nfront, nass1,
600 & lda_son, sizfr8,
601 & son_iw( k1 ), k2 - k1 + 1, nelim, etatass,
602 & packed_cb
603!$ & , keep(360)
604 & )
605 ENDIF
606 ENDIF
607 205 IF (level1) THEN
608 IF (same_proc) istchk = ptrist(step(ison))
609 IF (same_proc) THEN
610 IF (keep(50).NE.0) THEN
611 k2 = k1 + lstk - 1
612#if defined(__ve__)
613!NEC$ IVDEP
614#endif
615 DO kk = k1, k2
616 son_iw(kk) = son_iw(kk - nrows)
617 ENDDO
618 ELSE
619 k2 = k1 + lstk - 1
620 k3 = k1 + nelim
621#if defined(__ve__)
622!NEC$ IVDEP
623#endif
624 DO kk = k3, k2
625 son_iw(kk) = son_iw(kk - nrows)
626 ENDDO
627 IF (nelim .NE. 0) THEN
628 k3 = k3 - 1
629#if defined(__ve__)
630!NEC$ IVDEP
631#endif
632 DO kk = k1, k3
633 jpos = son_iw(kk) + ict11
634 son_iw(kk) = iw(jpos)
635 ENDDO
636 ENDIF
637 ENDIF
638 ENDIF
639 IF ( same_proc ) THEN
640 ptrist(step(ison)) = -99999999
641 ELSE
642 pimaster(step( ison )) = -99999999
643 ENDIF
644 IF (ithread .EQ. 0) THEN
645 CALL smumps_free_block_cb_static(
646 & ssarbr, myid, n, istchk,
647 & iw, liw, lrlu, lrlus, iptrlu,
648 & iwposcb, la, keep,keep8,
649 & .false.
650 & )
651 ELSE
652 CALL mumps_load_disable()
653 CALL smumps_free_block_cb_static(
654 & ssarbr, myid, n, istchk,
655 & mumps_tps_arr(ithread)%IW(1),
656 & mumps_tps_arr(ithread)%LIW,
657 & mumps_tps_arr(ithread)%LRLU,
658 & mumps_tps_arr(ithread)%LRLUS,
659 & mumps_tps_arr(ithread)%IPTRLU,
660 & mumps_tps_arr(ithread)%IWPOSCB,
661 & mumps_tps_arr(ithread)%LA, keep,keep8, .false.
662 & )
663 CALL mumps_load_enable()
664 ENDIF
665 IF (is_dynamic_cb) THEN
666 CALL smumps_dm_free_block(son_xxg,
667 & son_a, sizfr8,
668 & keep(405).EQ.1, keep8 )
669 ENDIF
670 ELSE
671 pdest = istchk + 6 + keep(ixsz)
672 ncbson = lstk - nelim
673 ptrcol = istchk + hs + nrows + npivs + nelim
674 DO islave = 0, nslson-1
675 IF (iw(pdest+islave).EQ.myid) THEN
676 CALL mumps_bloc2_get_slave_info(
677 & keep, keep8, ison, step, n, slavef,
678 & istep_to_iniv2, tab_pos_in_pere,
679 & islave+1, ncbson,
680 & nslson,
681 & trow_size, first_index )
682 shift_index = first_index - 1
683 indx = ptrcol + shift_index
684 CALL smumps_maplig( comm_load, ass_irecv,
685 & bufr, lbufr, lbufr_bytes,
686 & inode, ison, nslaves, idummy,
687 & nfront, nass1, nfs4father,
688 & trow_size, iw( indx ),
689 & procnode_steps,
690 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
691 & lrlus, n, iw, liw, a, la,
692 & ptrist, ptlust, ptrfac, ptrast, step,
693 & pimaster, pamaster, nstk_s, comp,
694 & info(1), info(2), myid, comm, perm, ipool, lpool,
695 & leaf, nbfin, icntl, keep, keep8, dkeep, root,
696 & opassw, opeliw, itloc, rhs_mumps, fils, dad,
697 & ptrarw, ptraiw,
698 & intarr, dblarr, nd, frere,
699 & nelt+1, nelt, frt_ptr, frt_elt,
700 &
701 & istep_to_iniv2, tab_pos_in_pere, lrgroups
702 & )
703 IF ( info(1) .LT. 0 ) GOTO 500
704 EXIT
705 ENDIF
706 ENDDO
707 IF (pimaster(step(ison)).GT.0) THEN
708 ierr = -1
709 DO WHILE (ierr.EQ.-1)
710 ptrcol = pimaster(step(ison)) + hs + nrows + npivs + nelim
711 pdest = pimaster(step(ison)) + 6 + keep(ixsz)
712 CALL smumps_buf_send_maplig( inode, nfront,
713 & nass1, nfs4father,ison, myid,
714 & izero, idummy, iw(ptrcol), ncbson,
715 & comm, ierr, iw(pdest), nslson,
716 & slavef,
717 & keep,keep8, step, n,
718 & istep_to_iniv2, tab_pos_in_pere
719 & )
720 IF (ierr.EQ.-1) THEN
721 blocking = .false.
722 set_irecv = .true.
723 message_received = .false.
724 CALL smumps_try_recvtreat( comm_load, ass_irecv,
725 & blocking, set_irecv, message_received,
726 & mpi_any_source, mpi_any_tag,
727 & status,
728 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
729 & iwpos, iwposcb, iptrlu,
730 & lrlu, lrlus, n, iw, liw, a, la,
731 & ptrist, ptlust, ptrfac,
732 & ptrast, step, pimaster, pamaster, nstk_s, comp,
733 & info(1), info(2), comm,
734 & perm,
735 & ipool, lpool, leaf,
736 & nbfin, myid, slavef,
737 & root, opassw, opeliw, itloc, rhs_mumps,
738 & fils, dad, ptrarw, ptraiw,
739 & intarr, dblarr, icntl, keep, keep8,dkeep, nd, frere,
740 & nelt+1, nelt, frt_ptr, frt_elt,
741 & istep_to_iniv2, tab_pos_in_pere, .true., lrgroups )
742 IF ( info(1) .LT. 0 ) GOTO 500
743 ENDIF
744 END DO
745 IF (ierr .EQ. -2) GOTO 290
746 IF (ierr .EQ. -3) GOTO 295
747 ENDIF
748 ENDIF
749 ison = frere(step(ison))
750 220 CONTINUE
751 END IF
752 DO iell=elbeg,elbeg+numelt-1
753 elti = frt_elt(iell)
754 j18= ptraiw(elti)
755 j28= ptraiw(elti+1)-1
756 aii8 = ptrarw(elti)
757 size_elti8 = j28 - j18 + 1_8
758 DO ii8=j18,j28
759 i = intarr(ii8)
760 IF (keep(50).EQ.0) THEN
761 ainput8 = aii8 + ii8 - j18
762 ict12 = poselt + int(i-1,8) * nfront8
763 DO jj8=j18,j28
764 apos2 = ict12 + int(intarr(jj8) - 1,8)
765 a(apos2) = a(apos2) + dblarr(ainput8)
766 ainput8 = ainput8 + size_elti8
767 END DO
768 ELSE
769 ict12 = poselt + int(- nfront + i - 1,8)
770 ict21 = poselt + int(i-1,8)*nfront8 - 1_8
771 DO jj8=ii8,j28
772 j = intarr(jj8)
773 IF (i.LT.j) THEN
774 apos2 = ict12 + int(j,8)*nfront8
775 ELSE
776 apos2 = ict21 + int(j,8)
777 ENDIF
778 a(apos2) = a(apos2) + dblarr(aii8)
779 aii8 = aii8 + 1_8
780 END DO
781 END IF
782 END DO
783 END DO
784 IF (keep(253).GT.0) THEN
785 poselt = ptrast(step(inode))
786 ibrot = inode
787 ijrow = pos_first_numorg
788 DO iorg = 1, numorg
789 IF (keep(50).EQ.0) THEN
790 DO j253=1, keep(253)
791 apos = poselt+
792 & int(ijrow-1,8) * nfront8 +
793 & int(nfront-keep(253)+j253-1,8)
794 a(apos) = a(apos) + rhs_mumps( (j253-1)*keep(254)+ibrot )
795 ENDDO
796 ELSE
797 DO j253=1, keep(253)
798 apos = poselt+
799 & int(nfront-keep(253)+j253-1,8) * nfront8 +
800 & int(ijrow-1,8)
801 a(apos) = a(apos) + rhs_mumps( (j253-1)*keep(254)+ibrot )
802 ENDDO
803 ENDIF
804 ibrot = fils(ibrot)
805 ijrow = ijrow+1
806 ENDDO
807 ENDIF
808 IF (parpiv_t1.NE.0.AND.(.NOT.son_level2)) THEN
809 ioldps = ptlust(step(inode))
810 CALL smumps_parpivt1_set_nvschur_max (
811 & n, inode, iw, liw, a, la, keep, perm,
812 & ioldps, poselt,
813 & nfront, nass1, lr_activated, parpiv_t1, nass)
814 ENDIF
815 GOTO 500
816 270 CONTINUE
817 info(1) = -8
818 info(2) = lreq
819 IF (lpok) THEN
820 WRITE( lp, * )
821 &' failure in INTEGER ALLOCATION DURING SMUMPS_ASM_NIV1_ELT'
822 ENDIF
823 GOTO 490
824 290 CONTINUE
825 IF (LPOK) THEN
826 WRITE( LP, * )
827 & ' FAILURE, SEND BUFFER TOO SMALL DURING SMUMPS_ASM_NIV1_ELT'
828 ENDIF
829 INFO(1) = -17
830 LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ)
831 INFO(2) = LREQ * KEEP( 34 )
832 GOTO 490
833 295 CONTINUE
834 IF (LPOK) THEN
835 WRITE( LP, * )
836 & ' FAILURE, RECV BUFFER TOO SMALL DURING SMUMPS_ASM_NIV1_ELT'
837 ENDIF
838 INFO(1) = -20
839 LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ)
840 INFO(2) = LREQ * KEEP( 34 )
841 GOTO 490
842 300 CONTINUE
843.EQ. IF (INFO(1)-13) THEN
844 IF (LPOK) THEN
845 WRITE( LP, * ) ' FAILURE IN INTEGER',
846 & ' DYNAMIC ALLOCATION DURING SMUMPS_ASM_NIV1_ELT'
847 ENDIF
848 INFO(2) = NUMSTK
849 ENDIF
850 490 CONTINUE
851.EQ. IF ( KEEP(405) 0 ) THEN
852 CALL SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
853 ENDIF
854 500 CONTINUE
855 RETURN
856 END SUBROUTINE SMUMPS_FAC_ASM_NIV1_ELT
857 SUBROUTINE SMUMPS_FAC_ASM_NIV2_ELT( COMM_LOAD, ASS_IRECV,
858 & NELT, FRT_PTR, FRT_ELT,
859 & N, INODE, IW, LIW, A, LA, INFO,
860 & ND, FILS, FRERE, DAD,
861 & CAND,
862 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
863 & MAXFRW, root,
864 & OPASSW, OPELIW, PTRIST, PTLUST, PTRFAC,
865 & PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S,
866 & PTRAIW, ITLOC, RHS_MUMPS, NSTEPS,
867 & COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS,
868 & ICNTL, KEEP, KEEP8,DKEEP,INTARR,LINTARR,DBLARR,LDBLARR,
869 & PROCNODE_STEPS, SLAVEF, COMM,MYID,
870 & BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL,
871 & PERM, MEM_DISTRIB
872 & , LRGROUPS
873 & )
874!$ USE OMP_LIB
875 USE MUMPS_BUILD_SORT_INDEX_ELT_M
876 USE SMUMPS_BUF
877 USE SMUMPS_LOAD
878 USE SMUMPS_LR_CORE, ONLY : IS_FRONT_BLR_CANDIDATE
879 USE SMUMPS_STRUC_DEF, ONLY : SMUMPS_ROOT_STRUC
880 USE SMUMPS_DYNAMIC_MEMORY_M, ONLY : SMUMPS_DM_SET_PTR,
881 & SMUMPS_DM_IS_DYNAMIC
882 USE SMUMPS_ANA_LR, ONLY : GET_CUT
883 USE SMUMPS_LR_CORE, ONLY : MAX_CLUSTER
884 USE MUMPS_LR_COMMON, ONLY : COMPUTE_BLR_VCS
885 IMPLICIT NONE
886 TYPE (SMUMPS_ROOT_STRUC) :: root
887 INTEGER COMM_LOAD, ASS_IRECV
888 INTEGER N,LIW,NSTEPS, NBFIN
889 INTEGER NELT
890 INTEGER KEEP(500), ICNTL(60)
891 INTEGER(8) KEEP8(150)
892 REAL DKEEP(230)
893 INTEGER(8) :: LRLUS, LRLU, IPTRLU, POSFAC, LA
894 INTEGER, INTENT(INOUT) :: INFO(2)
895 INTEGER INODE, MAXFRW, LPOOL, LEAF,
896 & IWPOS, IWPOSCB, COMP, SLAVEF
897 REAL, TARGET :: A(LA)
898 INTEGER, intent(in) :: LRGROUPS(N)
899 DOUBLE PRECISION OPASSW, OPELIW
900 INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB
901 INTEGER IPOOL(LPOOL)
902 INTEGER(8) :: PTRAST(KEEP(28))
903 INTEGER(8) :: PTRFAC(KEEP(28))
904 INTEGER(8) :: PAMASTER(KEEP(28))
905 INTEGER(8), INTENT(IN) :: PTRARW(NELT+1), PTRAIW(NELT+1)
906 INTEGER IW(LIW), ITLOC(N+KEEP(253)),
907 & ND(KEEP(28)),
908 & FILS(N), FRERE(KEEP(28)), DAD (KEEP(28)),
909 & PTRIST(KEEP(28)), PTLUST(KEEP(28)),
910 & STEP(N),
911 & PIMASTER(KEEP(28)),
912 & NSTK_S(KEEP(28)), PERM(N)
913 REAL :: RHS_MUMPS(KEEP(255))
914 INTEGER CAND(SLAVEF+1, max(1,KEEP(56)))
915 INTEGER ISTEP_TO_INIV2(KEEP(71)),
916 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
917 INTEGER FRT_PTR(N+1), FRT_ELT(NELT)
918 INTEGER(8), INTENT(IN) :: LINTARR,LDBLARR
919 REAL DBLARR(LDBLARR)
920 INTEGER INTARR(LINTARR)
921 INTEGER MYID, COMM
922 INTEGER IFATH
923 INTEGER LBUFR, LBUFR_BYTES
924 INTEGER PROCNODE_STEPS(KEEP(28))
925 INTEGER BUFR( LBUFR )
926 INCLUDE 'mumps_headers.h'
927 INCLUDE 'mpif.h'
928 INTEGER :: IERR
929 INTEGER :: STATUS(MPI_STATUS_SIZE)
930!$ INTEGER :: NOMP
931 INTEGER LP, HS, HF, HF_OLD, NCBSON, NSLAVES_OLD
932 LOGICAL LPOK
933 INTEGER NCBSON_MAX
934 INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL
935 INTEGER :: IBC_SOURCE
936 REAL, DIMENSION(:), POINTER :: SON_A
937 INTEGER NFS4FATHER, ESTIM_NFS4FATHER_ATSON
938 INTEGER NFRONT,NFRONT_EFF,ISTCHK,ISTCHK_CB_RIGHT,LSTK,LREQ
939 INTEGER :: SON_XXS
940 INTEGER(8) :: LAELL8
941 INTEGER LREQ_OOC
942 INTEGER NBPANELS_L, NBPANELS_U
943 LOGICAL PACKED_CB, IS_CB_LR
944 INTEGER(8) :: LCB
945 LOGICAL :: IS_DYNAMIC_CB
946 INTEGER(8) :: DYN_SIZE
947 INTEGER NCB
948 INTEGER MP
949 INTEGER :: K1, K2, KK, KK1
950 INTEGER :: J253
951 INTEGER(8) :: AII8, AINPUT8, II8
952 INTEGER(8) :: J18,J28,JJ8
953 INTEGER(8) :: LAPOS2, JJ2, JJ3
954 INTEGER(8) :: NFRONT8, POSELT, POSEL1, LDAFS8,
955 & IACHK, ICT12, ICT21
956 INTEGER(8) APOS, APOS2
957#if ! defined(ZERO_TRIANGLE)
958 INTEGER :: TOPDIAG
959#endif
960!$ INTEGER :: CHUNK
961!$ INTEGER(8) :: CHUNK8
962 INTEGER NELIM,NPIVS,NCOLS,NROWS,
963 & IORG
964 INTEGER LDAFS, LDA_SON, IJROW, IBROT
965 INTEGER Pos_First_NUMORG,NBCOL,NUMORG,IOLDPS
966 INTEGER NSLAVES, NSLSON
967 INTEGER NBLIG, PTRCOL, PTRROW, PDEST
968 INTEGER PDEST1(1)
969 INTEGER :: ISLAVE
970 INTEGER ELTI
971 INTEGER(8) :: SIZE_ELTI8
972 INTEGER :: I, J
973 INTEGER :: ELBEG, NUMELT
974 LOGICAL SAME_PROC, NIV1, SON_LEVEL2
975 LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
976 INTEGER TROW_SIZE, INDX, FIRST_INDEX, SHIFT_INDEX
977 INTEGER LRSTATUS
978 LOGICAL COMPRESS_PANEL, LR_ACTIVATED, COMPRESS_CB,
979 & OOCWRITE_COMPATIBLE_WITH_BLR
980 INTEGER IZERO
981 INTEGER IDUMMY(1)
982 PARAMETER( IZERO = 0 )
983 INTEGER MUMPS_PROCNODE, MUMPS_TYPENODE, MUMPS_TYPESPLIT
984 EXTERNAL MUMPS_PROCNODE, MUMPS_TYPENODE, MUMPS_TYPESPLIT
985 REAL ZERO
986 REAL RZERO
987 PARAMETER( RZERO = 0.0E0 )
988 PARAMETER( ZERO = 0.0E0 )
989 logical :: force_cand
990 INTEGER ETATASS
991 INTEGER(8) :: APOSMAX
992 REAL MAXARR
993 INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok
994 INTEGER NCB_SPLIT, SIZE_LIST_SPLIT, NBSPLIT,
995 & NUMORG_SPLIT, TYPESPLIT
996 INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST, COPY_CAND
997 INTEGER, ALLOCATABLE, DIMENSION(:) :: SONROWS_PER_ROW
998 INTEGER, POINTER, DIMENSION(:) :: BEGS_BLR
999 INTEGER :: NB_BLR, NPARTSCB, NPARTSASS, MAXI_CLUSTER,
1000 & IBCKSZ2, MINSIZE
1001 INTEGER :: NMB_OF_CAND, NMB_OF_CAND_ORIG
1002 LOGICAL :: IS_ofType5or6, SPLIT_MAP_RESTART
1003!$ NOMP = OMP_GET_MAX_THREADS()
1004 MP = ICNTL(2)
1005 LP = ICNTL(1)
1006.GT..AND..GE. LPOK = ((LP0)(ICNTL(4)1))
1007 IS_ofType5or6 = .FALSE.
1008 PACKED_CB = .FALSE.
1009 ETATASS = 0
1010 IN = INODE
1011 NSTEPS = NSTEPS + 1
1012 KEEP(429) = KEEP(429)+1
1013 NUMELT = FRT_PTR(INODE+1) - FRT_PTR(INODE)
1014.NE. IF ( NUMELT 0 ) THEN
1015 ELBEG = FRT_PTR(INODE)
1016 ELSE
1017 ELBEG = 1
1018 END IF
1019 NUMORG = 0
1020.GT. DO WHILE (IN0)
1021 NUMORG = NUMORG + 1
1022 IN = FILS(IN)
1023 ENDDO
1024 NUMSTK = 0
1025 NASS = 0
1026 IFSON = -IN
1027 ISON = IFSON
1028 NCBSON_MAX = 0
1029.GT. DO WHILE (ISON 0)
1030 NUMSTK = NUMSTK + 1
1031.AND. IF ( KEEP(48)==5
1032 & MUMPS_TYPENODE(PROCNODE_STEPS(STEP(ISON)),
1033.EQ. & KEEP(199)) 1) THEN
1034 NCBSON_MAX =
1035 & max(NCBSON_MAX,IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)))
1036 ENDIF
1037 NASS = NASS + IW(PIMASTER(STEP(ISON)) + 1 + KEEP(IXSZ))
1038 ISON = FRERE(STEP(ISON))
1039 ENDDO
1040 NFRONT = ND(STEP(INODE)) + NASS + KEEP(253)
1041 NASS1 = NASS + NUMORG
1042 NCB = NFRONT - NASS1
1043 CALL IS_FRONT_BLR_CANDIDATE(INODE, 2, NFRONT, NASS1, KEEP(486),
1044 & KEEP(489), KEEP(490), KEEP(491), KEEP(492),
1045 & KEEP(20), KEEP(60), DAD(STEP(INODE)), KEEP(38),
1046 & LRSTATUS, N, LRGROUPS)
1047.GE. COMPRESS_PANEL = (LRSTATUS2)
1048.EQ..OR. COMPRESS_CB = ((LRSTATUS1)
1049.EQ. & (LRSTATUS3))
1050.GT. LR_ACTIVATED = (LRSTATUS0)
1051.AND..NOT. IF (COMPRESS_CB(COMPRESS_PANEL)) THEN
1052 COMPRESS_PANEL = .TRUE.
1053 LRSTATUS = 3
1054 ENDIF
1055 OOCWRITE_COMPATIBLE_WITH_BLR =
1056.NOT..OR..NOT..OR. & ( LR_ACTIVATED(COMPRESS_PANEL)
1057.NE. & (KEEP(486)2)
1058 & )
1059.eq..or..eq. IF((KEEP(24)0)(KEEP(24)1)) then
1060 force_cand=.FALSE.
1061 ELSE
1062.eq. force_cand=(mod(KEEP(24),2)0)
1063 end if
1064 TYPESPLIT = MUMPS_TYPESPLIT (PROCNODE_STEPS(STEP(INODE)),
1065 & KEEP(199))
1066.EQ..OR..EQ. IS_ofType5or6 = (TYPESPLIT5 TYPESPLIT6)
1067 ISTCHK = PIMASTER(STEP(IFSON))
1068 PDEST = ISTCHK + 6 + KEEP(IXSZ)
1069 NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5)
1070 SPLIT_MAP_RESTART = .FALSE.
1071 IF (force_cand) THEN
1072 INIV2 = ISTEP_TO_INIV2( STEP( INODE ))
1073 NMB_OF_CAND = CAND( SLAVEF+1, INIV2 )
1074 NMB_OF_CAND_ORIG = NMB_OF_CAND
1075 SIZE_TMP_SLAVES_LIST = NMB_OF_CAND
1076 IF (IS_ofType5or6) THEN
1077 DO I=NMB_OF_CAND+1,SLAVEF
1078.LT. IF ( CAND( I, INIV2 )0) EXIT
1079 NMB_OF_CAND = NMB_OF_CAND +1
1080 ENDDO
1081 SIZE_TMP_SLAVES_LIST = NSLSON-1
1082 WRITE(6,*) "NMB_OF_CAND, SIZE_TMP_SLAVES_LIST ",
1083 & NMB_OF_CAND, SIZE_TMP_SLAVES_LIST
1084.EQ. IF (INODE-999999) THEN
1085 SPLIT_MAP_RESTART = .TRUE.
1086 ENDIF
1087 ENDIF
1088.AND. IF (IS_ofType5or6SPLIT_MAP_RESTART) THEN
1089 TYPESPLIT = 4
1090 IS_ofType5or6 = .FALSE.
1091 SIZE_TMP_SLAVES_LIST = NMB_OF_CAND
1092 CAND (SLAVEF+1, INIV2) = SIZE_TMP_SLAVES_LIST
1093 ENDIF
1094 ELSE
1095 INIV2 = 1
1096 SIZE_TMP_SLAVES_LIST = SLAVEF - 1
1097 NMB_OF_CAND = SLAVEF - 1
1098 NMB_OF_CAND_ORIG = SLAVEF - 1
1099 ENDIF
1100 ALLOCATE(TMP_SLAVES_LIST(SIZE_TMP_SLAVES_LIST),stat=allocok)
1101 IF (allocok > 0 ) THEN
1102 GOTO 265
1103 ENDIF
1104 TYPESPLIT = MUMPS_TYPESPLIT (PROCNODE_STEPS(STEP(INODE)),
1105 & KEEP(199))
1106.EQ. IF ( (TYPESPLIT4)
1107.OR..EQ..OR..EQ. & (TYPESPLIT5)(TYPESPLIT6)
1108 & ) THEN
1109.EQ. IF (TYPESPLIT4) THEN
1110 ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok)
1111 IF (allocok > 0 ) THEN
1112 GOTO 245
1113 ENDIF
1114 CALL SMUMPS_SPLIT_PREP_PARTITION (
1115 & INODE, STEP, N, SLAVEF,
1116 & PROCNODE_STEPS, KEEP, DAD, FILS,
1117 & CAND(1,INIV2), ICNTL, COPY_CAND,
1118 & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1),
1119 & SIZE_TMP_SLAVES_LIST
1120 & )
1121 NCB_SPLIT = NCB-NUMORG_SPLIT
1122 SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT
1123 CALL SMUMPS_LOAD_SET_PARTITION( NCBSON_MAX, SLAVEF, KEEP,KEEP8,
1124 & ICNTL, COPY_CAND,
1125 & MEM_DISTRIB(0), NCB_SPLIT, NFRONT, NSLAVES,
1126 & TAB_POS_IN_PERE(1,INIV2),
1127 & TMP_SLAVES_LIST(NBSPLIT+1),
1128 & SIZE_LIST_SPLIT,INODE
1129 & )
1130 DEALLOCATE (COPY_CAND)
1131 CALL SMUMPS_SPLIT_POST_PARTITION (
1132 & INODE, STEP, N, SLAVEF, NBSPLIT, NCB,
1133 & PROCNODE_STEPS, KEEP, DAD, FILS,
1134 & ICNTL,
1135 & TAB_POS_IN_PERE(1,INIV2),
1136 & NSLAVES
1137 & )
1138 IF (SPLIT_MAP_RESTART) THEN
1139 IS_ofType5or6 = .TRUE.
1140 TYPESPLIT = MUMPS_TYPESPLIT (PROCNODE_STEPS(STEP(INODE)),
1141 & KEEP(199))
1142 CAND( SLAVEF+1, INIV2 ) = NMB_OF_CAND_ORIG
1143 ENDIF
1144 ELSE
1145 ISTCHK = PIMASTER(STEP(IFSON))
1146 PDEST = ISTCHK + 6 + KEEP(IXSZ)
1147 NSLSON = IW(ISTCHK + KEEP(IXSZ) + 5)
1148.EQ. IF (KEEP(376) 1) THEN
1149 NFRONT = IW( PIMASTER(STEP(IFSON)) + KEEP(IXSZ))
1150 ENDIF
1151 CALL SMUMPS_SPLIT_PROPAGATE_PARTI (
1152 & INODE, TYPESPLIT, IFSON,
1153 & CAND(1,INIV2), NMB_OF_CAND_ORIG,
1154 & IW(PDEST), NSLSON,
1155 & STEP, N, SLAVEF,
1156 & PROCNODE_STEPS, KEEP, DAD, FILS,
1157 & ICNTL, ISTEP_TO_INIV2, INIV2,
1158 & TAB_POS_IN_PERE, NSLAVES,
1159 & TMP_SLAVES_LIST,
1160 & SIZE_TMP_SLAVES_LIST
1161 & )
1162 ENDIF
1163 ELSE
1164 CALL SMUMPS_LOAD_SET_PARTITION( NCBSON_MAX, SLAVEF, KEEP,KEEP8,
1165 & ICNTL, CAND(1,INIV2),
1166 & MEM_DISTRIB(0), NCB, NFRONT, NSLAVES,
1167 & TAB_POS_IN_PERE(1,INIV2),
1168 & TMP_SLAVES_LIST,
1169 & SIZE_TMP_SLAVES_LIST,INODE
1170 & )
1171 ENDIF
1172 HF = NSLAVES + 6 + KEEP(IXSZ)
1173 LREQ_OOC = 0
1174.EQ..AND. IF (KEEP(201)1OOCWRITE_COMPATIBLE_WITH_BLR) THEN
1175 CALL SMUMPS_OOC_GET_PP_SIZES(KEEP(50), NASS1, NFRONT, NASS1,
1176 & NBPANELS_L, NBPANELS_U, LREQ_OOC)
1177 ENDIF
1178 LREQ = HF + 2 * NFRONT + LREQ_OOC
1179.GT. IF ((IWPOS + LREQ -1) IWPOSCB) THEN
1180 CALL SMUMPS_COMPRE_NEW(N, KEEP,
1181 & IW, LIW, A, LA,
1182 & LRLU, IPTRLU,
1183 & IWPOS, IWPOSCB, PTRIST, PTRAST,
1184 & STEP, PIMASTER, PAMASTER,
1185 & LRLUS,KEEP(IXSZ),
1186 & COMP, DKEEP(97), MYID, SLAVEF,
1187 & PROCNODE_STEPS, DAD)
1188.NE. IF (LRLU LRLUS) THEN
1189 IF (LPOK) THEN
1190 WRITE(LP, * ) 'PB compress SMUMPS_FAC_ASM_NIV2_ELT',
1191 & 'LRLU,LRLUS=',LRLU,LRLUS
1192 ENDIF
1193 GOTO 270
1194 ENDIF
1195.GT. IF ((IWPOS + LREQ -1) IWPOSCB) GOTO 270
1196 ENDIF
1197 IOLDPS = IWPOS
1198 IWPOS = IWPOS + LREQ
1199 NIV1 = .FALSE.
1200 ALLOCATE(SONROWS_PER_ROW(NFRONT-NASS1), stat=allocok)
1201 IF (allocok > 0) THEN
1202 GOTO 275
1203 ENDIF
1204 CALL MUMPS_ELT_BUILD_SORT(
1205 & NUMELT, FRT_ELT(ELBEG),
1206 & MYID, INODE, N, IOLDPS, HF,
1207 & NFRONT, NFRONT_EFF, PERM,
1208 & NASS1, NASS, NUMSTK, NUMORG, IWPOSCB, IWPOS,
1209 & IFSON, STEP, PIMASTER, PTRIST, PTRAIW, NELT, IW, LIW,
1210 & INTARR, LINTARR, ITLOC, FILS, FRERE,
1211 & KEEP, SON_LEVEL2, NIV1, INFO(1),
1212 & DAD,PROCNODE_STEPS, SLAVEF,
1213 & FRT_PTR, FRT_ELT, Pos_First_NUMORG,
1214 & SONROWS_PER_ROW, NFRONT - NASS1)
1215.LT. IF (INFO(1)0) GOTO 250
1216.NE. IF ( NFRONT NFRONT_EFF ) THEN
1217 IF (
1218.EQ..OR..EQ. & (TYPESPLIT5) (TYPESPLIT6)) THEN
1219 WRITE(6,*) ' internal error 1 in fac_ass due to splitting ',
1220 & ' inode, nfront, nfront_eff =', INODE, NFRONT, NFRONT_EFF
1221 WRITE(6,*) ' splitting not yet ready for that'
1222 CALL MUMPS_ABORT()
1223 ENDIF
1224.GT. IF (NFRONTNFRONT_EFF) THEN
1225 NCB = NFRONT_EFF - NASS1
1226 NSLAVES_OLD = NSLAVES
1227 HF_OLD = HF
1228.EQ. IF (TYPESPLIT4) THEN
1229 ALLOCATE(COPY_CAND(SLAVEF+1),stat=allocok)
1230 IF (allocok > 0 ) THEN
1231 GOTO 245
1232 ENDIF
1233 CALL SMUMPS_SPLIT_PREP_PARTITION (
1234 & INODE, STEP, N, SLAVEF,
1235 & PROCNODE_STEPS, KEEP, DAD, FILS,
1236 & CAND(1,INIV2), ICNTL, COPY_CAND,
1237 & NBSPLIT, NUMORG_SPLIT, TMP_SLAVES_LIST(1),
1238 & SIZE_TMP_SLAVES_LIST
1239 & )
1240 NCB_SPLIT = NCB-NUMORG_SPLIT
1241 SIZE_LIST_SPLIT = SIZE_TMP_SLAVES_LIST - NBSPLIT
1242 CALL SMUMPS_LOAD_SET_PARTITION( NCBSON_MAX,
1243 & SLAVEF, KEEP,KEEP8,
1244 & ICNTL, COPY_CAND,
1245 & MEM_DISTRIB(0), NCB_SPLIT, NFRONT_EFF, NSLAVES,
1246 & TAB_POS_IN_PERE(1,INIV2),
1247 & TMP_SLAVES_LIST(NBSPLIT+1),
1248 & SIZE_LIST_SPLIT,INODE
1249 & )
1250 DEALLOCATE (COPY_CAND)
1251 CALL SMUMPS_SPLIT_POST_PARTITION (
1252 & INODE, STEP, N, SLAVEF, NBSPLIT, NCB,
1253 & PROCNODE_STEPS, KEEP, DAD, FILS,
1254 & ICNTL,
1255 & TAB_POS_IN_PERE(1,INIV2),
1256 & NSLAVES
1257 & )
1258 ELSE
1259 CALL SMUMPS_LOAD_SET_PARTITION( NCBSON_MAX,
1260 & SLAVEF, KEEP, KEEP8, ICNTL,
1261 & CAND(1,INIV2),
1262 & MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES,
1263 & TAB_POS_IN_PERE(1,INIV2),
1264 & TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE
1265 & )
1266 ENDIF
1267 HF = NSLAVES + 6 + KEEP(IXSZ)
1268 IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) -
1269 & (NSLAVES_OLD - NSLAVES)
1270.NE. IF (NSLAVES_OLD NSLAVES) THEN
1271 IF (NSLAVES_OLD > NSLAVES) THEN
1272 DO KK=0,2*NFRONT_EFF-1
1273 IW(IOLDPS+HF+KK)=IW(IOLDPS+HF_OLD+KK)
1274 ENDDO
1275 ELSE
1276 IF (IWPOS - 1 > IWPOSCB ) GOTO 270
1277 DO KK=2*NFRONT_EFF-1, 0, -1
1278 IW(IOLDPS+HF+KK) = IW(IOLDPS+HF_OLD+KK)
1279 ENDDO
1280 END IF
1281 END IF
1282 NFRONT = NFRONT_EFF
1283 LREQ = HF + 2 * NFRONT + LREQ_OOC
1284 ELSE
1285 IF (LPOK) THEN
1286 WRITE(LP,*) ' internal error 2 during ass_niv2'
1287 ENDIF
1288 GOTO 270
1289 ENDIF
1290 ENDIF
1291 NFRONT8=int(NFRONT,8)
1292.EQ..AND..NE..AND. IF (KEEP(201)1KEEP(50)1
1293 & OOCWRITE_COMPATIBLE_WITH_BLR) THEN
1294 CALL SMUMPS_OOC_PP_SET_PTR(KEEP(50),
1295 & NBPANELS_L, NBPANELS_U, NASS1,
1296 & IOLDPS + HF + 2 * NFRONT, IW, LIW)
1297 ENDIF
1298 MAXFRW = max0(MAXFRW, NFRONT)
1299 PTLUST(STEP(INODE)) = IOLDPS
1300 IW(IOLDPS+KEEP(IXSZ)) = NFRONT
1301 IW(IOLDPS + 1+KEEP(IXSZ)) = 0
1302 IW(IOLDPS + 2+KEEP(IXSZ)) = -NASS1
1303 IW(IOLDPS + 3+KEEP(IXSZ)) = -NASS1
1304 IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE)
1305 IW(IOLDPS+5+KEEP(IXSZ)) = NSLAVES
1306 IW(IOLDPS+6+KEEP(IXSZ):IOLDPS+5+NSLAVES+KEEP(IXSZ))=
1307 & TMP_SLAVES_LIST(1:NSLAVES)
1308 ESTIM_NFS4FATHER_ATSON = -9999
1309.NE..AND..EQ. IF (KEEP(219)0KEEP(50)2) THEN
1310 IFATH = DAD( STEP( INODE) )
1311.NE. IF (IFATH0) THEN
1312.AND. IF (COMPRESS_CB
1313 & MUMPS_TYPENODE(PROCNODE_STEPS(STEP(IFATH)),KEEP(199))
1314.EQ. & 2 ) THEN
1315 IOLDPS = PTLUST(STEP(INODE))
1316 CALL SMUMPS_COMPUTE_ESTIM_NFS4FATHER (
1317 & N, INODE, IFATH, FILS, PERM, KEEP,
1318 & IOLDPS, HF, IW, LIW, NFRONT, NASS1,
1319 & ESTIM_NFS4FATHER_ATSON
1320 & )
1321 ENDIF
1322 ENDIF
1323 ENDIF
1324 CALL SMUMPS_LOAD_MASTER_2_ALL(MYID, SLAVEF, COMM_LOAD,
1325 & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),
1326 & NASS1, KEEP, KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE)
1327.EQ. IF(KEEP(86)1)THEN
1328.eq. IF(mod(KEEP(24),2)0)THEN
1329 CALL SMUMPS_LOAD_SEND_MD_INFO(SLAVEF,
1330 & CAND(SLAVEF+1,INIV2),
1331 & CAND(1,INIV2),
1332 & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),
1333 & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST,
1334 & NSLAVES,INODE)
1335.EQ..OR..EQ. ELSEIF((KEEP(24)0)(KEEP(24)1))THEN
1336 CALL SMUMPS_LOAD_SEND_MD_INFO(SLAVEF,
1337 & SLAVEF-1,
1338 & TMP_SLAVES_LIST,
1339 & TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),
1340 & NASS1, KEEP,KEEP8, TMP_SLAVES_LIST,
1341 & NSLAVES,INODE)
1342 ENDIF
1343 ENDIF
1344 DEALLOCATE(TMP_SLAVES_LIST)
1345.EQ. IF (KEEP(50)0) THEN
1346 LAELL8 = int(NASS1,8) * NFRONT8
1347 LDAFS = NFRONT
1348 LDAFS8 = NFRONT8
1349 ELSE
1350 LAELL8 = int(NASS1,8)*int(NASS1,8)
1351.NE..AND..EQ. IF(KEEP(219)0KEEP(50) 2)
1352 & LAELL8 = LAELL8+int(NASS1,8)
1353 LDAFS = NASS1
1354 LDAFS8 = int(NASS1,8)
1355 ENDIF
1356 CALL SMUMPS_GET_SIZE_NEEDED
1357 & (0, LAELL8, .FALSE.,
1358 & KEEP(1), KEEP8(1),
1359 & N,IW,LIW,A,LA,
1360 & LRLU,IPTRLU,IWPOS,IWPOSCB,
1361 & PTRIST,PTRAST,
1362 & STEP, PIMASTER,PAMASTER,LRLUS,
1363 & KEEP(IXSZ), COMP, DKEEP(97), MYID,
1364 & SLAVEF, PROCNODE_STEPS, DAD,
1365 & INFO(1), INFO(2))
1366.LT. IF (INFO(1)0) GOTO 490
1367 LRLU = LRLU - LAELL8
1368 LRLUS = LRLUS - LAELL8
1369 KEEP8(67) = min(LRLUS, KEEP8(67))
1370 KEEP8(69) = KEEP8(69) + LAELL8
1371 KEEP8(68) = max(KEEP8(69), KEEP8(68))
1372 POSELT = POSFAC
1373 PTRAST(STEP(INODE)) = POSELT
1374 PTRFAC(STEP(INODE)) = POSELT
1375 POSFAC = POSFAC + LAELL8
1376 IW(IOLDPS+XXI) = LREQ
1377 CALL MUMPS_STOREI8(LAELL8,IW(IOLDPS+XXR))
1378 CALL MUMPS_STOREI8(0_8,IW(IOLDPS+XXD))
1379 IW(IOLDPS+XXS) = -9999
1380 IW(IOLDPS+XXN) = -99999
1381 IW(IOLDPS+XXP) = -99999
1382 IW(IOLDPS+XXA) = -99999
1383 IW(IOLDPS+XXF) = -99999
1384 IW(IOLDPS+XXLR)= LRSTATUS
1385 IW(IOLDPS+XXG) = MemNotPinned
1386 CALL SMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8,
1387 & KEEP,KEEP8,LRLUS)
1388 POSEL1 = POSELT - LDAFS8
1389#if defined(ZERO_TRIANGLE)
1390 LAPOS2 = POSELT + LAELL8 - 1_8
1391 A(POSELT:LAPOS2) = ZERO
1392#else
1393.eq..OR..lt. IF ( KEEP(50) 0 LDAFS KEEP(63) ) THEN
1394 LAPOS2 = POSELT + LAELL8 - 1_8
1395!$ CHUNK8 = int(KEEP(361),8)
1396!$OMP PARALLEL DO PRIVATE(JJ8) SCHEDULE(STATIC, CHUNK8)
1397.AND..GT.!$OMP& IF (LAPOS2 - POSELT > int(KEEP(361),8) NOMP 1)
1398#if defined(__ve__)
1399!NEC$ IVDEP
1400#endif
1401 DO JJ8 = POSELT, LAPOS2
1402 A(JJ8) = ZERO
1403 ENDDO
1404!$OMP END PARALLEL DO
1405 ELSE
1406 TOPDIAG = max(KEEP(7), KEEP(8))-1
1407 IF (LR_ACTIVATED) THEN
1408 NULLIFY(BEGS_BLR)
1409 CALL GET_CUT(IW(IOLDPS+HF:IOLDPS+HF+NFRONT-1), NASS1,
1410 & 0, LRGROUPS, NPARTSCB,
1411 & NPARTSASS, BEGS_BLR)
1412 NB_BLR = NPARTSASS + NPARTSCB
1413 CALL MAX_CLUSTER(BEGS_BLR,NB_BLR,MAXI_CLUSTER)
1414 DEALLOCATE(BEGS_BLR)
1415 CALL COMPUTE_BLR_VCS(KEEP(472), IBCKSZ2, KEEP(488), NASS1)
1416 MINSIZE = int(IBCKSZ2 / 2)
1417 TOPDIAG = max(2*MINSIZE + MAXI_CLUSTER-1, TOPDIAG)
1418 ENDIF
1419!$ CHUNK = max(KEEP(360)/2,
1420!$ & ( (( LDAFS + NOMP -1 ) / NOMP + 2) / 3) )
1421 APOS = POSELT
1422#if defined(__ve__)
1423!NEC$ IVDEP
1424#endif
1425!$OMP PARALLEL DO PRIVATE(APOS,JJ3) SCHEDULE(STATIC, CHUNK)
1426.GT..AND..GT.!$OMP& IF (LDAFS - 1 KEEP(360) NOMP 1)
1427 DO JJ8 = 0_8, int(LDAFS-1,8)
1428 APOS = POSELT + JJ8 * int(LDAFS,8)
1429 JJ3 = min( int(LDAFS,8) - 1_8, JJ8 + TOPDIAG )
1430 A(APOS:APOS+JJ3) = ZERO
1431 END DO
1432!$OMP END PARALLEL DO
1433.NE..AND..EQ. IF (KEEP(219)0KEEP(50)2) THEN
1434 APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8)
1435 A(APOSMAX:APOSMAX+int(LDAFS-1,8))=ZERO
1436 ENDIF
1437 END IF
1438#endif
1439.NE..AND..NE. IF ((NUMSTK0)(NASS0)) THEN
1440 ISON = IFSON
1441 DO 220 IELL = 1, NUMSTK
1442 ISTCHK = PIMASTER(STEP(ISON))
1443 NELIM = IW(ISTCHK + KEEP(IXSZ) + 1)
1444.EQ. IF (NELIM0) GOTO 210
1445 LSTK = IW(ISTCHK + KEEP(IXSZ))
1446 NPIVS = IW(ISTCHK + 3+KEEP(IXSZ))
1447.LT. IF (NPIVS0) NPIVS=0
1448 NSLSON = IW(ISTCHK + 5+KEEP(IXSZ))
1449 HS = 6 + NSLSON + KEEP(IXSZ)
1450 NCOLS = NPIVS + LSTK
1451.LT. SAME_PROC = (ISTCHKIWPOS)
1452 IF ( SAME_PROC ) THEN
1453 ISTCHK_CB_RIGHT=PTRIST(STEP(ISON))
1454 ELSE
1455 ISTCHK_CB_RIGHT=ISTCHK
1456 ENDIF
1457 SON_XXS = IW(ISTCHK_CB_RIGHT + XXS)
1458.EQ. PACKED_CB = ( SON_XXS S_CB1COMP )
1459.NOT. IF (SAME_PROC) THEN
1460 NROWS = IW(ISTCHK + KEEP(IXSZ) + 2)
1461 ELSE
1462 NROWS = NCOLS
1463 ENDIF
1464.EQ. IF (KEEP(50)0) THEN
1465 LDA_SON = LSTK
1466 LCB = int(NELIM,8)*int(LSTK,8)
1467 ELSE
1468.EQ. IF (NSLSON0) THEN
1469 IF (SAME_PROC) THEN
1470.EQ..OR. IS_CB_LR = IW(ISTCHK_CB_RIGHT+XXLR) 1
1471.EQ. & IW(ISTCHK_CB_RIGHT+XXLR) 3
1472 IF (IS_CB_LR) THEN
1473 LDA_SON = NELIM
1474 ELSE
1475 LDA_SON = LSTK
1476 ENDIF
1477 ELSE
1478 LDA_SON = LSTK
1479 ENDIF
1480 ELSE
1481 LDA_SON = NELIM
1482 ENDIF
1483 IF (PACKED_CB) THEN
1484 LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8
1485 ELSE
1486 LCB = int(LDA_SON,8)*int(NELIM,8)
1487 ENDIF
1488 ENDIF
1489.EQ. IF (KEEP(50) 0) THEN
1490 OPASSW = OPASSW + dble(LCB)
1491 ELSE
1492 OPASSW = OPASSW + int(NELIM,8)*int(NELIM+1,8)/2_8
1493 ENDIF
1494 IS_DYNAMIC_CB =
1495 & SMUMPS_DM_IS_DYNAMIC(IW(ISTCHK_CB_RIGHT+XXD:
1496 & ISTCHK_CB_RIGHT+XXD+1))
1497 IF ( IS_DYNAMIC_CB ) THEN
1498 CALL MUMPS_GETI8(DYN_SIZE, IW(ISTCHK_CB_RIGHT+XXD))
1499 CALL SMUMPS_DM_SET_PTR( PAMASTER(STEP(ISON)), DYN_SIZE,
1500 & SON_A )
1501 IACHK = 1_8
1502 ELSE
1503 IACHK = PAMASTER(STEP(ISON))
1504 SON_A=>A
1505 ENDIF
1506 K1 = ISTCHK + HS + NROWS + NPIVS
1507 K2 = K1 + NELIM - 1
1508.eq. IF (KEEP(50)0) THEN
1509 IF (IS_ofType5or6) THEN
1510 APOS = POSELT
1511 DO JJ8 = 1_8, int(NELIM,8)*int(LSTK,8)
1512 A(APOS+JJ8-1_8) = A(APOS+JJ8-1_8) + SON_A(IACHK+JJ8-1_8)
1513 ENDDO
1514 ELSE
1515 DO 170 KK = K1, K2
1516 APOS = POSEL1 + int(IW(KK),8) * LDAFS8
1517 DO 160 KK1 = 1, LSTK
1518 JJ2 = APOS + int(IW(K1 + KK1 - 1),8) - 1_8
1519 A(JJ2) = A(JJ2) + SON_A(IACHK + int(KK1 - 1,8))
1520 160 CONTINUE
1521 IACHK = IACHK + int(LSTK,8)
1522 170 CONTINUE
1523 ENDIF
1524 ELSE
1525.GT. IF (LCB 0) THEN
1526 CALL SMUMPS_LDLT_ASM_NIV12(A, LA, SON_A(IACHK),
1527 & POSELT, LDAFS, NASS1,
1528 & LDA_SON, LCB,
1529 & IW( K1 ), NELIM, NELIM, ETATASS,
1530 & PACKED_CB
1531!$ & , KEEP(360)
1532 & )
1533 ENDIF
1534 ENDIF
1535 210 ISON = FRERE(STEP(ISON))
1536 220 CONTINUE
1537 ENDIF
1538 APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8)
1539.NE. IF (KEEP(219)0) THEN
1540.EQ. IF (KEEP(50)2) THEN
1541 A( APOSMAX: APOSMAX+int(NASS1-1,8))=ZERO
1542 ENDIF
1543 ENDIF
1544 DO IELL=ELBEG,ELBEG+NUMELT-1
1545 ELTI = FRT_ELT(IELL)
1546 J18= PTRAIW(ELTI)
1547 J28= PTRAIW(ELTI+1) - 1_8
1548 AII8 = PTRARW(ELTI)
1549 SIZE_ELTI8 = J28 - J18 + 1_8
1550 DO II8=J18,J28
1551 I = INTARR(II8)
1552.EQ. IF (KEEP(50)0) THEN
1553.LE. IF (INASS1) THEN
1554 AINPUT8 = AII8 + II8 - J18
1555 ICT12 = POSELT + int(I-1,8) * LDAFS8
1556 DO JJ8=J18,J28
1557 APOS2 = ICT12 + int(INTARR(JJ8) - 1,8)
1558 A(APOS2) = A(APOS2) + DBLARR(AINPUT8)
1559 AINPUT8 = AINPUT8 + SIZE_ELTI8
1560 END DO
1561 ENDIF
1562 ELSE
1563 ICT12 = POSELT - LDAFS8 + int(I,8) - 1_8
1564 ICT21 = POSELT + int(I-1,8)*LDAFS8 - 1_8
1565.GT. IF ( I NASS1 ) THEN
1566.NE..AND..EQ. IF (KEEP(219)0 KEEP(50)2) THEN
1567 AINPUT8=AII8
1568 DO JJ8=II8,J28
1569 J=INTARR(JJ8)
1570.LE. IF (JNASS1) THEN
1571 A(APOSMAX+int(J-1,8))=
1572 & max(real(A(APOSMAX+int(J-1,8))),
1573 & abs(DBLARR(AINPUT8)))
1574 ENDIF
1575 AINPUT8=AINPUT8+1_8
1576 ENDDO
1577 ENDIF
1578 AII8 = AII8 + J28 - II8 + 1_8
1579 CYCLE
1580 ELSE
1581.NE. IF (KEEP(219)0) THEN
1582 MAXARR = RZERO
1583 ENDIF
1584 DO JJ8=II8,J28
1585 J = INTARR(JJ8)
1586.LE. IF ( J NASS1) THEN
1587.LT. IF (IJ) THEN
1588 APOS2 = ICT12 + int(J,8)*LDAFS8
1589 ELSE
1590 APOS2 = ICT21 + int(J,8)
1591 ENDIF
1592 A(APOS2) = A(APOS2) + DBLARR(AII8)
1593.NE..AND..EQ. ELSE IF (KEEP(219)0KEEP(50)2) THEN
1594 MAXARR = max(MAXARR,abs(DBLARR(AII8)))
1595 ENDIF
1596 AII8 = AII8 + 1_8
1597 END DO
1598.NE..AND..EQ. IF(KEEP(219)0KEEP(50) 2) THEN
1599 A(APOSMAX+int(I-1,8)) =
1600 & max( MAXARR, real(A(APOSMAX+int(I-1,8))))
1601 ENDIF
1602 ENDIF
1603 END IF
1604 END DO
1605 END DO
1606.GT. IF (KEEP(253)0) THEN
1607 POSELT = PTRAST(STEP(INODE))
1608 IBROT = INODE
1609 IJROW = Pos_First_NUMORG
1610 DO IORG = 1, NUMORG
1611.EQ. IF (KEEP(50)0) THEN
1612 DO J253 = 1, KEEP(253)
1613 APOS = POSELT +
1614 & int(IJROW-1,8) * int(LDAFS,8) +
1615 & int(LDAFS-KEEP(253)+J253-1,8)
1616 A(APOS) = A(APOS) + RHS_MUMPS( (J253-1)*KEEP(254)+IBROT )
1617 ENDDO
1618 ENDIF
1619 IBROT = FILS(IBROT)
1620 IJROW = IJROW+1
1621 ENDDO
1622 ENDIF
1623 PTRCOL = IOLDPS + HF + NFRONT
1624 PTRROW = IOLDPS + HF + NASS1
1625 PDEST = IOLDPS + 6 + KEEP(IXSZ)
1626 IBC_SOURCE = MYID
1627 DO ISLAVE = 1, NSLAVES
1628 CALL MUMPS_BLOC2_GET_SLAVE_INFO(
1629 & KEEP,KEEP8, INODE, STEP, N, SLAVEF,
1630 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1631 & ISLAVE, NCB,
1632 & NSLAVES,
1633 & NBLIG, FIRST_INDEX )
1634 SHIFT_INDEX = FIRST_INDEX - 1
1635 IERR = -1
1636.EQ. DO WHILE (IERR -1)
1637.eq. IF ( KEEP(50) 0 ) THEN
1638 NBCOL = NFRONT
1639 CALL SMUMPS_BUF_SEND_DESC_BANDE( INODE,
1640 & sum(SONROWS_PER_ROW(FIRST_INDEX:FIRST_INDEX+NBLIG-1)),
1641 & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1,
1642 & IZERO, IDUMMY,
1643 & NSLAVES,
1644 & ESTIM_NFS4FATHER_ATSON,
1645 & IW(PDEST), IBC_SOURCE, NFRONT, COMM, KEEP, IERR
1646 & , IW(IOLDPS+XXLR)
1647 & )
1648 ELSE
1649 NBCOL = NASS1+SHIFT_INDEX+NBLIG
1650 CALL SMUMPS_BUF_SEND_DESC_BANDE( INODE,
1651 & sum(SONROWS_PER_ROW(FIRST_INDEX:FIRST_INDEX+NBLIG-1)),
1652 & NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1,
1653 & NSLAVES-ISLAVE,
1654 & IW( PTLUST(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE),
1655 & NSLAVES,
1656 & ESTIM_NFS4FATHER_ATSON,
1657 & IW(PDEST), IBC_SOURCE, NFRONT, COMM, KEEP, IERR
1658 & , IW(IOLDPS+XXLR)
1659 & )
1660 ENDIF
1661.EQ. IF (IERR-1) THEN
1662 BLOCKING = .FALSE.
1663 SET_IRECV = .TRUE.
1664 MESSAGE_RECEIVED = .FALSE.
1665 CALL SMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV,
1666 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
1667 & MPI_ANY_SOURCE, MPI_ANY_TAG,
1668 & STATUS, BUFR, LBUFR,
1669 & LBUFR_BYTES,
1670 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,
1671 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
1672 & PTLUST, PTRFAC,
1673 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1),
1674 & INFO(2), COMM,
1675 & PERM,
1676 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
1677 & root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
1678 & FILS, DAD, PTRARW, PTRAIW,
1679 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
1680 & NELT+1, NELT, FRT_PTR, FRT_ELT,
1681 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
1682 & , LRGROUPS
1683 & )
1684.LT. IF ( INFO(1) 0 ) GOTO 500
1685 IF (MESSAGE_RECEIVED) THEN
1686 IOLDPS = PTLUST(STEP(INODE))
1687 PTRCOL = IOLDPS + HF + NFRONT
1688 PTRROW = IOLDPS + HF + NASS1 + SHIFT_INDEX
1689 ENDIF
1690 ENDIF
1691 ENDDO
1692.EQ. IF (IERR -2) GOTO 300
1693.EQ. IF (IERR -3) GOTO 305
1694 PTRROW = PTRROW + NBLIG
1695 PDEST = PDEST + 1
1696 ENDDO
1697 DEALLOCATE(SONROWS_PER_ROW)
1698.EQ. IF (NUMSTK0) GOTO 500
1699 ISON = IFSON
1700 DO IELL = 1, NUMSTK
1701 ISTCHK = PIMASTER(STEP(ISON))
1702 NELIM = IW(ISTCHK + 1 + KEEP(IXSZ))
1703 LSTK = IW(ISTCHK + KEEP(IXSZ))
1704 NPIVS = IW(ISTCHK + 3 + KEEP(IXSZ))
1705.LT. IF ( NPIVS 0 ) NPIVS = 0
1706 NSLSON = IW(ISTCHK + 5 + KEEP(IXSZ))
1707 HS = 6 + NSLSON + KEEP(IXSZ)
1708 NCOLS = NPIVS + LSTK
1709.LT. SAME_PROC = (ISTCHKIWPOS)
1710.NOT. IF (SAME_PROC) THEN
1711 NROWS = IW(ISTCHK + 2 + KEEP(IXSZ) )
1712 ELSE
1713 NROWS = NCOLS
1714 ENDIF
1715 PDEST = ISTCHK + 6 + KEEP(IXSZ)
1716 NCBSON = LSTK - NELIM
1717 PTRCOL = ISTCHK + HS + NROWS + NPIVS + NELIM
1718.NE..AND..EQ. IF (KEEP(219)0KEEP(50)2) THEN
1719 NFS4FATHER = NCBSON
1720 DO I=0,NCBSON-1
1721.GT. IF(IW(PTRCOL+I) NASS1) THEN
1722 NFS4FATHER = I
1723 EXIT
1724 ENDIF
1725 ENDDO
1726 NFS4FATHER = NFS4FATHER + NELIM
1727 ELSE
1728 NFS4FATHER = 0
1729 ENDIF
1730.EQ. IF (NSLSON0) THEN
1731 NSLSON = 1
1732 PDEST1(1) = MUMPS_PROCNODE(PROCNODE_STEPS(STEP(ISON)),
1733 & KEEP(199))
1734.EQ. IF (PDEST1(1)MYID) THEN
1735 CALL SMUMPS_MAPLIG_FILS_NIV1( COMM_LOAD, ASS_IRECV,
1736 & BUFR, LBUFR, LBUFR_BYTES,
1737 & INODE, ISON, NSLAVES,
1738 & IW( PTLUST(STEP(INODE)) + 6 +KEEP(IXSZ)),
1739 & NFRONT, NASS1, NFS4FATHER, NCBSON, IW( PTRCOL ),
1740 & PROCNODE_STEPS,
1741 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
1742 & LRLUS, N, IW, LIW, A, LA,
1743 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP,
1744 & PIMASTER, PAMASTER, NSTK_S, COMP,
1745 & INFO(1), INFO(2), MYID, COMM, PERM,
1746 & IPOOL, LPOOL, LEAF,
1747 & NBFIN, ICNTL, KEEP, KEEP8, DKEEP, root,
1748 & OPASSW, OPELIW,
1749 & ITLOC, RHS_MUMPS, FILS, DAD,
1750 & PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE, NELT+1, NELT,
1751 & FRT_PTR, FRT_ELT,
1752 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1753 & LRGROUPS )
1754.LT. IF ( INFO(1) 0 ) GOTO 500
1755 ELSE
1756 IERR = -1
1757.EQ. DO WHILE (IERR-1)
1758 PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM
1759 CALL SMUMPS_BUF_SEND_MAPLIG(
1760 & INODE, NFRONT,NASS1,NFS4FATHER,
1761 & ISON, MYID,
1762 & NSLAVES, IW( PTLUST(STEP(INODE)) + 6 +KEEP(IXSZ)),
1763 & IW(PTRCOL), NCBSON,
1764 & COMM, IERR, PDEST1, NSLSON, SLAVEF,
1765 & KEEP,KEEP8, STEP, N,
1766 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
1767 & )
1768.EQ. IF (IERR-1) THEN
1769 BLOCKING = .FALSE.
1770 SET_IRECV = .TRUE.
1771 MESSAGE_RECEIVED = .FALSE.
1772 CALL SMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV,
1773 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
1774 & MPI_ANY_SOURCE, MPI_ANY_TAG,
1775 & STATUS, BUFR, LBUFR, LBUFR_BYTES,
1776 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,
1777 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
1778 & PTLUST, PTRFAC,
1779 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1),
1780 & INFO(2), COMM,
1781 & PERM,
1782 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
1783 & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
1784 & PTRARW, PTRAIW,
1785 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
1786 & NELT+1, NELT, FRT_PTR, FRT_ELT,
1787 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
1788 & , LRGROUPS
1789 & )
1790.LT. IF ( INFO(1) 0 ) GOTO 500
1791 ENDIF
1792 ENDDO
1793.EQ. IF (IERR -2) GOTO 290
1794.EQ. IF (IERR -3) GOTO 295
1795 ENDIF
1796 ELSE
1797.GT. IF (PIMASTER(STEP(ISON))0) THEN
1798 IERR = -1
1799.EQ. DO WHILE (IERR-1)
1800 PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM
1801 PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ)
1802 CALL SMUMPS_BUF_SEND_MAPLIG(
1803 & INODE, NFRONT, NASS1, NFS4FATHER,
1804 & ISON, MYID,
1805 & NSLAVES, IW(PTLUST(STEP(INODE))+6+KEEP(IXSZ)),
1806 & IW(PTRCOL), NCBSON,
1807 & COMM, IERR, IW(PDEST), NSLSON, SLAVEF,
1808 & KEEP,KEEP8, STEP, N,
1809 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
1810 & )
1811.EQ. IF (IERR-1) THEN
1812 BLOCKING = .FALSE.
1813 SET_IRECV = .TRUE.
1814 MESSAGE_RECEIVED = .FALSE.
1815 CALL SMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV,
1816 & BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
1817 & MPI_ANY_SOURCE, MPI_ANY_TAG,
1818 & STATUS, BUFR, LBUFR,
1819 & LBUFR_BYTES,
1820 & PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,
1821 & LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
1822 & PTLUST, PTRFAC,
1823 & PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1),
1824 & INFO(2), COMM,
1825 & PERM,
1826 & IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
1827 & root,OPASSW, OPELIW, ITLOC, RHS_MUMPS,
1828 & FILS, DAD, PTRARW, PTRAIW,
1829 & INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
1830 & NELT+1, NELT, FRT_PTR, FRT_ELT,
1831 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
1832 & , LRGROUPS
1833 & )
1834.LT. IF ( INFO(1) 0 ) GOTO 500
1835 ENDIF
1836 ENDDO
1837.EQ. IF (IERR -2) GOTO 290
1838.EQ. IF (IERR -3) GOTO 295
1839 ENDIF
1840 DO ISLAVE = 0, NSLSON-1
1841.EQ. IF (IW(PDEST+ISLAVE)MYID) THEN
1842 CALL MUMPS_BLOC2_GET_SLAVE_INFO(
1843 & KEEP,KEEP8, ISON, STEP, N, SLAVEF,
1844 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1845 & ISLAVE+1, NCBSON,
1846 & NSLSON,
1847 & TROW_SIZE, FIRST_INDEX )
1848 SHIFT_INDEX = FIRST_INDEX - 1
1849 INDX = PTRCOL + SHIFT_INDEX
1850 CALL SMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV,
1851 & BUFR, LBUFR, LBUFR_BYTES,
1852 & INODE, ISON, NSLAVES,
1853 & IW( PTLUST(STEP(INODE))+6+KEEP(IXSZ)),
1854 & NFRONT, NASS1,NFS4FATHER,
1855 & TROW_SIZE, IW( INDX ),
1856 & PROCNODE_STEPS,
1857 & SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
1858 & LRLUS, N, IW, LIW, A, LA,
1859 & PTRIST, PTLUST, PTRFAC, PTRAST, STEP,
1860 & PIMASTER, PAMASTER, NSTK_S, COMP, INFO(1), INFO(2),
1861 & MYID, COMM, PERM, IPOOL, LPOOL, LEAF,
1862 & NBFIN, ICNTL, KEEP,KEEP8,DKEEP, root,
1863 & OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, DAD,
1864 & PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE,
1865 & NELT+1, NELT, FRT_PTR, FRT_ELT,
1866 &
1867 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, LRGROUPS)
1868.LT. IF ( INFO(1) 0 ) GOTO 500
1869 EXIT
1870 ENDIF
1871 ENDDO
1872 ENDIF
1873 ISON = FRERE(STEP(ISON))
1874 ENDDO
1875 GOTO 500
1876 250 CONTINUE
1877.EQ. IF (INFO(1)-13) THEN
1878 IF (LPOK) THEN
1879 WRITE( LP, * )
1880 &' failure in INTEGER DYNAMIC ALLOCATION DURING
1881 & SMUMPS_FAC_ASM_NIV2_ELT'
1882 ENDIF
1883 INFO(2) = NUMSTK + 1
1884 ENDIF
1885 GOTO 490
1886 245 CONTINUE
1887 IF (LPOK) THEN
1888 WRITE( LP, * ) ' FAILURE ALLOCATING COPY_CAND',
1889 & ' DURING SMUMPS_FAC_ASM_NIV2_ELT'
1890 ENDIF
1891 INFO(1) = -13
1892 INFO(2) = SLAVEF+1
1893 GOTO 490
1894 265 CONTINUE
1895 IF (LPOK) THEN
1896 WRITE( LP, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST',
1897 & ' DURING SMUMPS_FAC_ASM_NIV2_ELT'
1898 ENDIF
1899 INFO(1) = -13
1900 INFO(2) = SIZE_TMP_SLAVES_LIST
1901 GOTO 490
1902 270 CONTINUE
1903 INFO(1) = -8
1904 INFO(2) = LREQ
1905 IF (LPOK) THEN
1906 WRITE( LP, * )
1907 & ' FAILURE IN INTEGER ALLOCATION DURING SMUMPS_ASM_NIV2_ELT'
1908 ENDIF
1909 GOTO 490
1910 275 CONTINUE
1911 IF (LPOK) THEN
1912 WRITE( LP, * ) ' FAILURE ALLOCATING SONROWS_PER_ROW',
1913 & ' DURING SMUMPS_ASM_NIV2_ELT'
1914 ENDIF
1915 INFO(1) = -13
1916 INFO(2) = NFRONT-NASS1
1917 GOTO 490
1918 290 CONTINUE
1919 IF (LPOK) THEN
1920 WRITE( LP, * )
1921 &' FAILURE, SEND BUFFER TOO SMALL (1) DURING SMUMPS_ASM_NIV2_ELT'
1922 ENDIF
1923 INFO(1) = -17
1924 LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ)
1925 INFO(2) = LREQ * KEEP( 34 )
1926 GOTO 490
1927 295 CONTINUE
1928 IF (LPOK) THEN
1929 WRITE( LP, * )
1930 &' FAILURE, RECV BUFFER TOO SMALL (1) DURING SMUMPS_ASM_NIV2_ELT'
1931 ENDIF
1932 INFO(1) = -20
1933 LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ)
1934 INFO(2) = LREQ * KEEP( 34 )
1935 GOTO 490
1936 300 CONTINUE
1937 IF (LPOK) THEN
1938 WRITE( LP, * )
1939 &' FAILURE, SEND BUFFER TOO SMALL (2)',
1940 &' DURING SMUMPS_FAC_ASM_NIV2_ELT'
1941 ENDIF
1942 INFO(1) = -17
1943 LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ)
1944 INFO(2) = LREQ * KEEP( 34 )
1945 GOTO 490
1946 305 CONTINUE
1947 IF (LPOK) THEN
1948 WRITE( LP, * )
1949 &' FAILURE, RECV BUFFER TOO SMALL (2)',
1950 &' DURING SMUMPS_FAC_ASM_NIV2_ELT'
1951 ENDIF
1952 INFO(1) = -20
1953 LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ)
1954 INFO(2) = LREQ * KEEP( 34 )
1955 GOTO 490
1956 490 CALL SMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
1957 500 CONTINUE
1958 RETURN
1959 END SUBROUTINE SMUMPS_FAC_ASM_NIV2_ELT
1960 END MODULE SMUMPS_FAC_ASM_MASTER_ELT_M
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
mumps_get_flops_cost
subroutine mumps_get_flops_cost(nfront, npiv, nass, keep50, level, cost)
Definition estim_flops.F:74
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
mumps_bloc2_get_slave_info
subroutine mumps_bloc2_get_slave_info(keep, keep8, inode, step, n, slavef, istep_to_iniv2, tab_pos_in_pere islave, ncb, nslaves, size, first_index)
Definition mumps_type2_blocking.F:367
mumps_build_sort_index_elt_m
Definition fac_asm_build_sort_index_ELT_m.F:14
mumps_build_sort_index_elt_m::mumps_elt_build_sort
subroutine mumps_elt_build_sort(numelt, list_elt, myid, inode, n, ioldps, hf, nfront, nfront_eff, perm, nass1, nass, numstk, numorg, iwposcb, iwpos, ifson, step, pimaster, ptrist, ptraiw, nelt, iw, liw, intarr, lintarr, itloc, fils, frere_steps, keep, son_level2, niv1, iflag, dad, procnode_steps, slavef, frt_ptr, frt_elt, pos_first_numorg, sonrows_per_row, lsonrows_per_row, mumps_tps_arr, l0_omp_mapping)
Definition fac_asm_build_sort_index_ELT_m.F:31
mumps_lr_common
Definition lr_common.F:14
mumps_lr_common::compute_blr_vcs
subroutine compute_blr_vcs(k472, ibcksz, maxsize, nass)
Definition lr_common.F:18
mumps_tps_m
Definition omp_tps_common_m.F:14
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_send_maplig
subroutine, public smumps_buf_send_maplig(inode, nfront, nass1, nfs4father, ison, myid, nslaves, slaves_pere, trow, ncbson, comm, ierr, dest, ndest, slavef, keep, keep8, step, n, istep_to_iniv2, tab_pos_in_per)
Definition smumps_comm_buffer.F:1649
smumps_dynamic_memory_m
Definition sfac_mem_dynamic.F:14
smumps_dynamic_memory_m::smumps_dm_free_block
subroutine smumps_dm_free_block(xxg_status, dynptr, sizfr8, atomic_updates, keep8)
Definition sfac_mem_dynamic.F:433
smumps_dynamic_memory_m::smumps_dm_set_ptr
subroutine smumps_dm_set_ptr(address, sizfr8, cbptr)
Definition sfac_mem_dynamic.F:417
smumps_fac_asm_master_elt_m
Definition sfac_asm_master_ELT_m.F:14
smumps_fac_asm_master_elt_m::smumps_fac_asm_niv1_elt
subroutine smumps_fac_asm_niv1_elt(comm_load, ass_irecv, nelt, frt_ptr, frt_elt, n, inode, iw, liw, a, la, info, nd, fils, frere, dad, maxfrw, root, opassw, opeliw, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, ptrarw, ptraiw, itloc, rhs_mumps, nsteps, son_level2, comp, lrlu, iptrlu, iwpos, iwposcb, posfac, lrlus, lrlusm, icntl, keep, keep8, dkeep, intarr, lintarr, dblarr, ldblarr nstk_s, procnode_steps, slavef, comm, myid, bufr, lbufr, lbufr_bytes, nbfin, ipool, lpool, leaf, perm, istep_to_iniv2, tab_pos_in_pere, lrgroups, mumps_tps_arr, smumps_tps_arr, l0_omp_mapping)
Definition sfac_asm_master_ELT_m.F:33
smumps_load
Definition smumps_load.F:14
smumps_load::smumps_load_mem_update
subroutine, public smumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
Definition smumps_load.F:920
smumps_load::mumps_load_disable
subroutine, public mumps_load_disable()
Definition smumps_load.F:135
smumps_load::smumps_load_update
subroutine, public smumps_load_update(check_flops, process_bande, inc_load, keep, keep8)
Definition smumps_load.F:824
smumps_load::mumps_load_enable
subroutine, public mumps_load_enable()
Definition smumps_load.F:130
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::smumps_blr_asm_niv1
subroutine smumps_blr_asm_niv1(a, la, posel1, nfront, nass1, iwhandler, son_iw, liw, lstk, nelim, k1, k2, sym, keep, keep8, opassw)
Definition slr_core.F:1400
smumps_lr_core::is_front_blr_candidate
subroutine is_front_blr_candidate(inode, niv, nfront, nass, blron, k489, k490, k491, k492, k20, k60, idad, k38, lrstatus, n, lrgroups)
Definition slr_core.F:45
smumps_lr_data_m
Definition smumps_lr_data_m.F:14
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_data_m::smumps_blr_save_nfs4father
subroutine, public smumps_blr_save_nfs4father(iwhandler, nfs4father)
Definition smumps_lr_data_m.F:856
smumps_struc_def
Definition smumps_struc_def.F:14
smumps_tps_m
Definition somp_tps_m.F:14
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102
smumps_ldlt_asm_niv12
subroutine smumps_ldlt_asm_niv12(a, la, son_a, iafath, nfront, nass1, ncols, lcb, iw, nrows, nelim, etatass, cb_is_compressed)
Definition sfac_asm.F:406
smumps_parpivt1_set_nvschur_max
subroutine smumps_parpivt1_set_nvschur_max(n, inode, iw, liw, a, la, keep, perm, ioldps, poselt, nfront, nass1, lr_activated, parpiv_t1, nb_postponed)
Definition sfac_asm.F:950
smumps_set_parpivt1
subroutine smumps_set_parpivt1(inode, nfront, nass1, keep, lr_activated, parpiv_t1)
Definition sfac_asm.F:788
smumps_get_size_needed
subroutine smumps_get_size_needed(sizei_needed, sizer_needed, skip_top_stack, keep, keep8, n, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptrast, step, pimaster, pamaster, lrlus, xsize, comp, acc_time, myid, slavef, procnode_steps, dad, iflag, ierror)
Definition sfac_mem_compress_cb.F:437
smumps_compre_new
subroutine smumps_compre_new(n, keep, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptrast, step, pimaster, pamaster, lrlus, xsize, comp, acc_time, myid, slavef, procnode_steps, dad)
Definition sfac_mem_compress_cb.F:120
smumps_free_block_cb_static
subroutine smumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
Definition sfac_mem_free_block_cb.F:20
smumps_maplig
recursive subroutine smumps_maplig(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes inode_pere, ison, nslaves_pere, list_slaves_pere, nfront_pere, nass_pere, nfs4father, lmap, trow, procnode_steps, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk, comp, iflag, ierror, myid, comm, perm, ipool, lpool, leaf, nbfin, icntl, keep, keep8, dkeep, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
Definition sfac_process_maprow.F:34
smumps_try_recvtreat
recursive subroutine smumps_try_recvtreat(comm_load, ass_irecv, blocking, set_irecv, message_received, msgsou, msgtag, status, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef 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, stack_right_authorized, lrgroups)
Definition sfac_process_message.F:560
smumps_ooc_get_pp_sizes
subroutine smumps_ooc_get_pp_sizes(k50, nbrow_l, nbcol_u, nass, nbpanels_l, nbpanels_u, lreq)
Definition sooc_panel_piv.F:303
smumps_ooc_pp_set_ptr
subroutine smumps_ooc_pp_set_ptr(k50, nbpanels_l, nbpanels_u, nass, ipos, iw, liw)
Definition sooc_panel_piv.F:195
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33
smumps_compute_estim_nfs4father
subroutine smumps_compute_estim_nfs4father(n, inode, ifath, fils, perm, keep, ioldps, hf, iw, liw, nfront, nass1, estim_nfs4father_atson)
Definition stools.F:1612
mumps_in_or_root_ssarbr
logical function mumps_in_or_root_ssarbr(procinfo_inode, k199)
Definition tools_common.F:214
mumps_storei8
subroutine mumps_storei8(i8, int_array)
Definition tools_common.F:871
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888