OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cmumps_fac_asm_master_elt_m Module Reference

Functions/Subroutines

subroutine cmumps_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, cmumps_tps_arr, l0_omp_mapping)
subroutine cmumps_fac_asm_niv2_elt (comm_load, ass_irecv, nelt, frt_ptr, frt_elt, 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)

Function/Subroutine Documentation

◆ cmumps_fac_asm_niv1_elt()

subroutine cmumps_fac_asm_master_elt_m::cmumps_fac_asm_niv1_elt ( integer comm_load,
integer ass_irecv,
integer nelt,
integer, dimension(n+1) frt_ptr,
integer, dimension(nelt) frt_elt,
integer n,
integer inode,
integer, dimension(liw), target iw,
integer, target liw,
complex, dimension(la), target a,
integer(8) la,
integer, dimension(2), intent(inout) info,
integer, dimension(keep(28)) nd,
integer, dimension(n) fils,
integer, dimension(keep(28)) frere,
integer, dimension(keep(28)) dad,
integer maxfrw,
type (cmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) ptlust,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer(8), dimension(nelt+1), intent(in) ptrarw,
integer(8), dimension(nelt+1), intent(in) ptraiw,
integer, dimension(n+keep(253)) itloc,
complex, dimension(keep(255)) rhs_mumps,
integer nsteps,
logical son_level2,
integer comp,
integer(8) lrlu,
integer(8) iptrlu,
integer, target iwpos,
integer iwposcb,
integer(8) posfac,
integer(8) lrlus,
integer(8) lrlusm,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, dimension(230) dkeep,
integer, dimension(lintarr) intarr,
integer(8), intent(in) lintarr,
complex, dimension(ldblarr) dblarr,
integer(8), intent(in) ldblarr,
integer, dimension(keep(28)) nstk_s,
integer, dimension(keep(28)) procnode_steps,
integer slavef,
integer comm,
integer myid,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer nbfin,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer, dimension(n) perm,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer, dimension(n), intent(in) lrgroups,
type (mumps_tps_t), dimension(:), optional, target mumps_tps_arr,
type (cmumps_tps_t), dimension(:), optional, target cmumps_tps_arr,
integer, dimension(:), intent(in), optional l0_omp_mapping )

Definition at line 16 of file cfac_asm_master_ELT_m.F.

