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