OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
csol_bwd_aux.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 SUBROUTINE cmumps_solve_node_bwd( INODE,
15 & N, IPOOL, LPOOL, IIPOOL, NBFINF,
16 & A, LA, IW, LIW, W, LWC, NRHS,
17 & POSWCB, PLEFTW, POSIWCB,
18 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
19 & PTRICB, PTRACB, IWCB, LIWW, W2,
20 & NE_STEPS, STEP,
21 & FRERE, FILS, PTRIST, PTRFAC,
22 & MYLEAF_LEFT, INFO,
23 & PROCNODE_STEPS, DEJA_SEND,
24 & SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,
25 & KEEP,KEEP8, DKEEP, RHS_ROOT, LRHS_ROOT, MTYPE,
26 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS,
27 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
28 & , RHS_BOUNDS, LRHS_BOUNDS, DO_NBSPARSE, FROM_PP
29 & , ERROR_WAS_BROADCASTED
30 & , DO_MCAST2_TERMBWD
31 & )
32 USE cmumps_ooc
33 USE cmumps_buf
34 USE cmumps_sol_lr, only : cmumps_sol_bwd_lr_su
35 IMPLICIT NONE
36 INTEGER :: KEEP( 500 )
37 INTEGER(8) :: KEEP8(150)
38 REAL, INTENT(INOUT) :: DKEEP(230)
39 INTEGER :: INFO(80)
40 INTEGER, INTENT( IN ) :: INODE, N, NRHS, MTYPE, LIW, LIWW
41 INTEGER, INTENT( IN ) :: SLAVEF, COMM, MYID
42 INTEGER, INTENT (IN ) :: PROCNODE_STEPS(KEEP(28))
43 INTEGER, INTENT( IN ) :: NE_STEPS(KEEP(28))
44 INTEGER(8), INTENT( IN ) :: LA, LWC
45 INTEGER(8), INTENT( INOUT ) :: POSWCB, PLEFTW
46 INTEGER, INTENT( INOUT ) :: POSIWCB
47 INTEGER, INTENT( IN ) :: LPANEL_POS
48 INTEGER :: PANEL_POS(LPANEL_POS)
49 LOGICAL, INTENT(INOUT) :: DEJA_SEND(0:SLAVEF-1)
50 INTEGER, INTENT(IN) :: LPOOL
51 INTEGER, INTENT(INOUT) :: IPOOL(LPOOL), IIPOOL
52 INTEGER, INTENT(INOUT) :: NBFINF, MYLEAF_LEFT
53 INTEGER :: PTRIST(KEEP(28)), PTRICB(KEEP(28))
54 INTEGER(8) :: PTRACB(KEEP(28))
55 INTEGER(8) :: PTRFAC(KEEP(28))
56 COMPLEX :: A( LA )
57 COMPLEX :: W(LWC)
58 COMPLEX :: W2(KEEP(133))
59 INTEGER :: IW(LIW),IWCB(LIWW)
60 INTEGER STEP(N), FRERE(KEEP(28)),FILS(N)
61 INTEGER LBUFR, LBUFR_BYTES
62 INTEGER BUFR(LBUFR)
63 INTEGER ISTEP_TO_INIV2(KEEP(71)),
64 & tab_pos_in_pere(slavef+2,max(1,keep(56)))
65 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
66 COMPLEX RHSCOMP(LRHSCOMP,NRHS)
67 INTEGER(8), intent(in) :: LRHS_ROOT
68 COMPLEX RHS_ROOT( LRHS_ROOT )
69 LOGICAL, INTENT( IN ) :: PRUN_BELOW
70 INTEGER, INTENT(IN) :: SIZE_TO_PROCESS
71 LOGICAL, INTENT(IN) :: TO_PROCESS(SIZE_TO_PROCESS)
72 LOGICAL, INTENT(IN) :: DO_NBSPARSE
73 INTEGER, INTENT(IN) :: LRHS_BOUNDS
74 INTEGER, INTENT(IN) :: RHS_BOUNDS(LRHS_BOUNDS)
75 LOGICAL, INTENT(IN) :: FROM_PP
76 LOGICAL, INTENT( OUT ) :: ERROR_WAS_BROADCASTED
77 LOGICAL, INTENT( OUT ) :: DO_MCAST2_TERMBWD
78 include 'mpif.h'
79 include 'mumps_tags.h'
80 INTEGER IERR
81 LOGICAL FLAG
82 include 'mumps_headers.h'
83 LOGICAL COMPRESS_PANEL, LR_ACTIVATED
84 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR
85 LOGICAL LTLEVEL2, IN_SUBTREE
86 INTEGER TYPENODE
87 INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR
88 LOGICAL MUST_BE_PERMUTED
89 LOGICAL NO_CHILDREN
90 LOGICAL :: ALLOW_OTHERS_TO_LEAVE
91 INTEGER :: K, JBDEB, JBFIN, NRHS_B
92 INTEGER IWHDLR
93 INTEGER NPIV
94 INTEGER IPOS,LIELL,NELIM,JJ,I
95 INTEGER J1,J2,J,NCB
96 INTEGER NSLAVES
97 INTEGER IN,IF,LONG,POOL_FIRST_POS,TMP
98 INTEGER :: NBFILS
99 INTEGER :: PROCDEST, DEST
100 INTEGER(8) :: PTWCB, PPIV_COURANT
101 INTEGER :: Offset, EffectiveSize, ISLAVE, FirstIndex
102 INTEGER :: POSINDICES, IPOSINRHSCOMP, IPOSINRHSCOMP_PANEL
103 INTEGER(8) :: APOS, IST
104 INTEGER(8) :: IFR8
105 INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS
106 INTEGER(8) :: PTWCB_PANEL
107 INTEGER LDAJ, NBJ, LIWFAC,
108 & nbjlast, npiv_last, panel_size,
109 & ncb_panel, typef
110 INTEGER BEG_PANEL
111 LOGICAL TWOBYTWO
112 INTEGER NPANELS, IPANEL
113 COMPLEX ALPHA,ONE,ZERO
114 parameter(zero=(0.0e0,0.0e0),
115 & one=(1.0e0,0.0e0),
116 & alpha=(-1.0e0,0.0e0))
117 LOGICAL, EXTERNAL :: MUMPS_IN_OR_ROOT_SSARBR
118 INTEGER, EXTERNAL :: MUMPS_TYPENODE
119 INTEGER, EXTERNAL :: MUMPS_PROCNODE
120 error_was_broadcasted = .false.
121 do_mcast2_termbwd = .false.
122 no_children = .false.
123 IF (do_nbsparse) THEN
124 jbdeb= rhs_bounds(2*step(inode)-1)
125 jbfin= rhs_bounds(2*step(inode))
126 nrhs_b = jbfin-jbdeb+1
127 ELSE
128 jbdeb = 1
129 jbfin = nrhs
130 nrhs_b = nrhs
131 ENDIF
132 IF ( inode .EQ. keep( 38 ) .OR. inode .EQ. keep( 20 ) ) THEN
133 ipos = ptrist(step(inode))+keep(ixsz)
134 npiv = iw(ipos+3)
135 liell = iw(ipos) + npiv
136 ipos = ptrist(step(inode)) + 5 + keep(ixsz)
137 IF ( mtype .EQ. 1 .AND. keep(50) .EQ. 0) THEN
138 j1 = ipos + liell + 1
139 j2 = ipos + liell + npiv
140 ELSE
141 j1 = ipos + 1
142 j2 = ipos + npiv
143 END IF
144 ifr8 = 0_8
145 iposinrhscomp = posinrhscomp_bwd(iw(j1))
146 CALL cmumps_sol_cpy_fs2rhscomp(jbdeb, jbfin, j2-j1+1,
147 & keep, rhscomp, nrhs, lrhscomp, iposinrhscomp,
148 & rhs_root(1+npiv*(jbdeb-1)), npiv, 1)
149 in = inode
150 270 in = fils(in)
151 IF (in .GT. 0) GOTO 270
152 IF (in .EQ. 0) THEN
153 myleaf_left = myleaf_left - 1
154 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
155 & keep(31) .EQ. 0)
156 IF (keep(31) .NE. 0) THEN
157 IF ( .NOT. mumps_in_or_root_ssarbr(
158 & procnode_steps(step(inode)), keep(199) ) ) THEN
159 keep(31) = keep(31) - 1
160 IF (keep(31) .EQ. 1) THEN
161 allow_others_to_leave = .true.
162 ENDIF
163 ENDIF
164 ENDIF
165 IF (allow_others_to_leave) THEN
166 do_mcast2_termbwd = .true.
167 nbfinf = nbfinf - 1
168 ENDIF
169 RETURN
170 ENDIF
171 IF = -in
172 long = npiv
173 nbfils = ne_steps(step(inode))
174 IF ( prun_below ) THEN
175 i = nbfils
176 nbfils = 0
177 DO WHILE (i.GT.0)
178 IF ( to_process(step(if)) ) nbfils = nbfils+1
179 IF = frere(step(if))
180 i = i -1
181 ENDDO
182 IF (nbfils.EQ.0) THEN
183 no_children = .true.
184 ELSE
185 no_children = .false.
186 ENDIF
187 IF = -in
188 ENDIF
189 DO i = 0, slavef - 1
190 deja_send( i ) = .false.
191 END DO
192 pool_first_pos=iipool
193 DO i = 1, nbfils
194 IF ( prun_below ) THEN
195 1030 IF ( .NOT.to_process(step(if)) ) THEN
196 IF = frere(step(if))
197 GOTO 1030
198 ENDIF
199 no_children = .false.
200 ENDIF
201 IF (mumps_procnode(procnode_steps(step(if)),keep(199))
202 & .EQ. myid) THEN
203 ipool(iipool) = IF
204 iipool = iipool + 1
205 ELSE
206 procdest = mumps_procnode(procnode_steps(step(if)),
207 & keep(199))
208 IF (.NOT. deja_send( procdest )) THEN
209 600 CONTINUE
210 CALL cmumps_buf_send_vcb( nrhs_b, IF, 0, 0,
211 & long, long, iw( j1 ),
212 & rhs_root( 1+npiv*(jbdeb-1) ),
213 & jbdeb, jbfin,
214 & rhscomp(1, 1), nrhs, lrhscomp,
215 & iposinrhscomp, npiv,
216 & keep, procdest,
217 & noeud, comm, ierr )
218 IF ( ierr .EQ. -1 ) THEN
219 CALL cmumps_backslv_recv_and_treat(
220 & .false., flag,
221 & bufr, lbufr, lbufr_bytes,
222 & myid, slavef, comm,
223 & n, iwcb, liww, posiwcb,
224 & w, lwc, poswcb,
225 & iipool, nbfinf, ptricb, ptracb, info,
226 & ipool, lpool, panel_pos, lpanel_pos,
227 & step, frere, fils, procnode_steps,
228 & pleftw, keep,keep8, dkeep,
229 & ptrist, ptrfac, iw, liw, a, la, w2,
230 & myleaf_left,
231 & nrhs, mtype,
232 & rhscomp, lrhscomp, posinrhscomp_bwd,
233 & prun_below, to_process, size_to_process
234 & , from_pp
235 & )
236 IF ( info( 1 ) .LT. 0 ) THEN
237 error_was_broadcasted = .true.
238 RETURN
239 ENDIF
240 GOTO 600
241 ELSE IF ( ierr .EQ. -2 ) THEN
242 info( 1 ) = -17
243 info( 2 ) = nrhs_b * long * keep(35) +
244 & ( long + 4 ) * keep(34)
245 error_was_broadcasted = .false.
246 RETURN
247 ELSE IF ( ierr .EQ. -3 ) THEN
248 info( 1 ) = -20
249 info( 2 ) = nrhs_b * long * keep(35) +
250 & ( long + 4 ) * keep(34)
251 error_was_broadcasted = .false.
252 RETURN
253 ELSE IF ( ierr .NE. 0 ) THEN
254 WRITE(*,*) "Internal error 2 CMUMPS_SOLVE_NODE_BWD",
255 & ierr
256 CALL mumps_abort()
257 END IF
258 deja_send( procdest ) = .true.
259 END IF
260 ENDIF
261 IF = frere(step(if))
262 ENDDO
263 allow_others_to_leave = .false.
264 IF ( prun_below .AND. no_children ) THEN
265 myleaf_left = myleaf_left - 1
266 allow_others_to_leave = ( myleaf_left .EQ. 0 .AND.
267 & keep(31) .EQ. 0)
268 ENDIF
269 IF ( keep(31). ne. 0) THEN
270 IF ( .NOT. mumps_in_or_root_ssarbr(
271 & procnode_steps(step(inode)), keep(199) ) ) THEN
272 keep(31) = keep(31) - 1
273 IF (keep(31) .EQ. 1) THEN
274 allow_others_to_leave = .true.
275 ENDIF
276 ENDIF
277 ENDIF
278 IF ( allow_others_to_leave ) THEN
279 do_mcast2_termbwd = .true.
280 nbfinf = nbfinf - 1
281 ENDIF
282 IF (iipool.NE.pool_first_pos) THEN
283 DO i=1,(iipool-pool_first_pos)/2
284 tmp = ipool(pool_first_pos+i-1)
285 ipool(pool_first_pos+i-1) = ipool(iipool-i)
286 ipool(iipool-i) = tmp
287 ENDDO
288 ENDIF
289 RETURN
290 END IF
291 in_subtree = mumps_in_or_root_ssarbr(
292 & procnode_steps(step(inode)), keep(199) )
293 typenode = mumps_typenode(procnode_steps(step(inode)),
294 & keep(199))
295 ltlevel2= (
296 & (typenode .eq.2 ) .AND.
297 & (mtype.NE.1) )
298 npiv = iw(ptrist(step(inode))+2+keep(ixsz)+1)
299 IF ((npiv.NE.0).AND.(ltlevel2)) THEN
300 ipos = ptrist(step(inode)) + 2 + keep(ixsz)
301 liell = iw(ipos-2)+iw(ipos+1)
302 nelim = iw(ipos-1)
303 ipos = ipos + 1
304 npiv = iw(ipos)
305 ncb = liell - npiv - nelim
306 ipos = ipos + 2
307 nslaves = iw( ipos )
308 offset = 0
309 ipos = ipos + nslaves
310 iw(ptrist(step(inode))+xxs)= c_fini+nslaves
311 IF ( posiwcb - 2 .LT. 0 .or.
312 & poswcb-int(ncb,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
313 CALL cmumps_compso( n, keep(28), iwcb, liww, w, lwc,
314 & poswcb, posiwcb, ptricb, ptracb)
315 IF ( poswcb-int(ncb,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
316 info( 1 ) = -11
317 CALL mumps_set_ierror(ncb * nrhs_b - poswcb-pleftw+1_8,
318 & info(2))
319 error_was_broadcasted = .false.
320 RETURN
321 END IF
322 IF ( posiwcb - 2 .LT. 0 ) THEN
323 info( 1 ) = -14
324 info( 2 ) = 2 - posiwcb
325 error_was_broadcasted = .false.
326 RETURN
327 END IF
328 END IF
329 posiwcb = posiwcb - 2
330 poswcb = poswcb - int(ncb,8)*int(nrhs_b,8)
331 ptricb(step( inode )) = posiwcb + 1
332 ptracb(step( inode )) = poswcb + 1_8
333 iwcb( ptricb(step( inode )) ) = ncb*nrhs_b
334 iwcb( ptricb(step( inode )) + 1 ) = 1
335 IF ( mtype.EQ.1 .AND. keep(50).EQ.0 ) THEN
336 posindices = ipos + liell + 1
337 ELSE
338 posindices = ipos + 1
339 END IF
340 IF ( ncb.EQ.0 ) THEN
341 write(6,*) ' Internal Error type 2 node with no CB '
342 CALL mumps_abort()
343 ENDIF
344 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
345 j1 = ipos + liell + npiv + nelim +1
346 j2 = ipos + 2 * liell
347 ELSE
348 j1 = ipos + npiv + nelim +1
349 j2 = ipos + liell
350 END IF
351 ifr8 = ptracb(step( inode )) - 1_8
352 CALL cmumps_sol_bwd_gthr( jbdeb, jbfin, j1, j2,
353 & rhscomp, nrhs, lrhscomp,
354 & w(ptracb(step(inode))), ncb, 1,
355 & iw, liw, keep, n, posinrhscomp_bwd )
356 ifr8 = ifr8 + int(j2-keep(253)-j1+1,8)
357 IF (keep(252).NE.0) THEN
358 DO jj = j2-keep(253)+1, j2
359 ifr8 = ifr8 + 1_8
360 DO k=jbdeb, jbfin
361 IF (k.EQ.jj-j2+keep(253)) THEN
362 w(ifr8+int(k-jbdeb,8)*int(ncb,8)) = alpha
363 ELSE
364 w(ifr8+int(k-jbdeb,8)*int(ncb,8)) = zero
365 ENDIF
366 ENDDO
367 ENDDO
368 ENDIF
369 DO islave = 1, nslaves
370 CALL mumps_bloc2_get_slave_info(
371 & keep,keep8, inode, step, n, slavef,
372 & istep_to_iniv2, tab_pos_in_pere,
373 & islave, ncb,
374 & nslaves,
375 & effectivesize,
376 & firstindex )
377 500 CONTINUE
378 dest = iw( ptrist(step(inode))+5+islave+keep(ixsz))
379 CALL cmumps_buf_send_backvec(nrhs_b, inode,
380 & w(offset+ptracb(step(inode))),
381 & effectivesize,
382 & ncb, dest,
383 & backslv_master2slave, jbdeb, jbfin,
384 & keep, comm, ierr )
385 IF ( ierr .EQ. -1 ) THEN
386 CALL cmumps_backslv_recv_and_treat(
387 & .false., flag,
388 & bufr, lbufr, lbufr_bytes,
389 & myid, slavef, comm,
390 & n, iwcb, liww, posiwcb,
391 & w, lwc, poswcb,
392 & iipool, nbfinf, ptricb, ptracb, info,
393 & ipool, lpool, panel_pos, lpanel_pos,
394 & step, frere, fils,
395 & procnode_steps, pleftw, keep,keep8, dkeep,
396 & ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left,
397 & nrhs, mtype,
398 & rhscomp, lrhscomp, posinrhscomp_bwd,
399 & prun_below , to_process, size_to_process
400 & , from_pp
401 & )
402 IF ( info( 1 ) .LT. 0 ) THEN
403 error_was_broadcasted = .true.
404 RETURN
405 ENDIF
406 GOTO 500
407 ELSE IF ( ierr .EQ. -2 ) THEN
408 info( 1 ) = -17
409 info( 2 ) = nrhs_b * effectivesize * keep(35) +
410 & 2 * keep(34)
411 error_was_broadcasted = .false.
412 RETURN
413 ELSE IF ( ierr .EQ. -3 ) THEN
414 info( 1 ) = -20
415 info( 2 ) = nrhs_b * effectivesize * keep(35) +
416 & 2 * keep(34)
417 error_was_broadcasted = .false.
418 RETURN
419 END IF
420 offset = offset + effectivesize
421 END DO
422 iwcb( ptricb(step( inode )) + 1 ) = 0
423 CALL cmumps_freetopso(n, keep(28), iwcb, liww, w, lwc,
424 & poswcb,posiwcb,ptricb,ptracb)
425 RETURN
426 ENDIF
427 lr_activated = (iw(ptrist(step(inode))+xxlr).GT.0)
428 compress_panel = (iw(ptrist(step(inode))+xxlr).GE.2)
429 oocwrite_compatible_with_blr =
430 & (.NOT.lr_activated.OR.(.NOT.compress_panel).OR.
431 & (keep(485).EQ.0)
432 & )
433 ipos = ptrist(step(inode)) + 2 + keep(ixsz)
434 liell = iw(ipos-2)+iw(ipos+1)
435 nelim = iw(ipos-1)
436 ipos = ipos + 1
437 npiv = iw(ipos)
438 ncb = liell - npiv
439 ipos = ipos + 1
440 IF (keep(201).GT.0.AND.oocwrite_compatible_with_blr) THEN
441 CALL cmumps_solve_get_ooc_node(
442 & inode,ptrfac,keep,a,la,step,
443 & keep8,n,must_be_permuted,ierr)
444 IF(ierr.LT.0)THEN
445 info(1)=ierr
446 info(2)=0
447 error_was_broadcasted = .false.
448 RETURN
449 ENDIF
450 ENDIF
451 apos = ptrfac( step(inode))
452 nslaves = iw( ptrist(step(inode)) + 5 + keep(ixsz) )
453 ipos = ipos + 1 + nslaves
454 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
455 liwfac = iw(ptrist(step(inode))+xxi)
456 IF (mtype.NE.1) THEN
457 typef = typef_l
458 ELSE
459 typef = typef_u
460 ENDIF
461 panel_size = cmumps_ooc_panel_size( liell )
462 IF (keep(50).NE.1) THEN
463 CALL cmumps_ooc_pp_check_perm_freed(
464 & iw(ipos+1+2*liell),
465 & must_be_permuted )
466 ENDIF
467 ENDIF
468 long = 0
469 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
470 j1 = ipos + liell + 1
471 j2 = ipos + npiv + liell
472 ELSE
473 j1 = ipos + 1
474 j2 = ipos + npiv
475 ENDIF
476 IF (in_subtree) THEN
477 ptwcb = pleftw
478 IF ( poswcb .LT. int(liell,8)*int(nrhs_b,8) ) THEN
479 CALL cmumps_compso( n, keep(28), iwcb, liww, w, lwc,
480 & poswcb, posiwcb, ptricb, ptracb)
481 IF ( poswcb .LT. int(liell,8)*int(nrhs_b,8) ) THEN
482 info(1) = -11
483 CALL mumps_set_ierror(int(liell,8)*int(nrhs_b,8)-poswcb,
484 & info(2))
485 error_was_broadcasted = .false.
486 RETURN
487 END IF
488 END IF
489 ELSE
490 IF ( posiwcb - 2 .LT. 0 .or.
491 & poswcb-int(liell,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
492 CALL cmumps_compso( n, keep(28), iwcb, liww, w, lwc,
493 & poswcb, posiwcb, ptricb, ptracb )
494 IF ( poswcb-int(liell,8)*int(nrhs_b,8) .LT. pleftw-1_8 ) THEN
495 info( 1 ) = -11
496 CALL mumps_set_ierror( int(liell,8)*int(nrhs_b,8)-
497 & poswcb-pleftw+1_8,
498 & info(2) )
499 error_was_broadcasted = .false.
500 RETURN
501 END IF
502 IF ( posiwcb - 2 .LT. 0 ) THEN
503 info( 1 ) = -14
504 info( 2 ) = 2 - posiwcb
505 error_was_broadcasted = .false.
506 RETURN
507 END IF
508 END IF
509 posiwcb = posiwcb - 2
510 poswcb = poswcb - int(liell,8)*int(nrhs_b,8)
511 ptricb(step( inode )) = posiwcb + 1
512 ptracb(step( inode )) = poswcb + 1_8
513 iwcb( ptricb(step( inode )) ) = liell*nrhs_b
514 iwcb( ptricb(step( inode )) + 1 ) = 1
515 IF ( mtype.EQ.1 .AND. keep(50).EQ.0 ) THEN
516 posindices = ipos + liell + 1
517 ELSE
518 posindices = ipos + 1
519 END IF
520 ptwcb = ptracb(step( inode ))
521 ENDIF
522 IF (j2.GE.j1) THEN
523 iposinrhscomp = posinrhscomp_bwd(iw(j1))
524 ELSE
525 iposinrhscomp = -99999
526 ENDIF
527 IF (j2.GE.j1) THEN
528 DO k=jbdeb, jbfin
529 IF (keep(252).NE.0) THEN
530 DO jj = j1, j2
531 rhscomp(iposinrhscomp+jj-j1,k) = zero
532 ENDDO
533 ENDIF
534 END DO
535 ENDIF
536 ifr8 = ptwcb + int(npiv - 1,8)
537 IF ( liell .GT. npiv ) THEN
538 IF ( mtype .EQ. 1 .AND. keep(50).EQ.0 ) THEN
539 j1 = ipos + liell + npiv + 1
540 j2 = ipos + 2 * liell
541 ELSE
542 j1 = ipos + npiv + 1
543 j2 = ipos + liell
544 END IF
545 CALL cmumps_sol_bwd_gthr( jbdeb, jbfin, j1, j2,
546 & rhscomp, nrhs, lrhscomp,
547 & w(ptwcb), liell, npiv+1,
548 & iw, liw, keep, n, posinrhscomp_bwd )
549 ifr8 = ifr8 + int(j2-keep(253)-j1+1,8)
550 IF (keep(252).NE.0) THEN
551 DO jj = j2-keep(253)+1, j2
552 ifr8 = ifr8 + 1_8
553 DO k=jbdeb, jbfin
554 IF (k.EQ.jj-j2+keep(253)) THEN
555 w(ifr8+int(k-jbdeb,8)*int(liell,8)) = alpha
556 ELSE
557 w(ifr8+int(k-jbdeb,8)*int(liell,8)) = zero
558 ENDIF
559 ENDDO
560 ENDDO
561 ENDIF
562 ncb = liell - npiv
563 IF (npiv .EQ. 0) GOTO 160
564 ENDIF
565 IF (keep(201).EQ.1.AND.oocwrite_compatible_with_blr) THEN
566 j = npiv / panel_size
567 twobytwo = keep(50).EQ.2 .AND.
568 & ((typenode.EQ.1.AND.keep(103).GT.0) .OR.
569 & (typenode.EQ.2.AND.keep(105).GT.0))
570 IF (twobytwo) THEN
571 CALL cmumps_build_panel_pos(panel_size, panel_pos, lpanel_pos,
572 & iw(ipos+1+liell), npiv, npanels, liell,
573 & nbentries_allpanels)
574 ELSE
575 IF (npiv.EQ.j*panel_size) THEN
576 npiv_last = npiv
577 nbjlast = panel_size
578 npanels = j
579 ELSE
580 npiv_last = (j+1)* panel_size
581 nbjlast = npiv-j*panel_size
582 npanels = j+1
583 ENDIF
584 nbentries_allpanels =
585 & int(liell,8) * int(npiv,8)
586 & - int( ( j * ( j - 1 ) ) /2,8 )
587 & * int(panel_size,8) * int(panel_size,8)
588 & - int(j,8)
589 & * int(mod(npiv, panel_size),8)
590 & * int(panel_size,8)
591 jj=npiv_last
592 ENDIF
593 aposdeb = apos + nbentries_allpanels
594 DO ipanel = npanels, 1, -1
595 IF (twobytwo) THEN
596 nbj = panel_pos(ipanel+1)-panel_pos(ipanel)
597 beg_panel = panel_pos(ipanel)
598 ELSE
599 IF (jj.EQ.npiv_last) THEN
600 nbj = nbjlast
601 ELSE
602 nbj = panel_size
603 ENDIF
604 beg_panel = jj- panel_size+1
605 ENDIF
606 ldaj = liell-beg_panel+1
607 aposdeb = aposdeb - int(nbj,8)*int(ldaj,8)
608 ptwcb_panel = ptwcb + int(beg_panel - 1,8)
609 iposinrhscomp_panel = iposinrhscomp + beg_panel - 1
610 ncb_panel = ldaj - nbj
611 IF (keep(50).NE.1.AND.must_be_permuted) THEN
612 CALL cmumps_get_ooc_perm_ptr(typef, tmp_nbpanels,
613 & i_pivrptr, i_pivr, ipos + 1 + 2 * liell, iw, liw)
614 IF (npiv.EQ.(iw(i_pivrptr)-1)) THEN
615 must_be_permuted=.false.
616 ELSE
617 CALL cmumps_permute_panel(
618 & iw(i_pivr + iw(i_pivrptr+ipanel-1)-iw(i_pivrptr)),
619 & npiv-iw(i_pivrptr+ipanel-1)+1,
620 & iw(i_pivrptr+ipanel-1)-1,
621 & a(aposdeb),
622 & ldaj, nbj, beg_panel-1)
623 ENDIF
624 ENDIF
625#if defined(MUMPS_USE_BLAS2)
626 IF ( nrhs_b == 1 ) THEN
627 IF (ncb_panel.NE.0) THEN
628 IF (ncb_panel - ncb.NE. 0) THEN
629 CALL cgemv( 'T', ncb_panel-ncb, nbj, alpha,
630 & a( aposdeb + int(nbj,8) ), ldaj,
631 & rhscomp(iposinrhscomp_panel+nbj,jbdeb),
632 & 1, one,
633 & rhscomp(iposinrhscomp_panel,jbdeb), 1 )
634 ENDIF
635 IF (ncb .NE. 0) THEN
636 CALL cgemv( 'T', ncb, nbj, alpha,
637 & a( aposdeb + int(ldaj-ncb,8) ), ldaj,
638 & w( ptwcb + int(npiv,8) ),
639 & 1, one,
640 & rhscomp(iposinrhscomp_panel,jbdeb), 1 )
641 ENDIF
642 ENDIF
643 IF (mtype.NE.1) THEN
644 CALL ctrsv('L','T','U', nbj, a(aposdeb), ldaj,
645 & rhscomp(iposinrhscomp_panel,jbdeb), 1)
646 ELSE
647 CALL ctrsv('L','T','N', nbj, a(aposdeb), ldaj,
648 & rhscomp(iposinrhscomp_panel,jbdeb), 1)
649 ENDIF
650 ELSE
651#endif
652 IF (ncb_panel.NE.0) THEN
653 IF (ncb_panel - ncb .NE. 0) THEN
654 CALL cgemm( 'T', 'N', nbj, nrhs_b,
655 & ncb_panel-ncb, alpha,
656 & a(aposdeb +int(nbj,8)), ldaj,
657 & rhscomp(iposinrhscomp_panel+nbj,jbdeb), lrhscomp,
658 & one, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
659 ENDIF
660 IF (ncb .NE. 0) THEN
661 CALL cgemm( 'T', 'N', nbj, nrhs_b, ncb, alpha,
662 & a(aposdeb +int(ldaj-ncb,8)), ldaj,
663 & w( ptwcb+int(npiv,8) ), liell,
664 & one, rhscomp(iposinrhscomp_panel,jbdeb),lrhscomp)
665 ENDIF
666 ENDIF
667 IF (mtype.NE.1) THEN
668 CALL ctrsm('L','L','T','U',nbj, nrhs_b, one,
669 & a(aposdeb),
670 & ldaj, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
671 ELSE
672 CALL ctrsm('L','L','T','N',nbj, nrhs_b, one,
673 & a(aposdeb),
674 & ldaj, rhscomp(iposinrhscomp_panel,jbdeb), lrhscomp)
675 ENDIF
676#if defined(MUMPS_USE_BLAS2)
677 ENDIF
678#endif
679 IF (.NOT. twobytwo) jj=beg_panel-1
680 ENDDO
681 ELSE
682 IF ( iw(ptrist(step(inode))+xxlr) .GE. 2
683 & .AND. keep(485) .EQ. 1 ) THEN
684 iwhdlr = iw(ptrist(step(inode))+xxf)
685 CALL cmumps_sol_bwd_lr_su (
686 & inode, iwhdlr, npiv, nslaves,
687 & liell, w, lwc, nrhs_b, ptwcb,
688 & rhscomp, lrhscomp, nrhs,
689 & iposinrhscomp, jbdeb,
690 & mtype, keep, keep8,
691 & info(1), info(2) )
692 IF (info(1).LT.0) THEN
693 error_was_broadcasted = .false.
694 RETURN
695 ENDIF
696 ELSE
697 IF ( liell .GT. npiv ) THEN
698#if defined(LDLTPANEL_DEBUG)
699 WRITE(*,*) 'before gemm LIELL, NPIV, PTWCB=',liell,npiv,ptwcb
700 WRITE(*,*) 'before gemm RHSCOMP=',
701 & rhscomp(iposinrhscomp:iposinrhscomp+npiv-1,1)
702 WRITE(*,*) 'before gemm W',
703 & w(ptwcb+npiv:ptwcb+liell-1)
704 CALL mumps_geti8(ist, iw(ptrist(step(inode))+xxr))
705 WRITE(*,*) "factors=",A(APOS:APOS+IST-1)
706#endif
707.eq. IF ( MTYPE 1 ) THEN
708 IST = APOS + int(NPIV,8)
709#if defined(MUMPS_USE_BLAS2)
710 IF (NRHS_B == 1) THEN
711 CALL cgemv( 'T', NCB, NPIV, ALPHA, A(IST), LIELL,
712 & W(PTWCB+int(NPIV,8)), 1,
713 & ONE,
714 & RHSCOMP(IPOSINRHSCOMP,JBDEB), 1 )
715 ELSE
716#endif
717 CALL cgemm('T','N', NPIV, NRHS_B, NCB, ALPHA,
718 & A(IST),
719 & LIELL, W(PTWCB+int(NPIV,8)), LIELL, ONE,
720 & RHSCOMP(IPOSINRHSCOMP,JBDEB), LRHSCOMP)
721#if defined(MUMPS_USE_BLAS2)
722 ENDIF
723#endif
724 ELSE
725.eq. IF ( KEEP(50) 0 ) THEN
726 IST = APOS + int(NPIV,8) * int(LIELL,8)
727 ELSE
728.GT. IF( KEEP(459) 1) THEN
729 CALL MUMPS_GETI8(IST, IW(PTRIST(STEP(INODE))+XXR))
730 IST = APOS + IST - int(NPIV,8) * int(LIELL-NPIV,8)
731 ELSE
732 IST = APOS + int(NPIV,8) * int(NPIV,8)
733 ENDIF
734 END IF
735#if defined(MUMPS_USE_BLAS2)
736 IF ( NRHS_B == 1 ) THEN
737 CALL cgemv( 'N', NPIV, NCB, ALPHA, A( IST ), NPIV,
738 & W( PTWCB + int(NPIV,8) ),
739 & 1, ONE,
740 & RHSCOMP(IPOSINRHSCOMP,JBDEB), 1 )
741 ELSE
742#endif
743 CALL cgemm( 'N', 'N', NPIV, NRHS_B, NCB, ALPHA,
744 & A(IST),
745 & NPIV, W(PTWCB+int(NPIV,8)), LIELL,
746 & ONE, RHSCOMP(IPOSINRHSCOMP,JBDEB), LRHSCOMP)
747#if defined(MUMPS_USE_BLAS2)
748 END IF
749#endif
750 END IF
751 ENDIF
752.eq. IF ( MTYPE 1 ) THEN
753 LDAJ = LIELL
754 ELSE
755.EQ. IF ( KEEP(50) 0 ) THEN
756 LDAJ=LIELL
757 ELSE
758.GT. IF (KEEP(459)1) THEN
759 LDAJ=-999799
760 ELSE
761 LDAJ=NPIV
762 ENDIF
763 ENDIF
764 END IF
765 PPIV_COURANT = int(JBDEB-1,8)*int(LRHSCOMP,8)
766 & + int(IPOSINRHSCOMP,8)
767.GT..AND..NE. IF (KEEP(459)1 KEEP(50)0) THEN
768 CALL CMUMPS_SOLVE_BWD_PANELS( A, LA, APOS,
769 & NPIV, IW(IPOS+1+LIELL),
770 & NRHS_B, RHSCOMP(1,1), KEEP8(25), LRHSCOMP, PPIV_COURANT,
771 & MTYPE, KEEP )
772 ELSE
773 CALL CMUMPS_SOLVE_BWD_TRSOLVE( A, LA, APOS,
774 & NPIV, LDAJ,
775 & NRHS_B, RHSCOMP(1,1), KEEP8(25), LRHSCOMP, PPIV_COURANT,
776 & MTYPE, KEEP )
777 ENDIF
778 ENDIF
779 ENDIF
780.EQ..AND..EQ. IF ( MTYPE 1 KEEP(50)0) THEN
781 J1 = IPOS + LIELL + 1
782 ELSE
783 J1 = IPOS + 1
784 END IF
785 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(J1))
786 160 CONTINUE
787.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR) THEN
788 CALL CMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28),
789 & A,LA,.TRUE.,IERR)
790.LT. IF(IERR0)THEN
791 INFO(1)=IERR
792 INFO(2)=0
793 ERROR_WAS_BROADCASTED = .FALSE.
794 RETURN
795 ENDIF
796 ENDIF
797 IN = INODE
798 170 IN = FILS(IN)
799.GT. IF (IN 0) GOTO 170
800.EQ. IF (IN 0) THEN
801 MYLEAF_LEFT = MYLEAF_LEFT - 1
802.NOT. IF ( IN_SUBTREE ) THEN
803 IWCB(PTRICB(STEP(INODE))+1) = IWCB(PTRICB(STEP(INODE))+1)-1
804 CALL CMUMPS_FREETOPSO(N, KEEP(28), IWCB, LIWW,
805 & W, LWC,
806 & POSWCB,POSIWCB,PTRICB,PTRACB)
807 ENDIF
808.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
809.EQ. & KEEP(31) 0)
810.NE..AND. IF ( KEEP(31) 0
811.NOT. & IN_SUBTREE ) THEN
812 KEEP(31) = KEEP(31) - 1
813.EQ. IF (KEEP(31) 1) THEN
814 ALLOW_OTHERS_TO_LEAVE = .TRUE.
815 ENDIF
816 ENDIF
817 IF (ALLOW_OTHERS_TO_LEAVE) THEN
818 DO_MCAST2_TERMBWD = .TRUE.
819 NBFINF = NBFINF - 1
820 ENDIF
821 RETURN
822 ENDIF
823 IF = -IN
824 NBFILS = NE_STEPS(STEP(INODE))
825 IF ( PRUN_BELOW ) THEN
826 I = NBFILS
827 NBFILS = 0
828.GT. DO WHILE (I0)
829 IF ( TO_PROCESS(STEP(IF)) ) NBFILS = NBFILS+1
830 IF = FRERE(STEP(IF))
831 I = I -1
832 ENDDO
833.EQ. IF (NBFILS0) THEN
834 NO_CHILDREN = .TRUE.
835 ELSE
836 NO_CHILDREN = .FALSE.
837 ENDIF
838 IF = -IN
839 ENDIF
840 IF (IN_SUBTREE) THEN
841 DO I = 1, NBFILS
842 IF ( PRUN_BELOW ) THEN
843 1010 CONTINUE
844.NOT. IF ( TO_PROCESS(STEP(IF)) ) THEN
845 IF = FRERE(STEP(IF))
846 GOTO 1010
847 ENDIF
848 NO_CHILDREN = .FALSE.
849 ENDIF
850 IPOOL((IIPOOL-I+1)+NBFILS-I) = IF
851 IIPOOL = IIPOOL + 1
852 IF = FRERE(STEP(IF))
853 ENDDO
854.AND. IF (PRUN_BELOW NO_CHILDREN) THEN
855 MYLEAF_LEFT = MYLEAF_LEFT - 1
856.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
857.EQ. & KEEP(31) 0)
858 IF (ALLOW_OTHERS_TO_LEAVE ) THEN
859 DO_MCAST2_TERMBWD = .TRUE.
860 NBFINF = NBFINF - 1
861 RETURN
862 ENDIF
863 ENDIF
864 ELSE
865 DO I = 0, SLAVEF - 1
866 DEJA_SEND( I ) = .FALSE.
867 END DO
868 POOL_FIRST_POS=IIPOOL
869 DO 190 I = 1, NBFILS
870 IF ( PRUN_BELOW ) THEN
871.NOT.1020 IF ( TO_PROCESS(STEP(IF)) ) THEN
872 IF = FRERE(STEP(IF))
873 GOTO 1020
874 ENDIF
875 NO_CHILDREN = .FALSE.
876 ENDIF
877 IF (MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IF)),
878.EQ. & KEEP(199)) MYID) THEN
879 IPOOL(IIPOOL) = IF
880 IIPOOL = IIPOOL + 1
881 IF = FRERE(STEP(IF))
882 ELSE
883 PROCDEST = MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IF)),
884 & KEEP(199))
885.not. IF ( DEJA_SEND( PROCDEST )) THEN
886 400 CONTINUE
887 CALL CMUMPS_BUF_SEND_VCB( NRHS_B, IF, 0, 0,
888 & LIELL, LIELL - KEEP(253),
889 & IW( POSINDICES ),
890 & W( PTRACB(STEP(INODE)) ), JBDEB, JBFIN,
891 & RHSCOMP(1, 1), NRHS, LRHSCOMP,
892 & IPOSINRHSCOMP, NPIV,
893 & KEEP, PROCDEST, NOEUD, COMM, IERR )
894.EQ. IF ( IERR -1 ) THEN
895 CALL CMUMPS_BACKSLV_RECV_AND_TREAT(
896 & .FALSE., FLAG,
897 & BUFR, LBUFR, LBUFR_BYTES,
898 & MYID, SLAVEF, COMM,
899 & N, IWCB, LIWW, POSIWCB,
900 & W, LWC, POSWCB,
901 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
902 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
903 & STEP, FRERE, FILS, PROCNODE_STEPS,
904 & PLEFTW, KEEP, KEEP8, DKEEP,
905 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
906 & NRHS, MTYPE,
907 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
908 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
909 & , FROM_PP
910 & )
911.LT. IF ( INFO( 1 ) 0 ) THEN
912 ERROR_WAS_BROADCASTED = .TRUE.
913 RETURN
914 ENDIF
915 GOTO 400
916.EQ. ELSE IF ( IERR -2 ) THEN
917 INFO( 1 ) = -17
918 INFO( 2 ) = NRHS_B * LIELL * KEEP(35) + 4 * KEEP(34)
919 ERROR_WAS_BROADCASTED = .FALSE.
920 RETURN
921.EQ. ELSE IF ( IERR -3 ) THEN
922 INFO( 1 ) = -20
923 INFO( 2 ) = NRHS_B * LIELL * KEEP(35) + 4 * KEEP(34)
924 ERROR_WAS_BROADCASTED = .FALSE.
925 RETURN
926 END IF
927 DEJA_SEND( PROCDEST ) = .TRUE.
928 END IF
929 IF = FRERE(STEP(IF))
930 ENDIF
931 190 CONTINUE
932.AND. IF ( PRUN_BELOW NO_CHILDREN ) THEN
933 MYLEAF_LEFT = MYLEAF_LEFT - 1
934.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
935.EQ. & KEEP(31) 0)
936 IF ( ALLOW_OTHERS_TO_LEAVE ) THEN
937 DO_MCAST2_TERMBWD = .TRUE.
938 NBFINF = NBFINF - 1
939 RETURN
940 ENDIF
941 ENDIF
942 DO I=1,(IIPOOL-POOL_FIRST_POS)/2
943 TMP=IPOOL(POOL_FIRST_POS+I-1)
944 IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I)
945 IPOOL(IIPOOL-I)=TMP
946 ENDDO
947.NE. IF ( KEEP(31) 0 )
948 & THEN
949 KEEP(31) = KEEP(31) - 1
950.EQ. ALLOW_OTHERS_TO_LEAVE = (KEEP(31) 1)
951 IF (ALLOW_OTHERS_TO_LEAVE) THEN
952 DO_MCAST2_TERMBWD = .TRUE.
953 NBFINF = NBFINF - 1
954 ENDIF
955 ENDIF
956 IWCB(PTRICB(STEP(INODE))+1) = IWCB(PTRICB(STEP(INODE))+1)-1
957 CALL CMUMPS_FREETOPSO(N, KEEP(28), IWCB, LIWW,
958 & W, LWC,
959 & POSWCB,POSIWCB,PTRICB,PTRACB)
960 ENDIF
961 RETURN
962 END SUBROUTINE CMUMPS_SOLVE_NODE_BWD
963 RECURSIVE SUBROUTINE CMUMPS_BACKSLV_RECV_AND_TREAT(
964 & BLOQ, FLAG,
965 & BUFR, LBUFR, LBUFR_BYTES,
966 & MYID, SLAVEF, COMM,
967 & N, IWCB, LIWW, POSIWCB,
968 & W, LWC, POSWCB,
969 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
970 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
971 & STEP, FRERE, FILS, PROCNODE_STEPS,
972 & PLEFTW, KEEP, KEEP8, DKEEP,
973 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
974 & NRHS, MTYPE,
975 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
976 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
977 & , FROM_PP
978 & )
979 IMPLICIT NONE
980 LOGICAL BLOQ, FLAG
981 INTEGER LBUFR, LBUFR_BYTES
982 INTEGER BUFR( LBUFR )
983 INTEGER MYID, SLAVEF, COMM
984 INTEGER N, LIWW
985 INTEGER IWCB( LIWW )
986 INTEGER(8), intent(in) :: LWC
987 COMPLEX W( LWC )
988 INTEGER POSIWCB
989 INTEGER IIPOOL, LPOOL
990 INTEGER IPOOL( LPOOL )
991 INTEGER LPANEL_POS
992 INTEGER PANEL_POS( LPANEL_POS )
993 INTEGER NBFINF, INFO(80), KEEP(500)
994 INTEGER(8) :: POSWCB, PLEFTW
995 INTEGER(8) KEEP8(150)
996 REAL, INTENT(INOUT) :: DKEEP(230)
997 INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) )
998 INTEGER PTRICB(KEEP(28)), STEP( N ), FILS( N )
999 INTEGER(8) :: PTRACB(KEEP(28))
1000 INTEGER LIW
1001 INTEGER(8) :: LA
1002 INTEGER PTRIST(KEEP(28)), IW( LIW )
1003 INTEGER (8) :: PTRFAC(KEEP(28))
1004 COMPLEX A( LA ), W2( KEEP(133) )
1005 INTEGER NRHS
1006 INTEGER MYLEAF_LEFT, MTYPE
1007 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
1008 COMPLEX RHSCOMP(LRHSCOMP,NRHS)
1009 LOGICAL, INTENT(IN) :: PRUN_BELOW
1010 INTEGER SIZE_TO_PROCESS
1011 LOGICAL TO_PROCESS(SIZE_TO_PROCESS)
1012 LOGICAL, intent(in) :: FROM_PP
1013 INCLUDE 'mpif.h'
1014 INCLUDE 'mumps_tags.h'
1015 INTEGER MSGSOU, MSGTAG, MSGLEN
1016 INTEGER :: STATUS(MPI_STATUS_SIZE)
1017 INTEGER :: IERR
1018 FLAG = .FALSE.
1019 IF ( BLOQ ) THEN
1020 CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG,
1021 & COMM, STATUS, IERR )
1022 FLAG = .TRUE.
1023 ELSE
1024 CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM,
1025 & FLAG, STATUS, IERR )
1026 END IF
1027 IF (FLAG) THEN
1028 KEEP(266)=KEEP(266)-1
1029 MSGSOU=STATUS(MPI_SOURCE)
1030 MSGTAG=STATUS(MPI_TAG)
1031 CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR )
1032.GT. IF ( MSGLEN LBUFR_BYTES ) THEN
1033 INFO(1) = -20
1034 INFO(2) = MSGLEN
1035.NE. IF (NBFINF 0) THEN
1036 CALL CMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
1037 ENDIF
1038 ELSE
1039 CALL MPI_RECV(BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU,
1040 & MSGTAG, COMM, STATUS, IERR)
1041 CALL CMUMPS_BACKSLV_TRAITER_MESSAGE( MSGTAG, MSGSOU,
1042 & BUFR, LBUFR, LBUFR_BYTES,
1043 & MYID, SLAVEF, COMM,
1044 & N, IWCB, LIWW, POSIWCB,
1045 & W, LWC, POSWCB,
1046 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
1047 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
1048 & FRERE, FILS, PROCNODE_STEPS, PLEFTW,
1049 & KEEP, KEEP8, DKEEP,
1050 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
1051 & NRHS, MTYPE,
1052 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
1053 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
1054 & , FROM_PP
1055 & )
1056 END IF
1057 END IF
1058 RETURN
1059 END SUBROUTINE CMUMPS_BACKSLV_RECV_AND_TREAT
1060 RECURSIVE SUBROUTINE CMUMPS_BACKSLV_TRAITER_MESSAGE(
1061 & MSGTAG, MSGSOU,
1062 & BUFR, LBUFR, LBUFR_BYTES,
1063 & MYID, SLAVEF, COMM,
1064 & N, IWCB, LIWW, POSIWCB,
1065 & W, LWC, POSWCB,
1066 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
1067 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
1068 & FRERE, FILS, PROCNODE_STEPS, PLEFTW,
1069 & KEEP, KEEP8, DKEEP,
1070 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
1071 & NRHS, MTYPE,
1072 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
1073 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
1074 & , FROM_PP
1075 & )
1076 USE CMUMPS_OOC
1077 USE CMUMPS_SOL_LR, ONLY: CMUMPS_SOL_SLAVE_LR_U,
1078 & CMUMPS_SOL_BWD_LR_SU
1079 USE CMUMPS_BUF
1080 IMPLICIT NONE
1081 INTEGER MSGTAG, MSGSOU
1082 INTEGER LBUFR, LBUFR_BYTES
1083 INTEGER BUFR( LBUFR )
1084 INTEGER MYID, SLAVEF, COMM
1085 INTEGER N, LIWW
1086 INTEGER IWCB( LIWW )
1087 INTEGER(8), intent(in) :: LWC
1088 COMPLEX W( LWC )
1089 INTEGER POSIWCB
1090 INTEGER IIPOOL, LPOOL, LPANEL_POS
1091 INTEGER IPOOL( LPOOL )
1092 INTEGER PANEL_POS( LPANEL_POS )
1093 INTEGER NBFINF, INFO(80), KEEP(500)
1094 INTEGER(8) :: POSWCB, PLEFTW
1095 INTEGER(8) KEEP8(150)
1096 REAL, INTENT(INOUT) :: DKEEP(230)
1097 INTEGER PTRICB(KEEP(28)), STEP( N ), FILS( N )
1098 INTEGER(8) :: PTRACB(KEEP(28))
1099 INTEGER FRERE(KEEP(28))
1100 INTEGER PROCNODE_STEPS(KEEP(28))
1101 INTEGER LIW
1102 INTEGER(8) :: LA
1103 INTEGER IW( LIW ), PTRIST( KEEP(28) )
1104 INTEGER(8) :: PTRFAC(KEEP(28))
1105 COMPLEX A( LA ), W2( KEEP(133) )
1106 INTEGER NRHS
1107 INTEGER MYLEAF_LEFT, MTYPE
1108 INTEGER LRHSCOMP, POSINRHSCOMP_BWD(N)
1109 COMPLEX RHSCOMP(LRHSCOMP,NRHS)
1110 LOGICAL, INTENT(IN) :: PRUN_BELOW
1111 INTEGER SIZE_TO_PROCESS
1112 LOGICAL TO_PROCESS(SIZE_TO_PROCESS), NO_CHILDREN
1113 LOGICAL, intent(in) :: FROM_PP
1114 INCLUDE 'mpif.h'
1115 INCLUDE 'mumps_tags.h'
1116 INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1)
1117 INTEGER :: LIELL, K
1118 INTEGER(8) :: APOS, IST
1119 INTEGER NPIV, NROW_L, IPOS, NROW_RECU
1120 INTEGER(8) :: IFR8
1121 INTEGER I, JJ, IN, PROCDEST, J1, J2, LDA
1122 INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS,
1123 & IPOSINRHSCOMP, IPOSINRHSCOMP_PANEL
1124 INTEGER JBDEB, JBFIN, NRHS_B, allocok
1125 INTEGER(8) :: P_UPDATE, P_SOL_MAS
1126 INTEGER :: IWHDLR, MTYPE_SLAVE, LDA_SLAVE
1127 LOGICAL FLAG
1128 COMPLEX ZERO, ALPHA, ONE
1129 PARAMETER (ZERO=(0.0E0,0.0E0),
1130 & ONE=(1.0E0,0.0E0),
1131 & ALPHA=(-1.0E0,0.0E0))
1132 INCLUDE 'mumps_headers.h'
1133 INTEGER POOL_FIRST_POS, TMP
1134 LOGICAL, DIMENSION(:), ALLOCATABLE :: DEJA_SEND
1135 INTEGER :: NCB
1136 INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS
1137 INTEGER(8) :: PTWCB_PANEL
1138 INTEGER(8) :: PTWCB, PPIV_COURANT
1139 INTEGER LDAJ, NBJ, LIWFAC,
1140 & NBJLAST, NPIV_LAST, PANEL_SIZE,
1141 & NCB_PANEL, TYPEF
1142 LOGICAL TWOBYTWO
1143 INTEGER BEG_PANEL
1144 INTEGER IPANEL, NPANELS
1145 INTEGER TMP_NBPANELS, I_PIVRPTR, I_PIVR
1146 LOGICAL MUST_BE_PERMUTED
1147 LOGICAL COMPRESS_PANEL, LR_ACTIVATED
1148 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR
1149 LOGICAL :: ALLOW_OTHERS_TO_LEAVE
1150 LOGICAL, EXTERNAL :: MUMPS_IN_OR_ROOT_SSARBR
1151 INTEGER, EXTERNAL :: MUMPS_PROCNODE
1152 ALLOCATE(DEJA_SEND( 0:SLAVEF-1 ), stat=allocok)
1153.ne. if(allocok0) then
1154 INFO(1)=-13
1155 INFO(2)=SLAVEF
1156 WRITE(6,*) MYID,' Allocation error of DEJA_SEND '
1157 & //'in bwd solve COMPSO'
1158 GOTO 260
1159 END IF
1160 DUMMY(1)=0
1161.EQ. IF (MSGTAG TERMBWD) THEN
1162 NBFINF = NBFINF - 1
1163.EQ. ELSE IF (MSGTAG NOEUD) THEN
1164 POSITION = 0
1165 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1166 & INODE, 1, MPI_INTEGER,
1167 & COMM, IERR)
1168 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1169 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
1170 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1171 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
1172 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1173 & LONG, 1, MPI_INTEGER,
1174 & COMM, IERR)
1175 NRHS_B = JBFIN-JBDEB+1
1176.LT. IF ( POSIWCB - LONG 0
1177.OR..LT. & POSWCB - PLEFTW + 1_8 LONG ) THEN
1178 CALL CMUMPS_COMPSO(N, KEEP(28), IWCB,
1179 & LIWW, W, LWC,
1180 & POSWCB, POSIWCB, PTRICB, PTRACB)
1181.LT. IF (POSIWCB - LONG 0) THEN
1182 INFO(1)=-14
1183 INFO(2)=-POSIWCB + LONG
1184 WRITE(6,*) MYID,' Internal error 1 in bwd solve COMPSO'
1185 GOTO 260
1186 END IF
1187.LT. IF ( POSWCB - PLEFTW + 1_8 LONG ) THEN
1188 INFO(1) = -11
1189 CALL MUMPS_SET_IERROR(LONG + PLEFTW - POSWCB - 1_8,
1190 & INFO(2))
1191 WRITE(6,*) MYID,' Internal error 2 in bwd solve COMPSO'
1192 GOTO 260
1193 END IF
1194 ENDIF
1195 POSIWCB = POSIWCB - LONG
1196 POSWCB = POSWCB - LONG
1197.GT. IF (LONG 0) THEN
1198 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1199 & IWCB(POSIWCB + 1),
1200 & LONG, MPI_INTEGER, COMM, IERR)
1201 DO K=JBDEB,JBFIN
1202 CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
1203 & W(POSWCB + 1), LONG,
1204 & MPI_COMPLEX, COMM, IERR)
1205 DO JJ=0, LONG-1
1206 IPOSINRHSCOMP = abs( POSINRHSCOMP_BWD( IWCB(
1207 & POSIWCB+1+JJ ) ) )
1208.EQ..OR. IF ( (IPOSINRHSCOMP0)
1209.GT. & ( IPOSINRHSCOMPN ) ) CYCLE
1210 RHSCOMP(IPOSINRHSCOMP,K) = W(POSWCB+1+JJ)
1211 ENDDO
1212 ENDDO
1213 POSIWCB = POSIWCB + LONG
1214 POSWCB = POSWCB + LONG
1215 ENDIF
1216 POOL_FIRST_POS = IIPOOL
1217 IF ( PRUN_BELOW ) THEN
1218.NOT. IF (TO_PROCESS(STEP(INODE)))
1219 & GOTO 1010
1220 ENDIF
1221 IPOOL( IIPOOL ) = INODE
1222 IIPOOL = IIPOOL + 1
1223 1010 CONTINUE
1224 IF = FRERE( STEP(INODE) )
1225.GT. DO WHILE ( IF 0 )
1226 IF ( MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IF)),
1227.eq. & KEEP(199)) MYID ) THEN
1228 IF ( PRUN_BELOW ) THEN
1229.NOT. IF (TO_PROCESS(STEP(IF))) THEN
1230 IF = FRERE(STEP(IF))
1231 CYCLE
1232 ENDIF
1233 ENDIF
1234 IPOOL( IIPOOL ) = IF
1235 IIPOOL = IIPOOL + 1
1236 END IF
1237 IF = FRERE( STEP( IF ) )
1238 END DO
1239 DO I=1,(IIPOOL-POOL_FIRST_POS)/2
1240 TMP=IPOOL(POOL_FIRST_POS+I-1)
1241 IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I)
1242 IPOOL(IIPOOL-I)=TMP
1243 ENDDO
1244.EQ. ELSE IF ( MSGTAG BACKSLV_MASTER2SLAVE ) THEN
1245 POSITION = 0
1246 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1247 & INODE, 1, MPI_INTEGER, COMM, IERR )
1248 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1249 & NROW_RECU, 1, MPI_INTEGER, COMM, IERR )
1250 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1251 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
1252 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1253 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
1254 NRHS_B = JBFIN-JBDEB+1
1255.GT. LR_ACTIVATED = (IW(PTRIST(STEP(INODE))+XXLR)0)
1256.GE. COMPRESS_PANEL = (IW(PTRIST(STEP(INODE))+XXLR)2)
1257 OOCWRITE_COMPATIBLE_WITH_BLR =
1258.NOT..OR..NOT..OR. & ( LR_ACTIVATED(COMPRESS_PANEL)
1259.EQ. & (KEEP(485)0)
1260 & )
1261 IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ)
1262 NPIV = - IW( IPOS )
1263 NROW_L = IW( IPOS + 1 )
1264.NE. IF ( NROW_L NROW_RECU ) THEN
1265 WRITE(*,*) 'Error1 : NROW L/RECU=',NROW_L, NROW_RECU
1266 CALL MUMPS_ABORT()
1267 END IF
1268 LONG = NROW_L + NPIV
1269.LT. IF ( POSWCB - int(LONG,8)*int(NRHS_B,8) PLEFTW - 1_8 ) THEN
1270 CALL CMUMPS_COMPSO( N, KEEP(28), IWCB,
1271 & LIWW, W, LWC,
1272 & POSWCB, POSIWCB, PTRICB, PTRACB)
1273.LT. IF ( POSWCB - LONG*NRHS_B PLEFTW - 1_8 ) THEN
1274 INFO(1) = -11
1275 CALL MUMPS_SET_IERROR(LONG * NRHS_B- POSWCB,INFO(2))
1276 WRITE(6,*) MYID,' Internal error 3 in bwd solve COMPSO'
1277 GOTO 260
1278 END IF
1279 END IF
1280 P_UPDATE = PLEFTW
1281 P_SOL_MAS = PLEFTW + int(NPIV,8) * int(NRHS_B,8)
1282 PLEFTW = P_SOL_MAS + int(NROW_L,8) * int(NRHS_B,8)
1283 DO K=JBDEB, JBFIN
1284 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1285 & W( P_SOL_MAS+(K-JBDEB)*NROW_L),NROW_L,
1286 & MPI_COMPLEX,
1287 & COMM, IERR )
1288 ENDDO
1289.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR) THEN
1290 CALL CMUMPS_SOLVE_GET_OOC_NODE(
1291 & INODE,PTRFAC,KEEP,A,LA,STEP,
1292 & KEEP8,N,MUST_BE_PERMUTED,IERR)
1293.LT. IF(IERR0)THEN
1294 INFO(1)=IERR
1295 INFO(2)=0
1296 GOTO 260
1297 ENDIF
1298 ENDIF
1299 APOS = PTRFAC( STEP(INODE))
1300.GE..AND. IF ( IW(PTRIST(STEP(INODE))+XXLR) 2
1301.EQ. & KEEP(485) 1 ) THEN
1302 IWHDLR = IW(PTRIST(STEP(INODE))+XXF)
1303 MTYPE_SLAVE = 0
1304 W(P_UPDATE:P_UPDATE+NPIV*NRHS_B-1)=ZERO
1305 CALL CMUMPS_SOL_SLAVE_LR_U(INODE, IWHDLR, -9999,
1306 & W, LWC,
1307 & NROW_L, NPIV,
1308 & P_SOL_MAS, P_UPDATE,
1309 & JBDEB, JBFIN,
1310 & MTYPE_SLAVE, KEEP, KEEP8,
1311 & INFO(1), INFO(2) )
1312 ELSE
1313.EQ..AND. IF (KEEP(201) 1OOCWRITE_COMPATIBLE_WITH_BLR)
1314 & THEN
1315 MTYPE_SLAVE = 1
1316 LDA_SLAVE = NROW_L
1317 ELSE
1318 MTYPE_SLAVE = 0
1319 LDA_SLAVE = NPIV
1320 ENDIF
1321 CALL CMUMPS_SOLVE_GEMM_UPDATE(
1322 & A, LA, APOS, NROW_L,
1323 & LDA_SLAVE,
1324 & NPIV,
1325 & NRHS_B, W, LWC,
1326 & P_SOL_MAS, NROW_L,
1327 & P_UPDATE, NPIV,
1328 & MTYPE_SLAVE, KEEP, ZERO)
1329 ENDIF
1330.EQ..AND. IF (KEEP(201) 1OOCWRITE_COMPATIBLE_WITH_BLR)
1331 & THEN
1332 CALL CMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28),
1333 & A,LA,.TRUE.,IERR)
1334.LT. IF(IERR0)THEN
1335 INFO(1)=IERR
1336 INFO(2)=0
1337 GOTO 260
1338 ENDIF
1339 ENDIF
1340 PLEFTW = PLEFTW - int(NROW_L,8) * int(NRHS_B,8)
1341 100 CONTINUE
1342 CALL CMUMPS_BUF_SEND_BACKVEC( NRHS_B, INODE,
1343 & W(P_UPDATE),
1344 & NPIV, NPIV,
1345 & MSGSOU,
1346 & BACKSLV_UPDATERHS,
1347 & JBDEB, JBFIN,
1348 & KEEP, COMM, IERR )
1349.EQ. IF ( IERR -1 ) THEN
1350 CALL CMUMPS_BACKSLV_RECV_AND_TREAT(
1351 & .FALSE., FLAG,
1352 & BUFR, LBUFR, LBUFR_BYTES,
1353 & MYID, SLAVEF, COMM,
1354 & N, IWCB, LIWW, POSIWCB,
1355 & W, LWC, POSWCB,
1356 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
1357 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
1358 & FRERE, FILS, PROCNODE_STEPS, PLEFTW,
1359 & KEEP, KEEP8, DKEEP,
1360 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
1361 & NRHS, MTYPE,
1362 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
1363 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
1364 & , FROM_PP
1365 & )
1366.LT. IF ( INFO( 1 ) 0 ) GOTO 270
1367 GOTO 100
1368.EQ. ELSE IF ( IERR -2 ) THEN
1369 INFO( 1 ) = -17
1370 INFO( 2 ) = NRHS_B * NPIV * KEEP(35) + 4 * KEEP(34)
1371 GOTO 260
1372.EQ. ELSE IF ( IERR -3 ) THEN
1373 INFO( 1 ) = -20
1374 INFO( 2 ) = NRHS_B * NPIV * KEEP(35) + 4 * KEEP(34)
1375 GOTO 260
1376 END IF
1377 PLEFTW = PLEFTW - NPIV * NRHS_B
1378.EQ. ELSE IF ( MSGTAG BACKSLV_UPDATERHS ) THEN
1379 POSITION = 0
1380 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1381 & INODE, 1, MPI_INTEGER, COMM, IERR )
1382.GT. LR_ACTIVATED = (IW(PTRIST(STEP(INODE))+XXLR)0)
1383.GE. COMPRESS_PANEL = (IW(PTRIST(STEP(INODE))+XXLR)2)
1384 OOCWRITE_COMPATIBLE_WITH_BLR =
1385.NOT..OR..NOT..OR. & (LR_ACTIVATED(COMPRESS_PANEL)
1386.EQ. & (KEEP(485)0)
1387 & )
1388 IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ)
1389 LIELL = IW(IPOS-2)+IW(IPOS+1)
1390 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1391 & NPIV, 1, MPI_INTEGER, COMM, IERR )
1392 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1393 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
1394 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1395 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
1396 NRHS_B = JBFIN-JBDEB+1
1397 NELIM = IW(IPOS-1)
1398 IPOS = IPOS + 1
1399 NPIV = IW(IPOS)
1400 IPOS = IPOS + 1
1401 NSLAVES = IW( IPOS + 1 )
1402 IPOS = IPOS + 1 + NSLAVES
1403 INODEPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 4
1404.eq. IF ( KEEP(50) 0 ) THEN
1405 LDA = LIELL
1406 ELSE
1407 LDA = NPIV
1408 ENDIF
1409.EQ..AND..EQ. IF ( MTYPE 1 KEEP(50)0 ) THEN
1410 J1 = IPOS + LIELL + 1
1411 J2 = IPOS + NPIV + LIELL
1412 ELSE
1413 J1 = IPOS + 1
1414 J2 = IPOS + NPIV
1415 ENDIF
1416 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(J1))
1417 DO K=JBDEB, JBFIN
1418 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
1419 & W2, NPIV, MPI_COMPLEX,
1420 & COMM, IERR )
1421 I = 1
1422.NE..AND. IF ( (KEEP(253)0)
1423.EQ. & (IW(PTRIST(STEP(INODE))+XXS)C_FINI+NSLAVES)
1424 & ) THEN
1425 DO JJ = J1,J2
1426 RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = W2(I)
1427 I = I+1
1428 ENDDO
1429 ELSE
1430 DO JJ = J1,J2
1431 RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) =
1432 & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) + W2(I)
1433 I = I+1
1434 ENDDO
1435 ENDIF
1436 ENDDO
1437 IW(PTRIST(STEP(INODE))+XXS) =
1438 & IW(PTRIST(STEP(INODE))+XXS) - 1
1439.EQ. IF ( IW(PTRIST(STEP(INODE))+XXS)C_FINI ) THEN
1440.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR)
1441 & THEN
1442 CALL CMUMPS_SOLVE_GET_OOC_NODE(
1443 & INODE,PTRFAC,KEEP,A,LA,STEP,
1444 & KEEP8,N,MUST_BE_PERMUTED,IERR)
1445.LT. IF(IERR0)THEN
1446 INFO(1)=IERR
1447 INFO(2)=0
1448 GOTO 260
1449 ENDIF
1450.EQ..AND..NE. IF (KEEP(201)1 KEEP(50)1) THEN
1451 CALL CMUMPS_OOC_PP_CHECK_PERM_FREED(
1452 & IW(IPOS+1+2*LIELL),
1453 & MUST_BE_PERMUTED )
1454 ENDIF
1455 ENDIF
1456 APOS = PTRFAC(IW(INODEPOS))
1457.EQ..AND. IF (KEEP(201)1OOCWRITE_COMPATIBLE_WITH_BLR)
1458 & THEN
1459 LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
1460 TYPEF = TYPEF_L
1461 NROW_L = NPIV+NELIM
1462 PANEL_SIZE = CMUMPS_OOC_PANEL_SIZE(NROW_L)
1463.LT. IF (PANEL_SIZE0) THEN
1464 WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=',
1465 & PANEL_SIZE
1466 CALL MUMPS_ABORT()
1467 ENDIF
1468 ENDIF
1469.LT..or. IF ( POSIWCB - 2 0
1470.LT. & POSWCB-int(LIELL,8)*int(NRHS_B,8) PLEFTW-1_8 ) THEN
1471 CALL CMUMPS_COMPSO( N, KEEP(28), IWCB, LIWW, W, LWC,
1472 & POSWCB, POSIWCB, PTRICB, PTRACB )
1473.LT. IF ( POSWCB-int(LIELL,8)*int(NRHS_B,8) PLEFTW-1_8 ) THEN
1474 INFO( 1 ) = -11
1475 CALL MUMPS_SET_IERROR( int(LIELL,8)*int(NRHS_B,8)-
1476 & POSWCB-PLEFTW+1_8,
1477 & INFO(2) )
1478 GOTO 260
1479 END IF
1480.LT. IF ( POSIWCB - 2 0 ) THEN
1481 INFO( 1 ) = -14
1482 INFO( 2 ) = 2 - POSIWCB
1483 GO TO 260
1484 END IF
1485 END IF
1486 POSIWCB = POSIWCB - 2
1487 POSWCB = POSWCB - int(LIELL,8)*int(NRHS_B,8)
1488 PTRICB(STEP( INODE )) = POSIWCB + 1
1489 PTRACB(STEP( INODE )) = POSWCB + 1_8
1490 IWCB( PTRICB(STEP( INODE )) ) = LIELL*NRHS_B
1491 IWCB( PTRICB(STEP( INODE )) + 1 ) = 1
1492 IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 5 + NSLAVES
1493.EQ..AND..EQ. IF ( MTYPE1 KEEP(50)0 ) THEN
1494 POSINDICES = IPOS + LIELL + 1
1495 ELSE
1496 POSINDICES = IPOS + 1
1497 END IF
1498 PTWCB = PTRACB(STEP( INODE ))
1499 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(J1))
1500 IFR8 = PTRACB(STEP( INODE ))
1501 IFR8 = PTWCB + int(NPIV - 1,8)
1502.EQ..AND..EQ. IF ( MTYPE 1 KEEP(50)0 ) THEN
1503 J1 = IPOS + LIELL + NPIV + 1
1504 J2 = IPOS + 2 * LIELL
1505 ELSE
1506 J1 = IPOS + NPIV + 1
1507 J2 = IPOS + LIELL
1508 END IF
1509 CALL CMUMPS_SOL_BWD_GTHR( JBDEB, JBFIN, J1, J2,
1510 & RHSCOMP, NRHS, LRHSCOMP,
1511 & W(PTWCB), LIELL, NPIV+1,
1512 & IW, LIW, KEEP, N, POSINRHSCOMP_BWD )
1513 IFR8 = IFR8 + int(J2-KEEP(253)-J1+1,8)
1514.EQ..AND..AND. IF ( KEEP(201)1 OOCWRITE_COMPATIBLE_WITH_BLR
1515.GT..OR..NE. & (( NELIM 0 ) (MTYPE1 ))) THEN
1516 J = NPIV / PANEL_SIZE
1517.EQ..AND..GT. TWOBYTWO = KEEP(50)2 KEEP(105)0
1518 IF (TWOBYTWO) THEN
1519 CALL CMUMPS_BUILD_PANEL_POS(PANEL_SIZE, PANEL_POS, LPANEL_POS,
1520 & IW(IPOS+1+LIELL), NPIV, NPANELS, NROW_L,
1521 & NBENTRIES_ALLPANELS)
1522 ELSE
1523.EQ. IF (NPIVJ*PANEL_SIZE) THEN
1524 NPIV_LAST = NPIV
1525 NBJLAST = PANEL_SIZE
1526 NPANELS = J
1527 ELSE
1528 NPIV_LAST = (J+1)* PANEL_SIZE
1529 NBJLAST = NPIV-J*PANEL_SIZE
1530 NPANELS = J+1
1531 ENDIF
1532 NBENTRIES_ALLPANELS =
1533 & int(NROW_L,8) * int(NPIV,8)
1534 & - int( ( J * ( J - 1 ) ) /2,8 )
1535 & * int(PANEL_SIZE,8) * int(PANEL_SIZE,8)
1536 & - int(J,8)
1537 & * int(mod(NPIV, PANEL_SIZE),8)
1538 & * int(PANEL_SIZE,8)
1539 JJ=NPIV_LAST
1540 ENDIF
1541 APOSDEB = APOS + NBENTRIES_ALLPANELS
1542 DO IPANEL = NPANELS, 1, -1
1543 IF (TWOBYTWO) THEN
1544 NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL)
1545 BEG_PANEL = PANEL_POS(IPANEL)
1546 ELSE
1547.EQ. IF (JJNPIV_LAST) THEN
1548 NBJ = NBJLAST
1549 ELSE
1550 NBJ = PANEL_SIZE
1551 ENDIF
1552 BEG_PANEL = JJ- PANEL_SIZE+1
1553 ENDIF
1554 LDAJ = NROW_L-BEG_PANEL+1
1555 APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8)
1556 PTWCB = PTRACB(STEP(INODE))
1557 PTWCB_PANEL = PTRACB(STEP(INODE)) + int(BEG_PANEL - 1,8)
1558 IPOSINRHSCOMP_PANEL = IPOSINRHSCOMP + BEG_PANEL - 1
1559 NCB_PANEL = LDAJ - NBJ
1560 NCB = NROW_L - NPIV
1561.NE..AND. IF (KEEP(50)1 MUST_BE_PERMUTED) THEN
1562 CALL CMUMPS_GET_OOC_PERM_PTR(TYPEF, TMP_NBPANELS,
1563 & I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW)
1564 CALL CMUMPS_PERMUTE_PANEL(
1565 & IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)),
1566 & NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
1567 & IW(I_PIVRPTR+IPANEL-1)-1,
1568 & A(APOSDEB),
1569 & LDAJ, NBJ, BEG_PANEL-1)
1570 ENDIF
1571#if defined(MUMPS_USE_BLAS2)
1572 IF ( NRHS_B == 1 ) THEN
1573.NE. IF (NCB_PANEL0) THEN
1574.NE. IF (NCB_PANEL - NCB 0) THEN
1575 CALL cgemv( 'T', NCB_PANEL-NCB, NBJ, ALPHA,
1576 & A( APOSDEB + int(NBJ,8) ), LDAJ,
1577 & RHSCOMP(IPOSINRHSCOMP_PANEL+NBJ,JBDEB),
1578 & 1, ONE,
1579 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1 )
1580 ENDIF
1581.NE. IF (NCB 0) THEN
1582 CALL cgemv( 'T', NCB, NBJ, ALPHA,
1583 & A( APOSDEB + int(LDAJ-NCB,8) ), LDAJ,
1584 & W( PTWCB + int(NPIV,8) ),
1585 & 1, ONE,
1586 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1 )
1587 ENDIF
1588 ENDIF
1589.NE. IF (MTYPE1) THEN
1590 CALL ctrsv('L','T','U', NBJ, A(APOSDEB), LDAJ,
1591 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1)
1592 ELSE
1593 CALL ctrsv('L','T','N', NBJ, A(APOSDEB), LDAJ,
1594 & RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), 1)
1595 ENDIF
1596 ELSE
1597#endif
1598.NE. IF (NCB_PANEL0) THEN
1599.NE. IF (NCB_PANEL - NCB 0) THEN
1600 CALL cgemm( 'T', 'N', NBJ, NRHS_B,
1601 & NCB_PANEL-NCB, ALPHA,
1602 & A(APOSDEB +int(NBJ,8)), LDAJ,
1603 & RHSCOMP(IPOSINRHSCOMP_PANEL+NBJ,JBDEB), LRHSCOMP,
1604 & ONE, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP)
1605 ENDIF
1606.NE. IF (NCB 0) THEN
1607 CALL cgemm( 'T', 'N', NBJ, NRHS_B, NCB, ALPHA,
1608 & A(APOSDEB +int(LDAJ-NCB,8)), LDAJ,
1609 & W( PTWCB+int(NPIV,8) ), LIELL,
1610 & ONE, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB),LRHSCOMP)
1611 ENDIF
1612 ENDIF
1613.NE. IF (MTYPE1) THEN
1614 CALL ctrsm('L','L','T','U',NBJ, NRHS_B, ONE,
1615 & A(APOSDEB),
1616 & LDAJ, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP)
1617 ELSE
1618 CALL ctrsm('L','L','T','N',NBJ, NRHS_B, ONE,
1619 & A(APOSDEB),
1620 & LDAJ, RHSCOMP(IPOSINRHSCOMP_PANEL,JBDEB), LRHSCOMP)
1621 ENDIF
1622#if defined(MUMPS_USE_BLAS2)
1623 ENDIF
1624#endif
1625.NOT. IF ( TWOBYTWO) JJ=BEG_PANEL-1
1626 ENDDO
1627 GOTO 1234
1628 ENDIF
1629.GE. IF ( IW(PTRIST(STEP(INODE))+XXLR) 2
1630.AND..EQ. & KEEP(485) 1 ) THEN
1631 IWHDLR = IW(PTRIST(STEP(INODE))+XXF)
1632 CALL CMUMPS_SOL_BWD_LR_SU (
1633 & INODE, IWHDLR, NPIV, NSLAVES,
1634 & LIELL, W, LWC, NRHS_B, PTRACB(STEP(INODE)),
1635 & RHSCOMP, LRHSCOMP, NRHS,
1636 & IPOSINRHSCOMP, JBDEB,
1637 & MTYPE, KEEP, KEEP8,
1638 & INFO(1), INFO(2) )
1639 ELSE
1640.GT. IF (NELIM 0) THEN
1641.eq. IF ( KEEP(50) 0 ) THEN
1642 IST = APOS + int(NPIV,8) * int(LIELL,8)
1643 ELSE
1644.GT. IF( KEEP(459) 1) THEN
1645 CALL MUMPS_GETI8(IST, IW(PTRIST(STEP(INODE))+XXR))
1646 IST = APOS + IST - int(NPIV,8) * int(NELIM,8)
1647 ELSE
1648 IST = APOS + int(NPIV,8) * int(NPIV,8)
1649 ENDIF
1650 END IF
1651#if defined(MUMPS_USE_BLAS2)
1652 IF ( NRHS_B == 1 ) THEN
1653 CALL cgemv( 'N', NPIV, NELIM, ALPHA, A( IST ), NPIV,
1654 & W( NPIV + PTRACB(STEP(INODE)) ),
1655 & 1, ONE,
1656 & RHSCOMP(IPOSINRHSCOMP,JBDEB), 1 )
1657 ELSE
1658#endif
1659 CALL cgemm( 'N', 'N', NPIV, NRHS_B, NELIM, ALPHA,
1660 & A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))), LIELL,
1661 & ONE, RHSCOMP(IPOSINRHSCOMP,JBDEB), LRHSCOMP)
1662#if defined(MUMPS_USE_BLAS2)
1663 END IF
1664#endif
1665 ENDIF
1666 PPIV_COURANT = int(JBDEB-1,8)*int(LRHSCOMP,8)
1667 & + int(IPOSINRHSCOMP,8)
1668.GT..AND..NE. IF (KEEP(459)1 KEEP(50)0) THEN
1669 CALL CMUMPS_SOLVE_BWD_PANELS( A, LA, APOS,
1670 & NPIV, IW(IPOS+1+LIELL),
1671 & NRHS_B, RHSCOMP(1,1), KEEP8(25), LRHSCOMP, PPIV_COURANT,
1672 & MTYPE, KEEP )
1673 ELSE
1674 CALL CMUMPS_SOLVE_BWD_TRSOLVE( A, LA, APOS,
1675 & NPIV, LDA,
1676 & NRHS_B, RHSCOMP(1,1), KEEP8(25), LRHSCOMP, PPIV_COURANT,
1677 & MTYPE, KEEP )
1678 ENDIF
1679 ENDIF
1680 1234 CONTINUE
1681.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR) THEN
1682 CALL CMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28),
1683 & A,LA,.TRUE.,IERR)
1684.LT. IF(IERR0)THEN
1685 INFO(1)=IERR
1686 INFO(2)=0
1687 GOTO 260
1688 ENDIF
1689 ENDIF
1690 IPOS = PTRIST(STEP(INODE)) + KEEP(IXSZ) + 6 + NSLAVES
1691 IPOSINRHSCOMP = POSINRHSCOMP_BWD(IW(IPOS))
1692 IN = INODE
1693 170 IN = FILS(IN)
1694.GT. IF (IN 0) GOTO 170
1695.EQ. IF (IN 0) THEN
1696 MYLEAF_LEFT = MYLEAF_LEFT - 1
1697.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
1698.EQ. & KEEP(31) 0 )
1699.NE. IF (KEEP(31) 0) THEN
1700.NOT. IF ( MUMPS_IN_OR_ROOT_SSARBR(
1701 & PROCNODE_STEPS(STEP(INODE)),
1702 & KEEP(199) ) ) THEN
1703 KEEP(31) = KEEP(31) - 1
1704.EQ. IF (KEEP(31) 1) THEN
1705 ALLOW_OTHERS_TO_LEAVE = .TRUE.
1706 ENDIF
1707 ENDIF
1708 ENDIF
1709 IF ( ALLOW_OTHERS_TO_LEAVE ) THEN
1710 CALL CMUMPS_MCAST2( DUMMY, 1, MPI_INTEGER, MYID, COMM,
1711 & TERMBWD, SLAVEF, KEEP )
1712 NBFINF = NBFINF - 1
1713 ENDIF
1714 IWCB( PTRICB(STEP(INODE)) + 1 ) = 0
1715 CALL CMUMPS_FREETOPSO(N, KEEP(28),
1716 & IWCB, LIWW, W, LWC,
1717 & POSWCB, POSIWCB, PTRICB, PTRACB)
1718 GOTO 270
1719 ENDIF
1720 DO I = 0, SLAVEF - 1
1721 DEJA_SEND( I ) = .FALSE.
1722 END DO
1723 IN = -IN
1724 IF ( PRUN_BELOW ) THEN
1725 NO_CHILDREN = .TRUE.
1726 ELSE
1727 NO_CHILDREN = .FALSE.
1728 ENDIF
1729.GT. DO WHILE (IN0)
1730 IF ( PRUN_BELOW ) THEN
1731.NOT. IF ( TO_PROCESS(STEP(IN)) ) THEN
1732 IN = FRERE(STEP(IN))
1733 CYCLE
1734 ELSE
1735 NO_CHILDREN = .FALSE.
1736 ENDIF
1737 ENDIF
1738 POOL_FIRST_POS = IIPOOL
1739 IF (MUMPS_PROCNODE(PROCNODE_STEPS(STEP(IN)),
1740.EQ. & KEEP(199)) MYID) THEN
1741 IPOOL(IIPOOL ) = IN
1742 IIPOOL = IIPOOL + 1
1743 ELSE
1744 PROCDEST = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(IN)),
1745 & KEEP(199) )
1746.NOT. IF ( DEJA_SEND( PROCDEST ) ) THEN
1747 400 CONTINUE
1748 CALL CMUMPS_BUF_SEND_VCB( NRHS_B, IN, 0, 0,
1749 & LIELL, LIELL - KEEP(253),
1750 & IW( POSINDICES ),
1751 & W( PTRACB(STEP(INODE)) ), JBDEB, JBFIN,
1752 & RHSCOMP(1, 1), NRHS, LRHSCOMP,
1753 & IPOSINRHSCOMP, NPIV,
1754 & KEEP, PROCDEST, NOEUD, COMM, IERR )
1755.EQ. IF ( IERR -1 ) THEN
1756 CALL CMUMPS_BACKSLV_RECV_AND_TREAT(
1757 & .FALSE., FLAG,
1758 & BUFR, LBUFR, LBUFR_BYTES,
1759 & MYID, SLAVEF, COMM,
1760 & N, IWCB, LIWW, POSIWCB,
1761 & W, LWC, POSWCB,
1762 & IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
1763 & IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
1764 & STEP, FRERE, FILS, PROCNODE_STEPS,
1765 & PLEFTW, KEEP, KEEP8, DKEEP,
1766 & PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAF_LEFT,
1767 & NRHS, MTYPE,
1768 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_BWD,
1769 & PRUN_BELOW, TO_PROCESS, SIZE_TO_PROCESS
1770 & , FROM_PP
1771 & )
1772.LT. IF ( INFO( 1 ) 0 ) THEN
1773 GOTO 270
1774 ENDIF
1775 GOTO 400
1776.EQ. ELSE IF ( IERR -2 ) THEN
1777 INFO( 1 ) = -17
1778 INFO( 2 ) = NRHS_B * LIELL * KEEP(35) + 4 * KEEP(34)
1779 GOTO 260
1780.EQ. ELSE IF ( IERR -3 ) THEN
1781 INFO( 1 ) = -20
1782 INFO( 2 ) = NRHS_B * LIELL * KEEP(35) + 4 * KEEP(34)
1783 GOTO 260
1784 END IF
1785 DEJA_SEND( PROCDEST ) = .TRUE.
1786 END IF
1787 END IF
1788 IN = FRERE( STEP( IN ) )
1789 END DO
1790 ALLOW_OTHERS_TO_LEAVE = .FALSE.
1791 IF (NO_CHILDREN) THEN
1792 MYLEAF_LEFT = MYLEAF_LEFT - 1
1793.EQ..AND. ALLOW_OTHERS_TO_LEAVE = ( MYLEAF_LEFT 0
1794.EQ. & KEEP(31) 0 )
1795 ENDIF
1796.NE. IF (KEEP(31) 0) THEN
1797.NOT. IF ( MUMPS_IN_OR_ROOT_SSARBR(
1798 & PROCNODE_STEPS(STEP(INODE)),
1799 & KEEP(199) ) ) THEN
1800 KEEP(31) = KEEP(31) - 1
1801.EQ. IF (KEEP(31) 1) THEN
1802 ALLOW_OTHERS_TO_LEAVE = .TRUE.
1803 ENDIF
1804 ENDIF
1805 ENDIF
1806 IF ( ALLOW_OTHERS_TO_LEAVE ) THEN
1807 CALL CMUMPS_MCAST2( DUMMY, 1, MPI_INTEGER, MYID,
1808 & COMM, TERMBWD, SLAVEF, KEEP )
1809 NBFINF = NBFINF - 1
1810 ENDIF
1811.NOT. IF ( NO_CHILDREN ) THEN
1812 DO I=1,(IIPOOL-POOL_FIRST_POS)/2
1813 TMP=IPOOL(POOL_FIRST_POS+I-1)
1814 IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I)
1815 IPOOL(IIPOOL-I)=TMP
1816 ENDDO
1817 ENDIF
1818 IWCB( PTRICB(STEP( INODE )) + 1 ) = 0
1819 CALL CMUMPS_FREETOPSO( N, KEEP(28),
1820 & IWCB, LIWW, W, LWC,
1821 & POSWCB, POSIWCB, PTRICB, PTRACB)
1822 END IF
1823.EQ. ELSE IF (MSGTAGTERREUR) THEN
1824 INFO(1) = -001
1825 INFO(2) = MSGSOU
1826 GO TO 270
1827.EQ..OR. ELSE IF ( (MSGTAGUPDATE_LOAD)
1828.EQ. & (MSGTAGTAG_DUMMY) ) THEN
1829 GO TO 270
1830 ELSE
1831 INFO(1) = -100
1832 INFO(2) = MSGTAG
1833 GOTO 260
1834 ENDIF
1835 GO TO 270
1836 260 CONTINUE
1837.NE. IF (NBFINF 0) THEN
1838 CALL CMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
1839 ENDIF
1840 270 CONTINUE
1841 IF (allocated(DEJA_SEND)) DEALLOCATE(DEJA_SEND)
1842 RETURN
1843 END SUBROUTINE CMUMPS_BACKSLV_TRAITER_MESSAGE
1844 SUBROUTINE CMUMPS_BUILD_PANEL_POS(PANEL_SIZE, PANEL_POS,
1845 & LEN_PANEL_POS, INDICES, NPIV,
1846 & NPANELS, NFRONT_OR_NASS,
1847 & NBENTRIES_ALLPANELS)
1848 IMPLICIT NONE
1849 INTEGER, intent (in) :: PANEL_SIZE, NPIV
1850 INTEGER, intent (in) :: INDICES(NPIV)
1851 INTEGER, intent (in) :: LEN_PANEL_POS
1852 INTEGER, intent (out) :: NPANELS
1853 INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS)
1854 INTEGER, intent (in) :: NFRONT_OR_NASS
1855 INTEGER(8), intent(out):: NBENTRIES_ALLPANELS
1856 INTEGER NPANELS_MAX, I, NBeff
1857 INTEGER(8) :: NBENTRIES_THISPANEL
1858 NBENTRIES_ALLPANELS = 0_8
1859 NPANELS_MAX = (NPIV+PANEL_SIZE-1)/PANEL_SIZE
1860.LT. IF (LEN_PANEL_POS NPANELS_MAX + 1) THEN
1861 WRITE(*,*) "error 1 in cmumps_build_panel_pos",
1862 & LEN_PANEL_POS,NPANELS_MAX
1863 CALL MUMPS_ABORT()
1864 ENDIF
1865 I = 1
1866 NPANELS = 0
1867.GT. IF (I NPIV) RETURN
1868 10 CONTINUE
1869 NPANELS = NPANELS + 1
1870 PANEL_POS(NPANELS) = I
1871 NBeff = min(PANEL_SIZE, NPIV-I+1)
1872 IF ( INDICES(I+NBeff-1) < 0) THEN
1873 NBeff=NBeff+1
1874 ENDIF
1875 NBENTRIES_THISPANEL = int(NFRONT_OR_NASS-I+1,8) * int(NBeff,8)
1876 NBENTRIES_ALLPANELS = NBENTRIES_ALLPANELS + NBENTRIES_THISPANEL
1877 I=I+NBeff
1878.LE. IF ( I NPIV ) GOTO 10
1879 PANEL_POS(NPANELS+1)=NPIV+1
1880 RETURN
1881 END SUBROUTINE CMUMPS_BUILD_PANEL_POS
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
cmumps_get_ooc_perm_ptr
subroutine cmumps_get_ooc_perm_ptr(typef, nbpanels, i_pivptr, i_piv, ipos, iw, liw)
Definition cooc_panel_piv.F:133
cmumps_ooc_pp_check_perm_freed
subroutine cmumps_ooc_pp_check_perm_freed(iw_location, must_be_permuted)
Definition cooc_panel_piv.F:349
cmumps_permute_panel
subroutine cmumps_permute_panel(ipiv, lpiv, ishift, the_panel, nbrow, nbcol, kbeforepanel)
Definition cooc_panel_piv.F:78
cmumps_compso
subroutine cmumps_compso(n, keep28, iwcb, liww, w, lwc, poswcb, iwposcb, ptricb, ptracb)
Definition csol_aux.F:37
cmumps_freetopso
subroutine cmumps_freetopso(n, keep28, iwcb, liww, w, lwc, poswcb, iwposcb, ptricb, ptracb)
Definition csol_aux.F:17
cmumps_sol_cpy_fs2rhscomp
subroutine cmumps_sol_cpy_fs2rhscomp(jbdeb, jbfin, nbrows, keep, rhscomp, nrhs, lrhscomp, first_row_rhscomp, w, ld_w, first_row_w)
Definition csol_aux.F:1041
cmumps_sol_bwd_gthr
subroutine cmumps_sol_bwd_gthr(jbdeb, jbfin, j1, j2, rhscomp, nrhs, lrhscomp, w, ld_w, first_row_w, iw, liw, keep, n, posinrhscomp_bwd)
Definition csol_aux.F:1064
cmumps_solve_get_ooc_node
subroutine cmumps_solve_get_ooc_node(inode, ptrfac, keep, a, la, step, keep8, n, must_be_permuted, ierr)
Definition csol_aux.F:733
cmumps_build_panel_pos
subroutine cmumps_build_panel_pos(panel_size, panel_pos, len_panel_pos, indices, npiv, npanels, nfront_or_nass, nbentries_allpanels)
Definition csol_bwd_aux.F:1848
cmumps_backslv_recv_and_treat
recursive subroutine cmumps_backslv_recv_and_treat(bloq, flag, bufr, lbufr, lbufr_bytes, myid, slavef, comm, n, iwcb, liww, posiwcb, w, lwc, poswcb, iipool, nbfinf, ptricb, ptracb, info, ipool, lpool, panel_pos, lpanel_pos, step, frere, fils, procnode_steps, pleftw, keep, keep8, dkeep, ptrist, ptrfac, iw, liw, a, la, w2, myleaf_left, nrhs, mtype, rhscomp, lrhscomp, posinrhscomp_bwd, prun_below, to_process, size_to_process, from_pp)
Definition csol_bwd_aux.F:979
cmumps_solve_node_bwd
subroutine cmumps_solve_node_bwd(inode, n, ipool, lpool, iipool, nbfinf, a, la, iw, liw, w, lwc, nrhs, poswcb, pleftw, posiwcb, rhscomp, lrhscomp, posinrhscomp_bwd, ptricb, ptracb, iwcb, liww, w2, ne_steps, step, frere, fils, ptrist, ptrfac, myleaf_left, info, procnode_steps, deja_send, slavef, comm, myid, bufr, lbufr, lbufr_bytes, keep, keep8, dkeep, rhs_root, lrhs_root, mtype, istep_to_iniv2, tab_pos_in_pere, panel_pos, lpanel_pos, prun_below, to_process, size_to_process, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, error_was_broadcasted, do_mcast2_termbwd)
Definition csol_bwd_aux.F:32
cgemv
subroutine cgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
CGEMV
Definition cgemv.f:158
ctrsv
subroutine ctrsv(uplo, trans, diag, n, a, lda, x, incx)
CTRSV
Definition ctrsv.f:149
ctrsm
subroutine ctrsm(side, uplo, transa, diag, m, n, alpha, a, lda, b, ldb)
CTRSM
Definition ctrsm.f:180
cgemm
subroutine cgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
CGEMM
Definition cgemm.f:187
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_buf
Definition cmumps_comm_buffer.F:14
cmumps_buf::cmumps_buf_send_backvec
subroutine, public cmumps_buf_send_backvec(nrhs, inode, w, lw, ld_w, dest, msgtag, jbdeb, jbfin, keep, comm, ierr)
Definition cmumps_comm_buffer.F:2627
cmumps_buf::cmumps_buf_send_vcb
subroutine, public cmumps_buf_send_vcb(nrhs_b, node1, node2, ncb, ldw, long, iw, w, jbdeb, jbfin, rhscomp, nrhs, lrhscomp, iposinrhscomp, npiv, keep, dest, tag, comm, ierr)
Definition cmumps_comm_buffer.F:505
cmumps_ooc
Definition cmumps_ooc.F:14
cmumps_ooc::cmumps_ooc_panel_size
integer function, public cmumps_ooc_panel_size(nnmax)
Definition cmumps_ooc.F:3404
cmumps_sol_lr
Definition csol_lr.F:14
cmumps_sol_lr::cmumps_sol_bwd_lr_su
subroutine cmumps_sol_bwd_lr_su(inode, iwhdlr, npiv_global, nslaves, liell, wcb, lwcb, nrhs_b, ptwcb, rhscomp, lrhscomp, nrhs, iposinrhscomp, jbdeb, mtype, keep, keep8, iflag, ierror)
Definition csol_lr.F:386
mumps_set_ierror
subroutine mumps_set_ierror(size8, ierror)
Definition tools_common.F:865
mumps_geti8
subroutine mumps_geti8(i8, int_array)
Definition tools_common.F:888