OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
csol_fwd_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 RECURSIVE SUBROUTINE cmumps_traiter_message_solve
15 & ( bufr, lbufr, lbufr_bytes,
16 & msgtag, msgsou, myid, slavef, comm,
17 & n, nrhs, ipool, lpool, leaf,
18 & nbfin, nstk_s, iw, liw, a, la, ptrist,
19 & ptrfac, iwcb, liwcb,
20 & wcb, lwcb, poswcb,
21 & pleftwcb, posiwcb,
22 & ptricb,
23 & info, keep, keep8, dkeep, step, procnode_steps,
24 & rhscomp, lrhscomp, posinrhscomp_fwd
25 & , from_pp
26 & )
27 USE cmumps_ooc
28 USE cmumps_sol_lr, ONLY: cmumps_sol_slave_lr_u
29 USE cmumps_buf
30 IMPLICIT NONE
31 INTEGER lbufr, lbufr_bytes
32 INTEGER msgtag, msgsou, myid, slavef, comm
33 INTEGER liw
34 INTEGER(8), INTENT(IN) :: la, lwcb
35 INTEGER n, nrhs, lpool, leaf, nbfin, lrhscomp
36 INTEGER liwcb, posiwcb
37 INTEGER(8) :: poswcb, pleftwcb
38 INTEGER info( 80 ), keep( 500)
39 INTEGER(8) keep8(150)
40 REAL, INTENT(INOUT) :: dkeep(230)
41 INTEGER bufr( lbufr )
42 INTEGER ipool( lpool ), nstk_s( n )
43 INTEGER iwcb( liwcb )
44 INTEGER iw( liw )
45 INTEGER ptricb(keep(28)),PTRIST(keep(28))
46 INTEGER(8) :: ptrfac(keep(28))
47 INTEGER step(n)
48 INTEGER procnode_steps(keep(28))
49 COMPLEX wcb( lwcb ), a( la )
50 COMPLEX rhscomp( lrhscomp, nrhs )
51 INTEGER, intent(in) :: posinrhscomp_fwd(n)
52 LOGICAL, intent(in) :: from_pp
53 include 'mpif.h'
54 INCLUDE 'mumps_tags.h'
55 INTEGER(8) :: PTRX, PTRY, IFR8
56 INTEGER IERR, K, JJ, JBDEB, JBFIN, NRHS_B
57 INTEGER :: IWHDLR, LDA_SLAVE
58 INTEGER :: MTYPE_SLAVE
59 INTEGER FINODE, FPERE, LONG, NCB, POSITION, NCV, NPIV
60 INTEGER PDEST, I, IPOSINRHSCOMP
61 INTEGER J1
62 INTEGER(8) :: APOS
63 LOGICAL DUMMY
64 LOGICAL FLAG
65 LOGICAL :: OMP_FLAG
66 EXTERNAL MUMPS_PROCNODE
67 INTEGER MUMPS_PROCNODE
68 LOGICAL COMPRESS_PANEL, LR_ACTIVATED
69 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR
70 COMPLEX ALPHA, ONE
71 PARAMETER (ONE=(1.0E0,0.0E0), ALPHA=(-1.0E0,0.0E0))
72 INCLUDE 'mumps_headers.h'
73.EQ. IF ( MSGTAG RACINE_SOLVE ) THEN
74 NBFIN = NBFIN - 1
75.eq. IF ( NBFIN 0 ) GOTO 270
76.EQ. ELSE IF (MSGTAG ContVec ) THEN
77 POSITION = 0
78 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
79 & FINODE, 1, MPI_INTEGER, COMM, IERR )
80 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
81 & FPERE, 1, MPI_INTEGER, COMM, IERR )
82 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
83 & NCB, 1, MPI_INTEGER, COMM, IERR )
84 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
85 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
86 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
87 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
88 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
89 & LONG, 1, MPI_INTEGER, COMM, IERR )
90 NRHS_B = JBFIN-JBDEB+1
91.eq. IF ( NCB 0 ) THEN
92 PTRICB(STEP(FINODE)) = -1
93 ELSE
94.EQ. IF ( PTRICB(STEP(FINODE)) 0 ) THEN
95 PTRICB(STEP(FINODE)) = NCB + 1
96 END IF
97.LT. IF ( ( POSIWCB - LONG ) 0 ) THEN
98 INFO( 1 ) = -14
99 INFO( 2 ) = LONG
100 GOTO 260
101 END IF
102.LT. IF ( POSWCB - PLEFTWCB + 1_8
103 & int(LONG,8) * int(NRHS_B,8)) THEN
104 INFO( 1 ) = -11
105 CALL MUMPS_SET_IERROR(PLEFTWCB-POSWCB-1_8+
106 & int(LONG,8) * int(NRHS_B,8),
107 & INFO(2))
108 GOTO 260
109 END IF
110.GT. IF (LONG 0) THEN
111 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
112 & IWCB( 1 ),
113 & LONG, MPI_INTEGER, COMM, IERR )
114 DO K = 1, NRHS_B
115 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
116 & WCB( PLEFTWCB ),
117 & LONG, MPI_COMPLEX, COMM, IERR )
118#if defined(__ve__)
119!NEC$ IVDEP
120#endif
121 DO I = 1, LONG
122 IPOSINRHSCOMP= abs(POSINRHSCOMP_FWD(IWCB(I)))
123 RHSCOMP(IPOSINRHSCOMP,JBDEB+K-1) =
124 & RHSCOMP(IPOSINRHSCOMP,JBDEB+K-1) +
125 & WCB(PLEFTWCB+I-1)
126 ENDDO
127 END DO
128 PTRICB(STEP(FINODE)) = PTRICB(STEP(FINODE)) - LONG
129 ENDIF
130 END IF
131.OR. IF ( PTRICB(STEP(FINODE)) == 1
132 & PTRICB(STEP(FINODE)) == -1 ) THEN
133 NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1
134 PTRICB(STEP(FINODE)) = 0
135 END IF
136.EQ. IF ( NSTK_S(STEP(FPERE)) 0 ) THEN
137 IPOOL( LEAF ) = FPERE
138 LEAF = LEAF + 1
139 IF ( LEAF > LPOOL ) THEN
140 WRITE(*,*)
141 & 'internal error 1 cmumps_traiter_message_solve',
142 & LEAF, LPOOL
143 CALL MUMPS_ABORT()
144 END IF
145 ENDIF
146.EQ. ELSEIF ( MSGTAG Master2Slave ) THEN
147 POSITION = 0
148 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
149 & FINODE, 1, MPI_INTEGER, COMM, IERR )
150 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
151 & FPERE, 1, MPI_INTEGER, COMM, IERR )
152 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
153 & NCV, 1, MPI_INTEGER, COMM, IERR )
154 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
155 & NPIV, 1, MPI_INTEGER, COMM, IERR )
156 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
157 & JBDEB, 1, MPI_INTEGER, COMM, IERR )
158 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
159 & JBFIN, 1, MPI_INTEGER, COMM, IERR )
160 NRHS_B = JBFIN-JBDEB+1
161 PTRY = PLEFTWCB
162 PTRX = PLEFTWCB + int(NCV,8) * int(NRHS_B,8)
163 PLEFTWCB = PLEFTWCB + int(NPIV + NCV,8) * int(NRHS_B,8)
164.LT. IF ( POSWCB - PLEFTWCB + 1 0 ) THEN
165 INFO(1) = -11
166 CALL MUMPS_SET_IERROR(-POSWCB+PLEFTWCB-1_8,INFO(2))
167 GO TO 260
168 END IF
169 DO K=1, NRHS_B
170 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
171 & WCB( PTRY + (K-1) * NCV ), NCV,
172 & MPI_COMPLEX, COMM, IERR )
173 ENDDO
174.GT. IF ( NPIV 0 ) THEN
175 DO K=1, NRHS_B
176 CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
177 & WCB( PTRX + (K-1)*NPIV ), NPIV,
178 & MPI_COMPLEX, COMM, IERR )
179 END DO
180 END IF
181.GT. LR_ACTIVATED = (IW(PTRIST(STEP(FINODE))+XXLR)0)
182.GE. COMPRESS_PANEL = (IW(PTRIST(STEP(FINODE))+XXLR)2)
183 OOCWRITE_COMPATIBLE_WITH_BLR =
184.NOT..OR..NOT..OR. & (LR_ACTIVATED(COMPRESS_PANEL)
185.EQ. & (KEEP(485)0)
186 & )
187.GT..AND. IF (KEEP(201)0OOCWRITE_COMPATIBLE_WITH_BLR) THEN
188 CALL CMUMPS_SOLVE_GET_OOC_NODE(
189 & FINODE,PTRFAC,KEEP,A,LA,STEP,
190 & KEEP8,N,DUMMY,IERR)
191.LT. IF(IERR0)THEN
192 INFO(1)=IERR
193 INFO(2)=0
194 GOTO 260
195 ENDIF
196 ENDIF
197.GE..AND. IF ( IW(PTRIST(STEP(FINODE))+XXLR) 2
198.EQ. & KEEP(485) 1 ) THEN
199 IWHDLR = IW(PTRIST(STEP(FINODE))+XXF)
200 MTYPE_SLAVE = 1
201 CALL CMUMPS_SOL_SLAVE_LR_U( FINODE, IWHDLR,
202 & -9999,
203 & WCB, LWCB,
204 & NPIV, NCV,
205 & PTRX, PTRY,
206 & JBDEB, JBFIN,
207 & MTYPE_SLAVE, KEEP, KEEP8,
208 & INFO(1), INFO(2) )
209 ELSE
210 APOS = PTRFAC(STEP(FINODE))
211.EQ. IF (KEEP(201) 1) THEN
212 MTYPE_SLAVE = 0
213 LDA_SLAVE = NCV
214 ELSE
215 MTYPE_SLAVE = 1
216 LDA_SLAVE = NPIV
217 ENDIF
218 CALL CMUMPS_SOLVE_GEMM_UPDATE
219 & ( A, LA, APOS, NPIV,
220 & LDA_SLAVE,
221 & NCV,
222 & NRHS_B, WCB, LWCB,
223 & PTRX, NPIV,
224 & PTRY, NCV,
225 & MTYPE_SLAVE, KEEP, ONE )
226 ENDIF
227.GT..AND. IF ((KEEP(201)0)OOCWRITE_COMPATIBLE_WITH_BLR) THEN
228 CALL CMUMPS_FREE_FACTORS_FOR_SOLVE(FINODE,PTRFAC,
229 & KEEP(28),A,LA,.TRUE.,IERR)
230.LT. IF(IERR0)THEN
231 INFO(1)=IERR
232 INFO(2)=0
233 GOTO 260
234 ENDIF
235 ENDIF
236 PLEFTWCB = PLEFTWCB - int(NPIV,8) * int(NRHS_B,8)
237 PDEST = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(FPERE)),
238 & KEEP(199) )
239.EQ. IF ( PDEST MYID ) THEN
240.EQ. IF ( PTRICB(STEP(FINODE)) 0 ) THEN
241 NCB = IW( PTRIST(STEP(FINODE)) + 2 + KEEP(IXSZ) )
242 PTRICB(STEP(FINODE)) = NCB + 1
243 END IF
244 J1 = PTRIST(STEP(FINODE))+3+KEEP(IXSZ)
245 OMP_FLAG = .FALSE.
246.GE..AND.!$ OMP_FLAG = ( JBFIN-JBDEB+1KEEP(362)
247.GE.!$ & (NCV*(JBFIN-JBDEB+1) KEEP(363) ) )
248 IF (OMP_FLAG) THEN
249!$OMP PARALLEL DO PRIVATE(I,JJ,IFR8,IPOSINRHSCOMP)
250 DO K=1, NRHS_B
251 IFR8 = PTRY+int(K-1,8)*int(NCV,8)
252#if defined(__ve__)
253!NEC$ IVDEP
254#endif
255 DO I = 1,NCV
256 JJ = IW(J1+I)
257 IPOSINRHSCOMP= abs(POSINRHSCOMP_FWD(JJ))
258 RHSCOMP(IPOSINRHSCOMP,JBDEB+K-1)=
259 & RHSCOMP(IPOSINRHSCOMP,JBDEB+K-1)
260 & + WCB(IFR8+int(I-1,8))
261 ENDDO
262 ENDDO
263!$OMP END PARALLEL DO
264 ELSE
265 DO K=1, NRHS_B
266 IFR8 = PTRY+int(K-1,8)*int(NCV,8)
267#if defined(__ve__)
268!NEC$ IVDEP
269#endif
270 DO I = 1,NCV
271 JJ = IW(J1+I)
272 IPOSINRHSCOMP= abs(POSINRHSCOMP_FWD(JJ))
273 RHSCOMP(IPOSINRHSCOMP,JBDEB+K-1)=
274 & RHSCOMP(IPOSINRHSCOMP,JBDEB+K-1)
275 & + WCB(IFR8+int(I-1,8))
276 ENDDO
277 ENDDO
278 ENDIF
279 PTRICB(STEP(FINODE)) = PTRICB(STEP(FINODE)) - NCV
280 IF ( PTRICB( STEP( FINODE ) ) == 1 ) THEN
281 NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1
282 PTRICB(STEP(FINODE)) = 0
283 END IF
284.EQ. IF ( NSTK_S(STEP(FPERE)) 0 ) THEN
285 IPOOL( LEAF ) = FPERE
286 LEAF = LEAF + 1
287 IF ( LEAF > LPOOL ) THEN
288 WRITE(*,*)
289 & 'internal error in cmumps_traiter_message_solve',
290 & LEAF, LPOOL
291 CALL MUMPS_ABORT()
292 END IF
293 ENDIF
294 ELSE
295 210 CONTINUE
296 CALL CMUMPS_BUF_SEND_VCB( NRHS_B, FINODE, FPERE,
297 & IW(PTRIST(STEP( FINODE )) + 2 + KEEP(IXSZ) ), NCV,NCV,
298 & IW(PTRIST(STEP(FINODE))+4+ KEEP(IXSZ) ),
299 & WCB( PTRY ), JBDEB, JBFIN,
300 & RHSCOMP, 1, 1, -9999, -9999,
301 & KEEP, PDEST, ContVec, COMM, IERR )
302.EQ. IF ( IERR -1 ) THEN
303 CALL CMUMPS_SOLVE_RECV_AND_TREAT( .FALSE., FLAG,
304 & BUFR, LBUFR, LBUFR_BYTES,
305 & MYID, SLAVEF, COMM,
306 & N, NRHS, IPOOL, LPOOL, LEAF,
307 & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
308 & IWCB, LIWCB,
309 & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
310 & PTRICB, INFO, KEEP,KEEP8, DKEEP, STEP,
311 & PROCNODE_STEPS,
312 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD
313 & , FROM_PP
314 & )
315.LT. IF ( INFO( 1 ) 0 ) GOTO 270
316 GOTO 210
317.EQ. ELSE IF ( IERR -2 ) THEN
318 INFO( 1 ) = -17
319 INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) +
320 & NCV * KEEP( 35 )
321 GOTO 260
322.EQ. ELSE IF ( IERR -3 ) THEN
323 INFO( 1 ) = -20
324 INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) +
325 & NCV * KEEP( 35 )
326 END IF
327 END IF
328 PLEFTWCB = PLEFTWCB - int(NCV,8) * int(NRHS_B,8)
329.EQ. ELSEIF ( MSGTAG TERREUR ) THEN
330 INFO(1) = -001
331 INFO(2) = MSGSOU
332 GOTO 270
333.EQ..OR. ELSE IF ( (MSGTAGUPDATE_LOAD)
334.EQ. & (MSGTAGTAG_DUMMY) ) THEN
335 GO TO 270
336 ELSE
337 INFO(1)=-100
338 INFO(2)=MSGTAG
339 GO TO 260
340 ENDIF
341 GO TO 270
342 260 CONTINUE
343 CALL CMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
344 270 CONTINUE
345 RETURN
346 END SUBROUTINE CMUMPS_TRAITER_MESSAGE_SOLVE
347 SUBROUTINE CMUMPS_SOLVE_NODE_FWD( INODE,
348 & LASTFSL0STA, LASTFSL0DYN,
349 & BUFR, LBUFR, LBUFR_BYTES,
350 & MYID, SLAVEF, COMM,
351 & N, IPOOL, LPOOL, LEAF,
352 & NBFIN, NSTK_S,
353 & IWCB, LIWCB,
354 & WCB, LWCB, A, LA, IW, LIW,
355 & NRHS, POSWCB, PLEFTWCB, POSIWCB,
356 & PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS,
357 & FILS, STEP, FRERE, DAD,
358 & INFO, KEEP,KEEP8, DKEEP, RHS_ROOT, LRHS_ROOT, MTYPE,
359 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD,
360 &
361 & ISTEP_TO_INIV2, TAB_POS_IN_PERE
362 & , RHS_BOUNDS, LRHS_BOUNDS, DO_NBSPARSE, FROM_PP
363 & , ERROR_WAS_BROADCASTED
364 & )
365 USE CMUMPS_SOL_LR
366!$ USE CMUMPS_SOL_L0OMP_M, ONLY: LOCK_FOR_SCATTER
367 USE CMUMPS_SOL_L0OMP_M, ONLY: NB_LOCK_MAX
368 USE CMUMPS_OOC
369 USE CMUMPS_BUF
370 IMPLICIT NONE
371 INTEGER MTYPE
372 INTEGER, INTENT( IN ) :: INODE, LASTFSL0STA, LASTFSL0DYN
373 INTEGER LBUFR, LBUFR_BYTES
374 INTEGER MYID, SLAVEF, COMM
375 INTEGER LIWCB, LIW, POSIWCB
376 INTEGER(8) :: POSWCB, PLEFTWCB, LWCB
377 INTEGER(8) :: LA
378 INTEGER N, LPOOL, LEAF, NBFIN
379 INTEGER INFO( 80 ), KEEP( 500)
380 INTEGER(8) KEEP8(150)
381 REAL, INTENT(INOUT) :: DKEEP(230)
382 INTEGER BUFR( LBUFR )
383 INTEGER IPOOL( LPOOL ), NSTK_S(KEEP(28))
384 INTEGER IWCB( LIWCB ), IW( LIW )
385 INTEGER NRHS
386 COMPLEX WCB( LWCB )
387 COMPLEX :: A( LA )
388 INTEGER(8) :: LRHS_ROOT
389 COMPLEX RHS_ROOT( LRHS_ROOT )
390 INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28))
391 INTEGER(8) :: PTRFAC(KEEP(28))
392 INTEGER PROCNODE_STEPS(KEEP(28))
393 INTEGER FILS( N ), STEP( N ), FRERE(KEEP(28)), DAD(KEEP(28))
394 INTEGER ISTEP_TO_INIV2(KEEP(71)),
395 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
396 INTEGER POSINRHSCOMP_FWD(N), LRHSCOMP
397 COMPLEX RHSCOMP(LRHSCOMP, NRHS)
398 LOGICAL, intent(in) :: DO_NBSPARSE
399 INTEGER, intent(in) :: LRHS_BOUNDS
400 INTEGER, intent(in) :: RHS_BOUNDS(LRHS_BOUNDS)
401 LOGICAL, intent(in) :: FROM_PP
402 LOGICAL, intent(out) :: ERROR_WAS_BROADCASTED
403 EXTERNAL cgemv, ctrsv, cgemm, ctrsm, MUMPS_PROCNODE
404 INTEGER MUMPS_PROCNODE
405 COMPLEX ALPHA,ONE,ZERO
406 PARAMETER (ZERO=(0.0E0,0.0E0),
407 & ONE=(1.0E0,0.0E0),
408 & ALPHA=(-1.0E0,0.0E0))
409 INTEGER :: IWHDLR
410 INTEGER JBDEB, JBFIN, NRHS_B
411 INTEGER LDADIAG
412 INTEGER(8) :: APOS, APOS1, IFR8, IFR_ini8
413 INTEGER I, J, K, IPOS, NSLAVES, J1, J2, J3, FPERE, FPERE_MAPPING,
414 & NPIV, NCB, LIELL, JJ, NELIM, IERR
415 INTEGER(8) :: PCB_COURANT, PPIV_COURANT, PPIV_PANEL, PCB_PANEL
416 INTEGER IPOSINRHSCOMP_TMP
417 INTEGER Effective_CB_Size, NUPDATE, ISLAVE, PDEST, FirstIndex
418 LOGICAL FLAG
419 INTEGER :: NUPDATE_NONCRITICAL, IPOSINRHSCOMPLASTFSDYN
420 LOGICAL :: OMP_FLAG
421 INCLUDE 'mumps_headers.h'
422 INTEGER(8) :: APOSDEB
423 INTEGER TempNROW, TempNCOL, PANEL_SIZE,
424 & JFIN, NBJ, NUPDATE_PANEL,
425 & TYPEF
426 INTEGER LD_WCBPIV
427 INTEGER LD_WCBCB
428 LOGICAL :: LDEQLIELLPANEL
429 LOGICAL :: CBINITZERO
430 INTEGER LDAJ, LDAJ_FIRST_PANEL
431 INTEGER LDAtemp
432 LOGICAL COMPRESS_PANEL, LR_ACTIVATED
433 LOGICAL OOCWRITE_COMPATIBLE_WITH_BLR
434 INTEGER TMP_NBPANELS,
435 & I_PIVRPTR, I_PIVR, IPANEL
436 LOGICAL MUST_BE_PERMUTED
437 INTEGER :: SIZEBLOCK, NB, JCourant, NB_LOCK
438 INCLUDE 'mpif.h'
439 INCLUDE 'mumps_tags.h'
440 INTEGER DUMMY( 1 )
441 ERROR_WAS_BROADCASTED = .FALSE.
442 DUMMY(1)=1
443.GT. LR_ACTIVATED = (IW(PTRIST(STEP(INODE))+XXLR)0)
444.GE. COMPRESS_PANEL = (IW(PTRIST(STEP(INODE))+XXLR)2)
445 OOCWRITE_COMPATIBLE_WITH_BLR =
446.NOT..OR..NOT..OR. & (LR_ACTIVATED(COMPRESS_PANEL)
447.EQ. & (KEEP(485)0)
448 & )
449 IF (DO_NBSPARSE) THEN
450 JBDEB= RHS_BOUNDS(2*STEP(INODE)-1)
451 JBFIN= RHS_BOUNDS(2*STEP(INODE))
452 ELSE
453 JBDEB = 1
454 JBFIN = NRHS
455 ENDIF
456 NRHS_B = JBFIN-JBDEB+1
457 IF (DO_NBSPARSE) THEN
458.GT. if (JBDEBJBFIN) then
459 write(6,*) " Internal error 1 in nbsparse :",
460 & JBDEB, JBFIN
461 CALL MUMPS_ABORT()
462 endif
463.LT..OR..GT..or. IF (JBDEB1 JBDEBNRHS
464.LT..OR..GT. & JBFIN1 JBFINNRHS ) THEN
465 write(6,*) " Internal error 2 in nbsparse :",
466 & JBDEB, JBFIN
467 CALL MUMPS_ABORT()
468 endif
469 ENDIF
470.eq..OR..eq. IF ( INODE KEEP( 38 ) INODE KEEP( 20 ) ) THEN
471 LIELL = IW( PTRIST( STEP(INODE)) + 3 + KEEP(IXSZ))
472 NPIV = LIELL
473 NELIM = 0
474 NSLAVES = 0
475 IPOS = PTRIST( STEP(INODE)) + 5 + KEEP(IXSZ)
476 ELSE
477 IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ)
478 LIELL = IW(IPOS-2)+IW(IPOS+1)
479 NELIM = IW(IPOS-1)
480 NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) )
481 IPOS = IPOS + 1
482 NPIV = IW(IPOS)
483 IPOS = IPOS + 1
484.GT..AND. IF ((KEEP(201)0)OOCWRITE_COMPATIBLE_WITH_BLR) THEN
485 CALL CMUMPS_SOLVE_GET_OOC_NODE(
486 & INODE,PTRFAC,KEEP,A,LA,STEP,
487 & KEEP8,N,MUST_BE_PERMUTED,IERR)
488.LT. IF(IERR0)THEN
489 INFO(1)=IERR
490 INFO(2)=0
491 ERROR_WAS_BROADCASTED = .FALSE.
492 GOTO 270
493 ENDIF
494.EQ..AND..NE. IF (KEEP(201)1 KEEP(50)1) THEN
495 CALL CMUMPS_OOC_PP_CHECK_PERM_FREED(
496 & IW(IPOS+1+2*LIELL+1+NSLAVES),
497 & MUST_BE_PERMUTED )
498 ENDIF
499 ENDIF
500 NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ))
501 IPOS = IPOS + 1 + NSLAVES
502 END IF
503.EQ..OR..NE. IF ( MTYPE 1 KEEP(50) 0 ) THEN
504 J1 = IPOS + 1
505 J2 = IPOS + LIELL
506 J3 = IPOS + NPIV
507 ELSE
508 J1 = IPOS + LIELL + 1
509 J2 = IPOS + 2 * LIELL
510 J3 = IPOS + LIELL + NPIV
511 END IF
512 NCB = LIELL-NPIV
513.NE. IF (KEEP(50)0) THEN
514.GT. IF ( KEEP(459) 1 ) THEN
515 LDADIAG = -99999
516 ELSE
517 LDADIAG = NPIV
518 ENDIF
519 ELSE
520 LDADIAG = LIELL
521 ENDIF
522.eq..OR..eq. IF ( INODE KEEP( 38 ) INODE KEEP(20) ) THEN
523 IFR8 = 0_8
524 IPOSINRHSCOMP_TMP = POSINRHSCOMP_FWD(IW(J1))
525 IFR_ini8 = IFR8
526 OMP_FLAG = .FALSE.
527.GE..AND.!$ OMP_FLAG = ( JBFIN-JBDEB+1KEEP(362)
528.GE.!$ & (J3-J1+1)*(JBFIN-JBDEB+1) KEEP(363) )
529 IF (OMP_FLAG) THEN
530!$OMP PARALLEL DO PRIVATE(IFR8,JJ)
531 DO K=JBDEB,JBFIN
532 IFR8 = IFR_ini8 + int(K-1,8)*int(NPIV,8)
533 DO JJ = J1, J3
534 RHS_ROOT(IFR8+int(JJ-J1+1,8)) =
535 & RHSCOMP(IPOSINRHSCOMP_TMP+JJ-J1,K)
536 ENDDO
537 ENDDO
538!$OMP END PARALLEL DO
539 ELSE
540 DO K=JBDEB,JBFIN
541 IFR8 = IFR_ini8 + int(K-1,8)*int(NPIV,8)
542 DO JJ = J1, J3
543 RHS_ROOT(IFR8+int(JJ-J1+1,8)) =
544 & RHSCOMP(IPOSINRHSCOMP_TMP+JJ-J1,K)
545 ENDDO
546 ENDDO
547 ENDIF
548.LT. IF ( NPIV LIELL ) THEN
549 WRITE(*,*) ' internal error 1 in cmumps_solve_node_fwd',
550 & NPIV, LIELL
551 CALL MUMPS_ABORT()
552 END IF
553 GO TO 270
554 END IF
555 APOS = PTRFAC(STEP(INODE))
556.EQ..AND. IF ( (KEEP(201)1)OOCWRITE_COMPATIBLE_WITH_BLR ) THEN
557.EQ. IF (MTYPE1) THEN
558.EQ..AND..NE. IF ((MTYPE1)NSLAVES0) THEN
559 TempNROW= NPIV+NELIM
560 TempNCOL= NPIV
561 LDAJ_FIRST_PANEL=TempNROW
562 ELSE
563 TempNROW= LIELL
564 TempNCOL= NPIV
565 LDAJ_FIRST_PANEL=TempNROW
566 ENDIF
567 TYPEF=TYPEF_L
568 ELSE
569 TempNCOL= LIELL
570 TempNROW= NPIV
571 LDAJ_FIRST_PANEL=TempNCOL
572 TYPEF= TYPEF_U
573 ENDIF
574 PANEL_SIZE = CMUMPS_OOC_PANEL_SIZE( LDAJ_FIRST_PANEL )
575 ENDIF
576 PPIV_COURANT = PLEFTWCB
577 PLEFTWCB = PLEFTWCB + int(LIELL,8) * int(NRHS_B,8)
578.LT. IF ( POSWCB - PLEFTWCB + 1_8 0 ) THEN
579 INFO(1) = -11
580 CALL MUMPS_SET_IERROR(PLEFTWCB-POSWCB-1_8, INFO(2))
581 ERROR_WAS_BROADCASTED = .FALSE.
582 GOTO 270
583 END IF
584.EQ..AND. IF (KEEP(201) 1 OOCWRITE_COMPATIBLE_WITH_BLR) THEN
585 LDEQLIELLPANEL = .TRUE.
586 LD_WCBPIV = LIELL
587 LD_WCBCB = LIELL
588 PCB_COURANT = PPIV_COURANT + NPIV
589 ELSE
590 LDEQLIELLPANEL = .FALSE.
591 LD_WCBPIV = NPIV
592 LD_WCBCB = NCB
593 PCB_COURANT = PPIV_COURANT + int(NPIV,8)*int(NRHS_B,8)
594 ENDIF
595 FPERE = DAD(STEP(INODE))
596.NE. IF ( FPERE 0 ) THEN
597 FPERE_MAPPING = MUMPS_PROCNODE( PROCNODE_STEPS(STEP(FPERE)),
598 & KEEP(199) )
599 ELSE
600 FPERE_MAPPING = -1
601 ENDIF
602.LE. IF ( LASTFSL0DYN N ) THEN
603 CBINITZERO = .TRUE.
604.EQ. ELSE IF ( FPERE_MAPPING MYID ) THEN
605 CBINITZERO = .TRUE.
606 ELSE
607 CBINITZERO = .FALSE.
608 ENDIF
609 CALL CMUMPS_RHSCOMP_TO_WCB(
610 & NPIV, NCB, LIELL, CBINITZERO, LDEQLIELLPANEL,
611 & RHSCOMP(1, JBDEB), LRHSCOMP, NRHS_B,
612 & POSINRHSCOMP_FWD, N,
613 & WCB(PPIV_COURANT),
614 & IW, LIW, J1, J3, J2, KEEP, DKEEP)
615.NE. IF ( NPIV 0 ) THEN
616.EQ..AND. IF ((KEEP(201)1)OOCWRITE_COMPATIBLE_WITH_BLR) THEN
617 APOSDEB = APOS
618 J = 1
619 IPANEL = 0
620 10 CONTINUE
621 IPANEL = IPANEL + 1
622 JFIN = min(J+PANEL_SIZE-1, NPIV)
623 IF (IW(IPOS+ LIELL + JFIN) < 0) THEN
624 JFIN=JFIN+1
625 ENDIF
626 NBJ = JFIN-J+1
627 LDAJ = LDAJ_FIRST_PANEL-J+1
628.NE..AND. IF ( (KEEP(50)1) MUST_BE_PERMUTED ) THEN
629 CALL CMUMPS_GET_OOC_PERM_PTR(TYPEF, TMP_NBPANELS,
630 & I_PIVRPTR, I_PIVR, IPOS+1+2*LIELL, IW, LIW)
631.EQ. IF (NPIV(IW(I_PIVRPTR+IPANEL-1)-1)) THEN
632 MUST_BE_PERMUTED=.FALSE.
633 ELSE
634 CALL CMUMPS_PERMUTE_PANEL(
635 & IW( I_PIVR+ IW(I_PIVRPTR+IPANEL-1)-
636 & IW(I_PIVRPTR)),
637 & NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
638 & IW(I_PIVRPTR+IPANEL-1)-1,
639 & A(APOSDEB),
640 & LDAJ, NBJ, J-1 )
641 ENDIF
642 ENDIF
643 NUPDATE_PANEL = LDAJ - NBJ
644 PPIV_PANEL = PPIV_COURANT+int(J-1,8)
645 PCB_PANEL = PPIV_PANEL+int(NBJ,8)
646 APOS1 = APOSDEB+int(NBJ,8)
647.EQ. IF (MTYPE1) THEN
648#if defined(MUMPS_USE_BLAS2)
649 IF ( NRHS_B == 1 ) THEN
650 CALL ctrsv( 'l', 'n', 'u', NBJ, A(APOSDEB), LDAJ,
651 & WCB(PPIV_PANEL), 1 )
652.GT. IF (NUPDATE_PANEL0) THEN
653 CALL cgemv('n', NUPDATE_PANEL,NBJ,ALPHA, A(APOS1),
654 & LDAJ, WCB(PPIV_PANEL), 1, ONE,
655 & WCB(PCB_PANEL), 1)
656 ENDIF
657 ELSE
658#endif
659 CALL ctrsm( 'l','l','n','u', NBJ, NRHS_B, ONE,
660 & A(APOSDEB), LDAJ, WCB(PPIV_PANEL),
661 & LIELL )
662.GT. IF (NUPDATE_PANEL0) THEN
663 CALL cgemm('n', 'n', NUPDATE_PANEL, NRHS_B, NBJ,
664 & ALPHA,
665 & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE,
666 & WCB(PCB_PANEL), LIELL)
667 ENDIF
668#if defined(MUMPS_USE_BLAS2)
669 ENDIF
670#endif
671 ELSE
672#if defined(MUMPS_USE_BLAS2)
673 IF (NRHS_B == 1) THEN
674 CALL ctrsv( 'l', 'n', 'n', NBJ, A(APOSDEB), LDAJ,
675 & WCB(PPIV_PANEL), 1 )
676.GT. IF (NUPDATE_PANEL0) THEN
677 CALL cgemv('n',NUPDATE_PANEL, NBJ, ALPHA, A(APOS1),
678 & LDAJ, WCB(PPIV_PANEL), 1,
679 & ONE, WCB(PCB_PANEL), 1 )
680 ENDIF
681 ELSE
682#endif
683 CALL ctrsm('l','l','n','n',NBJ, NRHS_B, ONE,
684 & A(APOSDEB), LDAJ, WCB(PPIV_PANEL),
685 & LIELL)
686.GT. IF (NUPDATE_PANEL0) THEN
687 CALL cgemm('n', 'n', NUPDATE_PANEL, NRHS_B, NBJ,
688 & ALPHA,
689 & A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE,
690 & WCB(PCB_PANEL), LIELL)
691 ENDIF
692#if defined(MUMPS_USE_BLAS2)
693 ENDIF
694#endif
695 ENDIF
696 APOSDEB = APOSDEB+int(LDAJ,8)*int(NBJ,8)
697 J=JFIN+1
698.LE. IF ( J NPIV ) GOTO 10
699 ELSE
700.GE..AND. IF ( IW(PTRIST(STEP(INODE))+XXLR) 2
701.EQ. & KEEP(485) 1 ) THEN
702 IWHDLR = IW(PTRIST(STEP(INODE))+XXF)
703 CALL CMUMPS_SOL_FWD_LR_SU (
704 & INODE, N, IWHDLR, NPIV, NSLAVES,
705 & IW, IPOS, LIW,
706 & LIELL, WCB, LWCB,
707 & LD_WCBPIV, LD_WCBCB,
708 & PPIV_COURANT, PCB_COURANT,
709 & RHSCOMP, LRHSCOMP, NRHS,
710 & POSINRHSCOMP_FWD, JBDEB, JBFIN,
711 & MTYPE, KEEP, KEEP8, OOCWRITE_COMPATIBLE_WITH_BLR,
712 & INFO(1), INFO(2) )
713.LT. IF (INFO(1)0) THEN
714 ERROR_WAS_BROADCASTED = .FALSE.
715 GOTO 270
716 ENDIF
717.GT..AND..NE. ELSE IF ( KEEP(459) 1 KEEP(50) 0 ) THEN
718 CALL CMUMPS_SOLVE_FWD_PANELS(
719 & A, LA, APOS,
720 & NPIV, IW(IPOS+LIELL+1),
721 & NRHS_B, WCB, LWCB, LD_WCBPIV,
722 & PPIV_COURANT, MTYPE, KEEP)
723 ELSE
724 CALL CMUMPS_SOLVE_FWD_TRSOLVE (
725 & A, LA, APOS,
726 & NPIV, LDADIAG,
727 & NRHS_B, WCB, LWCB, LD_WCBPIV,
728 & PPIV_COURANT, MTYPE, KEEP)
729 ENDIF
730 END IF
731 END IF
732 NCB = LIELL - NPIV
733.EQ. IF ( MTYPE 1 ) THEN
734.EQ..OR..eq. IF ( NSLAVES 0 NPIV 0 ) THEN
735 NUPDATE = NCB
736 ELSE
737 NUPDATE = NELIM
738 END IF
739.GT..AND..NE. IF (KEEP(459) 1 KEEP(50) 0) THEN
740 CALL MUMPS_GETI8(APOS1, IW(PTRIST(STEP(INODE))+XXR))
741 APOS1 = APOS + APOS1 - int(NPIV,8)*int(NUPDATE,8)
742 ELSE
743 APOS1 = APOS + int(NPIV,8) * int(LDADIAG,8)
744 ENDIF
745 ELSE
746 APOS1 = APOS + int(NPIV,8)
747 NUPDATE = NCB
748 END IF
749.NE. IF (KEEP(201)1) THEN
750.LT..OR. IF ( IW(PTRIST(STEP(INODE))+XXLR) 2
751.EQ. & KEEP(485)0) THEN
752.EQ. IF (MTYPE 1) THEN
753 LDAtemp = NPIV
754 ELSE
755 LDAtemp = LIELL
756 ENDIF
757 CALL CMUMPS_SOLVE_GEMM_UPDATE
758 & (A, LA, APOS1,
759 & NPIV, LDAtemp, NUPDATE,
760 & NRHS_B, WCB, LWCB, PPIV_COURANT, LD_WCBPIV,
761 & PCB_COURANT, LD_WCBCB,
762 & MTYPE, KEEP, ONE)
763 ENDIF
764 END IF
765.LT..OR. IF ( IW(PTRIST(STEP(INODE))+XXLR) 2
766.EQ. & KEEP(485)0) THEN
767.GT..AND. IF (KEEP(201) 0 OOCWRITE_COMPATIBLE_WITH_BLR) THEN
768 CALL CMUMPS_SOL_LD_AND_RELOAD(
769 & INODE, N, NPIV, LIELL, NELIM, NSLAVES,
770 & PPIV_COURANT,
771 & IW, IPOS, LIW,
772 & A, LA, APOS,
773 & WCB, LWCB, LD_WCBPIV,
774 & RHSCOMP, LRHSCOMP, NRHS,
775 & POSINRHSCOMP_FWD, JBDEB, JBFIN,
776 & MTYPE, KEEP, OOCWRITE_COMPATIBLE_WITH_BLR,
777 & .FALSE.
778 & )
779 ELSE
780 CALL CMUMPS_SOL_LD_AND_RELOAD_PANEL (
781 & INODE, N, NPIV, LIELL, NELIM, NSLAVES,
782 & PPIV_COURANT,
783 & IW, IPOS, LIW,
784 & A, LA, APOS,
785 & WCB, LWCB, LD_WCBPIV,
786 & RHSCOMP, LRHSCOMP, NRHS,
787 & POSINRHSCOMP_FWD, JBDEB, JBFIN,
788 & MTYPE, KEEP, OOCWRITE_COMPATIBLE_WITH_BLR,
789 & .FALSE.
790 & )
791 ENDIF
792 ENDIF
793.EQ..AND. IF ((KEEP(201)1)OOCWRITE_COMPATIBLE_WITH_BLR)
794 &THEN
795 CALL CMUMPS_FREE_FACTORS_FOR_SOLVE(INODE,PTRFAC,KEEP(28),
796 & A,LA,.TRUE.,IERR)
797.LT. IF(IERR0)THEN
798 INFO(1)=IERR
799 INFO(2)=0
800 ERROR_WAS_BROADCASTED = .FALSE.
801 GOTO 270
802 ENDIF
803 END IF
804.EQ. IF ( FPERE 0 ) THEN
805 PLEFTWCB = PLEFTWCB - int(LIELL,8) *int(NRHS_B,8)
806 GOTO 270
807 ENDIF
808.NE..OR..EQ. IF ( NUPDATE 0 NCB0 ) THEN
809 IF (MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)),
810.EQ. & KEEP(199)) MYID) THEN
811.ne. IF ( NCB 0 ) THEN
812 PTRICB(STEP(INODE)) = NCB + 1
813 NUPDATE_NONCRITICAL = NUPDATE
814.LE. IF (LASTFSL0DYN N) THEN
815.EQ. IF ( LASTFSL0DYN 0 ) THEN
816 IPOSINRHSCOMPLASTFSDYN = 0
817 ELSE
818 IPOSINRHSCOMPLASTFSDYN =
819 & abs(POSINRHSCOMP_FWD(LASTFSL0DYN))
820 ENDIF
821 DO I = 1, NUPDATE
822.GT. IF ( abs(POSINRHSCOMP_FWD( IW(J3+I) ))
823 & IPOSINRHSCOMPLASTFSDYN ) THEN
824.GT. IF (abs(STEP(IW(J3+I)))
825 & abs(STEP( LASTFSL0STA))
826.OR..NE. & KEEP(261) 1) THEN
827 NUPDATE_NONCRITICAL = I - 1
828 EXIT
829 ENDIF
830 ENDIF
831 ENDDO
832 ENDIF
833 OMP_FLAG = .FALSE.
834.GE..AND.!$ OMP_FLAG = ( NRHS_BKEEP(362)
835.GE.!$ & (NUPDATE*NRHS_B KEEP(363)) )
836 IF (OMP_FLAG) THEN
837!$OMP PARALLEL DO PRIVATE(I,IFR8,IPOSINRHSCOMP_TMP)
838 DO K = JBDEB, JBFIN
839 IFR8 = PCB_COURANT + int(K-JBDEB,8)*int(LD_WCBCB,8)
840#if defined(__ve__)
841!NEC$ IVDEP
842#endif
843 DO I = 1, NUPDATE_NONCRITICAL
844 IPOSINRHSCOMP_TMP =
845 & abs(POSINRHSCOMP_FWD(IW(J3 + I)))
846 RHSCOMP( IPOSINRHSCOMP_TMP, K ) =
847 & RHSCOMP( IPOSINRHSCOMP_TMP, K )
848 & + WCB(IFR8 + int(I-1,8))
849 ENDDO
850 ENDDO
851!$OMP END PARALLEL DO
852 ELSE
853 DO K = JBDEB, JBFIN
854 IFR8 = PCB_COURANT + int(K-JBDEB,8)*int(LD_WCBCB,8)
855#if defined(__ve__)
856!NEC$ IVDEP
857#endif
858 DO I = 1, NUPDATE_NONCRITICAL
859 IPOSINRHSCOMP_TMP =
860 & abs(POSINRHSCOMP_FWD(IW(J3 + I)))
861 RHSCOMP( IPOSINRHSCOMP_TMP, K ) =
862 & RHSCOMP( IPOSINRHSCOMP_TMP, K )
863 & + WCB(IFR8 + int(I-1,8))
864 ENDDO
865 ENDDO
866 ENDIF
867 IF ( CBINITZERO ) THEN
868.NE. IF ( NUPDATE NUPDATE_NONCRITICAL) THEN
869 NB_LOCK = 1
870.NOT..AND..GT. IF (DO_NBSPARSE(KEEP(400)1)) THEN
871 NB_LOCK = min(KEEP(400),NB_LOCK_MAX)
872 ENDIF
873 SIZEBLOCK = (JBFIN-JBDEB+1+NB_LOCK-1) / NB_LOCK
874 DO NB = 1, NB_LOCK
875 JCourant = JBDEB+SIZEBLOCK*(NB-1)
876!$ CALL OMP_SET_LOCK(LOCK_FOR_SCATTER(NB))
877 DO K = Jcourant, min(JBFIN,Jcourant+SIZEBLOCK-1)
878 IFR8 = PCB_COURANT + int(K-JBDEB,8)*int(LD_WCBCB,8)
879#if defined(__ve__)
880!NEC$ IVDEP
881#endif
882 DO I = NUPDATE_NONCRITICAL+1, NUPDATE
883 IPOSINRHSCOMP_TMP =
884 & abs(POSINRHSCOMP_FWD(IW(J3 + I)))
885 RHSCOMP( IPOSINRHSCOMP_TMP, K ) =
886 & RHSCOMP( IPOSINRHSCOMP_TMP, K )
887 & + WCB(IFR8 + int(I-1,8))
888 ENDDO
889 ENDDO
890!$ CALL OMP_UNSET_LOCK(LOCK_FOR_SCATTER(NB))
891 ENDDO
892 ENDIF
893 ENDIF
894 PTRICB(STEP( INODE )) = PTRICB(STEP( INODE )) - NUPDATE
895 ELSE
896 PTRICB(STEP( INODE )) = -1
897 ENDIF
898 ELSE
899 210 CONTINUE
900 CALL CMUMPS_BUF_SEND_VCB( NRHS_B, INODE, FPERE,
901 & NCB, LD_WCBCB,
902 & NUPDATE,
903 & IW( J3 + 1 ), WCB( PCB_COURANT ), JBDEB, JBFIN,
904 & RHSCOMP, 1, 1, -9999, -9999,
905 & KEEP,
906 & MUMPS_PROCNODE(PROCNODE_STEPS(STEP(FPERE)), KEEP(199)),
907 & ContVec,
908 & COMM, IERR )
909.EQ. IF ( IERR -1 ) THEN
910 CALL CMUMPS_SOLVE_RECV_AND_TREAT( .FALSE., FLAG,
911 & BUFR, LBUFR, LBUFR_BYTES,
912 & MYID, SLAVEF, COMM,
913 & N, NRHS, IPOOL, LPOOL, LEAF,
914 & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
915 & IWCB, LIWCB,
916 & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
917 & PTRICB, INFO, KEEP,KEEP8, DKEEP, STEP,
918 & PROCNODE_STEPS,
919 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD
920 & , FROM_PP
921 & )
922.LT. IF ( INFO( 1 ) 0 ) THEN
923 ERROR_WAS_BROADCASTED = .TRUE.
924 GOTO 270
925 ENDIF
926 GOTO 210
927.EQ. ELSE IF ( IERR -2 ) THEN
928 INFO( 1 ) = -17
929 INFO( 2 ) = NUPDATE * KEEP( 35 ) +
930 & ( NUPDATE + 3 ) * KEEP( 34 )
931 ERROR_WAS_BROADCASTED = .FALSE.
932 GOTO 270
933.EQ. ELSE IF ( IERR -3 ) THEN
934 INFO( 1 ) = -20
935 INFO( 2 ) = NUPDATE * KEEP( 35 ) +
936 & ( NUPDATE + 3 ) * KEEP( 34 )
937 ERROR_WAS_BROADCASTED = .FALSE.
938 GOTO 270
939 END IF
940 ENDIF
941 END IF
942.NE..AND..eq. IF ( NSLAVES 0 MTYPE 1
943.and..NE. & NPIV 0 ) THEN
944 DO ISLAVE = 1, NSLAVES
945 PDEST = IW( PTRIST(STEP(INODE)) + 5 + ISLAVE +KEEP(IXSZ))
946 CALL MUMPS_BLOC2_GET_SLAVE_INFO(
947 & KEEP,KEEP8, INODE, STEP, N, SLAVEF,
948 & ISTEP_TO_INIV2, TAB_POS_IN_PERE,
949 & ISLAVE, NCB - NELIM,
950 & NSLAVES,
951 & Effective_CB_Size, FirstIndex )
952 222 CONTINUE
953 CALL CMUMPS_BUF_SEND_MASTER2SLAVE( NRHS_B,
954 & INODE, FPERE,
955 & Effective_CB_Size, LD_WCBCB, LD_WCBPIV, NPIV,
956 & JBDEB, JBFIN,
957 & WCB( PCB_COURANT + NELIM + FirstIndex - 1 ),
958 & WCB( PPIV_COURANT ),
959 & PDEST, COMM, KEEP, IERR )
960.EQ. IF ( IERR -1 ) THEN
961 CALL CMUMPS_SOLVE_RECV_AND_TREAT( .FALSE., FLAG,
962 & BUFR, LBUFR, LBUFR_BYTES,
963 & MYID, SLAVEF, COMM,
964 & N, NRHS, IPOOL, LPOOL, LEAF,
965 & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC,
966 & IWCB, LIWCB,
967 & WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
968 & PTRICB, INFO, KEEP,KEEP8, DKEEP, STEP,
969 & PROCNODE_STEPS,
970 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD
971 & , FROM_PP
972 & )
973.LT. IF ( INFO( 1 ) 0 ) THEN
974 ERROR_WAS_BROADCASTED = .TRUE.
975 GOTO 270
976 ENDIF
977 GOTO 222
978.EQ. ELSE IF ( IERR -2 ) THEN
979 INFO( 1 ) = -17
980 INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS_B*KEEP(35) +
981 & 6 * KEEP( 34 )
982 ERROR_WAS_BROADCASTED = .FALSE.
983 GOTO 270
984.EQ. ELSE IF ( IERR -3 ) THEN
985 INFO( 1 ) = -20
986 INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS_B*KEEP(35) +
987 & 6 * KEEP( 34 )
988 ERROR_WAS_BROADCASTED = .FALSE.
989 GOTO 270
990 END IF
991 END DO
992 END IF
993 PLEFTWCB = PLEFTWCB - int(LIELL,8)*int(NRHS_B,8)
994 270 CONTINUE
995 RETURN
996 END SUBROUTINE CMUMPS_SOLVE_NODE_FWD
997 RECURSIVE SUBROUTINE CMUMPS_SOLVE_RECV_AND_TREAT( BLOQ, FLAG,
998 & BUFR, LBUFR, LBUFR_BYTES,
999 & MYID, SLAVEF, COMM,
1000 & N, NRHS, IPOOL, LPOOL, LEAF,
1001 & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC,
1002 & IWCB, LIWCB,
1003 & WCB, LWCB, POSWCB,
1004 & PLEFTWCB, POSIWCB,
1005 & PTRICB, INFO, KEEP,KEEP8, DKEEP, STEP, PROCNODE_STEPS,
1006 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD
1007 & , FROM_PP
1008 & )
1009 IMPLICIT NONE
1010 LOGICAL BLOQ
1011 INTEGER LBUFR, LBUFR_BYTES
1012 INTEGER MYID, SLAVEF, COMM
1013 INTEGER N, NRHS, LPOOL, LEAF, NBFIN
1014 INTEGER LIWCB, POSIWCB
1015 INTEGER(8) :: POSWCB, PLEFTWCB
1016 INTEGER LIW
1017 INTEGER(8), INTENT(IN) :: LA, LWCB
1018 INTEGER INFO( 80 ), KEEP( 500)
1019 INTEGER(8) KEEP8(150)
1020 REAL, INTENT(INOUT) :: DKEEP(230)
1021 INTEGER BUFR( LBUFR ), IPOOL(LPOOL)
1022 INTEGER NSTK_S( KEEP(28) )
1023 INTEGER IWCB( LIWCB )
1024 INTEGER IW( LIW )
1025 COMPLEX WCB( LWCB ), A( LA )
1026 INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28))
1027 INTEGER(8) :: PTRFAC(KEEP(28))
1028 INTEGER STEP(N)
1029 INTEGER PROCNODE_STEPS(KEEP(28))
1030 LOGICAL FLAG
1031 INTEGER LRHSCOMP, POSINRHSCOMP_FWD(N)
1032 COMPLEX RHSCOMP(LRHSCOMP,NRHS)
1033 LOGICAL, intent(in) :: FROM_PP
1034 INCLUDE 'mpif.h'
1035 INCLUDE 'mumps_tags.h'
1036 INTEGER :: IERR
1037 INTEGER :: STATUS(MPI_STATUS_SIZE)
1038 INTEGER MSGSOU, MSGTAG, MSGLEN
1039 FLAG = .FALSE.
1040 IF ( BLOQ ) THEN
1041 FLAG = .FALSE.
1042 CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG,
1043 & COMM, STATUS, IERR )
1044 FLAG = .TRUE.
1045 ELSE
1046 CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM,
1047 & FLAG, STATUS, IERR )
1048 END IF
1049 IF ( FLAG ) THEN
1050 KEEP(266) = KEEP(266) -1
1051 MSGSOU = STATUS( MPI_SOURCE )
1052 MSGTAG = STATUS( MPI_TAG )
1053 CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN, IERR )
1054.GT. IF ( MSGLEN LBUFR_BYTES ) THEN
1055 INFO(1) = -20
1056 INFO(2) = MSGLEN
1057 CALL CMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
1058 ELSE
1059 CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED,
1060 & MSGSOU, MSGTAG, COMM, STATUS, IERR )
1061 CALL CMUMPS_TRAITER_MESSAGE_SOLVE( BUFR, LBUFR, LBUFR_BYTES,
1062 & MSGTAG, MSGSOU, MYID, SLAVEF, COMM,
1063 & N, NRHS, IPOOL, LPOOL, LEAF,
1064 & NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
1065 & IWCB, LIWCB,
1066 & WCB, LWCB, POSWCB,
1067 & PLEFTWCB, POSIWCB,
1068 & PTRICB, INFO, KEEP,KEEP8, DKEEP, STEP,
1069 & PROCNODE_STEPS,
1070 & RHSCOMP, LRHSCOMP, POSINRHSCOMP_FWD
1071 & , FROM_PP
1072 & )
1073 END IF
1074 END IF
1075 RETURN
1076 END SUBROUTINE CMUMPS_SOLVE_RECV_AND_TREAT
1077 SUBROUTINE CMUMPS_RHSCOMP_TO_WCB(
1078 & NPIV, NCB, LIELL, CBINITZERO, LDEQLIELLPANEL,
1079 & RHSCOMP, LRHSCOMP, NRHS_B,
1080 & POSINRHSCOMP_FWD, N,
1081 & WCB,
1082 & IW, LIW, J1, J3, J2, KEEP, DKEEP)
1083 IMPLICIT NONE
1084 INTEGER, INTENT( IN ) :: NPIV, NCB, LIELL, N,
1085 & LRHSCOMP, NRHS_B,
1086 & LIW, J1, J2, J3
1087 LOGICAL, INTENT( IN ) :: LDEQLIELLPANEL
1088 LOGICAL, INTENT( IN ) :: CBINITZERO
1089 INTEGER, INTENT( IN ) :: POSINRHSCOMP_FWD( N ), IW( LIW )
1090 COMPLEX, INTENT( INOUT ) :: RHSCOMP( LRHSCOMP, NRHS_B )
1091 COMPLEX, INTENT( OUT ) :: WCB( int(LIELL,8)*
1092 & int(NRHS_B,8) )
1093 INTEGER :: KEEP(500)
1094 REAL :: DKEEP(150)
1095 INTEGER, PARAMETER :: ZERO = (0.0E0,0.0E0)
1096 INTEGER(8), PARAMETER :: PPIV_COURANT = 1_8
1097 INTEGER(8) :: PCB_COURANT
1098 INTEGER :: LD_WCBCB, LD_WCBPIV, J, JJ, K, IPOSINRHSCOMP
1099 INTEGER(8) :: IFR8, IFR_ini8
1100 INCLUDE 'mpif.h'
1101 LOGICAL :: OMP_FLAG
1102 IF ( LDEQLIELLPANEL ) THEN
1103 LD_WCBPIV = LIELL
1104 LD_WCBCB = LIELL
1105 PCB_COURANT = PPIV_COURANT + NPIV
1106 ELSE
1107 LD_WCBPIV = NPIV
1108 LD_WCBCB = NCB
1109 PCB_COURANT = PPIV_COURANT + NPIV * NRHS_B
1110 ENDIF
1111 IF ( LDEQLIELLPANEL ) THEN
1112 DO K=1, NRHS_B
1113 IFR8 = PPIV_COURANT+int(K-1,8)*int(LD_WCBPIV,8)-1_8
1114 IPOSINRHSCOMP = POSINRHSCOMP_FWD(IW(J1))
1115 DO JJ = J1, J3
1116 IFR8 = IFR8 + 1_8
1117 WCB(IFR8) = RHSCOMP(IPOSINRHSCOMP,K)
1118 IPOSINRHSCOMP = IPOSINRHSCOMP + 1
1119 ENDDO
1120.GT..AND..NOT. IF (NCB0 CBINITZERO) THEN
1121#if defined(__ve__)
1122!NEC$ IVDEP
1123#endif
1124 DO JJ = J3+1, J2
1125 J = IW(JJ)
1126 IFR8 = IFR8 + 1_8
1127 IPOSINRHSCOMP = abs(POSINRHSCOMP_FWD(J))
1128 WCB(IFR8) = RHSCOMP(IPOSINRHSCOMP,K)
1129 RHSCOMP (IPOSINRHSCOMP,K) = ZERO
1130 ENDDO
1131 ENDIF
1132 ENDDO
1133 ELSE
1134 PCB_COURANT = PPIV_COURANT + LD_WCBPIV*NRHS_B
1135 IFR8 = PPIV_COURANT - 1_8
1136 IFR_ini8 = IFR8
1137 IPOSINRHSCOMP = POSINRHSCOMP_FWD(IW(J1))
1138 OMP_FLAG = .FALSE.
1139.GE..AND.!$ OMP_FLAG = ( NRHS_B KEEP(362)
1140.GE.!$ & int(NCB,8)*int(NRHS_B,8) KEEP(363) )
1141 IF (OMP_FLAG) THEN
1142!$OMP PARALLEL DO PRIVATE(JJ,IFR8)
1143 DO K=1, NRHS_B
1144 IFR8 = IFR_ini8 + int(K-1,8)*int(NPIV,8)
1145 DO JJ = J1, J3
1146 WCB(IFR8+int(JJ-J1+1,8)) =
1147 & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K)
1148 ENDDO
1149 ENDDO
1150!$OMP END PARALLEL DO
1151 ELSE
1152 DO K=1, NRHS_B
1153 IFR8 = IFR_ini8 + int(K-1,8)*int(NPIV,8)
1154 DO JJ = J1, J3
1155 WCB(IFR8+int(JJ-J1+1,8)) =
1156 & RHSCOMP(IPOSINRHSCOMP+JJ-J1,K)
1157 ENDDO
1158 ENDDO
1159 ENDIF
1160 IFR8 = PCB_COURANT - 1_8
1161.GT..AND..NOT. IF (NCB0 CBINITZERO) THEN
1162 IFR_ini8 = IFR8
1163 OMP_FLAG = .FALSE.
1164.GE..AND.!$ OMP_FLAG = ( NRHS_BKEEP(362)
1165.GE.!$ & NCB*NRHS_B KEEP(363) )
1166 IF (OMP_FLAG) THEN
1167!$OMP PARALLEL DO PRIVATE (IFR8, JJ, J, IPOSINRHSCOMP)
1168 DO K=1, NRHS_B
1169 IFR8 = IFR_ini8+(K-1)*NCB
1170#if defined(__ve__)
1171!NEC$ IVDEP
1172#endif
1173 DO JJ = J3 + 1, J2
1174 J = IW(JJ)
1175 IPOSINRHSCOMP = abs(POSINRHSCOMP_FWD(J))
1176 WCB(IFR8+int(JJ-J3,8)) = RHSCOMP(IPOSINRHSCOMP,K)
1177 RHSCOMP(IPOSINRHSCOMP,K)=ZERO
1178 ENDDO
1179 ENDDO
1180!$OMP END PARALLEL DO
1181 ELSE
1182 DO K=1, NRHS_B
1183 IFR8 = IFR_ini8+(K-1)*NCB
1184#if defined(__ve__)
1185!NEC$ IVDEP
1186#endif
1187 DO JJ = J3 + 1, J2
1188 J = IW(JJ)
1189 IPOSINRHSCOMP = abs(POSINRHSCOMP_FWD(J))
1190 WCB(IFR8+int(JJ-J3,8)) = RHSCOMP(IPOSINRHSCOMP,K)
1191 RHSCOMP(IPOSINRHSCOMP,K)=ZERO
1192 ENDDO
1193 ENDDO
1194 ENDIF
1195 ENDIF
1196 ENDIF
1197 IF ( CBINITZERO ) THEN
1198 OMP_FLAG = .FALSE.
1199.GE.!$ OMP_FLAG = int(NCB,8)*int(NRHS_B,8) KEEP(363)
1200 IF (OMP_FLAG) THEN
1201!$OMP PARALLEL DO COLLAPSE(2)
1202 DO K = 1, NRHS_B
1203 DO JJ = 1, NCB
1204 WCB(PCB_COURANT+int(K-1,8)*int(LD_WCBCB,8)+JJ-1_8) = ZERO
1205 ENDDO
1206 ENDDO
1207!$OMP END PARALLEL DO
1208 ELSE
1209 DO K = 1, NRHS_B
1210 DO JJ = 1, NCB
1211 WCB(PCB_COURANT+int(K-1,8)*int(LD_WCBCB,8)+JJ-1_8) = ZERO
1212 ENDDO
1213 ENDDO
1214 ENDIF
1215 ENDIF
1216 RETURN
1217 END SUBROUTINE CMUMPS_RHSCOMP_TO_WCB
cmumps_solve_node_fwd
subroutine cmumps_solve_node_fwd(inode, lastfsl0sta, lastfsl0dyn, bufr, lbufr, lbufr_bytes, myid, slavef, comm, n, ipool, lpool, leaf, nbfin, nstk_s, iwcb, liwcb, wcb, lwcb, a, la, iw, liw, nrhs, poswcb, pleftwcb, posiwcb, ptricb, ptrist, ptrfac, procnode_steps, fils, step, frere, dad, info, keep, keep8, dkeep, rhs_root, lrhs_root, mtype, rhscomp, lrhscomp, posinrhscomp_fwd istep_to_iniv2, tab_pos_in_pere, rhs_bounds, lrhs_bounds, do_nbsparse, from_pp, error_was_broadcasted)
Definition csol_fwd_aux.F:365
cmumps_traiter_message_solve
recursive subroutine cmumps_traiter_message_solve(bufr, lbufr, lbufr_bytes, msgtag, msgsou, myid, slavef, comm, n, nrhs, ipool, lpool, leaf, nbfin, nstk_s, iw, liw, a, la, ptrist, ptrfac, iwcb, liwcb, wcb, lwcb, poswcb, pleftwcb, posiwcb, ptricb, info, keep, keep8, dkeep, step, procnode_steps, rhscomp, lrhscomp, posinrhscomp_fwd, from_pp)
Definition csol_fwd_aux.F:27
cmumps_buf
Definition cmumps_comm_buffer.F:14
cmumps_ooc
Definition cmumps_ooc.F:14
cmumps_sol_lr
Definition csol_lr.F:14
cmumps_sol_lr::cmumps_sol_slave_lr_u
subroutine cmumps_sol_slave_lr_u(inode, iwhdlr, npiv_global, wcb, lwcb, ldx, ldy, ptrx_init, ptry_init, jbdeb, jbfin, mtype, keep, keep8, iflag, ierror)
Definition csol_lr.F:189