33!$ USE OMP_LIB
34 USE mumps_tps_m
35 USE cmumps_tps_m
36 USE cmumps_dynamic_memory_m, ONLY : cmumps_dm_set_ptr,
37 & cmumps_dm_free_block
38 USE mumps_build_sort_index_elt_m
39 USE cmumps_buf
40 USE cmumps_load
41 USE cmumps_lr_core, ONLY : is_front_blr_candidate,
42 & cmumps_blr_asm_niv1
43 USE cmumps_lr_data_m, ONLY : cmumps_blr_init_front,
44 & cmumps_blr_save_nfs4father
45 USE cmumps_struc_def, ONLY : cmumps_root_struc
46 USE cmumps_ana_lr, ONLY : get_cut
47 USE cmumps_lr_core, ONLY : max_cluster
48 USE mumps_lr_common, ONLY : compute_blr_vcs
49 IMPLICIT NONE
50 TYPE (CMUMPS_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 (CMUMPS_TPS_T), TARGET, OPTIONAL :: CMUMPS_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 COMPLEX :: 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 COMPLEX, TARGET :: A(LA)
86 INTEGER, INTENT(IN) :: LRGROUPS(N)
87 DOUBLE PRECISION OPASSW, OPELIW
88 INTEGER(8), INTENT(IN) :: LINTARR, LDBLARR
89 COMPLEX 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 COMPLEX, 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 COMPLEX ZERO
162 parameter( zero = (0.0e0,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 CMUMPS_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 cmumps_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 cmumps_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 CMUMPS_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_compute_estim_nfs4father (
466 & n, inode, ifath, fils, perm, keep,
467 & ioldps, hf, iw, liw, nfront, nass1,
468 & estim_nfs4father_atson
469 & )
470 CALL cmumps_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 => cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 cmumps_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 CMUMPS_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 CMUMPS_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 CMUMPS_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 IF (info(1).EQ.-13) THEN
844 IF (lpok) THEN
845 WRITE( lp, * ) ' FAILURE IN INTEGER',
846 & ' DYNAMIC ALLOCATION DURING CMUMPS_ASM_NIV1_ELT'
847 ENDIF
848 info(2) = numstk
849 ENDIF
850 490 CONTINUE
851 IF ( keep(405) .EQ. 0 ) THEN
852 CALL cmumps_bdc_error( myid, slavef, comm, keep )
853 ENDIF
854 500 CONTINUE
855 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
cmumps_bdc_error
subroutine cmumps_bdc_error(myid, slavef, comm, keep)
Definition cbcast_int.F:38
cmumps_ldlt_asm_niv12
subroutine cmumps_ldlt_asm_niv12(a, la, son_a, iafath, nfront, nass1, ncols, lcb, iw, nrows, nelim, etatass, cb_is_compressed)
Definition cfac_asm.F:406
cmumps_parpivt1_set_nvschur_max
subroutine cmumps_parpivt1_set_nvschur_max(n, inode, iw, liw, a, la, keep, perm, ioldps, poselt, nfront, nass1, lr_activated, parpiv_t1, nb_postponed)
Definition cfac_asm.F:950
cmumps_set_parpivt1
subroutine cmumps_set_parpivt1(inode, nfront, nass1, keep, lr_activated, parpiv_t1)
Definition cfac_asm.F:788
cmumps_get_size_needed
subroutine cmumps_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 cfac_mem_compress_cb.F:437
cmumps_compre_new
subroutine cmumps_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 cfac_mem_compress_cb.F:120
cmumps_free_block_cb_static
subroutine cmumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
Definition cfac_mem_free_block_cb.F:20
cmumps_maplig
recursive subroutine cmumps_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 cfac_process_maprow.F:34
cmumps_try_recvtreat
recursive subroutine cmumps_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 cfac_process_message.F:560
cmumps_ooc_get_pp_sizes
subroutine cmumps_ooc_get_pp_sizes(k50, nbrow_l, nbcol_u, nass, nbpanels_l, nbpanels_u, lreq)
Definition cooc_panel_piv.F:303
cmumps_ooc_pp_set_ptr
subroutine cmumps_ooc_pp_set_ptr(k50, nbpanels_l, nbpanels_u, nass, ipos, iw, liw)
Definition cooc_panel_piv.F:195
cmumps_compute_estim_nfs4father
subroutine cmumps_compute_estim_nfs4father(n, inode, ifath, fils, perm, keep, ioldps, hf, iw, liw, nfront, nass1, estim_nfs4father_atson)
Definition ctools.F:1612
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
cmumps_ana_lr
Definition cana_lr.F:14
cmumps_ana_lr::get_cut
subroutine get_cut(iwr, nass, ncb, lrgroups, npartscb, npartsass, cut)
Definition cana_lr.F:25
cmumps_buf
Definition cmumps_comm_buffer.F:14
cmumps_buf::cmumps_buf_send_maplig
subroutine, public cmumps_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 cmumps_comm_buffer.F:1649
cmumps_dynamic_memory_m
Definition cfac_mem_dynamic.F:14
cmumps_dynamic_memory_m::cmumps_dm_free_block
subroutine cmumps_dm_free_block(xxg_status, dynptr, sizfr8, atomic_updates, keep8)
Definition cfac_mem_dynamic.F:433
cmumps_dynamic_memory_m::cmumps_dm_set_ptr
subroutine cmumps_dm_set_ptr(address, sizfr8, cbptr)
Definition cfac_mem_dynamic.F:417
cmumps_load
Definition cmumps_load.F:14
cmumps_load::mumps_load_enable
subroutine, public mumps_load_enable()
Definition cmumps_load.F:130
cmumps_load::myid
integer, save, private myid
Definition cmumps_load.F:57
cmumps_load::cmumps_load_mem_update
subroutine, public cmumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
Definition cmumps_load.F:920
cmumps_load::mumps_load_disable
subroutine, public mumps_load_disable()
Definition cmumps_load.F:135
cmumps_load::cmumps_load_update
subroutine, public cmumps_load_update(check_flops, process_bande, inc_load, keep, keep8)
Definition cmumps_load.F:824
cmumps_lr_core
Definition clr_core.F:18
cmumps_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 clr_core.F:45
cmumps_lr_core::cmumps_blr_asm_niv1
subroutine cmumps_blr_asm_niv1(a, la, posel1, nfront, nass1, iwhandler, son_iw, liw, lstk, nelim, k1, k2, sym, keep, keep8, opassw)
Definition clr_core.F:1400
cmumps_lr_core::max_cluster
subroutine max_cluster(cut, cut_size, maxi_cluster)
Definition clr_core.F:1304
cmumps_lr_data_m
Definition cmumps_lr_data_m.F:14
cmumps_lr_data_m::cmumps_blr_init_front
subroutine, public cmumps_blr_init_front(iwhandler, info, mtk405)
Definition cmumps_lr_data_m.F:175
cmumps_lr_data_m::cmumps_blr_save_nfs4father
subroutine, public cmumps_blr_save_nfs4father(iwhandler, nfs4father)
Definition cmumps_lr_data_m.F:856
cmumps_struc_def
Definition cmumps_struc_def.F:14
cmumps_tps_m
Definition comp_tps_m.F:14
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
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_typenode
integer function mumps_typenode(procinfo_inode, k199)
Definition tools_common.F:90
mumps_procnode
integer function mumps_procnode(procinfo_inode, k199)
Definition tools_common.F:151
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888

◆ cmumps_fac_asm_niv2_elt()

subroutine cmumps_fac_asm_master_elt_m::cmumps_fac_asm_niv2_elt ( integer comm_load,
integer ass_irecv,
integer nelt,
integer, dimension(n+1) frt_ptr,
integer, dimension(nelt) frt_elt,
integer n,
integer inode,
integer, dimension(liw) iw,
integer liw,
complex, dimension(la), target a,
integer(8) la,
integer, dimension(2), intent(inout) info,
integer, dimension(keep(28)) nd,
integer, dimension(n) fils,
integer, dimension(keep(28)) frere,
integer, dimension (keep(28)) dad,
integer, dimension(slavef+1, max(1,keep(56))) cand,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer maxfrw,
type (cmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) ptlust,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer(8), dimension(nelt+1), intent(in) ptrarw,
integer, dimension(keep(28)) nstk_s,
integer(8), dimension(nelt+1), intent(in) ptraiw,
integer, dimension(n+keep(253)) itloc,
complex, dimension(keep(255)) rhs_mumps,
integer nsteps,
integer comp,
integer(8) lrlu,
integer(8) iptrlu,
integer iwpos,
integer iwposcb,
integer(8) posfac,
integer(8) lrlus,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
real, dimension(230) dkeep,
integer, dimension(lintarr) intarr,
integer(8), intent(in) lintarr,
complex, dimension(ldblarr) dblarr,
integer(8), intent(in) ldblarr,
integer, dimension(keep(28)) procnode_steps,
integer slavef,
integer comm,
integer myid,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer nbfin,
integer leaf,
integer, dimension(lpool) ipool,
integer lpool,
integer, dimension(n) perm,
integer, dimension(0:slavef - 1) mem_distrib,
integer, dimension(n), intent(in) lrgroups )

Definition at line 857 of file cfac_asm_master_ELT_m.F.

874!$ USE OMP_LIB
875 USE mumps_build_sort_index_elt_m
876 USE cmumps_buf
877 USE cmumps_load
878 USE cmumps_lr_core, ONLY : is_front_blr_candidate
879 USE cmumps_struc_def, ONLY : cmumps_root_struc
880 USE cmumps_dynamic_memory_m, ONLY : cmumps_dm_set_ptr,
881 & cmumps_dm_is_dynamic
882 USE cmumps_ana_lr, ONLY : get_cut
883 USE cmumps_lr_core, ONLY : max_cluster
884 USE mumps_lr_common, ONLY : compute_blr_vcs
885 IMPLICIT NONE
886 TYPE (CMUMPS_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 COMPLEX, 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 COMPLEX :: 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 COMPLEX 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 COMPLEX, 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 COMPLEX ZERO
986 REAL RZERO
987 parameter( rzero = 0.0e0 )
988 parameter( zero = (0.0e0,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 lpok = ((lp.GT.0).AND.(icntl(4).GE.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 IF ( numelt .NE. 0 ) THEN
1015 elbeg = frt_ptr(inode)
1016 ELSE
1017 elbeg = 1
1018 END IF
1019 numorg = 0
1020 DO WHILE (in.GT.0)
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 DO WHILE (ison .GT. 0)
1030 numstk = numstk + 1
1031 IF ( keep(48)==5 .AND.
1032 & mumps_typenode(procnode_steps(step(ison)),
1033 & keep(199)) .EQ. 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 compress_panel = (lrstatus.GE.2)
1048 compress_cb = ((lrstatus.EQ.1).OR.
1049 & (lrstatus.EQ.3))
1050 lr_activated = (lrstatus.GT.0)
1051 IF (compress_cb.AND.(.NOT.compress_panel)) THEN
1052 compress_panel = .true.
1053 lrstatus = 3
1054 ENDIF
1055 oocwrite_compatible_with_blr =
1056 & ( .NOT.lr_activated.OR.(.NOT.compress_panel).OR.
1057 & (keep(486).NE.2)
1058 & )
1059 IF((keep(24).eq.0).or.(keep(24).eq.1)) then
1060 force_cand=.false.
1061 ELSE
1062 force_cand=(mod(keep(24),2).eq.0)
1063 end if
1064 typesplit = mumps_typesplit(procnode_steps(step(inode)),
1065 & keep(199))
1066 is_oftype5or6 = (typesplit.EQ.5 .OR. typesplit.EQ.6)
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 IF ( cand( i, iniv2 ).LT.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 IF (inode.EQ.-999999) THEN
1085 split_map_restart = .true.
1086 ENDIF
1087 ENDIF
1088 IF (is_oftype5or6.AND.split_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 IF ( (typesplit.EQ.4)
1107 & .OR.(typesplit.EQ.5).OR.(typesplit.EQ.6)
1108 & ) THEN
1109 IF (typesplit.EQ.4) THEN
1110 ALLOCATE(copy_cand(slavef+1),stat=allocok)
1111 IF (allocok > 0 ) THEN
1112 GOTO 245
1113 ENDIF
1114 CALL cmumps_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 cmumps_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 cmumps_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 IF (keep(376) .EQ. 1) THEN
1149 nfront = iw( pimaster(step(ifson)) + keep(ixsz))
1150 ENDIF
1151 CALL cmumps_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 cmumps_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 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
1175 CALL cmumps_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 IF ((iwpos + lreq -1) .GT. iwposcb) THEN
1180 CALL cmumps_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 IF (lrlu .NE. lrlus) THEN
1189 IF (lpok) THEN
1190 WRITE(lp, * ) 'PB compress CMUMPS_FAC_ASM_NIV2_ELT',
1191 & 'LRLU,LRLUS=',lrlu,lrlus
1192 ENDIF
1193 GOTO 270
1194 ENDIF
1195 IF ((iwpos + lreq -1) .GT. 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 IF (info(1).LT.0) GOTO 250
1216 IF ( nfront .NE. nfront_eff ) THEN
1217 IF (
1218 & (typesplit.EQ.5) .OR. (typesplit.EQ.6)) 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 IF (nfront.GT.nfront_eff) THEN
1225 ncb = nfront_eff - nass1
1226 nslaves_old = nslaves
1227 hf_old = hf
1228 IF (typesplit.EQ.4) THEN
1229 ALLOCATE(copy_cand(slavef+1),stat=allocok)
1230 IF (allocok > 0 ) THEN
1231 GOTO 245
1232 ENDIF
1233 CALL cmumps_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 cmumps_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 cmumps_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 cmumps_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 IF (nslaves_old .NE. 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 IF (keep(201).EQ.1.AND.keep(50).NE.1.AND.
1293 & oocwrite_compatible_with_blr) THEN
1294 CALL cmumps_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 IF (keep(219).NE.0.AND.keep(50).EQ.2) THEN
1310 ifath = dad( step( inode) )
1311 IF (ifath.NE.0) THEN
1312 IF (compress_cb.AND.
1313 & mumps_typenode(procnode_steps(step(ifath)),keep(199))
1314 & .EQ. 2 ) THEN
1315 ioldps = ptlust(step(inode))
1316 CALL cmumps_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 cmumps_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 IF(keep(86).EQ.1)THEN
1328 IF(mod(keep(24),2).eq.0)THEN
1329 CALL cmumps_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 ELSEIF((keep(24).EQ.0).OR.(keep(24).EQ.1))THEN
1336 CALL cmumps_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 IF (keep(50).EQ.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 IF(keep(219).NE.0.AND.keep(50) .EQ. 2)
1352 & laell8 = laell8+int(nass1,8)
1353 ldafs = nass1
1354 ldafs8 = int(nass1,8)
1355 ENDIF
1356 CALL cmumps_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 IF (info(1).LT.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 cmumps_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 IF ( keep(50) .eq. 0 .OR. ldafs .lt. 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!$OMP& IF (LAPOS2 - POSELT > int(KEEP(361),8) .AND. NOMP .GT. 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!$OMP& IF (LDAFS - 1 .GT. KEEP(360) .AND. NOMP .GT. 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 IF (keep(219).NE.0.AND.keep(50).EQ.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 IF ((numstk.NE.0).AND.(nass.NE.0)) THEN
1440 ison = ifson
1441 DO 220 iell = 1, numstk
1442 istchk = pimaster(step(ison))
1443 nelim = iw(istchk + keep(ixsz) + 1)
1444 IF (nelim.EQ.0) GOTO 210
1445 lstk = iw(istchk + keep(ixsz))
1446 npivs = iw(istchk + 3+keep(ixsz))
1447 IF (npivs.LT.0) npivs=0
1448 nslson = iw(istchk + 5+keep(ixsz))
1449 hs = 6 + nslson + keep(ixsz)
1450 ncols = npivs + lstk
1451 same_proc = (istchk.LT.iwpos)
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 packed_cb = ( son_xxs .EQ. s_cb1comp )
1459 IF (.NOT.same_proc) THEN
1460 nrows = iw(istchk + keep(ixsz) + 2)
1461 ELSE
1462 nrows = ncols
1463 ENDIF
1464 IF (keep(50).EQ.0) THEN
1465 lda_son = lstk
1466 lcb = int(nelim,8)*int(lstk,8)
1467 ELSE
1468 IF (nslson.EQ.0) THEN
1469 IF (same_proc) THEN
1470 is_cb_lr = iw(istchk_cb_right+xxlr).EQ. 1 .OR.
1471 & iw(istchk_cb_right+xxlr).EQ. 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 IF (keep(50) .EQ. 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 & cmumps_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 cmumps_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 IF (keep(50).eq.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 IF (lcb .GT. 0) THEN
1526 CALL cmumps_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 IF (keep(219).NE.0) THEN
1540 IF (keep(50).EQ.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 IF (keep(50).EQ.0) THEN
1553 IF (i.LE.nass1) 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 IF ( i .GT. nass1 ) THEN
1566 IF (keep(219).NE.0 .AND. keep(50).EQ.2) THEN
1567 ainput8=aii8
1568 DO jj8=ii8,j28
1569 j=intarr(jj8)
1570 IF (j.LE.nass1) THEN
1571 a(aposmax+int(j-1,8))=cmplx(
1572 & max(real(a(aposmax+int(j-1,8))),
1573 & abs(dblarr(ainput8))),
1574 & kind=kind(a)
1575 & )
1576 ENDIF
1577 ainput8=ainput8+1_8
1578 ENDDO
1579 ENDIF
1580 aii8 = aii8 + j28 - ii8 + 1_8
1581 cycle
1582 ELSE
1583 IF (keep(219).NE.0) THEN
1584 maxarr = rzero
1585 ENDIF
1586 DO jj8=ii8,j28
1587 j = intarr(jj8)
1588 IF ( j .LE. nass1) THEN
1589 IF (i.LT.j) THEN
1590 apos2 = ict12 + int(j,8)*ldafs8
1591 ELSE
1592 apos2 = ict21 + int(j,8)
1593 ENDIF
1594 a(apos2) = a(apos2) + dblarr(aii8)
1595 ELSE IF (keep(219).NE.0.AND.keep(50).EQ.2) THEN
1596 maxarr = max(maxarr,abs(dblarr(aii8)))
1597 ENDIF
1598 aii8 = aii8 + 1_8
1599 END DO
1600 IF(keep(219).NE.0.AND.keep(50) .EQ. 2) THEN
1601 a(aposmax+int(i-1,8)) = cmplx(
1602 & max( maxarr, real(a(aposmax+int(i-1,8)))),
1603 & kind=kind(a)
1604 & )
1605 ENDIF
1606 ENDIF
1607 END IF
1608 END DO
1609 END DO
1610 IF (keep(253).GT.0) THEN
1611 poselt = ptrast(step(inode))
1612 ibrot = inode
1613 ijrow = pos_first_numorg
1614 DO iorg = 1, numorg
1615 IF (keep(50).EQ.0) THEN
1616 DO j253 = 1, keep(253)
1617 apos = poselt +
1618 & int(ijrow-1,8) * int(ldafs,8) +
1619 & int(ldafs-keep(253)+j253-1,8)
1620 a(apos) = a(apos) + rhs_mumps( (j253-1)*keep(254)+ibrot )
1621 ENDDO
1622 ENDIF
1623 ibrot = fils(ibrot)
1624 ijrow = ijrow+1
1625 ENDDO
1626 ENDIF
1627 ptrcol = ioldps + hf + nfront
1628 ptrrow = ioldps + hf + nass1
1629 pdest = ioldps + 6 + keep(ixsz)
1630 ibc_source = myid
1631 DO islave = 1, nslaves
1632 CALL mumps_bloc2_get_slave_info(
1633 & keep,keep8, inode, step, n, slavef,
1634 & istep_to_iniv2, tab_pos_in_pere,
1635 & islave, ncb,
1636 & nslaves,
1637 & nblig, first_index )
1638 shift_index = first_index - 1
1639 ierr = -1
1640 DO WHILE (ierr .EQ.-1)
1641 IF ( keep(50) .eq. 0 ) THEN
1642 nbcol = nfront
1643 CALL cmumps_buf_send_desc_bande( inode,
1644 & sum(sonrows_per_row(first_index:first_index+nblig-1)),
1645 & nblig, iw(ptrrow), nbcol, iw(ptrcol), nass1,
1646 & izero, idummy,
1647 & nslaves,
1648 & estim_nfs4father_atson,
1649 & iw(pdest), ibc_source, nfront, comm, keep, ierr
1650 & , iw(ioldps+xxlr)
1651 & )
1652 ELSE
1653 nbcol = nass1+shift_index+nblig
1654 CALL cmumps_buf_send_desc_bande( inode,
1655 & sum(sonrows_per_row(first_index:first_index+nblig-1)),
1656 & nblig, iw(ptrrow), nbcol, iw(ptrcol), nass1,
1657 & nslaves-islave,
1658 & iw( ptlust(step(inode))+6+keep(ixsz)+islave),
1659 & nslaves,
1660 & estim_nfs4father_atson,
1661 & iw(pdest), ibc_source, nfront, comm, keep, ierr
1662 & , iw(ioldps+xxlr)
1663 & )
1664 ENDIF
1665 IF (ierr.EQ.-1) THEN
1666 blocking = .false.
1667 set_irecv = .true.
1668 message_received = .false.
1669 CALL cmumps_try_recvtreat( comm_load, ass_irecv,
1670 & blocking, set_irecv, message_received,
1671 & mpi_any_source, mpi_any_tag,
1672 & status, bufr, lbufr,
1673 & lbufr_bytes,
1674 & procnode_steps, posfac, iwpos, iwposcb, iptrlu,
1675 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
1676 & ptlust, ptrfac,
1677 & ptrast, step, pimaster, pamaster, nstk_s, comp, info(1),
1678 & info(2), comm,
1679 & perm,
1680 & ipool, lpool, leaf, nbfin, myid, slavef,
1681 & root, opassw, opeliw, itloc, rhs_mumps,
1682 & fils, dad, ptrarw, ptraiw,
1683 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
1684 & nelt+1, nelt, frt_ptr, frt_elt,
1685 & istep_to_iniv2, tab_pos_in_pere, .true.
1686 & , lrgroups
1687 & )
1688 IF ( info(1) .LT. 0 ) GOTO 500
1689 IF (message_received) THEN
1690 ioldps = ptlust(step(inode))
1691 ptrcol = ioldps + hf + nfront
1692 ptrrow = ioldps + hf + nass1 + shift_index
1693 ENDIF
1694 ENDIF
1695 ENDDO
1696 IF (ierr .EQ. -2) GOTO 300
1697 IF (ierr .EQ. -3) GOTO 305
1698 ptrrow = ptrrow + nblig
1699 pdest = pdest + 1
1700 ENDDO
1701 DEALLOCATE(sonrows_per_row)
1702 IF (numstk.EQ.0) GOTO 500
1703 ison = ifson
1704 DO iell = 1, numstk
1705 istchk = pimaster(step(ison))
1706 nelim = iw(istchk + 1 + keep(ixsz))
1707 lstk = iw(istchk + keep(ixsz))
1708 npivs = iw(istchk + 3 + keep(ixsz))
1709 IF ( npivs .LT. 0 ) npivs = 0
1710 nslson = iw(istchk + 5 + keep(ixsz))
1711 hs = 6 + nslson + keep(ixsz)
1712 ncols = npivs + lstk
1713 same_proc = (istchk.LT.iwpos)
1714 IF (.NOT.same_proc) THEN
1715 nrows = iw(istchk + 2 + keep(ixsz) )
1716 ELSE
1717 nrows = ncols
1718 ENDIF
1719 pdest = istchk + 6 + keep(ixsz)
1720 ncbson = lstk - nelim
1721 ptrcol = istchk + hs + nrows + npivs + nelim
1722 IF (keep(219).NE.0.AND.keep(50).EQ.2) THEN
1723 nfs4father = ncbson
1724 DO i=0,ncbson-1
1725 IF(iw(ptrcol+i) .GT. nass1) THEN
1726 nfs4father = i
1727 EXIT
1728 ENDIF
1729 ENDDO
1730 nfs4father = nfs4father + nelim
1731 ELSE
1732 nfs4father = 0
1733 ENDIF
1734 IF (nslson.EQ.0) THEN
1735 nslson = 1
1736 pdest1(1) = mumps_procnode(procnode_steps(step(ison)),
1737 & keep(199))
1738 IF (pdest1(1).EQ.myid) THEN
1739 CALL cmumps_maplig_fils_niv1( comm_load, ass_irecv,
1740 & bufr, lbufr, lbufr_bytes,
1741 & inode, ison, nslaves,
1742 & iw( ptlust(step(inode)) + 6 +keep(ixsz)),
1743 & nfront, nass1, nfs4father, ncbson, iw( ptrcol ),
1744 & procnode_steps,
1745 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
1746 & lrlus, n, iw, liw, a, la,
1747 & ptrist, ptlust, ptrfac, ptrast, step,
1748 & pimaster, pamaster, nstk_s, comp,
1749 & info(1), info(2), myid, comm, perm,
1750 & ipool, lpool, leaf,
1751 & nbfin, icntl, keep, keep8, dkeep, root,
1752 & opassw, opeliw,
1753 & itloc, rhs_mumps, fils, dad,
1754 & ptrarw, ptraiw, intarr, dblarr, nd, frere, nelt+1, nelt,
1755 & frt_ptr, frt_elt,
1756 & istep_to_iniv2, tab_pos_in_pere,
1757 & lrgroups )
1758 IF ( info(1) .LT. 0 ) GOTO 500
1759 ELSE
1760 ierr = -1
1761 DO WHILE (ierr.EQ.-1)
1762 ptrcol = pimaster(step(ison)) + hs + nrows + npivs + nelim
1763 CALL cmumps_buf_send_maplig(
1764 & inode, nfront,nass1,nfs4father,
1765 & ison, myid,
1766 & nslaves, iw( ptlust(step(inode)) + 6 +keep(ixsz)),
1767 & iw(ptrcol), ncbson,
1768 & comm, ierr, pdest1, nslson, slavef,
1769 & keep,keep8, step, n,
1770 & istep_to_iniv2, tab_pos_in_pere
1771 & )
1772 IF (ierr.EQ.-1) THEN
1773 blocking = .false.
1774 set_irecv = .true.
1775 message_received = .false.
1776 CALL cmumps_try_recvtreat( comm_load, ass_irecv,
1777 & blocking, set_irecv, message_received,
1778 & mpi_any_source, mpi_any_tag,
1779 & status, bufr, lbufr, lbufr_bytes,
1780 & procnode_steps, posfac, iwpos, iwposcb, iptrlu,
1781 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
1782 & ptlust, ptrfac,
1783 & ptrast, step, pimaster, pamaster, nstk_s, comp, info(1),
1784 & info(2), comm,
1785 & perm,
1786 & ipool, lpool, leaf, nbfin, myid, slavef,
1787 & root,opassw, opeliw, itloc, rhs_mumps, fils, dad,
1788 & ptrarw, ptraiw,
1789 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
1790 & nelt+1, nelt, frt_ptr, frt_elt,
1791 & istep_to_iniv2, tab_pos_in_pere, .true.
1792 & , lrgroups
1793 & )
1794 IF ( info(1) .LT. 0 ) GOTO 500
1795 ENDIF
1796 ENDDO
1797 IF (ierr .EQ. -2) GOTO 290
1798 IF (ierr .EQ. -3) GOTO 295
1799 ENDIF
1800 ELSE
1801 IF (pimaster(step(ison)).GT.0) THEN
1802 ierr = -1
1803 DO WHILE (ierr.EQ.-1)
1804 ptrcol = pimaster(step(ison)) + hs + nrows + npivs + nelim
1805 pdest = pimaster(step(ison)) + 6 + keep(ixsz)
1806 CALL cmumps_buf_send_maplig(
1807 & inode, nfront, nass1, nfs4father,
1808 & ison, myid,
1809 & nslaves, iw(ptlust(step(inode))+6+keep(ixsz)),
1810 & iw(ptrcol), ncbson,
1811 & comm, ierr, iw(pdest), nslson, slavef,
1812 & keep,keep8, step, n,
1813 & istep_to_iniv2, tab_pos_in_pere
1814 & )
1815 IF (ierr.EQ.-1) THEN
1816 blocking = .false.
1817 set_irecv = .true.
1818 message_received = .false.
1819 CALL cmumps_try_recvtreat( comm_load, ass_irecv,
1820 & blocking, set_irecv, message_received,
1821 & mpi_any_source, mpi_any_tag,
1822 & status, bufr, lbufr,
1823 & lbufr_bytes,
1824 & procnode_steps, posfac, iwpos, iwposcb, iptrlu,
1825 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
1826 & ptlust, ptrfac,
1827 & ptrast, step, pimaster, pamaster, nstk_s, comp, info(1),
1828 & info(2), comm,
1829 & perm,
1830 & ipool, lpool, leaf, nbfin, myid, slavef,
1831 & root,opassw, opeliw, itloc, rhs_mumps,
1832 & fils, dad, ptrarw, ptraiw,
1833 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
1834 & nelt+1, nelt, frt_ptr, frt_elt,
1835 & istep_to_iniv2, tab_pos_in_pere, .true.
1836 & , lrgroups
1837 & )
1838 IF ( info(1) .LT. 0 ) GOTO 500
1839 ENDIF
1840 ENDDO
1841 IF (ierr .EQ. -2) GOTO 290
1842 IF (ierr .EQ. -3) GOTO 295
1843 ENDIF
1844 DO islave = 0, nslson-1
1845 IF (iw(pdest+islave).EQ.myid) THEN
1846 CALL mumps_bloc2_get_slave_info(
1847 & keep,keep8, ison, step, n, slavef,
1848 & istep_to_iniv2, tab_pos_in_pere,
1849 & islave+1, ncbson,
1850 & nslson,
1851 & trow_size, first_index )
1852 shift_index = first_index - 1
1853 indx = ptrcol + shift_index
1854 CALL cmumps_maplig( comm_load, ass_irecv,
1855 & bufr, lbufr, lbufr_bytes,
1856 & inode, ison, nslaves,
1857 & iw( ptlust(step(inode))+6+keep(ixsz)),
1858 & nfront, nass1,nfs4father,
1859 & trow_size, iw( indx ),
1860 & procnode_steps,
1861 & slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
1862 & lrlus, n, iw, liw, a, la,
1863 & ptrist, ptlust, ptrfac, ptrast, step,
1864 & pimaster, pamaster, nstk_s, comp, info(1), info(2),
1865 & myid, comm, perm, ipool, lpool, leaf,
1866 & nbfin, icntl, keep,keep8,dkeep, root,
1867 & opassw, opeliw, itloc, rhs_mumps, fils, dad,
1868 & ptrarw, ptraiw, intarr, dblarr, nd, frere,
1869 & nelt+1, nelt, frt_ptr, frt_elt,
1870 &
1871 & istep_to_iniv2, tab_pos_in_pere, lrgroups)
1872 IF ( info(1) .LT. 0 ) GOTO 500
1873 EXIT
1874 ENDIF
1875 ENDDO
1876 ENDIF
1877 ison = frere(step(ison))
1878 ENDDO
1879 GOTO 500
1880 250 CONTINUE
1881 IF (info(1).EQ.-13) THEN
1882 IF (lpok) THEN
1883 WRITE( lp, * )
1884 &' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING
1885 & CMUMPS_FAC_ASM_NIV2_ELT'
1886 ENDIF
1887 info(2) = numstk + 1
1888 ENDIF
1889 GOTO 490
1890 245 CONTINUE
1891 IF (lpok) THEN
1892 WRITE( lp, * ) ' FAILURE ALLOCATING COPY_CAND',
1893 & ' DURING CMUMPS_FAC_ASM_NIV2_ELT'
1894 ENDIF
1895 info(1) = -13
1896 info(2) = slavef+1
1897 GOTO 490
1898 265 CONTINUE
1899 IF (lpok) THEN
1900 WRITE( lp, * ) ' FAILURE ALLOCATING TMP_SLAVES_LIST',
1901 & ' DURING CMUMPS_FAC_ASM_NIV2_ELT'
1902 ENDIF
1903 info(1) = -13
1904 info(2) = size_tmp_slaves_list
1905 GOTO 490
1906 270 CONTINUE
1907 info(1) = -8
1908 info(2) = lreq
1909 IF (lpok) THEN
1910 WRITE( lp, * )
1911 & ' FAILURE IN INTEGER ALLOCATION DURING CMUMPS_ASM_NIV2_ELT'
1912 ENDIF
1913 GOTO 490
1914 275 CONTINUE
1915 IF (lpok) THEN
1916 WRITE( lp, * ) ' FAILURE ALLOCATING SONROWS_PER_ROW',
1917 & ' DURING CMUMPS_ASM_NIV2_ELT'
1918 ENDIF
1919 info(1) = -13
1920 info(2) = nfront-nass1
1921 GOTO 490
1922 290 CONTINUE
1923 IF (lpok) THEN
1924 WRITE( lp, * )
1925 &' FAILURE, SEND BUFFER TOO SMALL (1) DURING CMUMPS_ASM_NIV2_ELT'
1926 ENDIF
1927 info(1) = -17
1928 lreq = ncbson + 6 + nslson+keep(ixsz)
1929 info(2) = lreq * keep( 34 )
1930 GOTO 490
1931 295 CONTINUE
1932 IF (lpok) THEN
1933 WRITE( lp, * )
1934 &' FAILURE, RECV BUFFER TOO SMALL (1) DURING CMUMPS_ASM_NIV2_ELT'
1935 ENDIF
1936 info(1) = -20
1937 lreq = ncbson + 6 + nslson+keep(ixsz)
1938 info(2) = lreq * keep( 34 )
1939 GOTO 490
1940 300 CONTINUE
1941 IF (lpok) THEN
1942 WRITE( lp, * )
1943 &' FAILURE, SEND BUFFER TOO SMALL (2)',
1944 &' DURING CMUMPS_FAC_ASM_NIV2_ELT'
1945 ENDIF
1946 info(1) = -17
1947 lreq = nblig + nbcol + 4 + keep(ixsz)
1948 info(2) = lreq * keep( 34 )
1949 GOTO 490
1950 305 CONTINUE
1951 IF (lpok) THEN
1952 WRITE( lp, * )
1953 &' FAILURE, RECV BUFFER TOO SMALL (2)',
1954 &' DURING CMUMPS_FAC_ASM_NIV2_ELT'
1955 ENDIF
1956 info(1) = -20
1957 lreq = nblig + nbcol + 4 + keep(ixsz)
1958 info(2) = lreq * keep( 34 )
1959 GOTO 490
1960 490 CALL cmumps_bdc_error( myid, slavef, comm, keep )
1961 500 CONTINUE
1962 RETURN
cmplx
float cmplx[2]
Definition pblas.h:136
cmumps_maplig_fils_niv1
subroutine cmumps_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 cfac_process_maprow.F:644
cmumps_buf::cmumps_buf_send_desc_bande
subroutine, public cmumps_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 cmumps_comm_buffer.F:785
cmumps_dynamic_memory_m::cmumps_dm_is_dynamic
logical function cmumps_dm_is_dynamic(ixxd)
Definition cfac_mem_dynamic.F:114
cmumps_load::cmumps_load_set_partition
subroutine, public cmumps_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 cmumps_load.F:316
cmumps_load::cmumps_split_prep_partition
subroutine, public cmumps_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 cmumps_load.F:172
cmumps_load::cmumps_split_propagate_parti
subroutine, public cmumps_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 cmumps_load.F:277
cmumps_load::cmumps_load_send_md_info
subroutine, public cmumps_load_send_md_info(slavef, nmb_of_cand, list_of_cand, tab_pos, nass, keep, keep8, list_slaves, nslaves, inode)
Definition cmumps_load.F:5089
cmumps_load::cmumps_split_post_partition
subroutine, public cmumps_split_post_partition(inode, step, n, slavef, nbsplit, ncb, procnode_steps, keep, dad, fils, icntl, tab_pos, nslaves_node)
Definition cmumps_load.F:220
cmumps_load::cmumps_load_master_2_all
subroutine, public cmumps_load_master_2_all(myid, slavef, comm, tab_pos, nass, keep, keep8, list_slaves, nslaves, inode)
Definition cmumps_load.F:1671
mumps_typesplit
integer function mumps_typesplit(procinfo_inode, k199)
Definition tools_common.F:171