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