« back to all changes in this revision
Viewing changes to src/zmumps_part8.F
- browse files at revision 5
- compare with another revision
- download diff
- download tarball
- view history from revision 5
- Committer: Bazaar Package Importer
- Author(s): Adam C. Powell, IV
- Date: 2009-12-07 17:56:51 UTC
- mfrom: (1.1.1 upstream)
- Revision ID: james.westby@ubuntu.com-20091207175651-ftogh061hebcqzty
Tags: 4.9.2.dfsg-1
* New upstream release (closes: #554159).
* Changed -lblas to -lblas-3gf in Makefile.*.inc (closes: #557699).
* Linking tests to shared instead of static libs (closes: #555759).
* Changed -lblas to -lblas-3gf in Makefile.*.inc (closes: #557699).
* Linking tests to shared instead of static libs (closes: #555759).
- files added:
- debian/libmumps-4.9.2.install
- files removed:
- Make.inc/Makefile.PC.PAR
- files modified:
- ChangeLog
added
removed
src/zmumps_part8.F
1
1
C
2
C This file is part of MUMPS 4.8.4, built on Mon Dec 15 15:31:38 UTC 2008
2
C This file is part of MUMPS 4.9.2, built on Thu Nov 5 07:05:08 UTC 2009
3
3
C
4
4
C
5
5
C This version of MUMPS is provided to you free of charge. It is public
6
6
C domain, based on public domain software developed during the Esprit IV
7
7
C European project PARASOL (1996-1999) by CERFACS, ENSEEIHT-IRIT and RAL.
8
8
C Since this first public domain version in 1999, the developments are
9
C supported by the following institutions: CERFACS, ENSEEIHT-IRIT, and
10
C INRIA.
9
C supported by the following institutions: CERFACS, CNRS, INPT(ENSEEIHT)-
10
C IRIT, and INRIA.
11
11
C
12
C Main contributors are Patrick Amestoy, Iain Duff, Abdou Guermouche,
13
C Jacko Koster, Jean-Yves L'Excellent, and Stephane Pralet.
12
C Current development team includes Patrick Amestoy, Alfredo Buttari,
13
C Abdou Guermouche, Jean-Yves L'Excellent, Bora Ucar.
14
14
C
15
15
C Up-to-date copies of the MUMPS package can be obtained
16
16
C from the Web pages:
23
23
C
24
24
C User documentation of any code that uses this software can
25
25
C include this complete notice. You can acknowledge (using
26
C references [1], [2], and [3]) the contribution of this package
26
C references [1] and [2]) the contribution of this package
27
27
C in any scientific publication dependent upon the use of the
28
28
C package. You shall use reasonable endeavours to notify
29
29
C the authors of the package of this publication.
30
30
C
31
C [1] P. R. Amestoy, I. S. Duff and J.-Y. L'Excellent,
32
C Multifrontal parallel distributed symmetric and unsymmetric solvers,
33
C in Comput. Methods in Appl. Mech. Eng., 184, 501-520 (2000).
34
C
35
C [2] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent,
31
C [1] P. R. Amestoy, I. S. Duff, J. Koster and J.-Y. L'Excellent,
36
32
C A fully asynchronous multifrontal solver using distributed dynamic
37
33
C scheduling, SIAM Journal of Matrix Analysis and Applications,
38
34
C Vol 23, No 1, pp 15-41 (2001).
39
35
C
40
C [3] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and
36
C [2] P. R. Amestoy and A. Guermouche and J.-Y. L'Excellent and
41
37
C S. Pralet, Hybrid scheduling for the parallel solution of linear
42
38
C systems. Parallel Computing Vol 32 (2), pp 136-156 (2006).
43
39
C
45
41
USE ZMUMPS_STRUC_DEF
46
42
USE ZMUMPS_COMM_BUFFER
47
43
USE ZMUMPS_OOC
44
USE TOOLS_COMMON
48
45
IMPLICIT NONE
49
#ifndef SUN_
50
46
INTERFACE
51
47
SUBROUTINE ZMUMPS_710( id, NB_INT,NB_CMPLX )
52
48
USE ZMUMPS_STRUC_DEF
54
50
INTEGER*8 :: NB_INT,NB_CMPLX
55
51
END SUBROUTINE ZMUMPS_710
56
52
END INTERFACE
57
#endif
58
53
INCLUDE 'mpif.h'
59
54
INCLUDE 'mumps_headers.h'
60
55
#if defined(V_T)
72
67
INTEGER I,K,JPERM, J, II
73
68
INTEGER IZ, NZ_THIS_BLOCK, IRHS_PTR_BEG, SHIFT_PTR
74
69
INTEGER LIW,LIWW
75
INTEGER LA, LIW_PASSED, LA_PASSED
70
INTEGER(8) :: LA, LA_PASSED
71
INTEGER LIW_PASSED
76
72
INTEGER LWCB_MIN, LWCB
73
INTEGER(8) :: TMP_LWCB8
77
74
INTEGER ZMUMPS_LBUF, ZMUMPS_LBUF_INT
78
75
INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF,
79
* IBEG_GLOB_DEF, IEND_GLOB_DEF,
80
* IROOT_DEF_RHS_COL1
76
& IBEG_GLOB_DEF, IEND_GLOB_DEF,
77
& IROOT_DEF_RHS_COL1
81
78
INTEGER NITREF, NOITER, SOLVET, KASE, JOBIREF
82
79
COMPLEX*16 RSOL(1)
80
LOGICAL INTERLEAVE_PAR, DO_PERMUT_RHS
83
81
DOUBLE PRECISION ZERO, ONE
84
82
PARAMETER( ZERO = 0.0D0, ONE = 1.0D0 )
85
83
COMPLEX*16, DIMENSION(:), POINTER :: RHS_MUMPS
86
84
COMPLEX*16, DIMENSION(:), POINTER :: WORK_WCB
87
COMPLEX*16, ALLOCATABLE :: SAVERHS(:), RW1(:),
88
* RW2(:), SRW1(:),
89
& SRW3(:),
90
* Y(:), W(:), D(:)
85
COMPLEX*16, ALLOCATABLE :: SAVERHS(:), C_RW1(:),
86
& C_RW2(:),
87
& SRW3(:), C_Y(:),
88
& C_W(:)
89
COMPLEX*16, ALLOCATABLE :: CWORK(:)
90
DOUBLE PRECISION, ALLOCATABLE :: R_RW1(:), R_Y(:), D(:)
91
DOUBLE PRECISION, ALLOCATABLE :: R_W(:)
92
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:) :: R_LOCWK54
93
COMPLEX*16, ALLOCATABLE, DIMENSION(:) :: C_LOCWK54
91
94
INTEGER, DIMENSION(:), ALLOCATABLE :: UNS_PERM_INV,
92
* POSINRHSCOMP_N
95
& POSINRHSCOMP_N
93
96
INTEGER LIWK_SOLVE, LIWCB
94
97
INTEGER, ALLOCATABLE :: IW1(:), IWK_SOLVE(:), IWCB(:)
95
98
INTEGER, POINTER :: N, NZ
96
INTEGER :: MAXS
99
INTEGER(8) :: MAXS
97
100
INTEGER, POINTER :: NRHS, LRHS
98
101
DOUBLE PRECISION, DIMENSION(:), POINTER :: CNTL
99
102
INTEGER, DIMENSION (:), POINTER :: KEEP,ICNTL,INFO
107
110
end type scaling_data_t
108
111
type (scaling_data_t) :: scaling_data
109
112
DOUBLE PRECISION ARRET
110
COMPLEX*16 DUMMY(1)
113
COMPLEX*16 C_DUMMY(1)
114
DOUBLE PRECISION R_DUMMY(1)
111
115
INTEGER IDUMMY(1), JDUMMY(1), KDUMMY(1), JJ, WHAT
112
116
INTEGER allocok, PERLU
113
117
INTEGER NBRHS, NBRHS_EFF, BEG_RHS,
115
119
& MASTER_ROOT, MASTER_ROOT_IN_COMM
116
120
INTEGER IPT_RHS_ROOT, SIZE_ROOT, LD_REDRHS
117
121
INTEGER IBEG_REDRHS, IBEG_RHSCOMP, LD_RHSCOMP, LENRHSCOMP
118
INTEGER NB_K133, IRANK
119
LOGICAL WORKSPACE_MINIMAL_PREFERRED
122
INTEGER NB_K133, IRANK, TSIZE
123
LOGICAL WORKSPACE_MINIMAL_PREFERRED, WK_USER_PROVIDED
120
124
INTEGER*8 NB_BYTES
121
125
INTEGER*8 NB_BYTES_MAX
122
126
INTEGER*8 NB_INT, NB_CMPLX, K34_8, K35_8, NB_BYTES_ON_ENTRY
127
INTEGER*8 K16_8, ITMP8
123
128
INTEGER, DIMENSION(:), POINTER :: IRHS_SPARSE_COPY
124
129
COMPLEX*16, DIMENSION(:), POINTER :: RHS_SPARSE_COPY
125
130
#if defined(V_T)
169
174
NB_BYTES_MAX = 0_8
170
175
K34_8 = int(KEEP(34), 8)
171
176
K35_8 = int(KEEP(35), 8)
177
K16_8 = int(KEEP(16), 8)
178
LSCAL = .FALSE.
179
WORK_WCB_ALLOCATED = .FALSE.
180
ICNTL20 = 0
181
ICNTL21 = 0
172
182
I_AM_SLAVE = ( id%MYID .ne. MASTER .OR.
173
* ( id%MYID .eq. MASTER .AND.
174
* KEEP(46) .eq. 1 ) )
183
& ( id%MYID .eq. MASTER .AND.
184
& KEEP(46) .eq. 1 ) )
175
185
CALL ZMUMPS_710(id, NB_INT,NB_CMPLX )
176
186
NB_BYTES = NB_BYTES + NB_INT * K34_8 + NB_CMPLX * K35_8
177
187
NB_BYTES_ON_ENTRY = NB_BYTES
178
188
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
189
INTERLEAVE_PAR =.FALSE.
190
DO_PERMUT_RHS =.FALSE.
191
WK_USER_PROVIDED = .FALSE.
179
192
BUILD_POSINRHSCOMP = .TRUE.
180
193
SIZE_ROOT = -33333
181
194
IF ( KEEP( 38 ) .ne. 0 ) THEN
182
195
MASTER_ROOT = MUMPS_275(id%STEP( KEEP(38)),
183
* id%PROCNODE_STEPS, id%NSLAVES )
196
& id%PROCNODE_STEPS, id%NSLAVES )
184
197
IF (id%MYID_NODES .eq. MASTER_ROOT) THEN
185
198
SIZE_ROOT = id%root%TOT_ROOT_SIZE
186
199
ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN
188
201
ENDIF
189
202
ELSE IF (KEEP( 20 ) .ne. 0 ) THEN
190
203
MASTER_ROOT = MUMPS_275(id%STEP(KEEP(20)),
191
* id%PROCNODE_STEPS, id%NSLAVES )
204
& id%PROCNODE_STEPS, id%NSLAVES )
192
205
IF (id%MYID_NODES .eq. MASTER_ROOT) THEN
193
206
SIZE_ROOT = id%IS(
194
* id%PTLUST_S(id%STEP(KEEP(20)))+KEEP(IXSZ))
207
& id%PTLUST_S(id%STEP(KEEP(20)))+KEEP(IXSZ))
195
208
ELSE IF ((id%MYID.EQ.MASTER).AND.KEEP(60).NE.0) THEN
196
209
SIZE_ROOT=id%SIZE_SCHUR
197
210
ENDIF
209
222
INFO(2)=1
210
223
ENDIF
211
224
IF (( KEEP(111) .LT. -1 ) .OR.
212
* (KEEP(111).GT.KEEP(112)+KEEP(17)) .OR.
213
* (KEEP(111) .EQ.-1 .AND. KEEP(112)+KEEP(17).EQ.0))
214
* THEN
225
& (KEEP(111).GT.KEEP(112)+KEEP(17)) .OR.
226
& (KEEP(111) .EQ.-1 .AND. KEEP(112)+KEEP(17).EQ.0))
227
& THEN
215
228
INFO(1)=-36
216
229
INFO(2)=KEEP(111)
217
230
ENDIF
218
231
ENDIF
219
232
CALL MUMPS_276( ICNTL, INFO,
220
* id%COMM,id%MYID)
233
& id%COMM,id%MYID)
221
234
IF (INFO(1) < 0) RETURN
222
235
CALL MPI_BCAST(KEEP(111),1,MPI_INTEGER,MASTER,
223
* id%COMM,IERR)
236
& id%COMM,IERR)
224
237
IF (id%MYID .eq. MASTER) THEN
225
238
KEEP(84) = ICNTL(27)
226
239
IF (KEEP(201) .EQ. 0 .OR. KEEP(84) .GT. 0) THEN
234
247
CALL VTBEGIN(glob_comm_ini,IERR)
235
248
#endif
236
249
CALL MPI_BCAST(NRHS,1,MPI_INTEGER,MASTER,
237
* id%COMM,IERR)
250
& id%COMM,IERR)
238
251
CALL MPI_BCAST(NBRHS,1,MPI_INTEGER,MASTER,
239
* id%COMM,IERR)
252
& id%COMM,IERR)
240
253
IF (KEEP(201).NE.0) THEN
241
254
WORKSPACE_MINIMAL_PREFERRED = .FALSE.
242
255
IF (id%MYID .eq. MASTER) THEN
247
260
ENDIF
248
261
ENDIF
249
262
CALL MPI_BCAST( KEEP(107), 1, MPI_INTEGER,
250
* MASTER, id%COMM, IERR )
263
& MASTER, id%COMM, IERR )
251
264
CALL MPI_BCAST( KEEP(204), 1, MPI_INTEGER,
252
* MASTER, id%COMM, IERR )
265
& MASTER, id%COMM, IERR )
253
266
CALL MPI_BCAST( KEEP(208), 2, MPI_INTEGER,
254
* MASTER, id%COMM, IERR )
267
& MASTER, id%COMM, IERR )
255
268
CALL MPI_BCAST( WORKSPACE_MINIMAL_PREFERRED, 1,
256
* MPI_LOGICAL,
257
* MASTER, id%COMM, IERR )
269
& MPI_LOGICAL,
270
& MASTER, id%COMM, IERR )
258
271
ENDIF
259
272
IF ( I_AM_SLAVE ) THEN
260
273
NB_K133 = 3
264
277
END IF
265
278
ENDIF
266
279
LWCB_MIN = NB_K133*KEEP(133)*NBRHS
267
IF (ASSOCIATED(id%S)) THEN
268
MAXS = size(id%S)
280
WK_USER_PROVIDED = (id%LWK_USER.NE.0)
281
IF (id%LWK_USER.EQ.0) THEN
282
ITMP8 = 0_8
283
ELSE IF (id%LWK_USER.GT.0) THEN
284
ITMP8= int(id%LWK_USER,8)
285
ELSE
286
ITMP8 = -int(id%LWK_USER,8)* 1000000_8
287
ENDIF
288
IF (KEEP(201).EQ.0) THEN
289
IF (ITMP8.NE.KEEP8(24)) THEN
290
INFO(1) = -41
291
INFO(2) = id%LWK_USER
292
GOTO 99
293
ENDIF
294
ELSE
295
KEEP8(24)=ITMP8
296
ENDIF
297
MAXS = 0_8
298
IF (WK_USER_PROVIDED) THEN
299
MAXS = KEEP8(24)
300
IF (MAXS.LT. KEEP8(20)) THEN
301
INFO(1)= -11
302
ITMP8 = KEEP8(20)+1_8-MAXS
303
CALL MUMPS_731(ITMP8, INFO(2))
304
ENDIF
305
IF (INFO(1) .GE. 0 ) id%S => id%WK_USER(1:KEEP8(24))
306
ELSE IF (associated(id%S)) THEN
307
MAXS = KEEP8(23)
269
308
ELSE
270
309
IF (KEEP(201).EQ.0) THEN
271
IF (PROK)
272
& WRITE(MP,*) ' Working array S not allocated ',
310
WRITE(*,*) ' Working array S not allocated ',
273
311
& ' on entry to solve phase (in core) '
274
312
CALL MUMPS_ABORT()
275
ELSE
313
ELSE
276
314
IF ( KEEP(209).EQ.-1 .AND. WORKSPACE_MINIMAL_PREFERRED)
277
* THEN
278
MAXS = KEEP(203) + 1
315
& THEN
316
MAXS = KEEP8(20) + 1_8
279
317
ELSE IF ( KEEP(209) .GE.0 ) THEN
280
MAXS = max(KEEP(209), KEEP(203) + 1)
318
MAXS = max(int(KEEP(209),8), KEEP8(20) + 1_8)
281
319
ELSE
282
320
MAXS = id%KEEP8(14)
283
321
ENDIF
284
322
ALLOCATE (id%S(MAXS), stat = allocok)
323
KEEP8(23)=MAXS
285
324
IF ( allocok .GT. 0 ) THEN
286
325
WRITE(*,*) ' Problem allocation of S at solve'
287
326
INFO(1) = -13
288
INFO(2) = MAXS
327
CALL MUMPS_731(MAXS, INFO(2))
328
NULLIFY(id%S)
329
KEEP8(23)=0_8
289
330
ENDIF
290
NB_BYTES = NB_BYTES + int(MAXS,8) * K35_8
331
NB_BYTES = NB_BYTES + KEEP8(23) * K35_8
291
332
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
292
333
ENDIF
293
334
ENDIF
294
335
IF(KEEP(201).EQ.0)THEN
295
LA = KEEP8(31)
336
LA = KEEP8(31)
296
337
ELSE
297
338
LA = MAXS
298
IF(MAXS.GT.(KEEP8(31)+KEEP(203)*(KEEP(107)+1)))THEN
299
LA=KEEP8(31)+KEEP(203)*(KEEP(107)+1)
339
IF(MAXS.GT.KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8))THEN
340
LA=KEEP8(31)+KEEP8(20)*int(KEEP(107)+1,8)
300
341
ENDIF
301
342
ENDIF
302
IF ( MAXS-LA .GT. LWCB_MIN ) THEN
303
LWCB = MAXS - LA
304
WORK_WCB => id%S(LA+1:MAXS)
343
IF ( MAXS-LA .GT. int(LWCB_MIN,8) ) THEN
344
TMP_LWCB8 = min( MAXS - LA, int(huge(LWCB),8) )
345
LWCB = int( TMP_LWCB8, kind(LWCB) )
346
WORK_WCB => id%S(LA+1_8:LA+TMP_LWCB8)
305
347
WORK_WCB_ALLOCATED=.FALSE.
306
348
ELSE
307
349
LWCB = LWCB_MIN
315
357
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
316
358
ENDIF
317
359
ENDIF
360
99 CONTINUE
318
361
CALL MUMPS_276( ICNTL, INFO,
319
362
& id%COMM,id%MYID)
320
363
IF (INFO(1) < 0) GOTO 90
321
364
IF ( I_AM_SLAVE ) THEN
322
365
IF (KEEP(201).NE.0) THEN
323
366
IF (KEEP(201).EQ.1
324
$ .AND. KEEP(50).EQ.0) THEN
367
& .AND. KEEP(50).EQ.0) THEN
325
368
OOC_NB_FILE_TYPE=2
326
369
ELSE
327
370
OOC_NB_FILE_TYPE=1
328
371
ENDIF
329
372
CALL ZMUMPS_590(LA)
330
373
CALL ZMUMPS_586(id)
331
IF (INFO(1).LT.0) THEN
332
GOTO 111
333
ENDIF
334
374
ENDIF
335
375
ENDIF
376
CALL MUMPS_276( ICNTL, INFO,
377
& id%COMM,id%MYID)
378
IF (INFO(1) < 0) GOTO 90
336
379
IF (id%MYID .eq. MASTER) THEN
337
380
MTYPE = ICNTL( 9 )
338
381
IF ( PROKG ) THEN
339
382
WRITE( MPG, 150 )
340
* NRHS, NBRHS, ICNTL(9), ICNTL(10), ICNTL(11),
341
* ICNTL(20), ICNTL(21)
383
& NRHS, NBRHS, ICNTL(9), ICNTL(10), ICNTL(11),
384
& ICNTL(20), ICNTL(21)
342
385
IF (KEEP(111).NE.0) THEN
343
386
WRITE (MPG, 151) KEEP(111)
344
387
ENDIF
351
394
IF (ICNTL20.ne.0.and.ICNTL20.ne.1) ICNTL20=0
352
395
IF (ICNTL20 .NE.0.AND.KEEP(111).NE.0) THEN
353
396
IF (PROKG) WRITE(MPG,'(A)')
354
* ' WARNING: ICNTL(20) treated as if set to 0 (null space)'
397
& ' WARNING: ICNTL(20) treated as if set to 0 (null space)'
355
398
ICNTL20 = 0
356
399
ENDIF
357
400
IF (ICNTL21.ne.0.and.ICNTL21.ne.1) ICNTL21=0
358
401
LSCAL = (((KEEP(52) .GT. 0) .AND. (KEEP(52) .LE. 8)) .OR. (
359
* KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2)
402
& KEEP(52) .EQ. -1) .OR. KEEP(52) .EQ. -2)
360
403
ERANAL = ((ICNTL(11) .GT. 0) .OR. (ICNTL(10) .GT. 0))
361
404
IF ( (KEEP(55).eq.0) .AND. KEEP(54).eq.0 .AND.
362
405
& .NOT.associated(id%A) ) THEN
370
413
IF (KEEP(111).NE.0) THEN
371
414
IF (ICNTL10 .GT. 0) THEN
372
415
IF (PROKG) WRITE(MPG,'(A)')
373
* ' WARNING: ICNTL(10) treated as if set to 0 (null space)'
416
& ' WARNING: ICNTL(10) treated as if set to 0 (null space)'
374
417
ENDIF
375
418
IF (ICNTL11 .GT. 0) THEN
376
419
IF (PROKG) WRITE(MPG,'(A)')
377
* ' WARNING: ICNTL(11) treated as if set to 0 (null space)'
420
& ' WARNING: ICNTL(11) treated as if set to 0 (null space)'
378
421
ENDIF
379
422
ICNTL10 = 0
380
423
ICNTL11 = 0
383
426
IF (KEEP(221).NE.0) THEN
384
427
IF (ICNTL10 .GT. 0) THEN
385
428
IF (PROKG) WRITE(MPG,'(A)')
386
* ' WARNING: ICNTL(10) treated as if set to 0 (reduced RHS))'
429
& ' WARNING: ICNTL(10) treated as if set to 0 (reduced RHS))'
387
430
ENDIF
388
431
IF (ICNTL11 .GT. 0) THEN
389
432
IF (PROKG) WRITE(MPG,'(A)')
390
* ' WARNING: ICNTL(11) treated as if set to 0 (reduced RHS)'
433
& ' WARNING: ICNTL(11) treated as if set to 0 (reduced RHS)'
391
434
ENDIF
392
435
ICNTL10 = 0
393
436
ICNTL11 = 0
396
439
IF ((ERANAL .AND. NBRHS > 1) .OR. ICNTL(21) > 0) THEN
397
440
IF (ICNTL11 > 0) THEN
398
441
IF (PROKG) WRITE(MPG,'(A)')
399
* ' WARNING: ICNTL(11) treated as if set to zero'
442
& ' WARNING: ICNTL(11) treated as if set to zero'
400
443
ICNTL11=0
401
444
ENDIF
402
445
IF (ICNTL10 > 0) THEN
403
446
IF (PROKG) WRITE(MPG,'(A)')
404
* ' WARNING: ICNTL(10) treated as if set to zero'
447
& ' WARNING: ICNTL(10) treated as if set to zero'
405
448
ICNTL10=0
406
449
ENDIF
407
450
ERANAL = .FALSE.
419
462
ENDIF
420
463
END IF
421
464
CALL MPI_BCAST(ICNTL10,1,MPI_INTEGER,MASTER,
422
* id%COMM,IERR)
465
& id%COMM,IERR)
423
466
CALL MPI_BCAST(ICNTL11,1,MPI_INTEGER,MASTER,
424
* id%COMM,IERR)
467
& id%COMM,IERR)
425
468
CALL MPI_BCAST(ICNTL20,1,MPI_INTEGER,MASTER,
426
* id%COMM,IERR)
469
& id%COMM,IERR)
427
470
CALL MPI_BCAST(ICNTL21,1,MPI_INTEGER,MASTER,
428
* id%COMM,IERR)
471
& id%COMM,IERR)
429
472
CALL MPI_BCAST(ERANAL,1,MPI_LOGICAL,MASTER,
430
* id%COMM,IERR)
473
& id%COMM,IERR)
431
474
CALL MPI_BCAST(LSCAL,1,MPI_LOGICAL,MASTER,
432
* id%COMM,IERR)
475
& id%COMM,IERR)
433
476
CALL MPI_BCAST(MTYPE,1,MPI_INTEGER,MASTER,
434
* id%COMM,IERR)
477
& id%COMM,IERR)
435
478
CALL MPI_BCAST(KEEP(111),1,MPI_INTEGER,MASTER,
436
* id%COMM,IERR)
437
id%LBUFR_BYTES = ( 4 + KEEP(133) ) * KEEP(34) +
438
* KEEP(133) * NBRHS * KEEP(35)
439
id%LBUFR = ( id%LBUFR_BYTES * KEEP(34) - 1 ) / KEEP(34)
479
& id%COMM,IERR)
480
id%LBUFR_BYTES = ( ( 20 + KEEP(133) ) * KEEP(34) +
481
& KEEP(133) * NBRHS * KEEP(35) )
482
TSIZE = MIN(10*id%LBUFR_BYTES, 10000000)
483
id%LBUFR_BYTES = MAX(id%LBUFR_BYTES,TSIZE)
484
id%LBUFR = ( id%LBUFR_BYTES + KEEP(34) - 1 ) / KEEP(34)
440
485
IF ( associated (id%BUFR) ) THEN
441
486
NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8
442
487
DEALLOCATE(id%BUFR)
454
499
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
455
500
IF ( I_AM_SLAVE ) THEN
456
501
ZMUMPS_LBUF_INT = ( 20 + id%NSLAVES * id%NSLAVES * 4 )
457
* * KEEP(34)
502
& * KEEP(34)
458
503
ZMUMPS_LBUF = id%LBUFR_BYTES * id%NSLAVES + 3 * KEEP(34)
459
504
CALL ZMUMPS_55( ZMUMPS_LBUF_INT, IERR )
460
505
IF ( IERR .NE. 0 ) THEN
462
507
INFO(2) = ZMUMPS_LBUF_INT
463
508
IF ( LP .GT. 0 ) THEN
464
509
WRITE(LP,*) id%MYID,
465
* ':Error allocating small Send buffer:IERR=',IERR
510
& ':Error allocating small Send buffer:IERR=',IERR
466
511
END IF
467
512
GOTO 111
468
513
END IF
472
517
INFO(2) = ZMUMPS_LBUF
473
518
IF ( LP .GT. 0 ) THEN
474
519
WRITE(LP,*) id%MYID,
475
* ':Error allocating Send buffer:IERR=', IERR
520
& ':Error allocating Send buffer:IERR=', IERR
476
521
END IF
477
522
GOTO 111
478
523
END IF
479
524
ENDIF
480
525
IF (
481
* ( id%MYID .NE. MASTER )
482
* .or.
483
* (id%MYID .EQ. MASTER .AND. ICNTL21 .NE.0 .AND.
484
* ( ICNTL20.ne.0 .OR. KEEP(111).NE.0 ) )
485
* ) THEN
526
& ( id%MYID .NE. MASTER )
527
& .or.
528
& (id%MYID .EQ. MASTER .AND. ICNTL21 .NE.0 .AND.
529
& ( ICNTL20.ne.0 .OR. KEEP(111).NE.0 ) )
530
& ) THEN
486
531
IF ( I_AM_SLAVE ) THEN
487
532
ALLOCATE(RHS_MUMPS(N*NBRHS),stat=IERR)
488
533
NB_BYTES = NB_BYTES + int(size(RHS_MUMPS),8)*K35_8
492
537
INFO(1)=-13
493
538
INFO(2)=N*NBRHS
494
539
IF (LP > 0)
495
* WRITE(LP,*) 'ERREUR while allocating RHS on a slave'
540
& WRITE(LP,*) 'ERREUR while allocating RHS on a slave'
496
541
GOTO 111
497
542
END IF
498
543
ELSE
500
545
ENDIF
501
546
IF ( I_AM_SLAVE ) THEN
502
547
LD_RHSCOMP = max(KEEP(89),1)
548
IF (id%MYID.EQ.MASTER) THEN
549
LD_RHSCOMP = MAX (LD_RHSCOMP, KEEP(247))
550
ENDIF
503
551
IF (KEEP(221).EQ.2) THEN
504
552
IF (.NOT.associated(id%RHSCOMP)) THEN
505
553
INFO(1) = -35
511
559
INFO(2) = 2
512
560
GOTO 111
513
561
ENDIF
562
LENRHSCOMP = SIZE(id%RHSCOMP)
514
563
ELSE IF (KEEP(221).EQ.1) THEN
515
564
IF (associated(id%RHSCOMP)) THEN
516
565
NB_BYTES = NB_BYTES - int(size(id%RHSCOMP),8)*K35_8
595
644
CALL VTEND(glob_comm_ini,IERR)
596
645
#endif
597
646
CALL MUMPS_276( ICNTL, INFO,
598
* id%COMM,id%MYID)
647
& id%COMM,id%MYID)
599
648
IF (INFO(1) .LT.0 ) GOTO 90
600
649
IF ( ICNTL21==1 ) THEN
601
650
IF (LSCAL) THEN
613
662
INFO(2)=id%N
614
663
GOTO 40
615
664
ENDIF
616
NB_BYTES = NB_BYTES + int(id%N,8)*K35_8
665
NB_BYTES = NB_BYTES + int(id%N,8)*K16_8
617
666
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
618
667
ENDIF
619
668
IF (MTYPE == 1) THEN
620
669
CALL MPI_BCAST(id%COLSCA,id%N,
621
* MPI_DOUBLE_PRECISION,MASTER,
622
* id%COMM,IERR)
670
& MPI_DOUBLE_PRECISION,MASTER,
671
& id%COMM,IERR)
623
672
scaling_data%SCALING=>id%COLSCA
624
673
ELSE
625
674
CALL MPI_BCAST(id%ROWSCA,id%N,
626
* MPI_DOUBLE_PRECISION,MASTER,
627
* id%COMM,IERR)
675
& MPI_DOUBLE_PRECISION,MASTER,
676
& id%COMM,IERR)
628
677
scaling_data%SCALING=>id%ROWSCA
629
678
ENDIF
630
679
IF (I_AM_SLAVE) THEN
631
680
ALLOCATE(scaling_data%SCALING_LOC(id%KEEP(89)),
632
* stat=allocok)
681
& stat=allocok)
633
682
IF (allocok > 0) THEN
634
683
IF (LP > 0) THEN
635
684
WRITE(LP,*) 'Error allocating local scaling array'
638
687
INFO(2)=id%KEEP(89)
639
688
GOTO 40
640
689
ENDIF
641
NB_BYTES = NB_BYTES + int(id%KEEP(89),8)*K35_8
690
NB_BYTES = NB_BYTES + int(id%KEEP(89),8)*K16_8
642
691
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
643
692
ENDIF
644
693
ENDIF
646
695
LIW_PASSED=max(1,LIW)
647
696
IF (KEEP(89) .GT. 0) THEN
648
697
CALL ZMUMPS_535( MTYPE, id%ISOL_LOC(1),
649
* id%LSOL_LOC, id%PTLUST_S(1),
650
* id%KEEP(1),id%KEEP8(1),
651
* id%IS(1), LIW_PASSED,id%MYID_NODES,
652
* id%N, id%STEP(1), id%PROCNODE_STEPS(1),
653
* id%NSLAVES, scaling_data, LSCAL )
698
& id%LSOL_LOC, id%PTLUST_S(1),
699
& id%KEEP(1),id%KEEP8(1),
700
& id%IS(1), LIW_PASSED,id%MYID_NODES,
701
& id%N, id%STEP(1), id%PROCNODE_STEPS(1),
702
& id%NSLAVES, scaling_data, LSCAL )
654
703
ENDIF
655
704
IF (id%MYID.NE.MASTER .AND. LSCAL) THEN
656
705
IF (MTYPE == 1) THEN
660
709
DEALLOCATE(id%ROWSCA)
661
710
NULLIFY(id%ROWSCA)
662
711
ENDIF
663
NB_BYTES = NB_BYTES - int(id%N,8)*K35_8
712
NB_BYTES = NB_BYTES - int(id%N,8)*K16_8
664
713
ENDIF
665
714
ENDIF
666
715
IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN
675
724
ENDIF
676
725
40 CONTINUE
677
726
CALL MUMPS_276( ICNTL, INFO,
678
* id%COMM,id%MYID)
727
& id%COMM,id%MYID)
679
728
IF (INFO(1) .LT.0 ) GOTO 90
680
729
IF (KEEP(23) .NE. 0 .AND. MTYPE==1) THEN
681
730
CALL MPI_BCAST(id%UNS_PERM,id%N,MPI_INTEGER,MASTER,
682
* id%COMM,IERR)
731
& id%COMM,IERR)
683
732
IF (I_AM_SLAVE) THEN
684
733
DO I=1, KEEP(89)
685
734
id%ISOL_LOC(I) = id%UNS_PERM(id%ISOL_LOC(I))
719
768
BEG_RHS=1
720
769
DO WHILE (BEG_RHS.LE.NRHS)
721
770
NBRHS_EFF = min(NRHS-BEG_RHS+1, NBRHS)
722
IF ( ( (KEEP(111).EQ.0.AND.ICNTL20.eq.0)
723
* .or. ICNTL21.eq.0 )
724
* )
725
* THEN
771
IF ( .NOT.
772
& ( (ICNTL20 .ne. 0 .OR.KEEP(111).NE.0)
773
& .and. ICNTL21.ne.0 )
774
& )
775
& THEN
726
776
IF (id%MYID .eq. MASTER) THEN
727
777
IF (NRHS.GT.1) THEN
728
778
LD_RHS = LRHS
758
808
IF (id%MYID .eq. MASTER) THEN
759
809
IF (ICNTL20==1) THEN
760
810
NZ_THIS_BLOCK=id%IRHS_PTR(BEG_RHS+NBRHS_EFF)-
761
* id%IRHS_PTR(BEG_RHS)
811
& id%IRHS_PTR(BEG_RHS)
762
812
IF (KEEP(23) .NE. 0 .and. MTYPE .NE. 1) THEN
763
813
ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK),stat=allocok)
764
814
if (allocok .GT.0 ) THEN
770
820
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
771
821
ELSE
772
822
IRHS_SPARSE_COPY
773
* =>
774
* id%IRHS_SPARSE(id%IRHS_PTR(BEG_RHS):
775
* id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1)
823
& =>
824
& id%IRHS_SPARSE(id%IRHS_PTR(BEG_RHS):
825
& id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1)
776
826
ENDIF
777
IF (LSCAL) THEN
827
IF (LSCAL.OR.DO_PERMUT_RHS.OR.INTERLEAVE_PAR) THEN
778
828
ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK), stat=allocok)
779
829
if (allocok .GT.0 ) THEN
780
830
INFO(1)=-13
783
833
endif
784
834
NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*K35_8
785
835
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
786
ELSE
787
RHS_SPARSE_COPY
788
* => id%RHS_SPARSE(id%IRHS_PTR(BEG_RHS):
789
* id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1)
836
ELSE
837
RHS_SPARSE_COPY
838
& => id%RHS_SPARSE(id%IRHS_PTR(BEG_RHS):
839
& id%IRHS_PTR(BEG_RHS)+NZ_THIS_BLOCK-1)
790
840
ENDIF
791
841
ENDIF
792
842
IF (KEEP(23) .NE. 0) THEN
793
843
IF (MTYPE .NE. 1) THEN
794
844
IF (ICNTL20==0) THEN
795
ALLOCATE( RW1( N ),stat =allocok )
845
ALLOCATE( C_RW2( N ),stat =allocok )
796
846
IF ( allocok .GT. 0 ) THEN
797
847
INFO(1)=-13
798
848
INFO(2)=N
799
849
IF ( LP .GT. 0 ) THEN
800
850
WRITE(LP,*) id%MYID,
801
* ':Error allocating RW1 in ZMUMPS_SOLVE_DRIVE'
851
& ':Error allocating C_RW2 in ZMUMPS_SOLVE_DRIVE'
802
852
END IF
803
853
GOTO 30
804
854
END IF
805
855
DO K = 1, NBRHS_EFF
806
856
KDEC = IBEG+(K-1)*LD_RHS
807
857
DO I = 1, N
808
RW1(I)=RHS_MUMPS(I-1+KDEC)
858
C_RW2(I)=RHS_MUMPS(I-1+KDEC)
809
859
END DO
810
860
DO I = 1, N
811
861
JPERM = id%UNS_PERM(I)
812
RHS_MUMPS(I-1+KDEC) = RW1(JPERM)
862
RHS_MUMPS(I-1+KDEC) = C_RW2(JPERM)
813
863
END DO
814
864
END DO
815
DEALLOCATE(RW1)
865
DEALLOCATE(C_RW2)
816
866
ELSE
817
867
ALLOCATE(UNS_PERM_INV(N),stat=allocok)
818
868
if (allocok .GT.0 ) THEN
823
873
DO I = 1, N
824
874
UNS_PERM_INV(id%UNS_PERM(I))=I
825
875
ENDDO
826
DO I = id%IRHS_PTR(BEG_RHS),
827
* id%IRHS_PTR(BEG_RHS+NBRHS_EFF)-1
828
JPERM = UNS_PERM_INV(id%IRHS_SPARSE(I))
829
IRHS_SPARSE_COPY(I-id%IRHS_PTR(BEG_RHS)+1)=JPERM
830
ENDDO
876
DO I = id%IRHS_PTR(BEG_RHS),
877
& id%IRHS_PTR(BEG_RHS+NBRHS_EFF)-1
878
JPERM = UNS_PERM_INV(id%IRHS_SPARSE(I))
879
ENDDO
831
880
DEALLOCATE(UNS_PERM_INV)
832
881
ENDIF
833
882
ENDIF
848
897
DO K =1, NBRHS_EFF
849
898
KDEC = (K-1) * LD_RHS + IBEG - 1
850
899
DO I = 1, N
851
RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * id%ROWSCA(I)
900
RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) *
901
& dcmplx(id%ROWSCA(I))
852
902
END DO
853
903
ENDDO
854
904
ELSE
855
905
DO K =1, NBRHS_EFF
856
906
KDEC = (K-1) * LD_RHS + IBEG - 1
857
907
DO I = 1, N
858
RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * id%COLSCA(I)
908
RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) *
909
& dcmplx(id%COLSCA(I))
859
910
END DO
860
911
ENDDO
861
912
ENDIF
862
913
ELSE
863
914
KDEC=id%IRHS_PTR(BEG_RHS)
864
IF (MTYPE .eq. 1) THEN
865
DO IZ=1,NZ_THIS_BLOCK
866
I=IRHS_SPARSE_COPY(IZ)
867
RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)*id%ROWSCA(I)
868
ENDDO
869
ELSE
870
DO IZ=1,NZ_THIS_BLOCK
871
I=IRHS_SPARSE_COPY(IZ)
872
RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)*id%COLSCA(I)
873
ENDDO
874
ENDIF
875
ENDIF
915
IF (MTYPE .eq. 1) THEN
916
DO IZ=1,NZ_THIS_BLOCK
917
I=IRHS_SPARSE_COPY(IZ)
918
RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)*
919
& dcmplx(id%ROWSCA(I))
920
ENDDO
921
ELSE
922
DO IZ=1,NZ_THIS_BLOCK
923
I=IRHS_SPARSE_COPY(IZ)
924
RHS_SPARSE_COPY(IZ)=id%RHS_SPARSE(KDEC+IZ-1)*
925
& dcmplx(id%COLSCA(I))
926
ENDDO
927
ENDIF
928
ENDIF
876
929
END IF
877
930
ENDIF
878
931
#if defined(V_T)
880
933
#endif
881
934
30 CONTINUE
882
935
CALL MUMPS_276( ICNTL, INFO,
883
* id%COMM,id%MYID)
936
& id%COMM,id%MYID)
884
937
IF (INFO(1) .LT.0 ) GOTO 90
885
938
IF ( I_AM_SLAVE ) THEN
886
939
IF ( (KEEP(111).NE.0) .OR. (ICNTL20.NE.0) ) THEN
894
947
ENDIF
895
948
LIW_PASSED=max(1,LIW)
896
949
CALL ZMUMPS_639(id%NSLAVES,id%N,
897
* id%MYID_NODES, id%PTLUST_S(1),
898
* id%KEEP(1),id%KEEP8(1),
899
* id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED,
900
* id%STEP(1),
901
* id%POSINRHSCOMP(1), POSINRHSCOMP_N(1),
902
* id%N, MTYPE_LOC,
903
* WHAT )
950
& id%MYID_NODES, id%PTLUST_S(1),
951
& id%KEEP(1),id%KEEP8(1),
952
& id%PROCNODE_STEPS(1), id%IS(1), LIW_PASSED,
953
& id%STEP(1),
954
& id%POSINRHSCOMP(1), POSINRHSCOMP_N(1),
955
& id%N, MTYPE_LOC,
956
& WHAT )
904
957
BUILD_POSINRHSCOMP = .FALSE.
905
958
ENDIF
906
959
ENDIF
912
965
IF (ICNTL20 == 0) THEN
913
966
IF ( .NOT.I_AM_SLAVE ) THEN
914
967
CALL ZMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM,
915
* MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
916
* JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1),
917
* IDUMMY, 1,
918
* id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP,
919
* id%ICNTL(1),id%INFO(1))
968
& MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
969
& JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1),
970
& IDUMMY, 1,
971
& id%STEP(1), KDUMMY, 1, BUILD_POSINRHSCOMP,
972
& id%ICNTL(1),id%INFO(1))
920
973
BUILD_POSINRHSCOMP=.FALSE.
921
974
ELSE
922
975
LIW_PASSED = max( LIW, 1 )
923
976
CALL ZMUMPS_638(id%NSLAVES,id%N, id%MYID, id%COMM,
924
* MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
925
* id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1),
926
* id%PROCNODE_STEPS(1),
927
* IS(1), LIW_PASSED,
928
* id%STEP(1), id%POSINRHSCOMP(1), KEEP(28),
929
* BUILD_POSINRHSCOMP,
930
* id%ICNTL(1),id%INFO(1))
977
& MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
978
& id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1),
979
& id%PROCNODE_STEPS(1),
980
& IS(1), LIW_PASSED,
981
& id%STEP(1), id%POSINRHSCOMP(1), KEEP(28),
982
& BUILD_POSINRHSCOMP,
983
& id%ICNTL(1),id%INFO(1))
931
984
BUILD_POSINRHSCOMP=.FALSE.
932
985
ENDIF
933
986
IF (INFO(1).LT.0) GOTO 90
934
987
ELSE
935
988
CALL MPI_BCAST( NZ_THIS_BLOCK,1, MPI_INTEGER,
936
* MASTER, id%COMM,IERR)
989
& MASTER, id%COMM,IERR)
937
990
IF (id%MYID==MASTER) THEN
938
991
IRHS_PTR_BEG=BEG_RHS
939
992
ELSE
993
IF (associated(IRHS_SPARSE_COPY))
994
& DEALLOCATE(IRHS_SPARSE_COPY)
995
IF (associated(IRHS_SPARSE_COPY))
996
& DEALLOCATE(IRHS_SPARSE_COPY)
940
997
ALLOCATE(IRHS_SPARSE_COPY(NZ_THIS_BLOCK))
941
998
ALLOCATE(RHS_SPARSE_COPY(NZ_THIS_BLOCK))
942
999
NB_BYTES = NB_BYTES + int(NZ_THIS_BLOCK,8)*(K34_8+K35_8)
947
1004
IRHS_PTR_BEG=1
948
1005
ENDIF
949
1006
CALL MPI_BCAST(IRHS_SPARSE_COPY,
950
* NZ_THIS_BLOCK,
951
* MPI_INTEGER,
952
* MASTER, id%COMM,IERR)
1007
& NZ_THIS_BLOCK,
1008
& MPI_INTEGER,
1009
& MASTER, id%COMM,IERR)
953
1010
CALL MPI_BCAST(RHS_SPARSE_COPY,
954
* NZ_THIS_BLOCK,
955
* MPI_DOUBLE_COMPLEX,
956
* MASTER, id%COMM,IERR)
1011
& NZ_THIS_BLOCK,
1012
& MPI_DOUBLE_COMPLEX,
1013
& MASTER, id%COMM,IERR)
957
1014
CALL MPI_BCAST(id%IRHS_PTR(IRHS_PTR_BEG),
958
* NBRHS_EFF+1,
959
* MPI_INTEGER,
960
* MASTER, id%COMM,IERR)
1015
& NBRHS_EFF+1,
1016
& MPI_INTEGER,
1017
& MASTER, id%COMM,IERR)
961
1018
SHIFT_PTR=id%IRHS_PTR(IRHS_PTR_BEG)-1
962
1019
IF ( I_AM_SLAVE ) THEN
963
1020
DO K = 1, NBRHS_EFF
964
1021
KDEC = (K-1) * LD_RHS + IBEG - 1
965
1022
RHS_MUMPS(KDEC+1:KDEC+id%N)=dcmplx(ZERO)
966
1023
DO IZ=id%IRHS_PTR(IRHS_PTR_BEG+K-1)-SHIFT_PTR,
967
* id%IRHS_PTR(IRHS_PTR_BEG+K)-1-SHIFT_PTR
1024
& id%IRHS_PTR(IRHS_PTR_BEG+K)-1-SHIFT_PTR
968
1025
I=IRHS_SPARSE_COPY(IZ)
969
1026
IF (POSINRHSCOMP_N(I).NE.0) THEN
970
1027
RHS_MUMPS(KDEC+I)= RHS_SPARSE_COPY(IZ)
988
1045
DEALLOCATE(IRHS_SPARSE_COPY)
989
1046
ENDIF
990
1047
NULLIFY(IRHS_SPARSE_COPY)
991
IF (LSCAL) THEN
1048
IF (LSCAL.OR.DO_PERMUT_RHS.OR.INTERLEAVE_PAR) THEN
992
1049
NB_BYTES = NB_BYTES - int(size(RHS_SPARSE_COPY),8)*K35_8
993
1050
DEALLOCATE(RHS_SPARSE_COPY)
1051
NULLIFY(RHS_SPARSE_COPY)
994
1052
ENDIF
995
NULLIFY(RHS_SPARSE_COPY)
996
1053
ENDIF
997
1054
ENDIF
998
1055
ELSE IF (I_AM_SLAVE) THEN
1008
1065
id%RHSCOMP(KDEC+1:KDEC+LD_RHSCOMP)=dcmplx(ZERO)
1009
1066
END DO
1010
1067
DO I=max(IBEG_GLOB_DEF,KEEP(220)),
1011
* min(IEND_GLOB_DEF,KEEP(220)+KEEP(109)-1)
1068
& min(IEND_GLOB_DEF,KEEP(220)+KEEP(109)-1)
1012
1069
JJ= POSINRHSCOMP_N(id%PIVNUL_LIST(I-KEEP(220)+1))
1013
1070
IF (JJ.GT.0)
1014
* id%RHSCOMP(IBEG_RHSCOMP -1+ (I-IBEG_GLOB_DEF)*LD_RHSCOMP
1015
* + JJ) = dcmplx(ONE)
1071
& id%RHSCOMP(IBEG_RHSCOMP -1+ (I-IBEG_GLOB_DEF)*LD_RHSCOMP
1072
& + JJ) = dcmplx(ONE)
1016
1073
ENDDO
1017
1074
IF ( KEEP(17).NE.0 .and. id%MYID_NODES.EQ.MASTER_ROOT) THEN
1018
1075
IBEG_ROOT_DEF = max(IBEG_GLOB_DEF,KEEP(112)+1)
1079
1136
ENDIF
1080
1137
IF ( I_AM_SLAVE ) THEN
1081
1138
LIW_PASSED = max( LIW, 1 )
1082
LA_PASSED = max( LA, 1 )
1139
LA_PASSED = max( LA, 1_8 )
1083
1140
CALL ZMUMPS_245(id%root, N, id%S(1), LA_PASSED,
1084
* IS(1), LIW_PASSED,
1085
* WORK_WCB, LWCB,
1086
* IWCB, LIWCB,
1087
* RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1088
* id%NA,id%LNA,id%NE_STEPS(1), SRW3, MTYPE,
1089
* ICNTL, id%STEP(1), id%FRERE_STEPS(1),
1090
* id%DAD_STEPS(1), id%FILS(1),
1091
* id%PTLUST_S(1), id%PTRFAC(1),
1092
* IWK_SOLVE, LIWK_SOLVE,
1093
* id%PROCNODE_STEPS,
1094
* id%NSLAVES, INFO, KEEP,KEEP8,
1095
* id%COMM, id%COMM_NODES, id%MYID,
1096
* id%MYID_NODES,
1097
* id%BUFR,
1098
* id%LBUFR, id%LBUFR_BYTES,
1099
*
1100
* id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1),
1101
* IBEG_ROOT_DEF, IEND_ROOT_DEF,
1102
* IROOT_DEF_RHS_COL1,
1103
* IPT_RHS_ROOT, SIZE_ROOT, MASTER_ROOT,
1104
* id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP,
1105
* id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP
1106
$ )
1141
& IS(1), LIW_PASSED,
1142
& WORK_WCB, LWCB,
1143
& IWCB, LIWCB,
1144
& RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1145
& id%NA,id%LNA,id%NE_STEPS(1), SRW3, MTYPE,
1146
& ICNTL, id%STEP(1), id%FRERE_STEPS(1),
1147
& id%DAD_STEPS(1), id%FILS(1),
1148
& id%PTLUST_S(1), id%PTRFAC(1),
1149
& IWK_SOLVE, LIWK_SOLVE,
1150
& id%PROCNODE_STEPS,
1151
& id%NSLAVES, INFO, KEEP,KEEP8,
1152
& id%COMM, id%COMM_NODES, id%MYID,
1153
& id%MYID_NODES,
1154
& id%BUFR,
1155
& id%LBUFR, id%LBUFR_BYTES,
1156
&
1157
& id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1),
1158
& IBEG_ROOT_DEF, IEND_ROOT_DEF,
1159
& IROOT_DEF_RHS_COL1,
1160
& IPT_RHS_ROOT, SIZE_ROOT, MASTER_ROOT,
1161
& id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP,
1162
& id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP
1163
& )
1107
1164
END IF
1108
1165
CALL MUMPS_276( ICNTL, INFO,
1109
* id%COMM,id%MYID)
1166
& id%COMM,id%MYID)
1110
1167
IF (INFO(1).eq.-2) then
1111
1168
INFO(1)=-11
1112
1169
IF (LP.GT.0)
1171
1228
IF (ICNTL21 == 0) THEN
1172
1229
LIW_PASSED = max( LIW, 1 )
1173
1230
IF ( .NOT.I_AM_SLAVE ) THEN
1174
CALL ZMUMPS_521(id%NSLAVES,id%N, id%MYID, id%COMM,
1175
* MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1176
* JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1),
1177
* IDUMMY, 1,
1178
* id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES)
1231
ALLOCATE( CWORK(KEEP(247)) )
1232
CALL ZMUMPS_521(id%NSLAVES,id%N,
1233
& id%MYID, id%COMM,
1234
& MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1235
& JDUMMY, id%KEEP(1), id%KEEP8(1), id%PROCNODE_STEPS(1),
1236
& IDUMMY, 1,
1237
& id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES,
1238
& CWORK(1), KEEP(247))
1239
DEALLOCATE( CWORK )
1179
1240
ELSE
1180
1241
CALL ZMUMPS_521(id%NSLAVES,id%N, id%MYID, id%COMM,
1181
* MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1182
* id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1),
1183
* id%PROCNODE_STEPS(1),
1184
* IS(1), LIW_PASSED,
1185
* id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES)
1242
& MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1243
& id%PTLUST_S(1), id%KEEP(1), id%KEEP8(1),
1244
& id%PROCNODE_STEPS(1),
1245
& IS(1), LIW_PASSED,
1246
& id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES,
1247
& id%RHSCOMP(1), LENRHSCOMP)
1186
1248
ENDIF
1187
1249
IF ( id%MYID.eq.MASTER .AND. LSCAL ) THEN
1188
1250
IF (MTYPE .EQ. 1) THEN
1189
1251
DO K= 1, NBRHS_EFF
1190
1252
KDEC = (K-1) * LD_RHS + IBEG - 1
1191
1253
DO I = 1, N
1192
RHS_MUMPS(KDEC+ I) = RHS_MUMPS(KDEC+ I) * id%COLSCA(I)
1254
RHS_MUMPS(KDEC+ I) = RHS_MUMPS(KDEC+ I) *
1255
& dcmplx(id%COLSCA(I))
1193
1256
END DO
1194
1257
END DO
1195
1258
ELSE
1196
1259
DO K= 1, NBRHS_EFF
1197
1260
KDEC = (K-1) * LD_RHS + IBEG - 1
1198
1261
DO I = 1, N
1199
RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) * id%ROWSCA(I)
1262
RHS_MUMPS(KDEC+I) = RHS_MUMPS(KDEC+I) *
1263
& dcmplx(id%ROWSCA(I))
1200
1264
END DO
1201
1265
END DO
1202
1266
ENDIF
1206
1270
LIW_PASSED = max( LIW, 1 )
1207
1271
IF ( KEEP(89) .GT. 0 ) THEN
1208
1272
CALL ZMUMPS_532(id%NSLAVES,
1209
* id%N, id%MYID_NODES,
1210
* MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1211
* id%ISOL_LOC(1),
1212
* id%SOL_LOC(1), BEG_RHS, id%LSOL_LOC,
1213
* id%PTLUST_S(1), id%PROCNODE_STEPS(1),
1214
* id%KEEP(1),id%KEEP8(1),
1215
* IS(1), LIW_PASSED,
1216
* id%STEP(1), scaling_data, LSCAL )
1273
& id%N, id%MYID_NODES,
1274
& MTYPE, RHS_MUMPS(IBEG), LD_RHS, NBRHS_EFF,
1275
& id%ISOL_LOC(1),
1276
& id%SOL_LOC(1), BEG_RHS, id%LSOL_LOC,
1277
& id%PTLUST_S(1), id%PROCNODE_STEPS(1),
1278
& id%KEEP(1),id%KEEP8(1),
1279
& IS(1), LIW_PASSED,
1280
& id%STEP(1), scaling_data, LSCAL )
1217
1281
ENDIF
1218
1282
ENDIF
1219
1283
ENDIF
1228
1292
IF (id%MYID .EQ. MASTER) THEN
1229
1293
GIVSOL = .FALSE.
1230
1294
IF (MP .GT. 0) WRITE( MP, 170 )
1231
ALLOCATE(RW1(N),stat=allocok)
1232
if (allocok .GT.0 ) THEN
1233
INFO(1)=-13
1234
INFO(2)=N
1235
GOTO 776
1236
endif
1237
ALLOCATE(RW2(N),stat=allocok)
1238
if (allocok .GT.0 ) THEN
1239
INFO(1)=-13
1240
INFO(2)=N
1241
GOTO 776
1242
endif
1243
NB_BYTES = NB_BYTES + int(2*N,8)*K35_8
1244
END IF
1245
IF ( KEEP(54) .ne. 0 ) THEN
1246
ALLOCATE( SRW1( N ), stat =allocok )
1247
if (allocok .GT.0 ) THEN
1248
INFO(1)=-13
1249
INFO(2)=N
1250
endif
1251
NB_BYTES = NB_BYTES + int(N,8)*K35_8
1252
END IF
1253
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
1295
ALLOCATE(R_RW1(N),stat=allocok)
1296
if (allocok .GT.0 ) THEN
1297
INFO(1)=-13
1298
INFO(2)=N
1299
GOTO 776
1300
ENDIF
1301
ALLOCATE(C_RW2(N),stat=allocok)
1302
IF (allocok .GT.0) THEN
1303
INFO(1)=-13
1304
INFO(2)=N
1305
GOTO 776
1306
ENDIF
1307
NB_BYTES = NB_BYTES + int(N,8)*K35_8 + int(N,8)*K16_8
1308
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
1309
END IF
1254
1310
776 CONTINUE
1255
1311
CALL MUMPS_276( ICNTL, INFO,
1256
* id%COMM,id%MYID)
1312
& id%COMM,id%MYID)
1257
1313
IF ( INFO(1) .LT. 0 ) GOTO 90
1258
1314
IF ( KEEP(54) .eq. 0 ) THEN
1259
1315
IF (id%MYID .EQ. MASTER) THEN
1260
1316
IF (KEEP(55).EQ.0) THEN
1261
1317
CALL ZMUMPS_278( ICNTL(9), N, NZ, id%A(1),
1262
* id%IRN(1), id%JCN(1),
1263
* RHS_MUMPS(IBEG), SAVERHS, RW1, RW2, KEEP,KEEP8 )
1318
& id%IRN(1), id%JCN(1),
1319
& RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, KEEP,KEEP8 )
1264
1320
ELSE
1265
1321
CALL ZMUMPS_121( ICNTL(9), N,
1266
* id%NELT, id%ELTPTR,
1267
* id%LELTVAR, id%ELTVAR,
1268
* id%NA_ELT, id%A_ELT,
1269
* RHS_MUMPS(IBEG), SAVERHS, RW1, RW2, KEEP,KEEP8 )
1322
& id%NELT, id%ELTPTR,
1323
& id%LELTVAR, id%ELTVAR,
1324
& id%NA_ELT, id%A_ELT,
1325
& RHS_MUMPS(IBEG), SAVERHS, R_RW1, C_RW2, KEEP,KEEP8 )
1270
1326
ENDIF
1271
1327
END IF
1272
1328
ELSE
1273
1329
CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N,
1274
* MPI_DOUBLE_COMPLEX, MASTER,
1275
* id%COMM, IERR )
1330
& MPI_DOUBLE_COMPLEX, MASTER,
1331
& id%COMM, IERR )
1332
ALLOCATE( C_LOCWK54( N ), stat =allocok )
1333
if (allocok .GT.0 ) THEN
1334
INFO(1)=-13
1335
INFO(2)=N
1336
endif
1337
CALL MUMPS_276(ICNTL, INFO, id%COMM, id%MYID)
1338
IF ( INFO(1) .LT. 0 ) GOTO 90
1339
NB_BYTES = NB_BYTES + int(N,8)*K35_8
1340
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
1276
1341
IF ( I_AM_SLAVE .and.
1277
* id%NZ_loc .NE. 0 ) THEN
1342
& id%NZ_loc .NE. 0 ) THEN
1278
1343
CALL ZMUMPS_192( id%N, id%NZ_loc,
1279
* id%IRN_loc, id%JCN_loc, id%A_loc,
1280
* RHS_MUMPS(IBEG), SRW1, KEEP(50), MTYPE )
1344
& id%IRN_loc, id%JCN_loc, id%A_loc,
1345
& RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE )
1281
1346
ELSE
1282
SRW1 = dcmplx(ZERO)
1347
C_LOCWK54 = dcmplx(ZERO)
1283
1348
END IF
1284
1349
IF ( id%MYID .eq. MASTER ) THEN
1285
CALL MPI_REDUCE( SRW1, RW2,
1286
* id%N, MPI_DOUBLE_COMPLEX,
1287
* MPI_SUM,MASTER,id%COMM, IERR)
1288
RW2 = SAVERHS - RW2
1350
CALL MPI_REDUCE( C_LOCWK54, C_RW2,
1351
& id%N, MPI_DOUBLE_COMPLEX,
1352
& MPI_SUM,MASTER,id%COMM, IERR)
1353
C_RW2 = SAVERHS - C_RW2
1289
1354
ELSE
1290
CALL MPI_REDUCE( SRW1, DUMMY,
1291
* id%N, MPI_DOUBLE_COMPLEX,
1292
* MPI_SUM,MASTER,id%COMM, IERR)
1355
CALL MPI_REDUCE( C_LOCWK54, C_DUMMY,
1356
& id%N, MPI_DOUBLE_COMPLEX,
1357
& MPI_SUM,MASTER,id%COMM, IERR)
1293
1358
END IF
1294
IF ( I_AM_SLAVE .and.
1295
* id%NZ_loc .NE. 0 ) THEN
1359
NB_BYTES = NB_BYTES - int(size(C_LOCWK54),8)*K35_8
1360
DEALLOCATE( C_LOCWK54 )
1361
ALLOCATE( R_LOCWK54( N ), stat =allocok )
1362
if (allocok .GT.0 ) THEN
1363
INFO(1)=-13
1364
INFO(2)=N
1365
endif
1366
CALL MUMPS_276(ICNTL, INFO, id%COMM, id%MYID)
1367
IF ( INFO(1) .LT. 0 ) GOTO 90
1368
NB_BYTES = NB_BYTES + int(N,8)*K16_8
1369
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
1370
IF ( I_AM_SLAVE .AND. id%NZ_loc .NE. 0 ) THEN
1296
1371
CALL ZMUMPS_207(id%A_loc,
1297
* id%NZ_loc, id%N,
1298
* id%IRN_loc, id%JCN_loc,
1299
* SRW1, id%KEEP,id%KEEP8 )
1372
& id%NZ_loc, id%N,
1373
& id%IRN_loc, id%JCN_loc,
1374
& R_LOCWK54, id%KEEP,id%KEEP8)
1300
1375
ELSE
1301
SRW1 = dcmplx(ZERO)
1376
R_LOCWK54 = ZERO
1302
1377
END IF
1303
1378
IF ( id%MYID .eq. MASTER ) THEN
1304
CALL MPI_REDUCE( SRW1, RW1,
1305
* id%N, MPI_DOUBLE_COMPLEX,
1306
* MPI_SUM,MASTER,id%COMM, IERR)
1379
CALL MPI_REDUCE( R_LOCWK54, R_RW1,
1380
& id%N, MPI_DOUBLE_PRECISION,
1381
& MPI_SUM,MASTER,id%COMM, IERR)
1307
1382
ELSE
1308
CALL MPI_REDUCE( SRW1, DUMMY,
1309
* id%N, MPI_DOUBLE_COMPLEX,
1310
* MPI_SUM,MASTER,id%COMM, IERR)
1383
CALL MPI_REDUCE( R_LOCWK54, R_DUMMY,
1384
& id%N, MPI_DOUBLE_PRECISION,
1385
& MPI_SUM,MASTER,id%COMM, IERR)
1311
1386
END IF
1312
NB_BYTES = NB_BYTES - int(size(SRW1),8)*K35_8
1313
DEALLOCATE( SRW1 )
1387
NB_BYTES = NB_BYTES - int(size(R_LOCWK54),8)*K16_8
1388
DEALLOCATE( R_LOCWK54 )
1314
1389
END IF
1315
1390
IF ( id%MYID .EQ. MASTER ) THEN
1316
1391
CALL ZMUMPS_205(ICNTL(9),INFO(1),N,NZ,
1317
* RHS_MUMPS(IBEG), SAVERHS,RW1,RW2,GIVSOL,
1318
* RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MP,ICNTL,
1319
* KEEP,KEEP8)
1320
NB_BYTES = NB_BYTES - int(size(RW1),8)*K35_8
1321
& - int(size(RW2),8)*K35_8
1322
DEALLOCATE(RW1)
1323
DEALLOCATE(RW2)
1392
& RHS_MUMPS(IBEG), SAVERHS,R_RW1,C_RW2,GIVSOL,
1393
& RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MP,ICNTL,
1394
& KEEP,KEEP8)
1395
NB_BYTES = NB_BYTES - int(size(R_RW1),8)*K16_8
1396
& - int(size(C_RW2),8)*K35_8
1397
DEALLOCATE(R_RW1)
1398
DEALLOCATE(C_RW2)
1324
1399
END IF
1325
1400
END IF
1326
1401
IF ( PROK .AND. ICNTL10 .GT. 0 ) WRITE( MP, 270 )
1327
1402
IF ( PROKG .AND. ICNTL10 .GT. 0 ) WRITE( MPG, 270 )
1328
ALLOCATE(Y(N), stat = allocok)
1403
ALLOCATE(R_Y(N), stat = allocok)
1404
IF ( allocok .GT. 0 ) THEN
1405
INFO(1)=-13
1406
INFO(2)=N
1407
GOTO 777
1408
ENDIF
1409
NB_BYTES = NB_BYTES + int(N,8)*K16_8
1410
ALLOCATE(C_Y(N), stat = allocok)
1329
1411
IF ( allocok .GT. 0 ) THEN
1330
1412
INFO(1)=-13
1331
1413
INFO(2)=N
1347
1429
GOTO 777
1348
1430
ENDIF
1349
1431
NB_BYTES = NB_BYTES + int(N,8)*K35_8
1350
ALLOCATE( W(3*N), stat = allocok )
1351
IF ( allocok .GT. 0 ) THEN
1352
INFO(1)=-13
1353
INFO(2)=N
1354
GOTO 777
1355
ENDIF
1356
NB_BYTES = NB_BYTES + int(3*N,8)*K35_8
1432
ALLOCATE( C_W(N), stat = allocok )
1433
IF ( allocok .GT. 0 ) THEN
1434
INFO(1)=-13
1435
INFO(2)=N
1436
GOTO 777
1437
ENDIF
1438
NB_BYTES = NB_BYTES + int(N,8)*K35_8
1439
ALLOCATE( R_W(2*N), stat = allocok )
1440
IF ( allocok .GT. 0 ) THEN
1441
INFO(1)=-13
1442
INFO(2)=N
1443
GOTO 777
1444
ENDIF
1445
NB_BYTES = NB_BYTES + int(2*N,8)*K16_8
1357
1446
NITREF = ICNTL10
1358
1447
JOBIREF= ICNTL11
1359
1448
IF ( PROKG .AND. ICNTL10 .GT. 0 )
1360
* WRITE( MPG, 240) 'MAXIMUM NUMBER OF STEPS =', NITREF
1449
& WRITE( MPG, 240) 'MAXIMUM NUMBER OF STEPS =', NITREF
1361
1450
DO I = 1, N
1362
D( I ) = dcmplx(ONE)
1451
D( I ) = ONE
1363
1452
END DO
1364
1453
END IF
1365
ALLOCATE(SRW1(N),stat = allocok)
1454
ALLOCATE(C_LOCWK54(N),stat = allocok)
1366
1455
IF ( allocok .GT. 0 ) THEN
1367
1456
INFO(1)=-13
1368
1457
INFO(2)=N
1369
1458
GOTO 777
1370
1459
ENDIF
1371
1460
NB_BYTES = NB_BYTES + int(N,8)*K35_8
1372
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
1461
ALLOCATE(R_LOCWK54(N),stat = allocok)
1462
IF ( allocok .GT. 0 ) THEN
1463
INFO(1)=-13
1464
INFO(2)=N
1465
GOTO 777
1466
ENDIF
1467
NB_BYTES = NB_BYTES + int(N,8)*K16_8
1373
1468
KASE = 0
1374
1469
777 CONTINUE
1470
NB_BYTES_MAX = max(NB_BYTES_MAX,NB_BYTES)
1375
1471
CALL MUMPS_276( ICNTL, INFO,
1376
* id%COMM,id%MYID)
1472
& id%COMM,id%MYID)
1377
1473
IF ( INFO(1) .LT. 0 ) GOTO 90
1378
1474
22 CONTINUE
1379
1475
IF ( KEEP(54) .eq. 0 ) THEN
1381
1477
IF ( KASE .eq. 0 ) THEN
1382
1478
IF (KEEP(55).NE.0) THEN
1383
1479
CALL ZMUMPS_119(MTYPE, N,
1384
* id%NELT, id%ELTPTR(1),
1385
* id%LELTVAR, id%ELTVAR(1),
1386
* id%NA_ELT, id%A_ELT,
1387
* W(N+1), KEEP,KEEP8 )
1480
& id%NELT, id%ELTPTR(1),
1481
& id%LELTVAR, id%ELTVAR(1),
1482
& id%NA_ELT, id%A_ELT,
1483
& R_W(N+1), KEEP,KEEP8 )
1388
1484
ELSE
1389
1485
IF ( MTYPE .eq. 1 ) THEN
1390
1486
CALL ZMUMPS_207
1391
* ( id%A(1), NZ, N, id%IRN(1), id%JCN(1), W(N+1), KEEP,KEEP8)
1487
& ( id%A(1), NZ, N, id%IRN(1), id%JCN(1), R_W(N+1), KEEP,KEEP8)
1392
1488
ELSE
1393
1489
CALL ZMUMPS_207
1394
* ( id%A(1), NZ, N, id%JCN(1), id%IRN(1), W(N+1), KEEP,KEEP8)
1490
& ( id%A(1), NZ, N, id%JCN(1), id%IRN(1), R_W(N+1), KEEP,KEEP8)
1395
1491
END IF
1396
1492
ENDIF
1397
1493
ENDIF
1399
1495
ELSE
1400
1496
IF ( KASE .eq. 0 ) THEN
1401
1497
IF ( I_AM_SLAVE .and.
1402
* id%NZ_loc .NE. 0 ) THEN
1498
& id%NZ_loc .NE. 0 ) THEN
1403
1499
IF ( MTYPE .eq. 1 ) THEN
1404
1500
CALL ZMUMPS_207(id%A_loc,
1405
* id%NZ_loc, id%N,
1406
* id%IRN_loc, id%JCN_loc,
1407
* SRW1, id%KEEP,id%KEEP8 )
1501
& id%NZ_loc, id%N,
1502
& id%IRN_loc, id%JCN_loc,
1503
& R_LOCWK54, id%KEEP,id%KEEP8 )
1408
1504
ELSE
1409
1505
CALL ZMUMPS_207(id%A_loc,
1410
* id%NZ_loc, id%N,
1411
* id%JCN_loc, id%IRN_loc,
1412
* SRW1, id%KEEP,id%KEEP8 )
1506
& id%NZ_loc, id%N,
1507
& id%JCN_loc, id%IRN_loc,
1508
& R_LOCWK54, id%KEEP,id%KEEP8 )
1413
1509
END IF
1414
1510
ELSE
1415
SRW1 = dcmplx(ZERO)
1511
R_LOCWK54 = ZERO
1416
1512
END IF
1417
1513
IF ( id%MYID .eq. MASTER ) THEN
1418
CALL MPI_REDUCE( SRW1, W( N + 1 ),
1419
* id%N, MPI_DOUBLE_COMPLEX,
1420
* MPI_SUM,MASTER,id%COMM, IERR)
1514
CALL MPI_REDUCE( R_LOCWK54, R_W( N + 1 ),
1515
& id%N, MPI_DOUBLE_PRECISION,
1516
& MPI_SUM,MASTER,id%COMM, IERR)
1421
1517
ELSE
1422
CALL MPI_REDUCE( SRW1, DUMMY,
1423
* id%N, MPI_DOUBLE_COMPLEX,
1424
* MPI_SUM,MASTER,id%COMM, IERR)
1518
CALL MPI_REDUCE( R_LOCWK54, R_DUMMY,
1519
& id%N, MPI_DOUBLE_PRECISION,
1520
& MPI_SUM,MASTER,id%COMM, IERR)
1425
1521
END IF
1426
1522
END IF
1427
1523
END IF
1431
1527
ARRET = sqrt(epsilon(0.0D0))
1432
1528
END IF
1433
1529
CALL ZMUMPS_206(NZ,N,SAVERHS,RHS_MUMPS(IBEG),
1434
* Y, D, W,
1435
* IW1, KASE,RINFOG(7),
1436
* RINFOG(9), JOBIREF, RINFOG(10), NITREF, NOITER, MP,
1437
* KEEP,KEEP8, ARRET )
1530
& C_Y, D, R_W, C_W,
1531
& IW1, KASE,RINFOG(7),
1532
& RINFOG(9), JOBIREF, RINFOG(10), NITREF, NOITER, MP,
1533
& KEEP,KEEP8, ARRET )
1438
1534
END IF
1439
1535
IF ( KEEP(54) .ne. 0 ) THEN
1440
1536
CALL MPI_BCAST( KASE, 1, MPI_INTEGER, MASTER,
1441
* id%COMM, IERR )
1537
& id%COMM, IERR )
1442
1538
END IF
1443
1539
IF ( KEEP(54) .eq. 0 ) THEN
1444
1540
IF ( id%MYID .eq. MASTER ) THEN
1445
1541
IF ( KASE .eq. 14 ) THEN
1446
1542
IF (KEEP(55).NE.0) THEN
1447
1543
CALL ZMUMPS_122( MTYPE, N,
1448
* id%NELT, id%ELTPTR, id%LELTVAR,
1449
* id%ELTVAR, id%NA_ELT, id%A_ELT,
1450
* SAVERHS, RHS_MUMPS(IBEG),
1451
* Y, W, KEEP(50))
1544
& id%NELT, id%ELTPTR, id%LELTVAR,
1545
& id%ELTVAR, id%NA_ELT, id%A_ELT,
1546
& SAVERHS, RHS_MUMPS(IBEG),
1547
& C_Y, R_W, KEEP(50))
1452
1548
ELSE
1453
1549
IF ( MTYPE .eq. 1 ) THEN
1454
1550
CALL ZMUMPS_208
1455
* (id%A(1), NZ, N, id%IRN(1), id%JCN(1), SAVERHS,
1456
* RHS_MUMPS(IBEG), Y, W, KEEP,KEEP8)
1551
& (id%A(1), NZ, N, id%IRN(1), id%JCN(1), SAVERHS,
1552
& RHS_MUMPS(IBEG), C_Y, R_W, KEEP,KEEP8)
1457
1553
ELSE
1458
1554
CALL ZMUMPS_208
1459
* (id%A(1), NZ, N, id%JCN(1), id%IRN(1), SAVERHS,
1460
* RHS_MUMPS(IBEG), Y, W, KEEP,KEEP8)
1555
& (id%A(1), NZ, N, id%JCN(1), id%IRN(1), SAVERHS,
1556
& RHS_MUMPS(IBEG), C_Y, R_W, KEEP,KEEP8)
1461
1557
END IF
1462
1558
ENDIF
1463
1559
GOTO 22
1466
1562
ELSE
1467
1563
IF ( KASE.eq.14 ) THEN
1468
1564
CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N,
1469
* MPI_DOUBLE_COMPLEX, MASTER,
1470
* id%COMM, IERR )
1565
& MPI_DOUBLE_COMPLEX, MASTER,
1566
& id%COMM, IERR )
1471
1567
IF ( I_AM_SLAVE .and.
1472
* id%NZ_loc .NE. 0 ) THEN
1568
& id%NZ_loc .NE. 0 ) THEN
1473
1569
CALL ZMUMPS_192( id%N, id%NZ_loc,
1474
* id%IRN_loc, id%JCN_loc, id%A_loc,
1475
* RHS_MUMPS(IBEG), SRW1, KEEP(50), MTYPE )
1570
& id%IRN_loc, id%JCN_loc, id%A_loc,
1571
& RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE )
1476
1572
ELSE
1477
SRW1 = dcmplx(ZERO)
1573
C_LOCWK54 = dcmplx(ZERO)
1478
1574
END IF
1479
1575
IF ( id%MYID .eq. MASTER ) THEN
1480
CALL MPI_REDUCE( SRW1, Y,
1481
* id%N, MPI_DOUBLE_COMPLEX,
1482
* MPI_SUM,MASTER,id%COMM, IERR)
1483
Y = SAVERHS - Y
1576
CALL MPI_REDUCE( C_LOCWK54, C_Y,
1577
& id%N, MPI_DOUBLE_COMPLEX,
1578
& MPI_SUM,MASTER,id%COMM, IERR)
1579
C_Y = SAVERHS - C_Y
1484
1580
ELSE
1485
CALL MPI_REDUCE( SRW1, DUMMY,
1486
* id%N, MPI_DOUBLE_COMPLEX,
1487
* MPI_SUM,MASTER,id%COMM, IERR)
1581
CALL MPI_REDUCE( C_LOCWK54, C_DUMMY,
1582
& id%N, MPI_DOUBLE_COMPLEX,
1583
& MPI_SUM,MASTER,id%COMM, IERR)
1488
1584
END IF
1489
1585
IF ( I_AM_SLAVE .and. id%NZ_loc .NE. 0 ) THEN
1490
1586
CALL ZMUMPS_193( id%N, id%NZ_loc,
1491
* id%IRN_loc, id%JCN_loc, id%A_loc,
1492
* RHS_MUMPS(IBEG), SRW1, KEEP(50), MTYPE )
1587
& id%IRN_loc, id%JCN_loc, id%A_loc,
1588
& RHS_MUMPS(IBEG), R_LOCWK54, KEEP(50), MTYPE )
1493
1589
ELSE
1494
SRW1 = dcmplx(ZERO)
1590
R_LOCWK54 = ZERO
1495
1591
END IF
1496
1592
IF ( id%MYID .eq. MASTER ) THEN
1497
CALL MPI_REDUCE( SRW1, W,
1498
* id%N, MPI_DOUBLE_COMPLEX,
1499
* MPI_SUM,MASTER,id%COMM, IERR)
1593
CALL MPI_REDUCE( R_LOCWK54, R_W,
1594
& id%N, MPI_DOUBLE_PRECISION,
1595
& MPI_SUM,MASTER,id%COMM, IERR)
1500
1596
ELSE
1501
CALL MPI_REDUCE( SRW1, DUMMY,
1502
* id%N, MPI_DOUBLE_COMPLEX,
1503
* MPI_SUM,MASTER,id%COMM, IERR)
1597
CALL MPI_REDUCE( R_LOCWK54, R_DUMMY,
1598
& id%N, MPI_DOUBLE_PRECISION,
1599
& MPI_SUM, MASTER, id%COMM, IERR)
1504
1600
END IF
1505
1601
GOTO 22
1506
1602
END IF
1515
1611
IF ( LSCAL ) THEN
1516
1612
IF ( SOLVET .EQ. 1 ) THEN
1517
1613
DO K = 1, N
1518
Y( K ) = Y( K ) * id%ROWSCA( K )
1614
C_Y( K ) = C_Y( K ) * id%ROWSCA( K )
1519
1615
END DO
1520
1616
ELSE
1521
1617
DO K = 1, N
1522
Y( K ) = Y( K ) * id%COLSCA( K )
1618
C_Y( K ) = C_Y( K ) * id%COLSCA( K )
1523
1619
END DO
1524
1620
END IF
1525
1621
END IF
1526
1622
END IF
1527
1623
END IF
1528
1624
CALL MPI_BCAST( KASE , 1, MPI_INTEGER, MASTER,
1529
* id%COMM, IERR)
1625
& id%COMM, IERR)
1530
1626
CALL MPI_BCAST( SOLVET, 1, MPI_INTEGER, MASTER,
1531
* id%COMM, IERR)
1627
& id%COMM, IERR)
1532
1628
IF ( KASE .GT. 0 ) THEN
1533
CALL MPI_BCAST( Y, N, MPI_DOUBLE_COMPLEX, MASTER,
1534
* id%COMM, IERR )
1629
CALL MPI_BCAST( C_Y, N, MPI_DOUBLE_COMPLEX, MASTER,
1630
& id%COMM, IERR )
1535
1631
IF ( id%MYID_NODES .EQ. MASTER_ROOT ) THEN
1536
1632
IPT_RHS_ROOT = LWCB - NBRHS_EFF * SIZE_ROOT + 1
1537
1633
ELSE
1539
1635
ENDIF
1540
1636
IF ( I_AM_SLAVE ) THEN
1541
1637
LIW_PASSED = max( LIW, 1 )
1542
LA_PASSED = max( LA, 1 )
1638
LA_PASSED = max( LA, 1_8 )
1543
1639
CALL ZMUMPS_245( id%root, N,
1544
* id%S(1), LA_PASSED, id%IS( 1 ),
1545
* LIW_PASSED, WORK_WCB, LWCB,
1546
* IWCB, LIWCB,
1547
* Y, N, NBRHS_EFF, id%NA, id%LNA, id%NE_STEPS,
1548
* SRW1, SOLVET, ICNTL,
1549
* id%STEP(1), id%FRERE_STEPS(1), id%DAD_STEPS(1),
1550
* id%FILS(1),
1551
* id%PTLUST_S(1), id%PTRFAC(1),
1552
* IWK_SOLVE, LIWK_SOLVE,
1553
* id%PROCNODE_STEPS, id%NSLAVES, INFO, KEEP,KEEP8,
1554
* id%COMM,
1555
* id%COMM_NODES,
1556
* id%MYID, id%MYID_NODES,
1557
* id%BUFR, id%LBUFR, id%LBUFR_BYTES ,
1558
*
1559
* id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1),
1560
* IBEG_ROOT_DEF, IEND_ROOT_DEF,
1561
* IROOT_DEF_RHS_COL1,
1562
* IPT_RHS_ROOT, SIZE_ROOT, MASTER_ROOT,
1563
* id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP,
1564
* id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP )
1640
& id%S(1), LA_PASSED, id%IS( 1 ),
1641
& LIW_PASSED, WORK_WCB, LWCB,
1642
& IWCB, LIWCB,
1643
& C_Y, N, NBRHS_EFF, id%NA, id%LNA, id%NE_STEPS(1),
1644
& SRW3, SOLVET, ICNTL,
1645
& id%STEP(1), id%FRERE_STEPS(1), id%DAD_STEPS(1),
1646
& id%FILS(1),
1647
& id%PTLUST_S(1), id%PTRFAC(1),
1648
& IWK_SOLVE, LIWK_SOLVE,
1649
& id%PROCNODE_STEPS, id%NSLAVES, INFO, KEEP,KEEP8,
1650
& id%COMM,
1651
& id%COMM_NODES,
1652
& id%MYID, id%MYID_NODES,
1653
& id%BUFR, id%LBUFR, id%LBUFR_BYTES ,
1654
&
1655
& id%ISTEP_TO_INIV2(1), id%TAB_POS_IN_PERE(1,1),
1656
& IBEG_ROOT_DEF, IEND_ROOT_DEF,
1657
& IROOT_DEF_RHS_COL1,
1658
& IPT_RHS_ROOT, SIZE_ROOT, MASTER_ROOT,
1659
& id%RHSCOMP(IBEG_RHSCOMP), LD_RHSCOMP,
1660
& id%POSINRHSCOMP(1), BUILD_POSINRHSCOMP
1661
& )
1565
1662
END IF
1566
1663
CALL MUMPS_276( ICNTL, INFO,
1567
* id%COMM,id%MYID)
1664
& id%COMM,id%MYID)
1568
1665
IF (INFO(1).eq.-2) INFO(1)=-12
1569
1666
IF (INFO(1).eq.-3) INFO(1)=-15
1570
1667
IF (INFO(1).LT.0) GO TO 90
1571
1668
LIW_PASSED = max( LIW, 1 )
1572
1669
IF ( .NOT. I_AM_SLAVE ) THEN
1573
CALL ZMUMPS_521(id%NSLAVES,id%N, id%MYID, id%COMM,
1574
* MTYPE, Y, LD_RHS, NBRHS_EFF,
1575
* JDUMMY, id%KEEP(1),id%KEEP8(1), id%PROCNODE_STEPS(1),
1576
* IDUMMY, 1,
1577
* id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES)
1670
ALLOCATE( CWORK(KEEP(247)) )
1671
CALL ZMUMPS_521(id%NSLAVES,id%N,
1672
& id%MYID, id%COMM,
1673
& MTYPE, C_Y, LD_RHS, NBRHS_EFF,
1674
& JDUMMY, id%KEEP(1),id%KEEP8(1), id%PROCNODE_STEPS(1),
1675
& IDUMMY, 1,
1676
& id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES,
1677
& CWORK, KEEP(247))
1678
DEALLOCATE( CWORK )
1578
1679
ELSE
1579
CALL ZMUMPS_521(id%NSLAVES,id%N, id%MYID, id%COMM,
1580
* MTYPE, Y, LD_RHS, NBRHS_EFF,
1581
* id%PTLUST_S(1), id%KEEP(1),id%KEEP8(1),
1582
* id%PROCNODE_STEPS(1),
1583
* IS(1), LIW_PASSED,
1584
* id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES)
1680
CALL ZMUMPS_521(id%NSLAVES,id%N,
1681
& id%MYID, id%COMM,
1682
& MTYPE, C_Y, LD_RHS, NBRHS_EFF,
1683
& id%PTLUST_S(1), id%KEEP(1),id%KEEP8(1),
1684
& id%PROCNODE_STEPS(1),
1685
& IS(1), LIW_PASSED,
1686
& id%STEP(1), id%BUFR(1), id%LBUFR, id%LBUFR_BYTES,
1687
& id%RHSCOMP(1), LENRHSCOMP)
1585
1688
ENDIF
1586
1689
IF ( id%MYID.eq.MASTER) THEN
1587
1690
IF (LSCAL) THEN
1588
1691
IF (SOLVET .EQ. 1) THEN
1589
1692
DO K = 1, N
1590
Y(K) = Y(K) * id%COLSCA(K)
1693
C_Y(K) = C_Y(K) * id%COLSCA(K)
1591
1694
END DO
1592
1695
ELSE
1593
1696
DO K = 1, N
1594
Y(K) = Y(K) * id%ROWSCA(K)
1697
C_Y(K) = C_Y(K) * id%ROWSCA(K)
1595
1698
END DO
1596
1699
ENDIF
1597
1700
END IF
1601
1704
INFO( 1 ) = INFO( 1 ) + 8
1602
1705
END IF
1603
1706
IF ( id%MYID .eq. MASTER ) THEN
1604
NB_BYTES = NB_BYTES - int(size(W),8)*K35_8
1707
NB_BYTES = NB_BYTES - int(size(R_W),8)*K16_8
1708
& - int(size(D ),8)*K16_8
1605
1709
& - int(size(IW1),8)*K34_8
1606
DEALLOCATE(W)
1710
DEALLOCATE(R_W,D)
1607
1711
DEALLOCATE(IW1)
1608
1712
ENDIF
1609
IF ( PROKG .AND. NITREF .GT. 0 .AND.
1610
*id%MYID .EQ. MASTER ) THEN
1713
IF ( PROKG ) THEN
1714
IF (NITREF.GT.0) THEN
1611
1715
WRITE( MPG, 81 )
1612
1716
WRITE( MPG, 141 ) 'NUMBER OF STEPS OF ITERATIVE REFINEMENTS
1613
*=', NOITER
1717
&=', NOITER
1718
ENDIF
1614
1719
ENDIF
1615
IF ( id%MYID .EQ. MASTER .AND. NITREF .GT. 0 ) THEN
1720
IF ( id%MYID .EQ. MASTER ) THEN
1721
IF ( NITREF .GT. 0 ) THEN
1616
1722
id%INFOG(15) = NOITER
1723
END IF
1617
1724
END IF
1618
IF ( PROK .AND. NITREF .GT.0 ) WRITE( MP, 131 )
1725
IF ( PROK .AND. ICNTL10 .GT.0 ) WRITE( MP, 131 )
1619
1726
IF (ICNTL11 .GT. 0) THEN
1620
1727
IF ( KEEP(54) .eq. 0 ) THEN
1621
1728
IF (id%MYID .EQ. MASTER) THEN
1622
1729
IF (KEEP(55).EQ.0) THEN
1623
1730
CALL ZMUMPS_278( MTYPE, N, NZ, id%A(1),
1624
* id%IRN(1), id%JCN(1),
1625
* RHS_MUMPS(IBEG), SAVERHS, Y, D, KEEP,KEEP8 )
1731
& id%IRN(1), id%JCN(1),
1732
& RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP,KEEP8 )
1626
1733
ELSE
1627
1734
CALL ZMUMPS_121( MTYPE, N,
1628
* id%NELT, id%ELTPTR,
1629
* id%LELTVAR, id%ELTVAR,
1630
* id%NA_ELT, id%A_ELT,
1631
* RHS_MUMPS(IBEG), SAVERHS, Y, D, KEEP,KEEP8 )
1735
& id%NELT, id%ELTPTR,
1736
& id%LELTVAR, id%ELTVAR,
1737
& id%NA_ELT, id%A_ELT,
1738
& RHS_MUMPS(IBEG), SAVERHS, R_Y, C_W, KEEP,KEEP8 )
1632
1739
ENDIF
1633
1740
END IF
1634
1741
ELSE
1635
1742
CALL MPI_BCAST( RHS_MUMPS(IBEG), id%N,
1636
* MPI_DOUBLE_COMPLEX, MASTER,
1637
* id%COMM, IERR )
1743
& MPI_DOUBLE_COMPLEX, MASTER,
1744
& id%COMM, IERR )
1638
1745
IF ( I_AM_SLAVE .and.
1639
* id%NZ_loc .NE. 0 ) THEN
1746
& id%NZ_loc .NE. 0 ) THEN
1640
1747
CALL ZMUMPS_192( id%N, id%NZ_loc,
1641
* id%IRN_loc, id%JCN_loc, id%A_loc,
1642
* RHS_MUMPS(IBEG), SRW1, KEEP(50), MTYPE )
1748
& id%IRN_loc, id%JCN_loc, id%A_loc,
1749
& RHS_MUMPS(IBEG), C_LOCWK54, KEEP(50), MTYPE )
1643
1750
ELSE
1644
SRW1 = dcmplx(ZERO)
1751
C_LOCWK54 = dcmplx(ZERO)
1645
1752
END IF
1646
1753
IF ( id%MYID .eq. MASTER ) THEN
1647
CALL MPI_REDUCE( SRW1, D,
1648
* id%N, MPI_DOUBLE_COMPLEX,
1649
* MPI_SUM,MASTER,id%COMM, IERR)
1650
D = SAVERHS - D
1754
CALL MPI_REDUCE( C_LOCWK54, C_W,
1755
& id%N, MPI_DOUBLE_COMPLEX,
1756
& MPI_SUM,MASTER,id%COMM, IERR)
1757
C_W = SAVERHS - C_W
1651
1758
ELSE
1652
CALL MPI_REDUCE( SRW1, DUMMY,
1653
* id%N, MPI_DOUBLE_COMPLEX,
1654
* MPI_SUM,MASTER,id%COMM, IERR)
1759
CALL MPI_REDUCE( C_LOCWK54, C_DUMMY,
1760
& id%N, MPI_DOUBLE_COMPLEX,
1761
& MPI_SUM,MASTER,id%COMM, IERR)
1655
1762
END IF
1656
1763
IF ( I_AM_SLAVE .and.
1657
* id%NZ_loc .NE. 0 ) THEN
1764
& id%NZ_loc .NE. 0 ) THEN
1658
1765
CALL ZMUMPS_207(id%A_loc,
1659
* id%NZ_loc, id%N,
1660
* id%IRN_loc, id%JCN_loc,
1661
* SRW1, id%KEEP,id%KEEP8 )
1766
& id%NZ_loc, id%N,
1767
& id%IRN_loc, id%JCN_loc,
1768
& R_LOCWK54, id%KEEP,id%KEEP8 )
1662
1769
ELSE
1663
SRW1 = dcmplx(ZERO)
1770
R_LOCWK54 = ZERO
1664
1771
END IF
1665
1772
IF ( id%MYID .eq. MASTER ) THEN
1666
CALL MPI_REDUCE( SRW1, Y,
1667
* id%N, MPI_DOUBLE_COMPLEX,
1668
* MPI_SUM,MASTER,id%COMM, IERR)
1773
CALL MPI_REDUCE( R_LOCWK54, R_Y,
1774
& id%N, MPI_DOUBLE_PRECISION,
1775
& MPI_SUM,MASTER,id%COMM, IERR)
1669
1776
ELSE
1670
CALL MPI_REDUCE( SRW1, DUMMY,
1671
* id%N, MPI_DOUBLE_COMPLEX,
1672
* MPI_SUM,MASTER,id%COMM, IERR)
1777
CALL MPI_REDUCE( R_LOCWK54, R_DUMMY,
1778
& id%N, MPI_DOUBLE_PRECISION,
1779
& MPI_SUM,MASTER,id%COMM, IERR)
1673
1780
END IF
1674
1781
END IF
1675
1782
IF (id%MYID .EQ. MASTER) THEN
1676
IF ((MPG .GT. 0) .AND. (NITREF .GT. 0)) WRITE( MPG, 65 )
1677
IF ((MPG .GT. 0) .AND. (NITREF .LE. 0)) WRITE( MPG, 170 )
1783
IF ((MPG .GT. 0) .AND. (NITREF .GT. 0)) WRITE( MPG, 65 )
1784
IF ((MPG .GT. 0) .AND. (NITREF .LE. 0)) WRITE( MPG, 170 )
1678
1785
GIVSOL = .FALSE.
1679
1786
CALL ZMUMPS_205(MTYPE,INFO(1),N,NZ,RHS_MUMPS(IBEG),
1680
* SAVERHS,Y,D,GIVSOL,
1681
* RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MPG,ICNTL,
1682
* KEEP,KEEP8)
1787
& SAVERHS,R_Y,C_W,GIVSOL,
1788
& RSOL,RINFOG(4),RINFOG(5),RINFOG(6),MPG,ICNTL,
1789
& KEEP,KEEP8)
1683
1790
IF ( MPG .GT. 0 ) THEN
1684
1791
WRITE( MPG, 115 )
1685
*'RINFOG(7):COMPONENTWISE SCALED RESIDUAL(W1)=', RINFOG(7)
1686
WRITE( MPG, 115 )
1687
*'------(8):---------------------------- (W2)=', RINFOG(8)
1688
WRITE( MPG, 115 )
1689
*'------(9):Upper bound ERROR ...............=', RINFOG(9)
1690
WRITE( MPG, 115 )
1691
*'-----(10):CONDITION NUMBER (1) ............=', RINFOG(10)
1692
WRITE( MPG, 115 )
1693
*'-----(11):CONDITION NUMBER (2) ............=', RINFOG(11)
1792
&'RINFOG(7):COMPONENTWISE SCALED RESIDUAL(W1)=', RINFOG(7)
1793
WRITE( MPG, 115 )
1794
&'------(8):---------------------------- (W2)=', RINFOG(8)
1795
WRITE( MPG, 115 )
1796
&'------(9):Upper bound ERROR ...............=', RINFOG(9)
1797
WRITE( MPG, 115 )
1798
&'-----(10):CONDITION NUMBER (1) ............=', RINFOG(10)
1799
WRITE( MPG, 115 )
1800
&'-----(11):CONDITION NUMBER (2) ............=', RINFOG(11)
1694
1801
END IF
1695
1802
END IF
1696
1803
END IF
1697
1804
IF (id%MYID == MASTER) THEN
1698
NB_BYTES = NB_BYTES - int(size(D),8)*K35_8
1699
DEALLOCATE(D)
1805
NB_BYTES = NB_BYTES - int(size(C_W),8)*K35_8
1806
DEALLOCATE(C_W)
1700
1807
ENDIF
1701
1808
NB_BYTES = NB_BYTES -
1702
& (int(size(Y),8)+int(size(SRW1),8))*K35_8
1703
DEALLOCATE(Y)
1704
DEALLOCATE(SRW1)
1809
& (int(size(R_Y),8)+int(size(R_LOCWK54),8))*K16_8
1810
NB_BYTES = NB_BYTES -
1811
& (int(size(C_Y),8)+int(size(C_LOCWK54),8))*K35_8
1812
DEALLOCATE(R_Y)
1813
DEALLOCATE(C_Y)
1814
DEALLOCATE(R_LOCWK54)
1815
DEALLOCATE(C_LOCWK54)
1705
1816
END IF
1706
1817
IF ( id%MYID .EQ. MASTER .AND. ICNTL21==0
1707
* .AND. KEEP(23) .NE. 0) THEN
1818
& .AND. KEEP(23) .NE. 0) THEN
1708
1819
IF ((KEEP(221).NE.1 .AND. ICNTL(9) .EQ. 1)
1709
* .OR. KEEP(111) .NE.0) THEN
1710
ALLOCATE( RW1( N ),stat =allocok )
1820
& .OR. KEEP(111) .NE.0) THEN
1821
ALLOCATE( C_RW1( N ),stat =allocok )
1711
1822
IF ( allocok .GT. 0 ) THEN
1712
1823
INFO(1)=-13
1713
1824
INFO(2)=N
1717
1828
DO K = 1, NBRHS_EFF
1718
1829
KDEC = (K-1)*LD_RHS+IBEG-1
1719
1830
DO 70 I = 1, N
1720
RW1(I) = RHS_MUMPS(KDEC+I)
1831
C_RW1(I) = RHS_MUMPS(KDEC+I)
1721
1832
70 CONTINUE
1722
1833
DO 80 I = 1, N
1723
1834
JPERM = id%UNS_PERM(I)
1724
RHS_MUMPS( KDEC+JPERM ) = RW1( I )
1835
RHS_MUMPS( KDEC+JPERM ) = C_RW1( I )
1725
1836
80 CONTINUE
1726
1837
END DO
1727
DEALLOCATE( RW1 )
1838
DEALLOCATE( C_RW1 )
1728
1839
END IF
1729
1840
END IF
1730
1841
IF (id%MYID.EQ.MASTER .and.ICNTL21==0.and.KEEP(221).NE.1) THEN
1731
1842
IF ( INFO(1) .GE. 0 .AND. ICNTL(4).GE.3 .AND. ICNTL(3).GT.0)
1732
* THEN
1843
& THEN
1733
1844
K = min0(10, N)
1734
1845
IF (ICNTL(4) .eq. 4 ) K = N
1735
1846
J = min0(10,NBRHS_EFF)
1737
1848
DO II=1, J
1738
1849
WRITE(ICNTL(3),110) BEG_RHS+II-1
1739
1850
WRITE(ICNTL(3),160)
1740
* (RHS_MUMPS(IBEG+(II-1)*LRHS+I-1),I=1,K)
1851
& (RHS_MUMPS(IBEG+(II-1)*LRHS+I-1),I=1,K)
1741
1852
ENDDO
1742
1853
END IF
1743
1854
END IF
1773
1884
IF (IERR.LT.0 .AND. INFO(1) .GE. 0) INFO(1) = IERR
1774
1885
ENDIF
1775
1886
CALL MUMPS_276( ICNTL, INFO,
1776
* id%COMM,id%MYID)
1887
& id%COMM,id%MYID)
1777
1888
ENDIF
1778
1889
IF (associated(id%BUFR)) THEN
1779
1890
NB_BYTES = NB_BYTES - int(size(id%BUFR),8)*K34_8
1798
1909
DEALLOCATE( SAVERHS)
1799
1910
ENDIF
1800
1911
IF (
1801
* ( (ICNTL20 .ne. 0 .OR.KEEP(111).NE.0)
1802
* .and. ICNTL21.ne.0 )
1803
* )
1804
* THEN
1912
& ( (ICNTL20 .ne. 0 .OR.KEEP(111).NE.0)
1913
& .and. ICNTL21.ne.0 )
1914
& )
1915
& THEN
1805
1916
IF ( I_AM_SLAVE ) THEN
1806
NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8
1807
DEALLOCATE(RHS_MUMPS)
1917
IF (ASSOCIATED(RHS_MUMPS) ) THEN
1918
NB_BYTES = NB_BYTES - int(size(RHS_MUMPS),8)*K35_8
1919
DEALLOCATE(RHS_MUMPS)
1920
ENDIF
1808
1921
ENDIF
1809
1922
ENDIF
1810
1923
NULLIFY(RHS_MUMPS)
1826
1939
ENDIF
1827
1940
IF (LSCAL .AND. ICNTL21==1) THEN
1828
1941
NB_BYTES = NB_BYTES -
1829
& int(size(scaling_data%SCALING_LOC),8)*K35_8
1942
& int(size(scaling_data%SCALING_LOC),8)*K16_8
1830
1943
DEALLOCATE(scaling_data%SCALING_LOC)
1831
1944
NULLIFY(scaling_data%SCALING_LOC)
1832
1945
ENDIF
1833
IF (ASSOCIATED(id%S).AND.KEEP(201).GT.0) THEN
1834
NB_BYTES = NB_BYTES - int(size(id%S),8)*K35_8
1946
IF (WK_USER_PROVIDED) THEN
1947
NULLIFY(id%S)
1948
ELSE IF (associated(id%S).AND.KEEP(201).GT.0) THEN
1949
NB_BYTES = NB_BYTES - KEEP8(23)*K35_8
1950
id%KEEP8(23)=0_8
1835
1951
DEALLOCATE(id%S)
1836
1952
NULLIFY(id%S)
1837
1953
ENDIF
1859
1975
110 FORMAT (//' VECTOR SOLUTION FOR COLUMN ',I12)
1860
1976
115 FORMAT(1X, A44,1P,D9.2)
1861
1977
120 FORMAT(//' LEAVING SOLVER WITH: INFOG(1) ............ =',I12/
1862
* ' INFOG(2) ............ =',I12)
1978
& ' INFOG(2) ............ =',I12)
1863
1979
150 FORMAT (/' STATISTICS PRIOR SOLVE PHASE ...........'/
1864
* ' NUMBER OF RIGHT-HAND-SIDES =',I12/
1865
* ' BLOCKING FACTOR FOR MULTIPLE RHS =',I12/
1866
* ' ICNTL (9) =',I12/
1867
* ' --- (10) =',I12/
1868
* ' --- (11) =',I12/
1869
* ' --- (20) =',I12/
1870
* ' --- (21) =',I12)
1980
& ' NUMBER OF RIGHT-HAND-SIDES =',I12/
1981
& ' BLOCKING FACTOR FOR MULTIPLE RHS =',I12/
1982
& ' ICNTL (9) =',I12/
1983
& ' --- (10) =',I12/
1984
& ' --- (11) =',I12/
1985
& ' --- (20) =',I12/
1986
& ' --- (21) =',I12)
1871
1987
151 FORMAT (' --- (25) =',I12)
1872
1988
152 FORMAT (' --- (26) =',I12)
1873
1989
160 FORMAT (' RHS'/(1X,1P,5D14.6))
1879
1995
141 FORMAT(1X, A42,I4)
1880
1996
END SUBROUTINE ZMUMPS_301
1881
1997
SUBROUTINE ZMUMPS_245(root, N, A, LA, IW, LIW, W, LWC,
1882
* IWCB,LIWW,RHS,LRHS,NRHS,NA,LNA,NE_STEPS, W2,
1883
* MTYPE, ICNTL,
1884
* STEP, FRERE, DAD, FILS, PTRIST, PTRFAC, IW1,LIW1,
1885
* PROCNODE_STEPS, SLAVEF,
1886
* INFO, KEEP,KEEP8, COMM, COMM_NODES, MYID,
1887
* MYID_NODES,
1888
* BUFR, LBUFR, LBUFR_BYTES,
1889
*
1890
* ISTEP_TO_INIV2, TAB_POS_IN_PERE,
1891
* IBEG_ROOT_DEF, IEND_ROOT_DEF,
1892
* IROOT_DEF_RHS_COL1, IPT_RHS_ROOT, SIZE_ROOT, MASTER_ROOT,
1893
* RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP
1894
* )
1998
& IWCB,LIWW,RHS,LRHS,NRHS,NA,LNA,NE_STEPS, W2,
1999
& MTYPE, ICNTL,
2000
& STEP, FRERE, DAD, FILS, PTRIST, PTRFAC, IW1,LIW1,
2001
& PROCNODE_STEPS, SLAVEF,
2002
& INFO, KEEP,KEEP8, COMM, COMM_NODES, MYID,
2003
& MYID_NODES,
2004
& BUFR, LBUFR, LBUFR_BYTES,
2005
&
2006
& ISTEP_TO_INIV2, TAB_POS_IN_PERE,
2007
& IBEG_ROOT_DEF, IEND_ROOT_DEF,
2008
& IROOT_DEF_RHS_COL1, IPT_RHS_ROOT, SIZE_ROOT, MASTER_ROOT,
2009
& RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP
2010
& )
1895
2011
USE ZMUMPS_OOC
1896
2012
IMPLICIT NONE
1897
2013
INCLUDE 'zmumps_root.h'
1899
2015
INCLUDE 'VT.inc'
1900
2016
#endif
1901
2017
TYPE ( ZMUMPS_ROOT_STRUC ) :: root
1902
INTEGER LA,LWC,N,LIW,MTYPE,LIW1,LIWW,LNA
2018
INTEGER(8) :: LA
2019
INTEGER LWC,N,LIW,MTYPE,LIW1,LIWW,LNA
1903
2020
INTEGER ICNTL(40),INFO(40), KEEP(500)
1904
2021
INTEGER*8 KEEP8(150)
1905
2022
INTEGER IW(LIW),IW1(LIW1),NA(LNA),NE_STEPS(KEEP(28)),IWCB(LIWW)
1906
2023
INTEGER STEP(N), FRERE(KEEP(28)), FILS(N), PTRIST(KEEP(28)),
1907
* PTRFAC(KEEP(28)), DAD(KEEP(28))
2024
& DAD(KEEP(28))
2025
INTEGER(8) :: PTRFAC(KEEP(28))
1908
2026
INTEGER LRHS, NRHS, LRHSCOMP
1909
2027
COMPLEX*16 A(LA), W(LWC), RHS(LRHS,NRHS),
1910
* W2(KEEP(133)),
1911
* RHSCOMP(LRHSCOMP,NRHS)
2028
& W2(KEEP(133)),
2029
& RHSCOMP(LRHSCOMP,NRHS)
1912
2030
INTEGER SLAVEF, COMM, COMM_NODES, MYID, MYID_NODES
1913
2031
INTEGER PROCNODE_STEPS(KEEP(28)), POSINRHSCOMP(KEEP(28))
1914
2032
INTEGER LBUFR, LBUFR_BYTES
1915
2033
INTEGER BUFR(LBUFR)
1916
2034
INTEGER ISTEP_TO_INIV2(KEEP(71)),
1917
* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
2035
& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
1918
2036
INTEGER IBEG_ROOT_DEF, IEND_ROOT_DEF, IROOT_DEF_RHS_COL1
1919
2037
INTEGER NRHS_LOC
1920
2038
INTEGER IPT_RHS_ROOT, SIZE_ROOT, MASTER_ROOT
1927
2045
INTEGER IDUMMY(1), LIDUMMY, DUMMY, WHAT
1928
2046
INTEGER IPT_RHS_ROOT_LOC
1929
2047
INTEGER IERR
1930
INTEGER IOLDPS, IAPOS,
1931
* LOCAL_M ,
1932
* LOCAL_N
2048
INTEGER(8) :: IAPOS
2049
INTEGER IOLDPS,
2050
& LOCAL_M,
2051
& LOCAL_N
1933
2052
#if defined(V_T)
1934
2053
INTEGER soln_c_class, forw_soln, back_soln, root_soln
1935
2054
#endif
1936
2055
INTEGER INODE, IPOS, LIELL, NPIV,J1,JJ
1937
2056
INTEGER IZERO
1938
COMPLEX*16 ZERO
1939
2057
LOGICAL DOFORWARD, DOROOT, DOBACKWARD
1940
2058
LOGICAL I_WORKED_ON_ROOT
1941
2059
INTEGER IROOT
1942
2060
LOGICAL DOROOT_FWD_OOC, DOROOT_BWD_PANEL
1943
2061
LOGICAL DUMMY_BOOL
1944
2062
PARAMETER (IZERO = 0 )
1945
PARAMETER (ZERO = 0.0D0)
1946
2063
INCLUDE 'mumps_headers.h'
1947
2064
EXTERNAL ZMUMPS_248, ZMUMPS_249
1948
2065
INTEGER MUMPS_275
2000
2117
DOROOT = .FALSE.
2001
2118
ENDIF
2002
2119
DOROOT_BWD_PANEL = DOROOT .AND. MTYPE.NE.1 .AND. KEEP(50).EQ.0
2003
* .AND. KEEP(201).EQ.1
2120
& .AND. KEEP(201).EQ.1
2004
2121
DOROOT_FWD_OOC = DOROOT .AND. .NOT.DOROOT_BWD_PANEL
2005
2122
IF (KEEP(201).NE.0) THEN
2006
2123
IF (DOFORWARD .OR. DOROOT_FWD_OOC) THEN
2007
2124
CALL ZMUMPS_583(PTRFAC,KEEP(28),MTYPE,
2008
* A,LA,DOFORWARD,IERR)
2125
& A,LA,DOFORWARD,IERR)
2009
2126
IF(IERR.LT.0)THEN
2010
2127
INFO(1)=IERR
2011
2128
INFO(2)=0
2023
2140
CALL VTBEGIN(forw_soln,ierr)
2024
2141
#endif
2025
2142
CALL ZMUMPS_248(N, A(1), LA, IW(1), LIW, W(1),
2026
* LWC_LOC, RHS, LRHS, NRHS,
2027
* IW1(PTRICB), IWCB, LIWW,
2028
* RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP,
2029
* NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS,
2030
* IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC,
2031
* MYLEAF,INFO,
2032
* KEEP,KEEP8,
2033
* PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES,
2034
* BUFR, LBUFR, LBUFR_BYTES,
2035
* W( IPT_RHS_ROOT ), MTYPE_LOC,
2036
*
2037
* ISTEP_TO_INIV2, TAB_POS_IN_PERE
2038
* )
2143
& LWC_LOC, RHS, LRHS, NRHS,
2144
& IW1(PTRICB), IWCB, LIWW,
2145
& RHSCOMP,LRHSCOMP,POSINRHSCOMP,BUILD_POSINRHSCOMP,
2146
& NE_STEPS, NA, LNA, STEP, FRERE,DAD,FILS,
2147
& IW1(NSTK_S),IW1(IPOOL),LPOOL,PTRIST,PTRFAC,
2148
& MYLEAF,INFO,
2149
& KEEP,KEEP8,
2150
& PROCNODE_STEPS, SLAVEF, COMM_NODES, MYID_NODES,
2151
& BUFR, LBUFR, LBUFR_BYTES,
2152
& W( IPT_RHS_ROOT ), MTYPE_LOC,
2153
&
2154
& ISTEP_TO_INIV2, TAB_POS_IN_PERE
2155
& )
2039
2156
BUILD_POSINRHSCOMP = .FALSE.
2040
2157
#if defined(V_T)
2041
2158
CALL VTEND(forw_soln,ierr)
2045
2162
IF ( INFO(1) .LT. 0 ) THEN
2046
2163
IF ( LP .GT. 0 ) THEN
2047
2164
WRITE(LP,*) MYID,
2048
* ': ** ERROR RETURN FROM ZMUMPS_248,INFO(1:2)=',
2049
* INFO(1:2)
2165
& ': ** ERROR RETURN FROM ZMUMPS_248,INFO(1:2)=',
2166
& INFO(1:2)
2050
2167
END IF
2051
2168
RETURN
2052
2169
END IF
2054
2171
IF(KEEP(201).EQ.1.AND.DOROOT_BWD_PANEL) THEN
2055
2172
I_WORKED_ON_ROOT = .FALSE.
2056
2173
CALL ZMUMPS_584(PTRFAC,KEEP(28),MTYPE,
2057
* I_WORKED_ON_ROOT, IROOT, A, LA, IERR)
2174
& I_WORKED_ON_ROOT, IROOT, A, LA, IERR)
2058
2175
IF (IERR .LT. 0) THEN
2059
2176
INFO(1) = -90
2060
2177
INFO(2) = IERR
2073
2190
IF (KEEP(201).NE.0) THEN
2074
2191
CALL ZMUMPS_643(
2075
2192
& KEEP(38),PTRFAC,KEEP,A,LA,
2076
$ STEP,KEEP8,N,DUMMY_BOOL,IERR)
2193
& STEP,KEEP8,N,DUMMY_BOOL,IERR)
2077
2194
IF(IERR.LT.0)THEN
2078
2195
INFO(1)=IERR
2079
2196
INFO(2)=0
2080
2197
WRITE(*,*) '** ERROR after ZMUMPS_643',
2081
* INFO(1)
2198
& INFO(1)
2082
2199
call MUMPS_ABORT()
2083
2200
ENDIF
2084
2201
ENDIF
2087
2204
CALL VTBEGIN(root_soln,ierr)
2088
2205
#endif
2089
2206
CALL DESCINIT( root%DESCB, root%TOT_ROOT_SIZE,
2090
* NRHS, root%MBLOCK, root%NBLOCK, 0, 0,
2091
* root%CNTXT_BLACS, LOCAL_M, IERR )
2207
& NRHS, root%MBLOCK, root%NBLOCK, 0, 0,
2208
& root%CNTXT_BLACS, LOCAL_M, IERR )
2092
2209
IF (IERR.NE.0) THEN
2093
2210
WRITE(*,*) 'After DESCINIT, IERR = ', IERR
2094
2211
CALL MUMPS_ABORT()
2095
2212
END IF
2096
2213
#if defined(null_space_old)
2097
2214
CALL ZMUMPS_352( NRHS, root%DESCRIPTOR,
2098
* root%DESCB,
2099
* root%CNTXT_BLACS, LOCAL_M, LOCAL_N,
2100
* root%MBLOCK, root%NBLOCK,
2101
* root%IPIV, root%LPIV, MASTER_ROOT, MYID_NODES,
2102
* COMM_NODES,
2103
* W( IPT_RHS_ROOT ),
2104
* root%TOT_ROOT_SIZE, A( IAPOS ),
2105
* INFO(1), MTYPE, KEEP(50), KEEP(19),
2106
* root%QR_TAU, W(1), LWC_LOC, KEEP(17),
2107
* root%MAXG, root%GIND, root%GROW, root%GCOS, root%GSIN )
2215
& root%DESCB,
2216
& root%CNTXT_BLACS, LOCAL_M, LOCAL_N,
2217
& root%MBLOCK, root%NBLOCK,
2218
& root%IPIV, root%LPIV, MASTER_ROOT, MYID_NODES,
2219
& COMM_NODES,
2220
& W( IPT_RHS_ROOT ),
2221
& root%TOT_ROOT_SIZE, A( IAPOS ),
2222
& INFO(1), MTYPE, KEEP(50), KEEP(19),
2223
& root%QR_TAU, W(1), LWC_LOC, KEEP(17),
2224
& root%MAXG, root%GIND, root%GROW, root%GCOS, root%GSIN )
2108
2225
#else
2109
2226
CALL ZMUMPS_286( NRHS, root%DESCRIPTOR, root%DESCB,
2110
* root%CNTXT_BLACS, LOCAL_M, LOCAL_N,
2111
* root%MBLOCK, root%NBLOCK,
2112
* root%IPIV, root%LPIV, MASTER_ROOT, MYID_NODES,
2113
* COMM_NODES,
2114
* W( IPT_RHS_ROOT ),
2115
* root%TOT_ROOT_SIZE, A( IAPOS ),
2116
* INFO(1), MTYPE, KEEP(50))
2227
& root%CNTXT_BLACS, LOCAL_M, LOCAL_N,
2228
& root%MBLOCK, root%NBLOCK,
2229
& root%IPIV, root%LPIV, MASTER_ROOT, MYID_NODES,
2230
& COMM_NODES,
2231
& W( IPT_RHS_ROOT ),
2232
& root%TOT_ROOT_SIZE, A( IAPOS ),
2233
& INFO(1), MTYPE, KEEP(50))
2117
2234
#endif
2118
2235
IF(KEEP(201).NE.0)THEN
2119
2236
CALL ZMUMPS_598(KEEP(38),
2120
$ PTRFAC,KEEP(28),A,LA,.FALSE.,IERR)
2237
& PTRFAC,KEEP(28),A,LA,.FALSE.,IERR)
2121
2238
IF(IERR.LT.0)THEN
2122
2239
INFO(1)=IERR
2123
2240
INFO(2)=0
2124
2241
WRITE(*,*) '** ERROR after ZMUMPS_598 ',
2125
* INFO(1)
2242
& INFO(1)
2126
2243
call MUMPS_ABORT()
2127
2244
ENDIF
2128
2245
ENDIF
2129
2246
ENDIF
2130
2247
ELSE
2131
2248
IF (
2132
* (KEEP(221).EQ.0) .AND.
2133
* ( MYID_NODES .eq. MUMPS_275( STEP(KEEP(38)),
2134
* PROCNODE_STEPS, SLAVEF ) )
2135
* ) THEN
2136
W( IPT_RHS_ROOT:IPT_RHS_ROOT+NRHS*SIZE_ROOT- 1) = 0.0D0
2249
& (KEEP(221).EQ.0) .AND.
2250
& ( MYID_NODES .eq. MUMPS_275( STEP(KEEP(38)),
2251
& PROCNODE_STEPS, SLAVEF ) )
2252
& ) THEN
2253
W( IPT_RHS_ROOT:IPT_RHS_ROOT+NRHS*SIZE_ROOT- 1)
2254
& = dcmplx(0.0D0)
2137
2255
ENDIF
2138
2256
ENDIF
2139
2257
ELSE IF ( KEEP(20) .NE. 0 ) THEN
2140
2258
IF ( MYID_NODES .eq. MUMPS_275( STEP(KEEP(20)),
2141
* PROCNODE_STEPS, SLAVEF ) ) THEN
2259
& PROCNODE_STEPS, SLAVEF ) ) THEN
2142
2260
IF (KEEP(221).EQ.0)
2143
& W( IPT_RHS_ROOT:IPT_RHS_ROOT+NRHS*SIZE_ROOT- 1) = 0.0D0
2261
& W( IPT_RHS_ROOT:IPT_RHS_ROOT+NRHS*SIZE_ROOT- 1)
2262
& = dcmplx(0.0D0)
2144
2263
END IF
2145
2264
END IF
2146
2265
#if defined(V_T)
2152
2271
IF (BUILD_POSINRHSCOMP) THEN
2153
2272
WHAT = 0
2154
2273
CALL ZMUMPS_639
2155
* (SLAVEF, N, MYID_NODES,
2156
* PTRIST,
2157
* KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP,
2158
* POSINRHSCOMP, IDUMMY, LIDUMMY, DUMMY, WHAT)
2274
& (SLAVEF, N, MYID_NODES,
2275
& PTRIST,
2276
& KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP,
2277
& POSINRHSCOMP, IDUMMY, LIDUMMY, DUMMY, WHAT)
2159
2278
BUILD_POSINRHSCOMP=.FALSE.
2160
2279
ENDIF
2161
2280
IF ( KEEP(201).NE.0 .AND. .NOT. DOROOT_BWD_PANEL )
2162
* THEN
2281
& THEN
2163
2282
I_WORKED_ON_ROOT = DOROOT
2164
IROOT = max(KEEP(20),keep(38))
2283
IROOT = max(KEEP(20),KEEP(38))
2165
2284
CALL ZMUMPS_584(PTRFAC,KEEP(28),MTYPE,
2166
* I_WORKED_ON_ROOT, IROOT, A, LA, IERR)
2285
& I_WORKED_ON_ROOT, IROOT, A, LA, IERR)
2167
2286
ENDIF
2168
2287
IF ( KEEP( 50 ) .eq. 0 ) THEN
2169
2288
MTYPE_LOC = MTYPE
2174
2293
CALL VTBEGIN(back_soln,ierr)
2175
2294
#endif
2176
2295
CALL ZMUMPS_249( N, A, LA, IW, LIW, W(1), LWC_LOC,
2177
* RHS, LRHS, NRHS,
2178
* RHSCOMP, LRHSCOMP, POSINRHSCOMP,
2179
* IW1(PTRICB),IW1(PTRACB),IWCB,LIWW,
2180
* W2, NE_STEPS, NA, LNA, STEP, FRERE,FILS,
2181
* IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO,
2182
* PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES,
2183
* BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8,
2184
* W( IPT_RHS_ROOT ),
2185
* MTYPE_LOC,
2186
* ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS),
2187
* LPANEL_POS)
2296
& RHS, LRHS, NRHS,
2297
& RHSCOMP, LRHSCOMP, POSINRHSCOMP,
2298
& IW1(PTRICB),IW1(PTRACB),IWCB,LIWW,
2299
& W2, NE_STEPS, NA, LNA, STEP, FRERE,FILS,
2300
& IW1(IPOOL),LPOOL,PTRIST,PTRFAC,MYLEAF,INFO,
2301
& PROCNODE_STEPS, SLAVEF, COMM_NODES,MYID_NODES,
2302
& BUFR, LBUFR, LBUFR_BYTES, KEEP,KEEP8,
2303
& W( IPT_RHS_ROOT ),
2304
& MTYPE_LOC,
2305
& ISTEP_TO_INIV2, TAB_POS_IN_PERE, IW1(IPANEL_POS),
2306
& LPANEL_POS)
2188
2307
#if defined(V_T)
2189
2308
CALL VTEND(back_soln,ierr)
2190
2309
#endif
2196
2315
WRITE (MP,99992)
2197
2316
IF (N.GT.0) WRITE (MP,99993) (RHS(I,1),I=1,K)
2198
2317
IF (N.GT.0.and.NRHS>1)
2199
* WRITE (MP,99994) (RHS(I,2),I=1,K)
2318
& WRITE (MP,99994) (RHS(I,2),I=1,K)
2200
2319
ENDIF
2201
2320
ENDIF
2202
2321
RETURN
2207
2326
99992 FORMAT (//' LEAVING SOLVE (MPI41C) WITH')
2208
2327
END SUBROUTINE ZMUMPS_245
2209
2328
SUBROUTINE ZMUMPS_521(NSLAVES, N, MYID, COMM,
2210
* MTYPE, RHS, LRHS, NRHS, PTRIST,
2211
* KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, BUFFER,
2212
* SIZE_BUF, SIZE_BUF_BYTES )
2329
& MTYPE, RHS, LRHS, NRHS, PTRIST,
2330
& KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP, BUFFER,
2331
& SIZE_BUF, SIZE_BUF_BYTES, CWORK, LCWORK )
2213
2332
IMPLICIT NONE
2214
2333
INCLUDE 'mpif.h'
2215
2334
INCLUDE 'mumps_tags.h'
2216
2335
INTEGER NSLAVES, N, MYID, COMM, LIW, MTYPE
2217
INTEGER NRHS, LRHS
2336
INTEGER NRHS, LRHS, LCWORK
2218
2337
COMPLEX*16 RHS (LRHS, NRHS)
2219
2338
INTEGER KEEP(500)
2220
2339
INTEGER*8 KEEP8(150)
2340
COMPLEX*16 :: CWORK(LCWORK)
2221
2341
INTEGER PTRIST(KEEP(28)), PROCNODE_STEPS(KEEP(28))
2222
2342
INTEGER IW(LIW), STEP(N)
2223
2343
INTEGER SIZE_BUF, SIZE_BUF_BYTES
2224
INTEGER BUFFER(SIZE_BUF_BYTES)
2225
INTEGER I, J, JJ, J1, ISTEP, MASTER,
2226
* MYID_NODES, TYPE_PARAL, N2RECV
2227
INTEGER LIELL, IPOS, NPIV
2344
INTEGER BUFFER(SIZE_BUF)
2345
INTEGER I, II, J, J1, ISTEP, MASTER,
2346
& MYID_NODES, TYPE_PARAL, N2RECV
2347
INTEGER LIELL, IPOS, NPIV, MAXNPIV_estim, MAXSurf
2228
2348
INTEGER MSGSOU, STATUS(MPI_STATUS_SIZE), IERR
2229
2349
PARAMETER(MASTER=0)
2230
2350
LOGICAL I_AM_SLAVE
2231
2351
INTEGER RECORD_SIZE_P_1, SIZE1, SIZE2
2232
INTEGER POS_BUF, N2SEND, IROW
2352
INTEGER POS_BUF, N2SEND
2233
2353
INTEGER SK38, SK20
2234
COMPLEX*16 ONE_ROW(NRHS)
2354
INTEGER, PARAMETER :: FIN = -1
2355
INTEGER, PARAMETER :: yes = 1
2356
INTEGER, PARAMETER :: no = 0
2357
INTEGER, ALLOCATABLE, DIMENSION(:) :: IROWlist(:)
2358
INTEGER :: ONE_PACK
2235
2359
INCLUDE 'mumps_headers.h'
2236
2360
INTEGER MUMPS_275
2237
2361
EXTERNAL MUMPS_275
2238
IF (NSLAVES.EQ.1 .AND. KEEP(46).EQ.1) RETURN
2239
IF (NSLAVES.EQ.1 .AND. KEEP(46).EQ.0) THEN
2240
DO J=1, NRHS
2362
TYPE_PARAL = KEEP(46)
2363
I_AM_SLAVE = MYID .ne. 0 .OR. TYPE_PARAL .eq. 1
2364
IF ( TYPE_PARAL == 1 ) THEN
2365
MYID_NODES = MYID
2366
ELSE
2367
MYID_NODES = MYID-1
2368
ENDIF
2369
IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.1) RETURN
2370
IF (NSLAVES.EQ.1 .AND. TYPE_PARAL.EQ.0) THEN
2371
DO J=1, NRHS
2241
2372
IF ( MYID .EQ. 1 ) THEN
2242
2373
CALL MPI_SEND(RHS(1, J), N, MPI_DOUBLE_COMPLEX, MASTER,
2243
* GatherSol, COMM, IERR)
2244
*
2374
& GatherSol, COMM, IERR)
2375
&
2245
2376
ELSE
2246
2377
CALL MPI_RECV(RHS(1, J), N, MPI_DOUBLE_COMPLEX,
2247
* 1,
2248
* GatherSol, COMM, STATUS, IERR )
2378
& 1,
2379
& GatherSol, COMM, STATUS, IERR )
2249
2380
ENDIF
2250
ENDDO
2251
RETURN
2252
ENDIF
2253
N2SEND=0
2254
N2RECV=N
2255
POS_BUF=0
2256
TYPE_PARAL = KEEP(46)
2381
ENDDO
2382
RETURN
2383
ENDIF
2384
MAXNPIV_estim = max(KEEP(246), KEEP(247))
2385
MAXSurf = MAXNPIV_estim*NRHS
2386
IF (LCWORK .GE. MAXSurf) THEN
2387
ONE_PACK = yes
2388
ELSE IF (LCWORK .GE. MAXNPIV_estim) THEN
2389
ONE_PACK = no
2390
ELSE
2391
WRITE(*,*)
2392
& "Internal error 2 in ZMUMPS_521:",
2393
& TYPE_PARAL, LCWORK, KEEP(247), NRHS
2394
CALL MUMPS_ABORT()
2395
ENDIF
2396
IF (ONE_PACK .EQ. no .AND. I_AM_SLAVE) THEN
2397
WRITE(*,*)
2398
& "Internal error 1 in ZMUMPS_521:",
2399
& TYPE_PARAL, LCWORK, KEEP(246),KEEP(247), NRHS
2400
CALL MUMPS_ABORT()
2401
ENDIF
2402
IF (TYPE_PARAL .EQ. 0)
2403
&CALL MPI_BCAST(ONE_PACK, 1, MPI_INTEGER,
2404
& MASTER, COMM, IERR)
2405
IF (MYID.EQ.MASTER) THEN
2406
ALLOCATE(IROWlist(KEEP(247)))
2407
ENDIF
2408
IF (NSLAVES .EQ. 1 .AND. TYPE_PARAL .EQ. 1) THEN
2409
CALL MUMPS_ABORT()
2410
ENDIF
2411
SIZE1=0
2412
CALL MPI_PACK_SIZE(MAXNPIV_estim+2,MPI_INTEGER, COMM,
2413
& SIZE1, IERR)
2414
SIZE2=0
2415
CALL MPI_PACK_SIZE(MAXSurf,MPI_DOUBLE_COMPLEX, COMM,
2416
& SIZE2, IERR)
2417
RECORD_SIZE_P_1= SIZE1+SIZE2
2418
IF (RECORD_SIZE_P_1.GT.SIZE_BUF_BYTES) THEN
2419
write(6,*) MYID,
2420
& ' Internal error 3 in ZMUMPS_521 '
2421
write(6,*) MYID, ' RECORD_SIZE_P_1, SIZE_BUF_BYTES=',
2422
& RECORD_SIZE_P_1, SIZE_BUF_BYTES
2423
CALL MUMPS_ABORT()
2424
ENDIF
2425
N2SEND =0
2426
N2RECV =N
2427
POS_BUF =0
2257
2428
IF (KEEP(38).NE.0) THEN
2258
2429
SK38=STEP(KEEP(38))
2259
2430
ELSE
2264
2435
ELSE
2265
2436
SK20=0
2266
2437
ENDIF
2267
IF (NSLAVES > 1 .OR. TYPE_PARAL == 0) THEN
2268
CALL MPI_PACK_SIZE(2,MPI_INTEGER, COMM, SIZE1, IERR)
2269
CALL MPI_PACK_SIZE(NRHS,MPI_DOUBLE_COMPLEX, COMM,
2270
* SIZE2, IERR)
2271
RECORD_SIZE_P_1= SIZE1+SIZE2
2272
ELSE
2273
RECORD_SIZE_P_1 = -9999
2274
ENDIF
2275
I_AM_SLAVE = MYID .ne. 0 .OR. TYPE_PARAL .eq. 1
2276
IF ( TYPE_PARAL == 1 ) THEN
2277
MYID_NODES = MYID
2278
ELSE
2279
MYID_NODES = MYID-1
2280
ENDIF
2281
2438
IF (I_AM_SLAVE) THEN
2282
2439
POS_BUF = 0
2283
2440
DO ISTEP = 1, KEEP(28)
2284
2441
IF (MYID_NODES == MUMPS_275(ISTEP,
2285
* PROCNODE_STEPS,NSLAVES)) THEN
2442
& PROCNODE_STEPS,NSLAVES)) THEN
2286
2443
IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN
2287
2444
IPOS = PTRIST(ISTEP)
2288
2445
LIELL = IW(IPOS+3+KEEP(IXSZ))
2302
2459
J1=IPOS+1
2303
2460
END IF
2304
2461
IF (MYID .EQ. MASTER) THEN
2305
N2RECV=N2RECV-NPIV
2462
N2RECV=N2RECV-NPIV
2306
2463
ELSE
2307
DO JJ=J1,J1+NPIV-1
2308
CALL ZMUMPS_522( IW(JJ), RHS(IW(JJ),1:NRHS) )
2309
ENDDO
2464
IF (NPIV.GT.0)
2465
& CALL ZMUMPS_522( ONE_PACK )
2310
2466
ENDIF
2311
2467
ENDIF
2312
2468
ENDDO
2315
2471
IF ( MYID .EQ. MASTER ) THEN
2316
2472
DO WHILE (N2RECV .NE. 0)
2317
2473
CALL MPI_RECV( BUFFER, SIZE_BUF_BYTES, MPI_PACKED,
2318
* MPI_ANY_SOURCE,
2319
* GatherSol, COMM, STATUS, IERR )
2474
& MPI_ANY_SOURCE,
2475
& GatherSol, COMM, STATUS, IERR )
2320
2476
POS_BUF = 0
2321
2477
CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF,
2322
* IROW, 1, MPI_INTEGER, COMM, IERR)
2323
DO WHILE (IROW.NE.0)
2324
CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF,
2325
* ONE_ROW, NRHS, MPI_DOUBLE_COMPLEX,
2326
* COMM, IERR)
2327
RHS(IROW,1:NRHS)=ONE_ROW
2478
& NPIV, 1, MPI_INTEGER, COMM, IERR)
2479
DO WHILE (NPIV.NE.FIN)
2480
CALL MPI_UNPACK( BUFFER,SIZE_BUF_BYTES, POS_BUF,
2481
& IROWlist, NPIV, MPI_INTEGER, COMM, IERR)
2482
IF (ONE_PACK.EQ.yes) THEN
2483
CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF,
2484
& CWORK, NPIV*NRHS, MPI_DOUBLE_COMPLEX,
2485
& COMM, IERR)
2486
DO J=1, NRHS
2487
DO I=1,NPIV
2488
RHS(IROWlist(I),J)=
2489
& CWORK(I+(J-1)*NPIV)
2490
ENDDO
2491
END DO
2492
ELSE
2493
DO J=1,NRHS
2494
CALL MPI_UNPACK(BUFFER, SIZE_BUF_BYTES, POS_BUF,
2495
& CWORK, NPIV, MPI_DOUBLE_COMPLEX,
2496
& COMM, IERR)
2497
DO I=1,NPIV
2498
RHS(IROWlist(I),J)=CWORK(I)
2499
ENDDO
2500
ENDDO
2501
ENDIF
2502
N2RECV=N2RECV-NPIV
2328
2503
CALL MPI_UNPACK( BUFFER, SIZE_BUF_BYTES, POS_BUF,
2329
* IROW, 1, MPI_INTEGER, COMM, IERR)
2330
N2RECV=N2RECV-1
2504
& NPIV, 1, MPI_INTEGER, COMM, IERR)
2331
2505
ENDDO
2332
2506
ENDDO
2507
DEALLOCATE(IROWlist)
2333
2508
ENDIF
2334
2509
RETURN
2335
2510
CONTAINS
2336
SUBROUTINE ZMUMPS_522(IROW, RHS_VAL)
2337
INTEGER IROW
2338
COMPLEX*16 RHS_VAL(NRHS)
2339
CALL MPI_PACK(IROW, 1, MPI_INTEGER, BUFFER,
2340
* SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
2341
CALL MPI_PACK(RHS_VAL, NRHS, MPI_DOUBLE_COMPLEX,
2342
* BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM,
2343
* IERR)
2344
N2SEND=N2SEND+1
2511
SUBROUTINE ZMUMPS_522( ONE_PACK )
2512
INTEGER ONE_PACK
2513
INTEGER III
2514
DO II=1,NPIV
2515
I=IW(J1+II-1)
2516
DO J=1, NRHS
2517
CWORK(II+(J-1)*NPIV) = RHS(I,J)
2518
ENDDO
2519
ENDDO
2520
CALL MPI_PACK(NPIV, 1, MPI_INTEGER, BUFFER,
2521
& SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
2522
CALL MPI_PACK(IW(J1), NPIV, MPI_INTEGER, BUFFER,
2523
& SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
2524
IF (ONE_PACK.EQ.yes) THEN
2525
CALL MPI_PACK(CWORK(1), NPIV*NRHS, MPI_DOUBLE_COMPLEX,
2526
& BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM,
2527
& IERR)
2528
ELSE
2529
III = 1
2530
DO J=1,NRHS
2531
CALL MPI_PACK(CWORK(III), NPIV, MPI_DOUBLE_COMPLEX,
2532
& BUFFER, SIZE_BUF_BYTES, POS_BUF, COMM,
2533
& IERR)
2534
III =III+NPIV
2535
ENDDO
2536
ENDIF
2537
N2SEND=N2SEND+NPIV
2345
2538
IF ( POS_BUF + RECORD_SIZE_P_1 > SIZE_BUF_BYTES ) THEN
2346
2539
CALL ZMUMPS_523()
2347
2540
END IF
2349
2542
END SUBROUTINE ZMUMPS_522
2350
2543
SUBROUTINE ZMUMPS_523()
2351
2544
IF (N2SEND .NE. 0) THEN
2352
CALL MPI_PACK(0, 1, MPI_INTEGER, BUFFER,
2353
* SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
2545
CALL MPI_PACK(FIN, 1, MPI_INTEGER, BUFFER,
2546
& SIZE_BUF_BYTES, POS_BUF, COMM, IERR )
2354
2547
CALL MPI_SEND(BUFFER, POS_BUF, MPI_PACKED, MASTER,
2355
* GatherSol, COMM, IERR)
2548
& GatherSol, COMM, IERR)
2356
2549
ENDIF
2357
2550
POS_BUF=0
2358
2551
N2SEND=0
2360
2553
END SUBROUTINE ZMUMPS_523
2361
2554
END SUBROUTINE ZMUMPS_521
2362
2555
SUBROUTINE ZMUMPS_535(MTYPE, ISOL_LOC,
2363
* LSOL_LOC, PTRIST, KEEP,KEEP8,
2364
* IW, LIW_PASSED, MYID_NODES, N, STEP,
2365
* PROCNODE, NSLAVES, scaling_data, LSCAL)
2556
& LSOL_LOC, PTRIST, KEEP,KEEP8,
2557
& IW, LIW_PASSED, MYID_NODES, N, STEP,
2558
& PROCNODE, NSLAVES, scaling_data, LSCAL)
2366
2559
IMPLICIT NONE
2367
2560
INTEGER MTYPE, LSOL_LOC, MYID_NODES, N, NSLAVES
2368
2561
INTEGER KEEP(500)
2399
2592
K=0
2400
2593
DO ISTEP=1, KEEP(28)
2401
2594
IF ( MYID_NODES == MUMPS_275( ISTEP,
2402
* PROCNODE, NSLAVES)) THEN
2595
& PROCNODE, NSLAVES)) THEN
2403
2596
IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN
2404
2597
IPOS = PTRIST(ISTEP)+KEEP(IXSZ)
2405
2598
LIELL = IW(IPOS+3)
2423
2616
ISOL_LOC(K)=IW(JJ)
2424
2617
IF (LSCAL) THEN
2425
2618
scaling_data%SCALING_LOC(K)=
2426
* scaling_data%SCALING(IW(JJ))
2619
& scaling_data%SCALING(IW(JJ))
2427
2620
ENDIF
2428
2621
ENDDO
2429
2622
ENDIF
2431
2624
RETURN
2432
2625
END SUBROUTINE ZMUMPS_535
2433
2626
SUBROUTINE ZMUMPS_532(
2434
* SLAVEF, N, MYID_NODES,
2435
* MTYPE, RHS, LD_RHS, NRHS,
2436
* ISOL_LOC, SOL_LOC, BEG_RHS, LSOL_LOC,
2437
* PTRIST,
2438
* PROCNODE_STEPS, KEEP,KEEP8, IW, LIW, STEP,
2439
* scaling_data, LSCAL)
2627
& SLAVEF, N, MYID_NODES,
2628
& MTYPE, RHS, LD_RHS, NRHS,
2629
& ISOL_LOC, SOL_LOC, BEG_RHS, LSOL_LOC,
2630
& PTRIST,
2631
& PROCNODE_STEPS, KEEP,KEEP8, IW, LIW, STEP,
2632
& scaling_data, LSCAL)
2440
2633
IMPLICIT NONE
2441
2634
INCLUDE 'mpif.h'
2442
2635
INCLUDE 'mumps_tags.h'
2465
2658
K=0
2466
2659
DO ISTEP = 1, KEEP(28)
2467
2660
IF (MYID_NODES == MUMPS_275(ISTEP,
2468
* PROCNODE_STEPS,SLAVEF)) THEN
2661
& PROCNODE_STEPS,SLAVEF)) THEN
2469
2662
ROOT=.false.
2470
2663
IF (KEEP(38).ne.0) ROOT = STEP(KEEP(38))==ISTEP
2471
2664
IF (KEEP(20).ne.0) ROOT = STEP(KEEP(20))==ISTEP
2491
2684
K=K+1
2492
2685
IF (LSCAL) THEN
2493
2686
SOL_LOC(K,BEG_RHS:BEG_RHS+NRHS-1) =
2494
* scaling_data%SCALING_LOC(K)*RHS(IW(JJ),1:NRHS)
2687
& dcmplx(scaling_data%SCALING_LOC(K))*RHS(IW(JJ),1:NRHS)
2495
2688
ELSE
2496
2689
SOL_LOC(K,BEG_RHS:BEG_RHS+NRHS-1) =
2497
* RHS(IW(JJ),1:NRHS)
2690
& RHS(IW(JJ),1:NRHS)
2498
2691
ENDIF
2499
2692
ENDDO
2500
2693
ENDIF
2502
2695
RETURN
2503
2696
END SUBROUTINE ZMUMPS_532
2504
2697
SUBROUTINE ZMUMPS_638
2505
* (NSLAVES, N, MYID, COMM,
2506
* MTYPE, RHS, LRHS, NRHS, PTRIST,
2507
* KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP,
2508
* POSINRHSCOMP, LENPOSINRHSCOMP,
2509
* BUILD_POSINRHSCOMP, ICNTL, INFO)
2698
& (NSLAVES, N, MYID, COMM,
2699
& MTYPE, RHS, LRHS, NRHS, PTRIST,
2700
& KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP,
2701
& POSINRHSCOMP, LENPOSINRHSCOMP,
2702
& BUILD_POSINRHSCOMP, ICNTL, INFO)
2510
2703
IMPLICIT NONE
2511
2704
INCLUDE 'mpif.h'
2512
2705
INCLUDE 'mumps_tags.h'
2529
2722
DOUBLE PRECISION ZERO
2530
2723
PARAMETER(ZERO=0.0D0)
2531
2724
INTEGER I, J, K, JJ, J1, ISTEP, MASTER,
2532
* MYID_NODES, TYPE_PARAL, N2RECV
2725
& MYID_NODES, TYPE_PARAL, N2RECV
2533
2726
INTEGER LIELL, IPOS, NPIV
2534
2727
INTEGER MSGSOU, STATUS(MPI_STATUS_SIZE), IERR
2535
2728
PARAMETER(MASTER=0)
2557
2750
ENDIF
2558
2751
BUF_EFFSIZE = 0
2559
2752
ALLOCATE (BUF_INDX(BUF_MAXSIZE),
2560
* BUF_RHS(NRHS,BUF_MAXSIZE),
2561
* stat=allocok)
2753
& BUF_RHS(NRHS,BUF_MAXSIZE),
2754
& stat=allocok)
2562
2755
IF (allocok .GT. 0) THEN
2563
2756
INFO(1)=-13
2564
2757
INFO(2)=BUF_MAXSIZE*(NRHS+1)
2569
2762
ENTRIES_2_PROCESS = N - KEEP(89)
2570
2763
DO WHILE ( ENTRIES_2_PROCESS .NE. 0)
2571
2764
CALL MPI_RECV( BUF_INDX, BUF_MAXSIZE, MPI_INTEGER,
2572
* MPI_ANY_SOURCE,
2573
* ScatterRhsI, COMM, STATUS, IERR )
2765
& MPI_ANY_SOURCE,
2766
& ScatterRhsI, COMM, STATUS, IERR )
2574
2767
CALL MPI_GET_COUNT( STATUS, MPI_INTEGER, BUF_EFFSIZE, IERR )
2575
2768
PROC_WHO_ASKS = STATUS(MPI_SOURCE)
2576
2769
DO I = 1, BUF_EFFSIZE
2581
2774
ENDDO
2582
2775
ENDDO
2583
2776
CALL MPI_SEND( BUF_RHS, NRHS*BUF_EFFSIZE,
2584
* MPI_DOUBLE_COMPLEX, PROC_WHO_ASKS,
2585
* ScatterRhsR, COMM, IERR)
2777
& MPI_DOUBLE_COMPLEX, PROC_WHO_ASKS,
2778
& ScatterRhsR, COMM, IERR)
2586
2779
ENTRIES_2_PROCESS = ENTRIES_2_PROCESS - BUF_EFFSIZE
2587
2780
ENDDO
2588
2781
BUF_EFFSIZE= 0
2595
2788
IF (MYID.NE.MASTER) RHS = dcmplx(ZERO)
2596
2789
DO ISTEP = 1, KEEP(28)
2597
2790
IF (MYID_NODES == MUMPS_275(ISTEP,
2598
* PROCNODE_STEPS,NSLAVES)) THEN
2791
& PROCNODE_STEPS,NSLAVES)) THEN
2599
2792
IF ( ISTEP.EQ.SK38 .OR. ISTEP.EQ.SK20 ) THEN
2600
2793
IPOS = PTRIST(ISTEP)
2601
2794
LIELL = IW(IPOS+3+KEEP(IXSZ))
2637
2830
CONTAINS
2638
2831
SUBROUTINE ZMUMPS_640()
2639
2832
CALL MPI_SEND(BUF_INDX, BUF_EFFSIZE, MPI_INTEGER,
2640
* MASTER, ScatterRhsI, COMM, IERR )
2833
& MASTER, ScatterRhsI, COMM, IERR )
2641
2834
CALL MPI_RECV(BUF_RHS, BUF_EFFSIZE*NRHS,
2642
* MPI_DOUBLE_COMPLEX,
2643
* MASTER,
2644
* ScatterRhsR, COMM, STATUS, IERR )
2835
& MPI_DOUBLE_COMPLEX,
2836
& MASTER,
2837
& ScatterRhsR, COMM, STATUS, IERR )
2645
2838
DO I = 1, BUF_EFFSIZE
2646
2839
INDX = BUF_INDX(I)
2647
2840
DO K = 1, NRHS
2653
2846
END SUBROUTINE ZMUMPS_640
2654
2847
END SUBROUTINE ZMUMPS_638
2655
2848
SUBROUTINE ZMUMPS_639
2656
* (NSLAVES, N, MYID_NODES,
2657
* PTRIST,
2658
* KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP,
2659
* POSINRHSCOMP, POSINRHSCOMP_N, LPIRC_N, MTYPE,
2660
* WHAT )
2849
& (NSLAVES, N, MYID_NODES,
2850
& PTRIST,
2851
& KEEP,KEEP8, PROCNODE_STEPS, IW, LIW, STEP,
2852
& POSINRHSCOMP, POSINRHSCOMP_N, LPIRC_N, MTYPE,
2853
& WHAT )
2661
2854
IMPLICIT NONE
2662
2855
INCLUDE 'mpif.h'
2663
2856
INCLUDE 'mumps_tags.h'
2697
2890
ENDIF
2698
2891
DO ISTEP = 1, KEEP(28)
2699
2892
IF (MYID_NODES == MUMPS_275(ISTEP,
2700
* PROCNODE_STEPS,NSLAVES)) THEN
2893
& PROCNODE_STEPS,NSLAVES)) THEN
2701
2894
IPOS = PTRIST(ISTEP)
2702
2895
NPIV = IW(IPOS+3+KEEP(IXSZ))
2703
2896
POSINRHSCOMP(ISTEP) = IPOSINRHSCOMP
2730
2923
RETURN
2731
2924
END SUBROUTINE ZMUMPS_639
2732
2925
SUBROUTINE ZMUMPS_248(N, A, LA, IW, LIW, WCB, LWCB,
2733
* RHS, LRHS, NRHS,
2734
* PTRICB, IWCB, LIWCB,
2735
* RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP,
2736
* NE_STEPS, NA, LNA, STEP,
2737
* FRERE, DAD, FILS,
2738
* NSTK_S, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO,
2739
* KEEP,KEEP8,
2740
* PROCNODE_STEPS,
2741
* SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,
2742
* RHS_ROOT, MTYPE,
2743
*
2744
* ISTEP_TO_INIV2, TAB_POS_IN_PERE
2745
* )
2926
& RHS, LRHS, NRHS,
2927
& PTRICB, IWCB, LIWCB,
2928
& RHSCOMP, LRHSCOMP, POSINRHSCOMP, BUILD_POSINRHSCOMP,
2929
& NE_STEPS, NA, LNA, STEP,
2930
& FRERE, DAD, FILS,
2931
& NSTK_S, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO,
2932
& KEEP,KEEP8,
2933
& PROCNODE_STEPS,
2934
& SLAVEF, COMM, MYID, BUFR, LBUFR, LBUFR_BYTES,
2935
& RHS_ROOT, MTYPE,
2936
&
2937
& ISTEP_TO_INIV2, TAB_POS_IN_PERE
2938
& )
2746
2939
USE ZMUMPS_OOC
2747
2940
IMPLICIT NONE
2748
2941
INTEGER MTYPE
2749
INTEGER N, LA, LIW, LWCB, LPOOL, LIWCB, LNA
2942
INTEGER(8) :: LA
2943
INTEGER N, LIW, LWCB, LPOOL, LIWCB, LNA
2750
2944
INTEGER SLAVEF, MYLEAF, COMM, MYID
2751
2945
INTEGER INFO( 40 ), KEEP(500)
2752
2946
INTEGER*8 KEEP8(150)
2758
2952
INTEGER BUFR( LBUFR )
2759
2953
INTEGER NA( LNA ), NE_STEPS( KEEP(28) )
2760
2954
INTEGER STEP( N ), FRERE( KEEP(28) ), FILS( N ),
2761
* DAD( KEEP(28) )
2955
& DAD( KEEP(28) )
2762
2956
INTEGER NSTK_S(KEEP(28)), IPOOL( LPOOL )
2763
INTEGER PTRIST(KEEP(28)), PTRFAC(KEEP(28))
2957
INTEGER PTRIST(KEEP(28))
2958
INTEGER(8) :: PTRFAC(KEEP(28))
2764
2959
INTEGER PTRICB( KEEP(28) )
2765
2960
INTEGER IW( LIW ), IWCB( LIWCB )
2766
2961
INTEGER ISTEP_TO_INIV2(KEEP(71)),
2767
* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
2962
& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
2768
2963
INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP
2769
2964
LOGICAL BUILD_POSINRHSCOMP
2770
2965
COMPLEX*16 RHSCOMP( LRHSCOMP, NRHS )
2792
2987
ENDDO
2793
2988
PTRICB = 0
2794
2989
CALL MUMPS_362(N, LEAF, NBROOT, MYROOT, MYID,
2795
* SLAVEF, NA, LNA, KEEP,KEEP8, STEP,
2796
* PROCNODE_STEPS, IPOOL, LPOOL)
2990
& SLAVEF, NA, LNA, KEEP,KEEP8, STEP,
2991
& PROCNODE_STEPS, IPOOL, LPOOL)
2797
2992
NBFIN = SLAVEF
2798
2993
IF ( MYROOT .EQ. 0 ) THEN
2799
2994
NBFIN = NBFIN - 1
2800
2995
DUMMY(1) = 1
2801
2996
CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM,
2802
* RACINE_SOLVE, SLAVEF)
2997
& RACINE_SOLVE, SLAVEF)
2803
2998
END IF
2804
2999
MYLEAF = LEAF - 1
2805
3000
III = 1
2811
3006
GOTO 60
2812
3007
ENDIF
2813
3008
BLOQ = ( ( III .EQ. LEAF )
2814
$ )
3009
& )
2815
3010
CALL ZMUMPS_303( BLOQ, FLAG,
2816
* BUFR, LBUFR, LBUFR_BYTES,
2817
* MYID, SLAVEF, COMM,
2818
* N, NRHS, IPOOL, LPOOL, III, LEAF,
2819
* NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
2820
* IWCB, LIWCB,
2821
* WCB, LWCB, POSWCB,
2822
* PLEFTWCB, POSIWCB,
2823
* PTRICB, INFO, KEEP,KEEP8, STEP,
2824
* PROCNODE_STEPS,
2825
* RHS, LRHS
2826
$ )
3011
& BUFR, LBUFR, LBUFR_BYTES,
3012
& MYID, SLAVEF, COMM,
3013
& N, NRHS, IPOOL, LPOOL, III, LEAF,
3014
& NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
3015
& IWCB, LIWCB,
3016
& WCB, LWCB, POSWCB,
3017
& PLEFTWCB, POSIWCB,
3018
& PTRICB, INFO, KEEP,KEEP8, STEP,
3019
& PROCNODE_STEPS,
3020
& RHS, LRHS
3021
& )
2827
3022
IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260
2828
3023
IF (.not. FLAG) THEN
2829
3024
IF (III .NE. LEAF) THEN
2836
3031
GOTO 50
2837
3032
60 CONTINUE
2838
3033
CALL ZMUMPS_302( INODE, BUFR, LBUFR, LBUFR_BYTES,
2839
* MSGTAG, MSGSOU, MYID, SLAVEF, COMM, N,
2840
* IPOOL, LPOOL, III, LEAF, NBFIN, NSTK_S,
2841
* IWCB, LIWCB, WCB, LWCB, A, LA,
2842
* IW, LIW, RHS, LRHS, NRHS,
2843
* POSWCB, PLEFTWCB, POSIWCB,
2844
* PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS,
2845
* FILS, STEP, FRERE, DAD,
2846
* MYROOT, INFO, KEEP,KEEP8, RHS_ROOT, MTYPE,
2847
* RHSCOMP, LRHSCOMP, POSINRHSCOMP,
2848
* RHSCOMPFREEPOS, BUILD_POSINRHSCOMP,
2849
* ISTEP_TO_INIV2, TAB_POS_IN_PERE
2850
$ )
3034
& MSGTAG, MSGSOU, MYID, SLAVEF, COMM, N,
3035
& IPOOL, LPOOL, III, LEAF, NBFIN, NSTK_S,
3036
& IWCB, LIWCB, WCB, LWCB, A, LA,
3037
& IW, LIW, RHS, LRHS, NRHS,
3038
& POSWCB, PLEFTWCB, POSIWCB,
3039
& PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS,
3040
& FILS, STEP, FRERE, DAD,
3041
& MYROOT, INFO, KEEP,KEEP8, RHS_ROOT, MTYPE,
3042
& RHSCOMP, LRHSCOMP, POSINRHSCOMP,
3043
& RHSCOMPFREEPOS, BUILD_POSINRHSCOMP,
3044
& ISTEP_TO_INIV2, TAB_POS_IN_PERE
3045
& )
2851
3046
IF ( INFO( 1 ) .LT. 0 .OR. NBFIN .EQ. 0 ) GOTO 260
2852
3047
GOTO 50
2853
3048
260 CONTINUE
2854
3049
CALL ZMUMPS_150( MYID,COMM,BUFR,
2855
* LBUFR,LBUFR_BYTES )
3050
& LBUFR,LBUFR_BYTES )
2856
3051
RETURN
2857
3052
END SUBROUTINE ZMUMPS_248
2858
3053
RECURSIVE SUBROUTINE ZMUMPS_323
2859
* ( BUFR, LBUFR, LBUFR_BYTES,
2860
* MSGTAG, MSGSOU, MYID, SLAVEF, COMM,
2861
* N, NRHS, IPOOL, LPOOL, III, LEAF,
2862
* NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,
2863
* PTRFAC, IWCB, LIWCB,
2864
* WCB, LWCB, POSWCB,
2865
* PLEFTWCB, POSIWCB,
2866
* PTRICB,
2867
* INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS,
2868
* RHS, LRHS
2869
$ )
3054
& ( BUFR, LBUFR, LBUFR_BYTES,
3055
& MSGTAG, MSGSOU, MYID, SLAVEF, COMM,
3056
& N, NRHS, IPOOL, LPOOL, III, LEAF,
3057
& NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,
3058
& PTRFAC, IWCB, LIWCB,
3059
& WCB, LWCB, POSWCB,
3060
& PLEFTWCB, POSIWCB,
3061
& PTRICB,
3062
& INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS,
3063
& RHS, LRHS
3064
& )
2870
3065
USE ZMUMPS_OOC
2871
3066
USE ZMUMPS_COMM_BUFFER
2872
3067
IMPLICIT NONE
2873
3068
INTEGER LBUFR, LBUFR_BYTES
2874
3069
INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM
2875
INTEGER LIW, LA
3070
INTEGER LIW
3071
INTEGER(8) :: LA
2876
3072
INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN
2877
3073
INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB
2878
3074
INTEGER INFO( 40 ), KEEP( 500)
2881
3077
INTEGER IPOOL( LPOOL ), NSTK_S( N )
2882
3078
INTEGER IWCB( LIWCB )
2883
3079
INTEGER IW( LIW )
2884
INTEGER PTRICB(KEEP(28)),PTRIST(KEEP(28)),PTRFAC(KEEP(28))
3080
INTEGER PTRICB(KEEP(28)),PTRIST(KEEP(28))
3081
INTEGER(8) :: PTRFAC(KEEP(28))
2885
3082
INTEGER STEP(N)
2886
3083
INTEGER PROCNODE_STEPS(KEEP(28))
2887
3084
COMPLEX*16 WCB( LWCB ), A( LA )
2891
3088
INCLUDE 'mumps_tags.h'
2892
3089
INTEGER IERR, K, JJ
2893
3090
INTEGER FINODE, FPERE, LONG, NCB, POSITION, NCV, NPIV
2894
INTEGER PTRX, PTRY, APOS, PDEST, I
2895
INTEGER LIWFAC, TailleEcrite, PANEL_SIZE, TYPEF
3091
INTEGER PTRX, PTRY, PDEST, I
3092
INTEGER(8) :: APOS
3093
INTEGER LIWFAC, PANEL_SIZE, TYPEF
2896
3094
LOGICAL DUMMY
2897
3095
LOGICAL FLAG
2898
3096
EXTERNAL MUMPS_275
2899
3097
INTEGER MUMPS_275
2900
3098
COMPLEX*16 ALPHA, ONE
2901
PARAMETER( ONE = 1.0D0, ALPHA = -1.0D0 )
3099
PARAMETER (ONE=(1.0D0,0.0D0), ALPHA=(-1.0D0,0.0D0))
2902
3100
INCLUDE 'mumps_headers.h'
2903
3101
IF ( MSGTAG .EQ. RACINE_SOLVE ) THEN
2904
3102
NBFIN = NBFIN - 1
2906
3104
ELSE IF (MSGTAG .EQ. ContVec ) THEN
2907
3105
POSITION = 0
2908
3106
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2909
* FINODE, 1, MPI_INTEGER, COMM, IERR )
2910
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2911
* FPERE, 1, MPI_INTEGER, COMM, IERR )
2912
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2913
* NCB, 1, MPI_INTEGER, COMM, IERR )
2914
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2915
* LONG, 1, MPI_INTEGER, COMM, IERR )
3107
& FINODE, 1, MPI_INTEGER, COMM, IERR )
3108
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
3109
& FPERE, 1, MPI_INTEGER, COMM, IERR )
3110
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
3111
& NCB, 1, MPI_INTEGER, COMM, IERR )
3112
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
3113
& LONG, 1, MPI_INTEGER, COMM, IERR )
2916
3114
IF ( NCB .eq. 0 ) THEN
2917
3115
PTRICB(STEP(FINODE)) = -1
2918
3116
NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1
2940
3138
END IF
2941
3139
IF (LONG .GT. 0) THEN
2942
3140
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2943
* IWCB( 1 ),
2944
* LONG, MPI_INTEGER, COMM, IERR )
3141
& IWCB( 1 ),
3142
& LONG, MPI_INTEGER, COMM, IERR )
2945
3143
DO K = 1, NRHS
2946
3144
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2947
* WCB( PLEFTWCB ),
2948
* LONG, MPI_DOUBLE_COMPLEX, COMM, IERR )
3145
& WCB( PLEFTWCB ),
3146
& LONG, MPI_DOUBLE_COMPLEX, COMM, IERR )
2949
3147
DO I = 1, LONG
2950
3148
RHS(IWCB(I),K) = RHS(IWCB(I),K) +WCB(PLEFTWCB+I-1)
2951
3149
ENDDO
2967
3165
ELSEIF ( MSGTAG .EQ. Master2Slave ) THEN
2968
3166
POSITION = 0
2969
3167
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2970
* FINODE, 1, MPI_INTEGER, COMM, IERR )
2971
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2972
* FPERE, 1, MPI_INTEGER, COMM, IERR )
2973
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2974
* NCV, 1, MPI_INTEGER, COMM, IERR )
2975
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2976
* NPIV, 1, MPI_INTEGER, COMM, IERR )
3168
& FINODE, 1, MPI_INTEGER, COMM, IERR )
3169
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
3170
& FPERE, 1, MPI_INTEGER, COMM, IERR )
3171
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
3172
& NCV, 1, MPI_INTEGER, COMM, IERR )
3173
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
3174
& NPIV, 1, MPI_INTEGER, COMM, IERR )
2977
3175
PTRY = PLEFTWCB
2978
3176
PTRX = PLEFTWCB + NCV * NRHS
2979
3177
PLEFTWCB = PLEFTWCB + (NPIV + NCV) * NRHS
2984
3182
END IF
2985
3183
DO K=1, NRHS
2986
3184
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2987
* WCB( PTRY + (K-1) * NCV ), NCV,
2988
* MPI_DOUBLE_COMPLEX, COMM, IERR )
3185
& WCB( PTRY + (K-1) * NCV ), NCV,
3186
& MPI_DOUBLE_COMPLEX, COMM, IERR )
2989
3187
ENDDO
2990
3188
IF ( NPIV .GT. 0 ) THEN
2991
3189
DO K=1, NRHS
2992
3190
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
2993
* WCB( PTRX + (K-1)*NPIV ), NPIV,
2994
* MPI_DOUBLE_COMPLEX, COMM, IERR )
3191
& WCB( PTRX + (K-1)*NPIV ), NPIV,
3192
& MPI_DOUBLE_COMPLEX, COMM, IERR )
2995
3193
END DO
2996
3194
END IF
2997
3195
IF (KEEP(201).NE.0) THEN
2998
3196
CALL ZMUMPS_643(
2999
3197
& FINODE,PTRFAC,KEEP,A,LA,STEP,
3000
$ KEEP8,N,DUMMY,IERR)
3198
& KEEP8,N,DUMMY,IERR)
3001
3199
IF(IERR.LT.0)THEN
3002
3200
INFO(1)=IERR
3003
3201
INFO(2)=0
3008
3206
IF (KEEP(201).EQ.1) THEN
3009
3207
IF ( NRHS == 1 ) THEN
3010
3208
CALL ZGEMV( 'N', NCV, NPIV, ALPHA, A(APOS), NCV,
3011
* WCB( PTRX ), 1, ONE,
3012
* WCB( PTRY ), 1 )
3209
& WCB( PTRX ), 1, ONE,
3210
& WCB( PTRY ), 1 )
3013
3211
ELSE
3014
3212
CALL ZGEMM( 'N', 'N', NCV, NRHS, NPIV, ALPHA,
3015
* A(APOS), NCV,
3016
* WCB( PTRX), NPIV, ONE,
3017
* WCB( PTRY), NCV )
3213
& A(APOS), NCV,
3214
& WCB( PTRX), NPIV, ONE,
3215
& WCB( PTRY), NCV )
3018
3216
ENDIF
3019
3217
ELSE
3020
3218
IF ( NRHS == 1 ) THEN
3021
3219
CALL ZGEMV( 'T', NPIV, NCV, ALPHA, A(APOS), NPIV,
3022
* WCB( PTRX ), 1, ONE,
3023
* WCB( PTRY ), 1 )
3220
& WCB( PTRX ), 1, ONE,
3221
& WCB( PTRY ), 1 )
3024
3222
ELSE
3025
3223
CALL ZGEMM( 'T', 'N', NCV, NRHS, NPIV, ALPHA,
3026
* A(APOS), NPIV,
3027
* WCB( PTRX), NPIV, ONE,
3028
* WCB( PTRY), NCV )
3224
& A(APOS), NPIV,
3225
& WCB( PTRX), NPIV, ONE,
3226
& WCB( PTRY), NCV )
3029
3227
ENDIF
3030
3228
ENDIF
3031
3229
IF (KEEP(201).NE.0) THEN
3032
3230
CALL ZMUMPS_598(FINODE,PTRFAC,
3033
$ KEEP(28),A,LA,.TRUE.,IERR)
3231
& KEEP(28),A,LA,.TRUE.,IERR)
3034
3232
IF(IERR.LT.0)THEN
3035
3233
INFO(1)=IERR
3036
3234
INFO(2)=0
3039
3237
ENDIF
3040
3238
PLEFTWCB = PLEFTWCB - NPIV * NRHS
3041
3239
PDEST = MUMPS_275( STEP(FPERE),
3042
* PROCNODE_STEPS, SLAVEF )
3240
& PROCNODE_STEPS, SLAVEF )
3043
3241
IF ( PDEST .EQ. MYID ) THEN
3044
3242
IF ( PTRICB(STEP(FINODE)) .EQ. 0 ) THEN
3045
3243
NCB = IW( PTRIST(STEP(FINODE)) + 2 + KEEP(IXSZ) )
3052
3250
ENDDO
3053
3251
END DO
3054
3252
PTRICB(STEP(FINODE)) =
3055
* PTRICB(STEP(FINODE)) - NCV
3253
& PTRICB(STEP(FINODE)) - NCV
3056
3254
IF ( PTRICB( STEP( FINODE ) ) == 1 ) THEN
3057
3255
NSTK_S(STEP(FPERE)) = NSTK_S(STEP(FPERE)) - 1
3058
3256
END IF
3067
3265
ELSE
3068
3266
210 CONTINUE
3069
3267
CALL ZMUMPS_78( NRHS, FINODE, FPERE,
3070
* IW(PTRIST(STEP( FINODE )) + 2 + KEEP(IXSZ) ), NCV,NCV,
3071
* IW(PTRIST(STEP(FINODE))+4+ KEEP(IXSZ) ),
3072
* WCB( PTRY ), PDEST, ContVec, COMM, IERR )
3268
& IW(PTRIST(STEP( FINODE )) + 2 + KEEP(IXSZ) ), NCV,NCV,
3269
& IW(PTRIST(STEP(FINODE))+4+ KEEP(IXSZ) ),
3270
& WCB( PTRY ), PDEST, ContVec, COMM, IERR )
3073
3271
IF ( IERR .EQ. -1 ) THEN
3074
3272
CALL ZMUMPS_303( .FALSE., FLAG,
3075
* BUFR, LBUFR, LBUFR_BYTES,
3076
* MYID, SLAVEF, COMM,
3077
* N, NRHS, IPOOL, LPOOL, III, LEAF,
3078
* NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
3079
* IWCB, LIWCB,
3080
* WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
3081
* PTRICB, INFO, KEEP,KEEP8, STEP,
3082
* PROCNODE_STEPS,
3083
* RHS, LRHS
3084
$ )
3273
& BUFR, LBUFR, LBUFR_BYTES,
3274
& MYID, SLAVEF, COMM,
3275
& N, NRHS, IPOOL, LPOOL, III, LEAF,
3276
& NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
3277
& IWCB, LIWCB,
3278
& WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
3279
& PTRICB, INFO, KEEP,KEEP8, STEP,
3280
& PROCNODE_STEPS,
3281
& RHS, LRHS
3282
& )
3085
3283
IF ( INFO( 1 ) .LT. 0 ) GOTO 270
3086
3284
GOTO 210
3087
3285
ELSE IF ( IERR .EQ. -2 ) THEN
3088
3286
INFO( 1 ) = -17
3089
3287
INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) +
3090
* NCV * KEEP( 35 )
3288
& NCV * KEEP( 35 )
3091
3289
GOTO 260
3092
3290
ELSE IF ( IERR .EQ. -3 ) THEN
3093
3291
INFO( 1 ) = -20
3094
3292
INFO( 2 ) = ( NCV + 4 ) * KEEP( 34 ) +
3095
* NCV * KEEP( 35 )
3293
& NCV * KEEP( 35 )
3096
3294
END IF
3097
3295
END IF
3098
3296
PLEFTWCB = PLEFTWCB - NCV * NRHS
3101
3299
INFO(2) = MSGSOU
3102
3300
GOTO 270
3103
3301
ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR.
3104
* (MSGTAG.EQ.TAG_DUMMY) ) THEN
3302
& (MSGTAG.EQ.TAG_DUMMY) ) THEN
3105
3303
GO TO 270
3106
3304
ELSE
3107
3305
INFO(1)=-100
3115
3313
RETURN
3116
3314
END SUBROUTINE ZMUMPS_323
3117
3315
SUBROUTINE ZMUMPS_302( INODE,
3118
* BUFR, LBUFR, LBUFR_BYTES,
3119
* MSGTAG, MSGSOU, MYID, SLAVEF, COMM,
3120
* N, IPOOL, LPOOL, III, LEAF,
3121
* NBFIN, NSTK_S,
3122
* IWCB, LIWCB,
3123
* WCB, LWCB, A, LA, IW, LIW,
3124
* RHS, LRHS, NRHS, POSWCB,
3125
* PLEFTWCB, POSIWCB,
3126
* PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS,
3127
* FILS, STEP, FRERE, DAD,
3128
* MYROOT,
3129
* INFO, KEEP,KEEP8, RHS_ROOT, MTYPE,
3130
* RHSCOMP, LRHSCOMP, POSINRHSCOMP,
3131
* RHSCOMPFREEPOS, BUILD_POSINRHSCOMP,
3132
*
3133
* ISTEP_TO_INIV2, TAB_POS_IN_PERE
3134
*
3135
$ )
3316
& BUFR, LBUFR, LBUFR_BYTES,
3317
& MSGTAG, MSGSOU, MYID, SLAVEF, COMM,
3318
& N, IPOOL, LPOOL, III, LEAF,
3319
& NBFIN, NSTK_S,
3320
& IWCB, LIWCB,
3321
& WCB, LWCB, A, LA, IW, LIW,
3322
& RHS, LRHS, NRHS, POSWCB,
3323
& PLEFTWCB, POSIWCB,
3324
& PTRICB, PTRIST, PTRFAC, PROCNODE_STEPS,
3325
& FILS, STEP, FRERE, DAD,
3326
& MYROOT,
3327
& INFO, KEEP,KEEP8, RHS_ROOT, MTYPE,
3328
& RHSCOMP, LRHSCOMP, POSINRHSCOMP,
3329
& RHSCOMPFREEPOS, BUILD_POSINRHSCOMP,
3330
&
3331
& ISTEP_TO_INIV2, TAB_POS_IN_PERE
3332
&
3333
& )
3136
3334
USE ZMUMPS_OOC
3137
3335
USE ZMUMPS_COMM_BUFFER
3138
3336
IMPLICIT NONE
3139
3337
INTEGER MTYPE
3140
3338
INTEGER INODE, LBUFR, LBUFR_BYTES
3141
3339
INTEGER MSGTAG, MSGSOU, MYID, SLAVEF, COMM
3142
INTEGER LIWCB, LWCB, LIW, LA, POSWCB, PLEFTWCB, POSIWCB
3340
INTEGER LIWCB, LWCB, LIW, POSWCB, PLEFTWCB, POSIWCB
3341
INTEGER(8) :: LA
3143
3342
INTEGER N, LPOOL, III, LEAF, NBFIN
3144
3343
INTEGER MYROOT
3145
3344
INTEGER INFO( 40 ), KEEP( 500)
3150
3349
INTEGER LRHS, NRHS
3151
3350
COMPLEX*16 WCB( LWCB ), A( LA )
3152
3351
COMPLEX*16 RHS(LRHS, NRHS ), RHS_ROOT( * )
3153
INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)), PTRFAC(KEEP(28))
3352
INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28))
3353
INTEGER(8) :: PTRFAC(KEEP(28))
3154
3354
INTEGER PROCNODE_STEPS(KEEP(28))
3155
3355
INTEGER FILS( N ), STEP( N ), FRERE(KEEP(28)), DAD(KEEP(28))
3156
3356
INTEGER ISTEP_TO_INIV2(KEEP(71)),
3157
* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
3357
& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
3158
3358
INTEGER POSINRHSCOMP(KEEP(28)), LRHSCOMP, RHSCOMPFREEPOS
3159
3359
COMPLEX*16 RHSCOMP(LRHSCOMP, NRHS)
3160
3360
LOGICAL BUILD_POSINRHSCOMP
3161
3361
EXTERNAL ZGEMV, ZTRSV, ZGEMM, ZTRSM, MUMPS_275
3162
3362
INTEGER MUMPS_275
3163
3363
COMPLEX*16 ALPHA,ONE,ZERO
3164
PARAMETER(ONE=1.0D0, ALPHA=-1.0D0, ZERO=0.0D0)
3364
PARAMETER (ZERO=(0.0D0,0.0D0),
3365
& ONE=(1.0D0,0.0D0),
3366
& ALPHA=(-1.0D0,0.0D0))
3367
INTEGER(8) :: APOS, APOS1, APOS2, APOSOFF
3165
3368
INTEGER I, J, K, IPOS, NSLAVES, J1, J2, J3, FPERE, NPIV, NCB,
3166
* IERR,
3167
* APOS, APOS1, IF, IFR, IPOSCB, APOSCB, LIELL, IN, JJ,
3168
* NELIM, PLEFT, PCB_COURANT, PPIV_COURANT
3369
& IERR,
3370
& IF, IFR, IPOSCB, APOSCB, LIELL, IN, JJ,
3371
& NELIM, PLEFT, PCB_COURANT, PPIV_COURANT
3169
3372
INTEGER IPOSINRHSCOMP
3170
3373
INTEGER Effective_CB_Size, NUPDATE, ISLAVE, PDEST, FirstIndex
3171
3374
LOGICAL FLAG
3172
3375
INCLUDE 'mumps_headers.h'
3173
INTEGER APOS2, APOSOFF, POSWCB1,POSWCB2, JJ1, JJ2
3174
INTEGER TempNROW, TempNCOL, TailleEcrite, PANEL_SIZE, LIWFAC,
3175
& APOSDEB, JFIN, NBJ, NUPDATE_PANEL,
3376
INTEGER POSWCB1,POSWCB2, JJ1, JJ2
3377
INTEGER(8) :: APOSDEB
3378
INTEGER TempNROW, TempNCOL, PANEL_SIZE, LIWFAC,
3379
& JFIN, NBJ, NUPDATE_PANEL,
3176
3380
& PPIV_PANEL, PCB_PANEL, NBK, TYPEF
3177
3381
INTEGER LD_WCBPIV
3178
3382
INTEGER LD_WCBCB
3179
3383
INTEGER LDAJ, LDAJ_FIRST_PANEL
3180
3384
INTEGER TMP_NBPANELS,
3181
* I_PIVRPTR, I_PIVR, IPANEL
3385
& I_PIVRPTR, I_PIVR, IPANEL
3182
3386
INTEGER INODE_STATE
3183
3387
LOGICAL MUST_BE_PERMUTED
3184
3388
INCLUDE 'mpif.h'
3201
3405
IF (KEEP(201).NE.0) THEN
3202
3406
CALL ZMUMPS_643(
3203
3407
& INODE,PTRFAC,KEEP,A,LA,STEP,
3204
$ KEEP8,N,MUST_BE_PERMUTED,IERR)
3408
& KEEP8,N,MUST_BE_PERMUTED,IERR)
3205
3409
IF(IERR.LT.0)THEN
3206
3410
INFO(1)=IERR
3207
3411
INFO(2)=0
3208
3412
GOTO 260
3209
3413
ENDIF
3210
IF (KEEP(201).EQ.1) THEN
3211
IF
3212
& ( IW(
3213
& PTRIST(STEP(INODE))+IW(PTRIST(STEP(INODE))+XXI)-1
3214
& )
3215
& .EQ.-7777) THEN
3216
MUST_BE_PERMUTED = .FALSE.
3414
IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN
3415
CALL ZMUMPS_755(
3416
& IW(IPOS+1+2*LIELL+1+NSLAVES),
3417
& MUST_BE_PERMUTED )
3217
3418
ENDIF
3218
ENDIF
3219
ENDIF
3220
APOS = PTRFAC(IW(IPOS))
3221
IF (KEEP(201).EQ.1) THEN
3222
IF (MTYPE.EQ.1) THEN
3223
IF ((MTYPE.EQ.1).AND.NSLAVES.NE.0) THEN
3224
TempNROW= NPIV+NELIM
3225
TempNCOL= NPIV
3226
LDAJ_FIRST_PANEL=TempNROW
3227
ELSE
3228
TempNROW= LIELL
3229
TempNCOL= NPIV
3230
LDAJ_FIRST_PANEL=TempNROW
3231
ENDIF
3232
TYPEF=TYPEF_L
3233
ELSE
3234
TempNCOL= LIELL
3235
TempNROW= NPIV
3236
LDAJ_FIRST_PANEL=TempNCOL
3237
TYPEF= TYPEF_U
3238
ENDIF
3239
IF (INODE.eq.KEEP(38).OR.INODE.eq.KEEP(20)) THEN
3240
WRITE(6,*) ' FWD Special case of ROOT to be checked '
3241
LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
3242
TYPEF= TYPEF_L
3243
CALL ZMUMPS_690( INODE, TYPEF,
3244
& IW(PTRIST(STEP(INODE))), LIWFAC, TempNROW,
3245
& PANEL_SIZE, TailleEcrite)
3246
PANEL_SIZE = TailleEcrite
3247
ELSE
3248
LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
3249
CALL ZMUMPS_690( INODE, TYPEF,
3250
& IW(PTRIST(STEP(INODE))), LIWFAC, LDAJ_FIRST_PANEL,
3251
& PANEL_SIZE, TailleEcrite)
3252
ENDIF
3253
IF (PANEL_SIZE.LT.0) THEN
3254
WRITE(6,*) ' Internal error in fwd solve PANEL_SIZE=',
3255
& PANEL_SIZE
3256
CALL MUMPS_ABORT()
3257
ENDIF
3258
ENDIF
3259
NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ))
3260
IPOS = IPOS + 1 + NSLAVES
3419
ENDIF
3420
NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ))
3421
IPOS = IPOS + 1 + NSLAVES
3261
3422
END IF
3262
3423
IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN
3263
3424
J1 = IPOS + 1
3288
3449
IF (SLAVEF .GT. 1) THEN
3289
3450
DUMMY (1) = 1
3290
3451
CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID,
3291
* COMM, RACINE_SOLVE, SLAVEF)
3452
& COMM, RACINE_SOLVE, SLAVEF)
3292
3453
ENDIF
3293
3454
END IF
3294
3455
GO TO 270
3295
3456
END IF
3457
APOS = PTRFAC(STEP(INODE))
3458
IF (KEEP(201).EQ.1) THEN
3459
IF (MTYPE.EQ.1) THEN
3460
IF ((MTYPE.EQ.1).AND.NSLAVES.NE.0) THEN
3461
TempNROW= NPIV+NELIM
3462
TempNCOL= NPIV
3463
LDAJ_FIRST_PANEL=TempNROW
3464
ELSE
3465
TempNROW= LIELL
3466
TempNCOL= NPIV
3467
LDAJ_FIRST_PANEL=TempNROW
3468
ENDIF
3469
TYPEF=TYPEF_L
3470
ELSE
3471
TempNCOL= LIELL
3472
TempNROW= NPIV
3473
LDAJ_FIRST_PANEL=TempNCOL
3474
TYPEF= TYPEF_U
3475
ENDIF
3476
LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
3477
PANEL_SIZE = ZMUMPS_690( LDAJ_FIRST_PANEL )
3478
ENDIF
3296
3479
PLEFT = PLEFTWCB
3297
3480
PPIV_COURANT = PLEFTWCB
3298
3481
PLEFTWCB = PLEFTWCB + LIELL * NRHS
3360
3543
LDAJ = LDAJ_FIRST_PANEL-J+1
3361
3544
IF ( (KEEP(50).NE.1).AND. MUST_BE_PERMUTED ) THEN
3362
3545
CALL ZMUMPS_667(TYPEF, TMP_NBPANELS,
3363
* I_PIVRPTR, I_PIVR, IPOS+1+2*LIELL, IW, LIW)
3546
& I_PIVRPTR, I_PIVR, IPOS+1+2*LIELL, IW, LIW)
3364
3547
IF (NPIV.EQ.(IW(I_PIVRPTR+IPANEL-1)-1)) THEN
3365
3548
MUST_BE_PERMUTED=.FALSE.
3366
3549
ELSE
3367
3550
CALL ZMUMPS_698(
3368
* IW( I_PIVR+ IW(I_PIVRPTR+IPANEL-1)-
3369
* IW(I_PIVRPTR)),
3370
* NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
3371
* IW(I_PIVRPTR+IPANEL-1)-1,
3372
*
3373
* A(APOSDEB),
3374
* LDAJ, NBJ, J-1 )
3551
& IW( I_PIVR+ IW(I_PIVRPTR+IPANEL-1)-
3552
& IW(I_PIVRPTR)),
3553
& NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
3554
& IW(I_PIVRPTR+IPANEL-1)-1,
3555
&
3556
& A(APOSDEB),
3557
& LDAJ, NBJ, J-1 )
3375
3558
ENDIF
3376
3559
ENDIF
3377
3560
NUPDATE_PANEL = LDAJ - NBJ
3378
3561
PPIV_PANEL = PPIV_COURANT+J-1
3379
3562
PCB_PANEL = PPIV_PANEL+NBJ
3380
APOS1 = APOSDEB+NBJ
3563
APOS1 = APOSDEB+int(NBJ,8)
3381
3564
IF (MTYPE.EQ.1) THEN
3382
3565
IF ( NRHS == 1 ) THEN
3383
3566
CALL ZTRSV( 'L', 'N', 'U', NBJ, A(APOSDEB), LDAJ,
3384
* WCB(PPIV_PANEL), 1 )
3567
& WCB(PPIV_PANEL), 1 )
3385
3568
IF (NUPDATE_PANEL.GT.0) THEN
3386
3569
CALL ZGEMV('N', NUPDATE_PANEL,NBJ,ALPHA, A(APOS1),
3387
* LDAJ, WCB(PPIV_PANEL), 1, ONE,
3388
* WCB(PCB_PANEL), 1)
3570
& LDAJ, WCB(PPIV_PANEL), 1, ONE,
3571
& WCB(PCB_PANEL), 1)
3389
3572
ENDIF
3390
3573
ELSE
3391
3574
CALL ZTRSM( 'L','L','N','U', NBJ, NRHS, ONE,
3392
* A(APOSDEB), LDAJ, WCB(PPIV_PANEL),
3393
* LIELL )
3575
& A(APOSDEB), LDAJ, WCB(PPIV_PANEL),
3576
& LIELL )
3394
3577
IF (NUPDATE_PANEL.GT.0) THEN
3395
3578
CALL ZGEMM('N', 'N', NUPDATE_PANEL, NRHS, NBJ,
3396
$ ALPHA,
3397
* A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE,
3398
* WCB(PCB_PANEL), LIELL)
3579
& ALPHA,
3580
& A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE,
3581
& WCB(PCB_PANEL), LIELL)
3399
3582
ENDIF
3400
3583
ENDIF
3401
3584
ELSE
3402
3585
IF (NRHS == 1) THEN
3403
3586
CALL ZTRSV( 'L', 'N', 'N', NBJ, A(APOSDEB), LDAJ,
3404
* WCB(PPIV_PANEL), 1 )
3587
& WCB(PPIV_PANEL), 1 )
3405
3588
IF (NUPDATE_PANEL.GT.0) THEN
3406
3589
CALL ZGEMV('N',NUPDATE_PANEL, NBJ, ALPHA, A(APOS1),
3407
* LDAJ, WCB(PPIV_PANEL), 1,
3408
* ONE, WCB(PCB_PANEL), 1 )
3590
& LDAJ, WCB(PPIV_PANEL), 1,
3591
& ONE, WCB(PCB_PANEL), 1 )
3409
3592
ENDIF
3410
3593
ELSE
3411
3594
CALL ZTRSM('L','L','N','N',NBJ, NRHS, ONE,
3412
* A(APOSDEB), LDAJ, WCB(PPIV_PANEL),
3413
* LIELL)
3595
& A(APOSDEB), LDAJ, WCB(PPIV_PANEL),
3596
& LIELL)
3414
3597
IF (NUPDATE_PANEL.GT.0) THEN
3415
3598
CALL ZGEMM('N', 'N', NUPDATE_PANEL, NRHS, NBJ,
3416
$ ALPHA,
3417
* A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE,
3418
* WCB(PCB_PANEL), LIELL)
3599
& ALPHA,
3600
& A(APOS1), LDAJ, WCB(PPIV_PANEL), LIELL, ONE,
3601
& WCB(PCB_PANEL), LIELL)
3419
3602
ENDIF
3420
3603
ENDIF
3421
3604
ENDIF
3422
APOSDEB = APOSDEB+LDAJ*NBJ
3605
APOSDEB = APOSDEB+int(LDAJ,8)*int(NBJ,8)
3423
3606
J=JFIN+1
3424
3607
IF ( J .LE. NPIV ) GOTO 10
3425
3608
ELSE
3426
3609
IF (KEEP(50).NE.0) THEN
3427
3610
IF ( NRHS == 1 ) THEN
3428
3611
CALL ZTRSV( 'U', 'T', 'U', NPIV, A(APOS), NPIV,
3429
* WCB(PPIV_COURANT), 1 )
3612
& WCB(PPIV_COURANT), 1 )
3430
3613
ELSE
3431
3614
CALL ZTRSM( 'L','U','T','U', NPIV, NRHS, ONE,
3432
* A(APOS), NPIV, WCB(PPIV_COURANT),
3433
* NPIV )
3615
& A(APOS), NPIV, WCB(PPIV_COURANT),
3616
& NPIV )
3434
3617
ENDIF
3435
3618
ELSE
3436
3619
IF ( MTYPE .eq. 1 ) THEN
3437
3620
IF ( NRHS == 1) THEN
3438
3621
CALL ZTRSV( 'U', 'T', 'U', NPIV, A(APOS), LIELL,
3439
* WCB(PPIV_COURANT), 1 )
3622
& WCB(PPIV_COURANT), 1 )
3440
3623
ELSE
3441
3624
CALL ZTRSM( 'L','U','T','U', NPIV, NRHS, ONE,
3442
* A(APOS), LIELL, WCB(PPIV_COURANT),
3443
* NPIV )
3625
& A(APOS), LIELL, WCB(PPIV_COURANT),
3626
& NPIV )
3444
3627
ENDIF
3445
3628
ELSE
3446
3629
IF (NRHS == 1) THEN
3447
3630
CALL ZTRSV( 'L', 'N', 'N', NPIV, A(APOS), LIELL,
3448
* WCB(PPIV_COURANT), 1 )
3631
& WCB(PPIV_COURANT), 1 )
3449
3632
ELSE
3450
3633
CALL ZTRSM('L','L','N','N',NPIV, NRHS, ONE,
3451
* A(APOS), LIELL, WCB(PPIV_COURANT),
3452
* NPIV)
3634
& A(APOS), LIELL, WCB(PPIV_COURANT),
3635
& NPIV)
3453
3636
ENDIF
3454
3637
END IF
3455
3638
END IF
3458
3641
NCB = LIELL - NPIV
3459
3642
IF ( MTYPE .EQ. 1 ) THEN
3460
3643
IF ( KEEP(50) .eq. 0 ) THEN
3461
APOS1 = APOS + NPIV * LIELL
3644
APOS1 = APOS + int(NPIV,8) * int(LIELL,8)
3462
3645
ELSE
3463
APOS1 = APOS + NPIV * NPIV
3646
APOS1 = APOS + int(NPIV,8) * int(NPIV,8)
3464
3647
END IF
3465
3648
IF ( NSLAVES .EQ. 0 .OR. NPIV .eq. 0 ) THEN
3466
3649
NUPDATE = NCB
3468
3651
NUPDATE = NELIM
3469
3652
END IF
3470
3653
ELSE
3471
APOS1 = APOS + NPIV
3654
APOS1 = APOS + int(NPIV,8)
3472
3655
NUPDATE = NCB
3473
3656
END IF
3474
3657
IF (KEEP(201).NE.1) THEN
3476
3659
IF ( MTYPE .eq. 1 ) THEN
3477
3660
IF ( NRHS == 1 ) THEN
3478
3661
CALL ZGEMV('T', NPIV, NUPDATE, ALPHA, A(APOS1),
3479
* NPIV, WCB(PPIV_COURANT), 1, ONE,
3480
* WCB(PCB_COURANT), 1)
3662
& NPIV, WCB(PPIV_COURANT), 1, ONE,
3663
& WCB(PCB_COURANT), 1)
3481
3664
ELSE
3482
3665
CALL ZGEMM('T', 'N', NUPDATE, NRHS, NPIV, ALPHA,
3483
* A(APOS1), NPIV, WCB(PPIV_COURANT), NPIV, ONE,
3484
* WCB(PCB_COURANT), NCB)
3666
& A(APOS1), NPIV, WCB(PPIV_COURANT), NPIV, ONE,
3667
& WCB(PCB_COURANT), NCB)
3485
3668
END IF
3486
3669
ELSE
3487
3670
IF ( NRHS == 1 ) THEN
3488
3671
CALL ZGEMV('N',NUPDATE, NPIV, ALPHA, A(APOS1),
3489
* LIELL, WCB(PPIV_COURANT), 1,
3490
* ONE, WCB(PCB_COURANT), 1 )
3672
& LIELL, WCB(PPIV_COURANT), 1,
3673
& ONE, WCB(PCB_COURANT), 1 )
3491
3674
ELSE
3492
3675
CALL ZGEMM('N', 'N', NUPDATE, NRHS, NPIV, ALPHA,
3493
* A(APOS1), LIELL, WCB(PPIV_COURANT), NPIV, ONE,
3494
* WCB(PCB_COURANT), NCB)
3676
& A(APOS1), LIELL, WCB(PPIV_COURANT), NPIV, ONE,
3677
& WCB(PCB_COURANT), NCB)
3495
3678
END IF
3496
3679
END IF
3497
3680
END IF
3534
3717
LDAJ = LDAJ - PANEL_SIZE
3535
3718
ENDIF
3536
3719
ENDIF
3537
APOS1 = APOS1 + LDAJ + 1
3720
APOS1 = APOS1 + int(LDAJ + 1,8)
3538
3721
JJ = JJ+1
3539
3722
ELSE
3540
3723
IF (KEEP(201).EQ.1) THEN
3541
3724
NBK = NBK+1
3542
3725
ENDIF
3543
APOS2 = APOS1+LDAJ+1
3726
APOS2 = APOS1+int(LDAJ+1,8)
3544
3727
IF (KEEP(201).EQ.1) THEN
3545
APOSOFF = APOS1+LDAJ
3728
APOSOFF = APOS1+int(LDAJ,8)
3546
3729
ELSE
3547
APOSOFF=APOS1+1
3730
APOSOFF=APOS1+1_8
3548
3731
ENDIF
3549
3732
DO K=1, NRHS
3550
3733
POSWCB1 = IFR+(K-1)*LD_WCBPIV
3551
3734
POSWCB2 = POSWCB1+1
3552
3735
RHSCOMP(IPOSINRHSCOMP+JJ-J1,K) = WCB(POSWCB1)*A(APOS1)
3553
* + WCB(POSWCB2)*A(APOSOFF)
3736
& + WCB(POSWCB2)*A(APOSOFF)
3554
3737
RHSCOMP(IPOSINRHSCOMP+JJ-J1+1,K) =
3555
* WCB(POSWCB1)*A(APOSOFF)
3556
* + WCB(POSWCB2)*A(APOS2)
3738
& WCB(POSWCB1)*A(APOSOFF)
3739
& + WCB(POSWCB2)*A(APOS2)
3557
3740
END DO
3558
3741
IF (KEEP(201).EQ.1) THEN
3559
3742
NBK = NBK+1
3562
3745
NBK = 0
3563
3746
ENDIF
3564
3747
ENDIF
3565
APOS1 = APOS2 + LDAJ + 1
3748
APOS1 = APOS2 + int(LDAJ + 1,8)
3566
3749
JJ = JJ+2
3567
3750
IFR = IFR+1
3568
3751
ENDIF
3570
3753
END IF
3571
3754
IF (KEEP(201).NE.0) THEN
3572
3755
CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28),
3573
$ A,LA,.TRUE.,IERR)
3756
& A,LA,.TRUE.,IERR)
3574
3757
IF(IERR.LT.0)THEN
3575
3758
INFO(1)=IERR
3576
3759
INFO(2)=0
3586
3769
IF (SLAVEF .GT. 1) THEN
3587
3770
DUMMY (1) = 1
3588
3771
CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID,
3589
* COMM, RACINE_SOLVE, SLAVEF)
3772
& COMM, RACINE_SOLVE, SLAVEF)
3590
3773
ENDIF
3591
3774
END IF
3592
3775
GO TO 270
3593
3776
ENDIF
3594
3777
IF ( NUPDATE .NE. 0 .OR. NCB.eq.0 ) THEN
3595
3778
IF (MUMPS_275(STEP(FPERE),PROCNODE_STEPS,
3596
* SLAVEF) .EQ. MYID) THEN
3779
& SLAVEF) .EQ. MYID) THEN
3597
3780
IF ( NCB .ne. 0 ) THEN
3598
3781
PTRICB(STEP(INODE)) = NCB + 1
3599
3782
DO 190 I = 1, NUPDATE
3600
3783
DO K=1, NRHS
3601
3784
RHS( IW(J3 + I), K ) = RHS( IW(J3 + I), K )
3602
* + WCB(PCB_COURANT + I-1 +(K-1)*LD_WCBCB)
3785
& + WCB(PCB_COURANT + I-1 +(K-1)*LD_WCBCB)
3603
3786
ENDDO
3604
3787
190 CONTINUE
3605
3788
PTRICB(STEP( INODE )) = PTRICB(STEP( INODE )) - NUPDATE
3621
3804
ELSE
3622
3805
210 CONTINUE
3623
3806
CALL ZMUMPS_78( NRHS, INODE, FPERE, NCB, LD_WCBCB,
3624
* NUPDATE,
3625
* IW( J3 + 1 ), WCB( PCB_COURANT ),
3626
* MUMPS_275(STEP(FPERE),
3627
* PROCNODE_STEPS,SLAVEF),
3628
* ContVec,
3629
* COMM, IERR )
3807
& NUPDATE,
3808
& IW( J3 + 1 ), WCB( PCB_COURANT ),
3809
& MUMPS_275(STEP(FPERE),
3810
& PROCNODE_STEPS,SLAVEF),
3811
& ContVec,
3812
& COMM, IERR )
3630
3813
IF ( IERR .EQ. -1 ) THEN
3631
3814
CALL ZMUMPS_303( .FALSE., FLAG,
3632
* BUFR, LBUFR, LBUFR_BYTES,
3633
* MYID, SLAVEF, COMM,
3634
* N, NRHS, IPOOL, LPOOL, III, LEAF,
3635
* NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
3636
* IWCB, LIWCB,
3637
* WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
3638
* PTRICB, INFO, KEEP,KEEP8, STEP,
3639
* PROCNODE_STEPS,
3640
* RHS, LRHS
3641
$ )
3815
& BUFR, LBUFR, LBUFR_BYTES,
3816
& MYID, SLAVEF, COMM,
3817
& N, NRHS, IPOOL, LPOOL, III, LEAF,
3818
& NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
3819
& IWCB, LIWCB,
3820
& WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
3821
& PTRICB, INFO, KEEP,KEEP8, STEP,
3822
& PROCNODE_STEPS,
3823
& RHS, LRHS
3824
& )
3642
3825
IF ( INFO( 1 ) .LT. 0 ) GOTO 270
3643
3826
GOTO 210
3644
3827
ELSE IF ( IERR .EQ. -2 ) THEN
3645
3828
INFO( 1 ) = -17
3646
3829
INFO( 2 ) = NUPDATE * KEEP( 35 ) +
3647
* ( NUPDATE + 3 ) * KEEP( 34 )
3830
& ( NUPDATE + 3 ) * KEEP( 34 )
3648
3831
GOTO 260
3649
3832
ELSE IF ( IERR .EQ. -3 ) THEN
3650
3833
INFO( 1 ) = -20
3651
3834
INFO( 2 ) = NUPDATE * KEEP( 35 ) +
3652
* ( NUPDATE + 3 ) * KEEP( 34 )
3835
& ( NUPDATE + 3 ) * KEEP( 34 )
3653
3836
GOTO 260
3654
3837
END IF
3655
3838
ENDIF
3656
3839
END IF
3657
3840
IF ( NSLAVES .NE. 0 .AND. MTYPE .eq. 1
3658
* .and. NPIV .NE. 0 ) THEN
3841
& .and. NPIV .NE. 0 ) THEN
3659
3842
DO ISLAVE = 1, NSLAVES
3660
3843
PDEST = IW( PTRIST(STEP(INODE)) + 5 + ISLAVE +KEEP(IXSZ))
3661
3844
CALL MUMPS_49(
3665
3848
& NSLAVES,
3666
3849
& Effective_CB_Size, FirstIndex )
3667
3850
222 CALL ZMUMPS_72( NRHS,
3668
* INODE, FPERE,
3669
* Effective_CB_Size, LD_WCBCB, LD_WCBPIV, NPIV,
3670
* WCB( PCB_COURANT + NELIM + FirstIndex - 1 ),
3671
* WCB( PPIV_COURANT ),
3672
* PDEST, COMM, IERR )
3851
& INODE, FPERE,
3852
& Effective_CB_Size, LD_WCBCB, LD_WCBPIV, NPIV,
3853
& WCB( PCB_COURANT + NELIM + FirstIndex - 1 ),
3854
& WCB( PPIV_COURANT ),
3855
& PDEST, COMM, IERR )
3673
3856
IF ( IERR .EQ. -1 ) THEN
3674
3857
CALL ZMUMPS_303( .FALSE., FLAG,
3675
* BUFR, LBUFR, LBUFR_BYTES,
3676
* MYID, SLAVEF, COMM,
3677
* N, NRHS, IPOOL, LPOOL, III, LEAF,
3678
* NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC,
3679
* IWCB, LIWCB,
3680
* WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
3681
* PTRICB, INFO, KEEP,KEEP8, STEP,
3682
* PROCNODE_STEPS,
3683
* RHS, LRHS
3684
$ )
3858
& BUFR, LBUFR, LBUFR_BYTES,
3859
& MYID, SLAVEF, COMM,
3860
& N, NRHS, IPOOL, LPOOL, III, LEAF,
3861
& NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC,
3862
& IWCB, LIWCB,
3863
& WCB, LWCB, POSWCB, PLEFTWCB, POSIWCB,
3864
& PTRICB, INFO, KEEP,KEEP8, STEP,
3865
& PROCNODE_STEPS,
3866
& RHS, LRHS
3867
& )
3685
3868
IF ( INFO( 1 ) .LT. 0 ) GOTO 270
3686
3869
GOTO 222
3687
3870
ELSE IF ( IERR .EQ. -2 ) THEN
3688
3871
INFO( 1 ) = -17
3689
3872
INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) +
3690
* ( Effective_CB_Size + 4 ) * KEEP( 34 )
3873
& ( Effective_CB_Size + 4 ) * KEEP( 34 )
3691
3874
GOTO 260
3692
3875
ELSE IF ( IERR .EQ. -3 ) THEN
3693
3876
INFO( 1 ) = -20
3694
3877
INFO( 2 ) = (NPIV+Effective_CB_Size)*NRHS*KEEP(35) +
3695
* ( Effective_CB_Size + 4 ) * KEEP( 34 )
3878
& ( Effective_CB_Size + 4 ) * KEEP( 34 )
3696
3879
GOTO 260
3697
3880
END IF
3698
3881
END DO
3705
3888
RETURN
3706
3889
END SUBROUTINE ZMUMPS_302
3707
3890
RECURSIVE SUBROUTINE ZMUMPS_303( BLOQ, FLAG,
3708
* BUFR, LBUFR, LBUFR_BYTES,
3709
* MYID, SLAVEF, COMM,
3710
* N, NRHS, IPOOL, LPOOL, III, LEAF,
3711
* NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC,
3712
* IWCB, LIWCB,
3713
* WCB, LWCB, POSWCB,
3714
* PLEFTWCB, POSIWCB,
3715
* PTRICB, INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS,
3716
* RHS, LRHS
3717
$ )
3891
& BUFR, LBUFR, LBUFR_BYTES,
3892
& MYID, SLAVEF, COMM,
3893
& N, NRHS, IPOOL, LPOOL, III, LEAF,
3894
& NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST,PTRFAC,
3895
& IWCB, LIWCB,
3896
& WCB, LWCB, POSWCB,
3897
& PLEFTWCB, POSIWCB,
3898
& PTRICB, INFO, KEEP,KEEP8, STEP, PROCNODE_STEPS,
3899
& RHS, LRHS
3900
& )
3718
3901
IMPLICIT NONE
3719
3902
LOGICAL BLOQ
3720
3903
INTEGER LBUFR, LBUFR_BYTES
3721
3904
INTEGER MYID, SLAVEF, COMM
3722
3905
INTEGER N, NRHS, LPOOL, III, LEAF, NBFIN
3723
3906
INTEGER LIWCB, LWCB, POSWCB, PLEFTWCB, POSIWCB
3724
INTEGER LIW, LA
3907
INTEGER LIW
3908
INTEGER(8) :: LA
3725
3909
INTEGER INFO( 40 ), KEEP( 500)
3726
3910
INTEGER*8 KEEP8(150)
3727
3911
INTEGER BUFR( LBUFR ), IPOOL(LPOOL)
3729
3913
INTEGER IWCB( LIWCB )
3730
3914
INTEGER IW( LIW )
3731
3915
COMPLEX*16 WCB( LWCB ), A( LA )
3732
INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28)), PTRFAC(KEEP(28))
3916
INTEGER PTRICB(KEEP(28)), PTRIST(KEEP(28))
3917
INTEGER(8) :: PTRFAC(KEEP(28))
3733
3918
INTEGER STEP(N)
3734
3919
INTEGER PROCNODE_STEPS(KEEP(28))
3735
3920
INTEGER LRHS
3736
3921
COMPLEX*16 RHS(LRHS, NRHS)
3737
3922
LOGICAL FLAG
3738
3923
INCLUDE 'mpif.h'
3739
INCLUDE 'mumps_tags.h'
3924
INCLUDE 'mumps_tags.h'
3740
3925
INTEGER IERR, STATUS( MPI_STATUS_SIZE )
3741
3926
INTEGER MSGSOU, MSGTAG, MSGLEN
3742
3927
FLAG = .FALSE.
3743
3928
IF ( BLOQ ) THEN
3744
3929
CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG,
3745
* COMM, STATUS, IERR )
3930
& COMM, STATUS, IERR )
3746
3931
FLAG = .TRUE.
3747
3932
ELSE
3748
3933
CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM,
3749
* FLAG, STATUS, IERR )
3934
& FLAG, STATUS, IERR )
3750
3935
END IF
3751
3936
IF ( FLAG ) THEN
3752
3937
MSGSOU = STATUS( MPI_SOURCE )
3758
3943
CALL ZMUMPS_44( MYID, SLAVEF, COMM )
3759
3944
ELSE
3760
3945
CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED,
3761
* MSGSOU, MSGTAG, COMM, STATUS, IERR )
3946
& MSGSOU, MSGTAG, COMM, STATUS, IERR )
3762
3947
CALL ZMUMPS_323( BUFR, LBUFR, LBUFR_BYTES,
3763
* MSGTAG, MSGSOU, MYID, SLAVEF, COMM,
3764
* N, NRHS, IPOOL, LPOOL, III, LEAF,
3765
* NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
3766
* IWCB, LIWCB,
3767
* WCB, LWCB, POSWCB,
3768
* PLEFTWCB, POSIWCB,
3769
* PTRICB, INFO, KEEP,KEEP8, STEP,
3770
* PROCNODE_STEPS,
3771
* RHS, LRHS
3772
$ )
3948
& MSGTAG, MSGSOU, MYID, SLAVEF, COMM,
3949
& N, NRHS, IPOOL, LPOOL, III, LEAF,
3950
& NBFIN, NSTK_S, IW, LIW, A, LA, PTRIST, PTRFAC,
3951
& IWCB, LIWCB,
3952
& WCB, LWCB, POSWCB,
3953
& PLEFTWCB, POSIWCB,
3954
& PTRICB, INFO, KEEP,KEEP8, STEP,
3955
& PROCNODE_STEPS,
3956
& RHS, LRHS
3957
& )
3773
3958
END IF
3774
3959
END IF
3775
3960
RETURN
3776
3961
END SUBROUTINE ZMUMPS_303
3777
3962
SUBROUTINE ZMUMPS_249(N, A, LA, IW, LIW, W, LWC,
3778
* RHS, LRHS, NRHS,
3779
* RHSCOMP, LRHSCOMP, POSINRHSCOMP,
3780
* PTRICB, PTRACB, IWCB, LIWW, W2,
3781
* NE_STEPS, NA, LNA, STEP,
3782
* FRERE, FILS, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO,
3783
* PROCNODE_STEPS,
3784
* SLAVEF, COMM,MYID, BUFR, LBUFR, LBUFR_BYTES,
3785
* KEEP,KEEP8, RHS_ROOT, MTYPE,
3786
*
3787
* ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS
3788
* )
3963
& RHS, LRHS, NRHS,
3964
& RHSCOMP, LRHSCOMP, POSINRHSCOMP,
3965
& PTRICB, PTRACB, IWCB, LIWW, W2,
3966
& NE_STEPS, NA, LNA, STEP,
3967
& FRERE, FILS, IPOOL, LPOOL, PTRIST, PTRFAC, MYLEAF, INFO,
3968
& PROCNODE_STEPS,
3969
& SLAVEF, COMM,MYID, BUFR, LBUFR, LBUFR_BYTES,
3970
& KEEP,KEEP8, RHS_ROOT, MTYPE,
3971
&
3972
& ISTEP_TO_INIV2, TAB_POS_IN_PERE, PANEL_POS, LPANEL_POS
3973
& )
3789
3974
USE ZMUMPS_OOC
3790
3975
USE ZMUMPS_COMM_BUFFER
3791
3976
IMPLICIT NONE
3792
3977
INTEGER MTYPE
3793
INTEGER N,LA,LIW,LIWW,LWC,LPOOL,LNA
3978
INTEGER(8) :: LA
3979
INTEGER N,LIW,LIWW,LWC,LPOOL,LNA
3794
3980
INTEGER SLAVEF,MYLEAF,COMM,MYID
3795
3981
INTEGER LPANEL_POS
3796
3982
INTEGER KEEP( 500 )
3800
3986
INTEGER IPOOL(LPOOL)
3801
3987
INTEGER PANEL_POS(LPANEL_POS)
3802
3988
INTEGER INFO(40)
3803
INTEGER PTRIST(KEEP(28)),PTRFAC(KEEP(28)),
3804
* PTRICB(KEEP(28)),PTRACB(KEEP(28))
3989
INTEGER PTRIST(KEEP(28)),
3990
& PTRICB(KEEP(28)),PTRACB(KEEP(28))
3991
INTEGER(8) :: PTRFAC(KEEP(28))
3805
3992
INTEGER LRHS, NRHS
3806
3993
COMPLEX*16 A(LA), RHS(LRHS,NRHS), W(LWC)
3807
3994
COMPLEX*16 W2(KEEP(133))
3810
3997
INTEGER LBUFR, LBUFR_BYTES
3811
3998
INTEGER BUFR(LBUFR)
3812
3999
INTEGER ISTEP_TO_INIV2(KEEP(71)),
3813
* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
4000
& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
3814
4001
INTEGER LRHSCOMP, POSINRHSCOMP(KEEP(28))
3815
4002
COMPLEX*16 RHSCOMP(LRHSCOMP,NRHS)
3816
4003
COMPLEX*16 RHS_ROOT( * )
3821
4008
INTEGER STATUS( MPI_STATUS_SIZE ), IERR
3822
4009
LOGICAL FLAG
3823
4010
INTEGER POSIWCB,POSWCB,K
3824
INTEGER APOS,APOSCB,NPIV
4011
INTEGER(8) :: APOS, IST
4012
INTEGER APOSCB,NPIV
3825
4013
INTEGER IPOS,IPOSCB,LIELL,NELIM,IFR,JJ,I
3826
INTEGER J1,J2,J,IST,NCB,NBFINF
4014
INTEGER J1,J2,J,NCB,NBFINF
3827
4015
INTEGER NBLEAF,INODE,NBROOT,NROOT,NBFILS
3828
4016
INTEGER IN,IF,LONG,POOL_FIRST_POS,TMP
3829
4017
INTEGER III,IIPOOL,MYLEAFE
3830
4018
INTEGER NSLAVES
3831
4019
COMPLEX*16 ALPHA,ONE,ZERO
3832
PARAMETER(ONE=1.0D0, ALPHA=-1.0D0, ZERO=0.0D0)
4020
PARAMETER (ZERO=(0.0D0,0.0D0),
4021
& ONE=(1.0D0,0.0D0),
4022
& ALPHA=(-1.0D0,0.0D0))
3833
4023
LOGICAL BLOQ,DEBUT
3834
4024
INTEGER PROCDEST, DEST
3835
4025
INTEGER SSII,POSII, POSINDICES, IPOSINRHSCOMP
3845
4035
LOGICAL MUST_BE_PERMUTED
3846
4036
LOGICAL SKIP
3847
4037
LOGICAL DEJA_SEND( 0:SLAVEF-1 )
3848
INTEGER APOSDEB, LDAJ, NBJ, LIWFAC, TailleEcrite,
3849
& APOSTEMP, NBJLAST, NPIV_LAST, PANEL_SIZE,
4038
INTEGER(8) :: APOSDEB, APOSTEMP, NBENTRIES_ALLPANELS
4039
INTEGER LDAJ, NBJ, LIWFAC,
4040
& NBJLAST, NPIV_LAST, PANEL_SIZE,
3850
4041
& PTWCB_PANEL, NCB_PANEL, TYPEF
3851
4042
INTEGER BEG_PANEL
3852
4043
LOGICAL TWOBYTWO
3854
4045
LOGICAL MUMPS_283, MUMPS_170
3855
4046
INTEGER MUMPS_330
3856
4047
EXTERNAL ZGEMV, ZTRSV, ZTRSM, ZGEMM,
3857
* MUMPS_283, MUMPS_330,
3858
* MUMPS_170
4048
& MUMPS_283, MUMPS_330,
4049
& MUMPS_170
3859
4050
PLEFTW = 1
3860
4051
POSIWCB = LIWW
3861
4052
POSWCB = LWC
3865
4056
DO I = NBROOT, 1, -1
3866
4057
INODE = NA(NBLEAF+I+2)
3867
4058
IF (MUMPS_275(STEP(INODE),PROCNODE_STEPS,
3868
* SLAVEF) .EQ. MYID) THEN
4059
& SLAVEF) .EQ. MYID) THEN
3869
4060
NROOT = NROOT + 1
3870
4061
IPOOL(NROOT) = INODE
3871
4062
ENDIF
3878
4069
DO I=1, NBLEAF
3879
4070
INODE=NA(I+2)
3880
4071
IF (MUMPS_275(STEP(INODE),PROCNODE_STEPS,
3881
* SLAVEF) .EQ. MYID) THEN
4072
& SLAVEF) .EQ. MYID) THEN
3882
4073
MYLEAF = MYLEAF + 1
3883
4074
ENDIF
3884
4075
ENDDO
3887
4078
NBFINF = SLAVEF
3888
4079
IF (MYLEAFE .EQ. 0) THEN
3889
4080
CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, FEUILLE,
3890
* SLAVEF)
4081
& SLAVEF)
3891
4082
NBFINF = NBFINF - 1
3892
4083
IF (NBFINF .EQ. 0) THEN
3893
4084
GOTO 340
3895
4086
ENDIF
3896
4087
50 CONTINUE
3897
4088
BLOQ = ( ( III .EQ. IIPOOL )
3898
$ )
4089
& )
3899
4090
CALL ZMUMPS_41( BLOQ, FLAG, BUFR, LBUFR,
3900
* LBUFR_BYTES, MYID, SLAVEF, COMM,
3901
* N, IWCB, LIWW, POSIWCB,
3902
* W, LWC, POSWCB,
3903
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
3904
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
3905
* STEP, FRERE, FILS, PROCNODE_STEPS,
3906
* PLEFTW, KEEP,KEEP8,
3907
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
3908
* RHS, LRHS, NRHS, MTYPE,
3909
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
3910
* )
4091
& LBUFR_BYTES, MYID, SLAVEF, COMM,
4092
& N, IWCB, LIWW, POSIWCB,
4093
& W, LWC, POSWCB,
4094
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4095
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4096
& STEP, FRERE, FILS, PROCNODE_STEPS,
4097
& PLEFTW, KEEP,KEEP8,
4098
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4099
& RHS, LRHS, NRHS, MTYPE,
4100
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
4101
& )
3911
4102
IF ( INFO(1) .LT. 0 ) GOTO 340
3912
4103
IF ( .NOT. FLAG ) THEN
3913
4104
IF (III .NE. IIPOOL) THEN
3946
4137
MYLEAFE = MYLEAFE - 1
3947
4138
IF (MYLEAFE .EQ. 0) THEN
3948
4139
CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM,
3949
* FEUILLE, SLAVEF )
4140
& FEUILLE, SLAVEF )
3950
4141
NBFINF = NBFINF - 1
3951
4142
IF (NBFINF .EQ. 0) GOTO 340
3952
4143
ENDIF
3962
4153
POOL_FIRST_POS=IIPOOL
3963
4154
DO I = 1, NBFILS
3964
4155
IF (MUMPS_275(STEP(IF),PROCNODE_STEPS,SLAVEF)
3965
* .EQ. MYID) THEN
4156
& .EQ. MYID) THEN
3966
4157
IPOOL(IIPOOL) = IF
3967
4158
IIPOOL = IIPOOL + 1
3968
4159
ELSE
3969
4160
PROCDEST = MUMPS_275(STEP(IF),PROCNODE_STEPS,
3970
* SLAVEF)
4161
& SLAVEF)
3971
4162
IF (.NOT. DEJA_SEND( PROCDEST )) THEN
3972
4163
600 CALL ZMUMPS_78( NRHS, IF, 0, 0,
3973
* LONG, LONG, IW( J1 ),
3974
* RHS_ROOT( 1 ), PROCDEST,
3975
* NOEUD, COMM, IERR )
4164
& LONG, LONG, IW( J1 ),
4165
& RHS_ROOT( 1 ), PROCDEST,
4166
& NOEUD, COMM, IERR )
3976
4167
IF ( IERR .EQ. -1 ) THEN
3977
4168
CALL ZMUMPS_41(
3978
* .FALSE., FLAG,
3979
* BUFR, LBUFR, LBUFR_BYTES,
3980
* MYID, SLAVEF, COMM,
3981
* N, IWCB, LIWW, POSIWCB,
3982
* W, LWC, POSWCB,
3983
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
3984
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
3985
* STEP, FRERE, FILS, PROCNODE_STEPS,
3986
* PLEFTW, KEEP,KEEP8,
3987
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
3988
* RHS, LRHS, NRHS, MTYPE,
3989
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
3990
* )
4169
& .FALSE., FLAG,
4170
& BUFR, LBUFR, LBUFR_BYTES,
4171
& MYID, SLAVEF, COMM,
4172
& N, IWCB, LIWW, POSIWCB,
4173
& W, LWC, POSWCB,
4174
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4175
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4176
& STEP, FRERE, FILS, PROCNODE_STEPS,
4177
& PLEFTW, KEEP,KEEP8,
4178
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4179
& RHS, LRHS, NRHS, MTYPE,
4180
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
4181
& )
3991
4182
IF ( INFO( 1 ) .LT. 0 ) GOTO 340
3992
4183
GOTO 600
3993
4184
ELSE IF ( IERR .EQ. -2 ) THEN
3994
4185
INFO( 1 ) = -17
3995
4186
INFO( 2 ) = LONG * KEEP(35) +
3996
* ( LONG + 2 ) * KEEP(34)
4187
& ( LONG + 2 ) * KEEP(34)
3997
4188
GOTO 330
3998
4189
ELSE IF ( IERR .EQ. -3 ) THEN
3999
4190
INFO( 1 ) = -20
4000
4191
INFO( 2 ) = LONG * KEEP(35) +
4001
* ( LONG + 2 ) * KEEP(34)
4192
& ( LONG + 2 ) * KEEP(34)
4002
4193
GOTO 330
4003
4194
END IF
4004
4195
DEJA_SEND( PROCDEST ) = .TRUE.
4017
4208
GOTO 50
4018
4209
END IF
4019
4210
IN_SUBTREE = MUMPS_170(
4020
* STEP (INODE),
4021
* PROCNODE_STEPS, SLAVEF )
4211
& STEP (INODE),
4212
& PROCNODE_STEPS, SLAVEF )
4022
4213
TYPENODE = MUMPS_330(STEP(INODE),PROCNODE_STEPS,
4023
* SLAVEF)
4214
& SLAVEF)
4024
4215
LTLEVEL2= (
4025
* (TYPENODE .eq.2 ) .AND.
4026
* (MTYPE.NE.1) )
4216
& (TYPENODE .eq.2 ) .AND.
4217
& (MTYPE.NE.1) )
4027
4218
NPIV = IW(PTRIST(STEP(INODE))+2+KEEP(IXSZ)+1)
4028
4219
IF ((NPIV.NE.0).AND.(LTLEVEL2)) THEN
4029
4220
IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ)
4038
4229
IPOS = IPOS + NSLAVES
4039
4230
IW(PTRIST(STEP(INODE))+XXS)= C_FINI+NSLAVES
4040
4231
IF ( POSIWCB - 2 .LT. 0 .or.
4041
* POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN
4232
& POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN
4042
4233
CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC,
4043
* POSWCB, POSIWCB, PTRICB, PTRACB)
4234
& POSWCB, POSIWCB, PTRICB, PTRACB)
4044
4235
IF ( POSWCB - NCB*NRHS .LT. PLEFTW - 1 ) THEN
4045
4236
INFO( 1 ) = -11
4046
4237
INFO( 2 ) = NCB * NRHS - POSWCB - PLEFTW + 1
4092
4283
& FirstIndex )
4093
4284
500 DEST = IW( PTRIST(STEP(INODE))+5+ISLAVE+KEEP(IXSZ))
4094
4285
CALL ZMUMPS_63(NRHS, INODE,
4095
* W(Offset+PTRACB(STEP(INODE))), EffectiveSize,
4096
* NCB, DEST,
4097
* BACKSLV_MASTER2SLAVE,
4098
* COMM, IERR )
4286
& W(Offset+PTRACB(STEP(INODE))), EffectiveSize,
4287
& NCB, DEST,
4288
& BACKSLV_MASTER2SLAVE,
4289
& COMM, IERR )
4099
4290
IF ( IERR .EQ. -1 ) THEN
4100
4291
CALL ZMUMPS_41(
4101
* .FALSE., FLAG,
4102
* BUFR, LBUFR, LBUFR_BYTES,
4103
* MYID, SLAVEF, COMM,
4104
* N, IWCB, LIWW, POSIWCB,
4105
* W, LWC, POSWCB,
4106
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4107
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4108
* STEP, FRERE, FILS,
4109
* PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
4110
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4111
* RHS, LRHS, NRHS, MTYPE,
4112
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
4113
* )
4292
& .FALSE., FLAG,
4293
& BUFR, LBUFR, LBUFR_BYTES,
4294
& MYID, SLAVEF, COMM,
4295
& N, IWCB, LIWW, POSIWCB,
4296
& W, LWC, POSWCB,
4297
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4298
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4299
& STEP, FRERE, FILS,
4300
& PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
4301
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4302
& RHS, LRHS, NRHS, MTYPE,
4303
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
4304
& )
4114
4305
IF ( INFO( 1 ) .LT. 0 ) GOTO 340
4115
4306
GOTO 500
4116
4307
ELSE IF ( IERR .EQ. -2 ) THEN
4117
4308
INFO( 1 ) = -17
4118
4309
INFO( 2 ) = EffectiveSize * KEEP(35) +
4119
* 2 * KEEP(34)
4310
& 2 * KEEP(34)
4120
4311
GOTO 330
4121
4312
ELSE IF ( IERR .EQ. -3 ) THEN
4122
4313
INFO( 1 ) = -20
4123
4314
INFO( 2 ) = EffectiveSize * KEEP(35) +
4124
* 2 * KEEP(34)
4315
& 2 * KEEP(34)
4125
4316
GOTO 330
4126
4317
END IF
4127
4318
Offset = Offset + EffectiveSize
4128
4319
END DO
4129
4320
IWCB( PTRICB(STEP( INODE )) + 1 ) = 0
4130
4321
CALL ZMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW, W, LWC,
4131
* POSWCB,POSIWCB,PTRICB,PTRACB)
4322
& POSWCB,POSIWCB,PTRICB,PTRACB)
4132
4323
GOTO 50
4133
4324
ENDIF
4134
4325
IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ)
4140
4331
IF (KEEP(201).NE.0) THEN
4141
4332
CALL ZMUMPS_643(
4142
4333
& INODE,PTRFAC,KEEP,A,LA,STEP,
4143
$ KEEP8,N,MUST_BE_PERMUTED,IERR)
4334
& KEEP8,N,MUST_BE_PERMUTED,IERR)
4144
4335
IF(IERR.LT.0)THEN
4145
4336
INFO(1)=IERR
4146
4337
INFO(2)=0
4147
4338
GOTO 330
4148
4339
ENDIF
4149
IF (KEEP(201).EQ.1) THEN
4150
IF
4151
& ( IW(
4152
& PTRIST(STEP(INODE))+IW(PTRIST(STEP(INODE))+XXI)-1
4153
& )
4154
& .EQ.-7777) THEN
4155
MUST_BE_PERMUTED = .FALSE.
4156
ENDIF
4157
ENDIF
4158
4340
ENDIF
4159
4341
APOS = PTRFAC(IW(IPOS))
4342
NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) )
4343
IPOS = IPOS + 1 + NSLAVES
4160
4344
IF (KEEP(201).EQ.1) THEN
4161
4345
LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
4162
4346
IF (MTYPE.NE.1) THEN
4164
4348
ELSE
4165
4349
TYPEF = TYPEF_U
4166
4350
ENDIF
4167
CALL ZMUMPS_690( INODE, TYPEF,
4168
& IW(PTRIST(STEP(INODE))), LIWFAC, LIELL,
4169
& PANEL_SIZE, TailleEcrite)
4170
#if defined(check)
4171
#endif
4351
PANEL_SIZE = ZMUMPS_690( LIELL )
4352
IF (KEEP(50).NE.1) THEN
4353
CALL ZMUMPS_755(
4354
& IW(IPOS+1+2*LIELL),
4355
& MUST_BE_PERMUTED )
4356
ENDIF
4172
4357
ENDIF
4173
NSLAVES = IW( PTRIST(STEP(INODE)) + 5 + KEEP(IXSZ) )
4174
IPOS = IPOS + 1 + NSLAVES
4175
4358
LONG = 0
4176
4359
IF ( MTYPE .EQ. 1 .OR. KEEP(50) .NE. 0 ) THEN
4177
4360
J1 = IPOS + 1
4184
4367
PTWCB = PLEFTW
4185
4368
IF ( POSWCB .LT. LIELL*NRHS ) THEN
4186
4369
CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC,
4187
* POSWCB, POSIWCB, PTRICB, PTRACB)
4370
& POSWCB, POSIWCB, PTRICB, PTRACB)
4188
4371
IF ( POSWCB .LT. LIELL*NRHS ) THEN
4189
4372
INFO(1) = -11
4190
4373
INFO(2) = LIELL*NRHS - POSWCB
4193
4376
END IF
4194
4377
ELSE
4195
4378
IF ( POSIWCB - 2 .LT. 0 .or.
4196
* POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN
4379
& POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN
4197
4380
CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB, LIWW, W, LWC,
4198
* POSWCB, POSIWCB, PTRICB, PTRACB)
4381
& POSWCB, POSIWCB, PTRICB, PTRACB)
4199
4382
IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN
4200
4383
INFO( 1 ) = -11
4201
4384
INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1
4248
4431
IF (KEEP(201).EQ.1) THEN
4249
4432
J = NPIV / PANEL_SIZE
4250
4433
TWOBYTWO = KEEP(50).EQ.2 .AND.
4251
* ((TYPENODE.EQ.1.AND.KEEP(103).GT.0) .OR.
4252
* (TYPENODE.EQ.2.AND.KEEP(105).GT.0))
4434
& ((TYPENODE.EQ.1.AND.KEEP(103).GT.0) .OR.
4435
& (TYPENODE.EQ.2.AND.KEEP(105).GT.0))
4253
4436
IF (TWOBYTWO) THEN
4254
4437
CALL ZMUMPS_641(PANEL_SIZE, PANEL_POS, LPANEL_POS,
4255
* IW(IPOS+1+LIELL), NPIV, NPANELS)
4438
& IW(IPOS+1+LIELL), NPIV, NPANELS, LIELL,
4439
& NBENTRIES_ALLPANELS)
4256
4440
ELSE
4257
4441
IF (NPIV.EQ.J*PANEL_SIZE) THEN
4258
4442
NPIV_LAST = NPIV
4263
4447
NBJLAST = NPIV-J*PANEL_SIZE
4264
4448
NPANELS = J+1
4265
4449
ENDIF
4450
NBENTRIES_ALLPANELS =
4451
& int(LIELL,8) * int(NPIV,8)
4452
& - int( ( J * ( J - 1 ) ) / 2,8 )
4453
& * int(PANEL_SIZE,8) * int(PANEL_SIZE,8)
4454
& - int(J,8)
4455
& * int(MOD(NPIV, PANEL_SIZE),8)
4456
& * int(PANEL_SIZE,8)
4266
4457
JJ=NPIV_LAST
4267
4458
ENDIF
4268
APOSDEB = APOS + TailleEcrite
4459
APOSDEB = APOS + NBENTRIES_ALLPANELS
4269
4460
DO IPANEL = NPANELS, 1, -1
4270
4461
IF (TWOBYTWO) THEN
4271
4462
NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL)
4279
4470
BEG_PANEL = JJ- PANEL_SIZE+1
4280
4471
ENDIF
4281
4472
LDAJ = LIELL-BEG_PANEL+1
4282
APOSDEB = APOSDEB - NBJ*LDAJ
4473
APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8)
4283
4474
PTWCB_PANEL = PTWCB + BEG_PANEL - 1
4284
4475
NCB_PANEL = LDAJ - NBJ
4285
4476
IF (KEEP(50).NE.1 .AND. MUST_BE_PERMUTED) THEN
4286
4477
CALL ZMUMPS_667(TYPEF, TMP_NBPANELS,
4287
* I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW)
4478
& I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW)
4288
4479
IF (NPIV.EQ.(IW(I_PIVRPTR)-1)) THEN
4289
4480
MUST_BE_PERMUTED=.FALSE.
4290
4481
ELSE
4291
4482
CALL ZMUMPS_698(
4292
* IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)),
4293
* NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
4294
* IW(I_PIVRPTR+IPANEL-1)-1,
4295
* A(APOSDEB),
4296
* LDAJ, NBJ, BEG_PANEL-1)
4483
& IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)),
4484
& NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
4485
& IW(I_PIVRPTR+IPANEL-1)-1,
4486
& A(APOSDEB),
4487
& LDAJ, NBJ, BEG_PANEL-1)
4297
4488
ENDIF
4298
4489
ENDIF
4299
4490
IF ( NRHS == 1 ) THEN
4300
4491
IF (NCB_PANEL.NE.0) THEN
4301
4492
CALL ZGEMV( 'T', NCB_PANEL, NBJ, ALPHA,
4302
* A( APOSDEB + NBJ ), LDAJ,
4303
* W( NBJ + PTWCB_PANEL ),
4304
* 1, ONE,
4305
* W(PTWCB_PANEL), 1 )
4493
& A( APOSDEB + int(NBJ,8) ), LDAJ,
4494
& W( NBJ + PTWCB_PANEL ),
4495
& 1, ONE,
4496
& W(PTWCB_PANEL), 1 )
4306
4497
ENDIF
4307
4498
IF (MTYPE.NE.1) THEN
4308
4499
CALL ZTRSV('L','T','U', NBJ, A(APOSDEB), LDAJ,
4309
* W(PTWCB_PANEL), 1)
4500
& W(PTWCB_PANEL), 1)
4310
4501
ELSE
4311
4502
CALL ZTRSV('L','T','N', NBJ, A(APOSDEB), LDAJ,
4312
* W(PTWCB_PANEL), 1)
4503
& W(PTWCB_PANEL), 1)
4313
4504
ENDIF
4314
4505
ELSE
4315
4506
IF (NCB_PANEL.NE.0) THEN
4316
4507
CALL ZGEMM( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA,
4317
* A(APOSDEB +NBJ), LDAJ, W(NBJ+PTWCB_PANEL),LIELL,
4318
* ONE, W(PTWCB_PANEL),LIELL)
4508
& A(APOSDEB +int(NBJ,8)), LDAJ,
4509
& W(NBJ+PTWCB_PANEL),LIELL,
4510
& ONE, W(PTWCB_PANEL),LIELL)
4319
4511
ENDIF
4320
4512
IF (MTYPE.NE.1) THEN
4321
4513
CALL ZTRSM('L','L','T','U',NBJ, NRHS, ONE,
4322
* A(APOSDEB),
4323
* LDAJ, W(PTWCB_PANEL), LIELL)
4514
& A(APOSDEB),
4515
& LDAJ, W(PTWCB_PANEL), LIELL)
4324
4516
ELSE
4325
4517
CALL ZTRSM('L','L','T','N',NBJ, NRHS, ONE,
4326
* A(APOSDEB),
4327
* LDAJ, W(PTWCB_PANEL), LIELL)
4518
& A(APOSDEB),
4519
& LDAJ, W(PTWCB_PANEL), LIELL)
4328
4520
ENDIF
4329
4521
ENDIF
4330
4522
IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1
4333
4525
IF (KEEP(201).EQ.0.OR.KEEP(201).EQ.2)THEN
4334
4526
IF ( LIELL .GT. NPIV ) THEN
4335
4527
IF ( MTYPE .eq. 1 ) THEN
4336
IST = APOS + NPIV
4528
IST = APOS + int(NPIV,8)
4337
4529
IF (NRHS == 1) THEN
4338
4530
CALL ZGEMV( 'T', NCB, NPIV, ALPHA, A(IST), LIELL,
4339
* W(NPIV + PTWCB), 1,
4340
* ONE,
4341
* W(PTWCB), 1 )
4531
& W(NPIV + PTWCB), 1,
4532
& ONE,
4533
& W(PTWCB), 1 )
4342
4534
ELSE
4343
4535
CALL ZGEMM('T','N', NPIV, NRHS, NCB, ALPHA, A(IST), LIELL,
4344
* W(NPIV+PTWCB), LIELL, ONE,
4345
* W(PTWCB), LIELL)
4536
& W(NPIV+PTWCB), LIELL, ONE,
4537
& W(PTWCB), LIELL)
4346
4538
ENDIF
4347
4539
ELSE
4348
4540
IF ( KEEP(50) .eq. 0 ) THEN
4349
IST = APOS + NPIV * LIELL
4541
IST = APOS + int(NPIV,8) * int(LIELL,8)
4350
4542
ELSE
4351
IST = APOS + NPIV * NPIV
4543
IST = APOS + int(NPIV,8) * int(NPIV,8)
4352
4544
END IF
4353
4545
IF ( NRHS == 1 ) THEN
4354
4546
CALL ZGEMV( 'N', NPIV, NCB, ALPHA, A( IST ), NPIV,
4355
* W( NPIV + PTWCB ),
4356
* 1, ONE,
4357
* W(PTWCB), 1 )
4547
& W( NPIV + PTWCB ),
4548
& 1, ONE,
4549
& W(PTWCB), 1 )
4358
4550
ELSE
4359
4551
CALL ZGEMM( 'N', 'N', NPIV, NRHS, NCB, ALPHA,
4360
* A(IST), NPIV, W(NPIV+PTWCB),LIELL,
4361
* ONE, W(PTWCB),LIELL)
4552
& A(IST), NPIV, W(NPIV+PTWCB),LIELL,
4553
& ONE, W(PTWCB),LIELL)
4362
4554
END IF
4363
4555
END IF
4364
4556
ENDIF
4365
4557
IF ( MTYPE .eq. 1 ) THEN
4366
4558
IF ( NRHS == 1 ) THEN
4367
4559
CALL ZTRSV('L', 'T', 'N', NPIV, A(APOS), LIELL,
4368
* W(PTWCB), 1)
4560
& W(PTWCB), 1)
4369
4561
ELSE
4370
4562
CALL ZTRSM('L','L','T','N', NPIV, NRHS, ONE, A(APOS),
4371
* LIELL, W(PTWCB), LIELL)
4563
& LIELL, W(PTWCB), LIELL)
4372
4564
ENDIF
4373
4565
ELSE
4374
4566
IF ( KEEP(50) .EQ. 0 ) THEN
4375
4567
IF ( NRHS == 1 ) THEN
4376
4568
CALL ZTRSV('U','N','U', NPIV, A(APOS), LIELL,
4377
* W(PTWCB), 1)
4569
& W(PTWCB), 1)
4378
4570
ELSE
4379
4571
CALL ZTRSM('L','U','N','U', NPIV, NRHS, ONE, A(APOS),
4380
* LIELL,W(PTWCB),LIELL)
4572
& LIELL,W(PTWCB),LIELL)
4381
4573
END IF
4382
4574
ELSE
4383
4575
IF ( NRHS == 1 ) THEN
4384
4576
CALL ZTRSV('U','N','U', NPIV, A(APOS), NPIV,
4385
* W(PTWCB), 1)
4577
& W(PTWCB), 1)
4386
4578
ELSE
4387
4579
CALL ZTRSM('L','U','N','U',NPIV, NRHS, ONE, A(APOS),
4388
* NPIV, W(PTWCB), LIELL)
4580
& NPIV, W(PTWCB), LIELL)
4389
4581
END IF
4390
4582
END IF
4391
4583
END IF
4404
4596
160 CONTINUE
4405
4597
IF (KEEP(201).NE.0) THEN
4406
4598
CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28),
4407
$ A,LA,.TRUE.,IERR)
4599
& A,LA,.TRUE.,IERR)
4408
4600
IF(IERR.LT.0)THEN
4409
4601
INFO(1)=IERR
4410
4602
INFO(2)=0
4418
4610
MYLEAFE = MYLEAFE - 1
4419
4611
IF (MYLEAFE .EQ. 0) THEN
4420
4612
CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM,
4421
* FEUILLE, SLAVEF )
4613
& FEUILLE, SLAVEF )
4422
4614
NBFINF = NBFINF - 1
4423
4615
IF (NBFINF .EQ. 0) GOTO 340
4424
4616
ENDIF
4440
4632
POOL_FIRST_POS=IIPOOL
4441
4633
DO 190 I = 1, NBFILS
4442
4634
IF (MUMPS_275(STEP(IF),PROCNODE_STEPS,
4443
* SLAVEF) .EQ. MYID) THEN
4635
& SLAVEF) .EQ. MYID) THEN
4444
4636
IPOOL(IIPOOL) = IF
4445
4637
IIPOOL = IIPOOL + 1
4446
4638
IF = FRERE(STEP(IF))
4449
4641
IF (.not. DEJA_SEND( PROCDEST )) THEN
4450
4642
400 CONTINUE
4451
4643
CALL ZMUMPS_78( NRHS, IF, 0, 0, LIELL,
4452
* LIELL,
4453
* IW( POSINDICES ),
4454
* W ( PTRACB(STEP( INODE ))), PROCDEST,
4455
* NOEUD, COMM, IERR )
4644
& LIELL,
4645
& IW( POSINDICES ),
4646
& W ( PTRACB(STEP( INODE ))), PROCDEST,
4647
& NOEUD, COMM, IERR )
4456
4648
IF ( IERR .EQ. -1 ) THEN
4457
4649
CALL ZMUMPS_41(
4458
* .FALSE., FLAG,
4459
* BUFR, LBUFR, LBUFR_BYTES,
4460
* MYID, SLAVEF, COMM,
4461
* N, IWCB, LIWW, POSIWCB,
4462
* W, LWC, POSWCB,
4463
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4464
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4465
* STEP, FRERE, FILS, PROCNODE_STEPS,
4466
* PLEFTW, KEEP,KEEP8,
4467
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4468
* RHS, LRHS, NRHS, MTYPE,
4469
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
4470
* )
4650
& .FALSE., FLAG,
4651
& BUFR, LBUFR, LBUFR_BYTES,
4652
& MYID, SLAVEF, COMM,
4653
& N, IWCB, LIWW, POSIWCB,
4654
& W, LWC, POSWCB,
4655
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4656
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4657
& STEP, FRERE, FILS, PROCNODE_STEPS,
4658
& PLEFTW, KEEP,KEEP8,
4659
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4660
& RHS, LRHS, NRHS, MTYPE,
4661
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
4662
& )
4471
4663
IF ( INFO( 1 ) .LT. 0 ) GOTO 340
4472
4664
GOTO 400
4473
4665
ELSE IF ( IERR .EQ. -2 ) THEN
4491
4683
ENDDO
4492
4684
IWCB(PTRICB(STEP(INODE))+1) = IWCB(PTRICB(STEP(INODE))+1)-1
4493
4685
CALL ZMUMPS_151(NRHS,N, KEEP(28), IWCB, LIWW,
4494
* W, LWC,
4495
* POSWCB,POSIWCB,PTRICB,PTRACB)
4686
& W, LWC,
4687
& POSWCB,POSIWCB,PTRICB,PTRACB)
4496
4688
ENDIF
4497
4689
GOTO 50
4498
4690
330 CONTINUE
4499
4691
CALL ZMUMPS_242(DUMMY, 1, MPI_INTEGER, MYID, COMM, TERREUR,
4500
* SLAVEF)
4692
& SLAVEF)
4501
4693
340 CONTINUE
4502
4694
CALL ZMUMPS_150( MYID,COMM,BUFR,
4503
* LBUFR,LBUFR_BYTES )
4695
& LBUFR,LBUFR_BYTES )
4504
4696
RETURN
4505
4697
END SUBROUTINE ZMUMPS_249
4506
4698
RECURSIVE SUBROUTINE ZMUMPS_41(
4507
* BLOQ, FLAG,
4508
* BUFR, LBUFR, LBUFR_BYTES,
4509
* MYID, SLAVEF, COMM,
4510
* N, IWCB, LIWW, POSIWCB,
4511
* W, LWC, POSWCB,
4512
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4513
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4514
* STEP, FRERE, FILS, PROCNODE_STEPS,
4515
* PLEFTW, KEEP,KEEP8,
4516
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, RHS,
4517
* LRHS, NRHS, MTYPE,
4518
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
4519
* )
4699
& BLOQ, FLAG,
4700
& BUFR, LBUFR, LBUFR_BYTES,
4701
& MYID, SLAVEF, COMM,
4702
& N, IWCB, LIWW, POSIWCB,
4703
& W, LWC, POSWCB,
4704
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4705
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS,
4706
& STEP, FRERE, FILS, PROCNODE_STEPS,
4707
& PLEFTW, KEEP,KEEP8,
4708
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE, RHS,
4709
& LRHS, NRHS, MTYPE,
4710
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
4711
& )
4520
4712
IMPLICIT NONE
4521
4713
LOGICAL BLOQ, FLAG
4522
4714
INTEGER LBUFR, LBUFR_BYTES
4536
4728
INTEGER*8 KEEP8(150)
4537
4729
INTEGER PROCNODE_STEPS( KEEP(28) ), FRERE( KEEP(28) )
4538
4730
INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N )
4539
INTEGER LIW, LA
4540
INTEGER PTRIST(KEEP(28)), PTRFAC(KEEP(28)), IW( LIW )
4731
INTEGER LIW
4732
INTEGER(8) :: LA
4733
INTEGER PTRIST(KEEP(28)), IW( LIW )
4734
INTEGER (8) :: PTRFAC(KEEP(28))
4541
4735
COMPLEX*16 A( LA ), W2( KEEP(133) )
4542
4736
INTEGER LRHS, NRHS
4543
4737
COMPLEX*16 RHS(LRHS, NRHS)
4551
4745
FLAG = .FALSE.
4552
4746
IF ( BLOQ ) THEN
4553
4747
CALL MPI_PROBE( MPI_ANY_SOURCE, MPI_ANY_TAG,
4554
* COMM, STATUS, IERR )
4748
& COMM, STATUS, IERR )
4555
4749
FLAG = .TRUE.
4556
4750
ELSE
4557
4751
CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG, COMM,
4558
* FLAG, STATUS, IERR )
4752
& FLAG, STATUS, IERR )
4559
4753
END IF
4560
4754
IF (FLAG) THEN
4561
4755
MSGSOU=STATUS(MPI_SOURCE)
4567
4761
CALL ZMUMPS_44( MYID, SLAVEF, COMM )
4568
4762
ELSE
4569
4763
CALL MPI_RECV(BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU,
4570
* MSGTAG, COMM, STATUS, IERR)
4764
& MSGTAG, COMM, STATUS, IERR)
4571
4765
CALL ZMUMPS_42( MSGTAG, MSGSOU,
4572
* BUFR, LBUFR, LBUFR_BYTES,
4573
* MYID, SLAVEF, COMM,
4574
* N, IWCB, LIWW, POSIWCB,
4575
* W, LWC, POSWCB,
4576
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4577
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
4578
* FRERE, FILS, PROCNODE_STEPS, PLEFTW,
4579
* KEEP,KEEP8,
4580
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4581
* RHS, LRHS, NRHS, MTYPE,
4582
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
4583
* )
4766
& BUFR, LBUFR, LBUFR_BYTES,
4767
& MYID, SLAVEF, COMM,
4768
& N, IWCB, LIWW, POSIWCB,
4769
& W, LWC, POSWCB,
4770
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4771
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
4772
& FRERE, FILS, PROCNODE_STEPS, PLEFTW,
4773
& KEEP,KEEP8,
4774
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4775
& RHS, LRHS, NRHS, MTYPE,
4776
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
4777
& )
4584
4778
END IF
4585
4779
END IF
4586
4780
RETURN
4587
4781
END SUBROUTINE ZMUMPS_41
4588
4782
RECURSIVE SUBROUTINE ZMUMPS_42(
4589
* MSGTAG, MSGSOU,
4590
* BUFR, LBUFR, LBUFR_BYTES,
4591
* MYID, SLAVEF, COMM,
4592
* N, IWCB, LIWW, POSIWCB,
4593
* W, LWC, POSWCB,
4594
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4595
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
4596
* FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
4597
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4598
* RHS, LRHS, NRHS, MTYPE,
4599
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
4600
* )
4783
& MSGTAG, MSGSOU,
4784
& BUFR, LBUFR, LBUFR_BYTES,
4785
& MYID, SLAVEF, COMM,
4786
& N, IWCB, LIWW, POSIWCB,
4787
& W, LWC, POSWCB,
4788
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4789
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
4790
& FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
4791
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4792
& RHS, LRHS, NRHS, MTYPE,
4793
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
4794
& )
4601
4795
USE ZMUMPS_OOC
4602
4796
USE ZMUMPS_COMM_BUFFER
4603
4797
IMPLICIT NONE
4619
4813
INTEGER PTRICB(KEEP(28)), PTRACB(KEEP(28)), STEP( N ), FILS( N )
4620
4814
INTEGER FRERE(KEEP(28))
4621
4815
INTEGER PROCNODE_STEPS(KEEP(28))
4622
INTEGER LIW, LA
4623
INTEGER IW( LIW ), PTRIST( KEEP(28) ), PTRFAC(KEEP(28))
4816
INTEGER LIW
4817
INTEGER(8) :: LA
4818
INTEGER IW( LIW ), PTRIST( KEEP(28) )
4819
INTEGER(8) :: PTRFAC(KEEP(28))
4624
4820
COMPLEX*16 A( LA ), W2( KEEP(133) )
4625
4821
INTEGER LRHS, NRHS
4626
4822
COMPLEX*16 RHS(LRHS, NRHS)
4633
4829
INCLUDE 'mumps_tags.h'
4634
4830
INTEGER POSITION, IF, INODE, IERR, LONG, DUMMY(1)
4635
4831
INTEGER P_UPDATE, P_SOL_MAS, LIELL, K
4636
INTEGER NPIV, NROW_L, APOS, IPOS, NROW_RECU
4637
INTEGER I, JJ, IN, PROCDEST, J1, J2, IFR, IST, LDA
4832
INTEGER(8) :: APOS, IST
4833
INTEGER NPIV, NROW_L, IPOS, NROW_RECU
4834
INTEGER I, JJ, IN, PROCDEST, J1, J2, IFR, LDA
4638
4835
INTEGER NSLAVES, NELIM, J, POSINDICES, INODEPOS,
4639
4836
& IPOSINRHSCOMP
4640
4837
LOGICAL FLAG
4641
4838
COMPLEX*16 ZERO, ALPHA, ONE
4642
PARAMETER( ZERO = 0.0D0, ALPHA = -1.0D0, ONE = 1.0D0)
4839
PARAMETER (ZERO=(0.0D0,0.0D0),
4840
& ONE=(1.0D0,0.0D0),
4841
& ALPHA=(-1.0D0,0.0D0))
4643
4842
INCLUDE 'mumps_headers.h'
4644
4843
INTEGER POOL_FIRST_POS, TMP
4645
4844
LOGICAL DEJA_SEND( 0:SLAVEF-1 )
4646
4845
INTEGER MUMPS_275
4647
4846
EXTERNAL MUMPS_275, ZTRSV, ZTRSM, ZGEMV, ZGEMM
4648
INTEGER APOSDEB, LDAJ, NBJ, LIWFAC, TailleEcrite,
4649
& APOSTEMP, NBJLAST, NPIV_LAST, PANEL_SIZE,
4847
INTEGER(8) :: APOSDEB, NBENTRIES_ALLPANELS
4848
INTEGER LDAJ, NBJ, LIWFAC,
4849
& NBJLAST, NPIV_LAST, PANEL_SIZE,
4650
4850
& PTWCB_PANEL, NCB_PANEL, TYPEF
4651
4851
LOGICAL TWOBYTWO
4652
4852
INTEGER BEG_PANEL
4656
4856
ELSE IF (MSGTAG .EQ. NOEUD) THEN
4657
4857
POSITION = 0
4658
4858
CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
4659
* INODE, 1, MPI_INTEGER,
4660
* COMM, IERR)
4859
& INODE, 1, MPI_INTEGER,
4860
& COMM, IERR)
4661
4861
CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
4662
* LONG, 1, MPI_INTEGER,
4663
* COMM, IERR)
4862
& LONG, 1, MPI_INTEGER,
4863
& COMM, IERR)
4664
4864
IF ( POSIWCB - LONG - 2 .LT. 0
4665
* .OR. POSWCB - PLEFTW + 1 .LT. LONG ) THEN
4865
& .OR. POSWCB - PLEFTW + 1 .LT. LONG ) THEN
4666
4866
CALL ZMUMPS_95(NRHS, N, KEEP(28), IWCB,
4667
* LIWW, W, LWC,
4668
* POSWCB, POSIWCB, PTRICB, PTRACB)
4867
& LIWW, W, LWC,
4868
& POSWCB, POSIWCB, PTRICB, PTRACB)
4669
4869
IF ((POSIWCB - LONG - 2 ) .LT. 0) THEN
4670
4870
INFO(1)=-14
4671
4871
INFO(2)=-POSIWCB + LONG + 2
4683
4883
POSWCB = POSWCB - LONG
4684
4884
IF (LONG .GT. 0) THEN
4685
4885
CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
4686
* IWCB(POSIWCB + 1),
4687
* LONG, MPI_INTEGER, COMM, IERR)
4886
& IWCB(POSIWCB + 1),
4887
& LONG, MPI_INTEGER, COMM, IERR)
4688
4888
DO K=1,NRHS
4689
4889
CALL MPI_UNPACK(BUFR, LBUFR_BYTES, POSITION,
4690
* W(POSWCB + 1), LONG,
4691
* MPI_DOUBLE_COMPLEX, COMM, IERR)
4890
& W(POSWCB + 1), LONG,
4891
& MPI_DOUBLE_COMPLEX, COMM, IERR)
4692
4892
DO JJ=0, LONG-1
4693
4893
RHS(IWCB(POSIWCB+1+JJ),K) = W(POSWCB+1+JJ)
4694
4894
ENDDO
4702
4902
IF = FRERE( STEP(INODE) )
4703
4903
DO WHILE ( IF .GT. 0 )
4704
4904
IF ( MUMPS_275(STEP(IF),PROCNODE_STEPS,
4705
* SLAVEF) .eq. MYID ) THEN
4905
& SLAVEF) .eq. MYID ) THEN
4706
4906
IPOOL( IIPOOL ) = IF
4707
4907
IIPOOL = IIPOOL + 1
4708
4908
END IF
4716
4916
ELSE IF ( MSGTAG .EQ. BACKSLV_MASTER2SLAVE ) THEN
4717
4917
POSITION = 0
4718
4918
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4719
* INODE, 1, MPI_INTEGER, COMM, IERR )
4919
& INODE, 1, MPI_INTEGER, COMM, IERR )
4720
4920
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4721
* NROW_RECU, 1, MPI_INTEGER, COMM, IERR )
4921
& NROW_RECU, 1, MPI_INTEGER, COMM, IERR )
4722
4922
IPOS = PTRIST( STEP(INODE) ) + KEEP(IXSZ)
4723
4923
NPIV = - IW( IPOS )
4724
4924
NROW_L = IW( IPOS + 1 )
4725
4925
IF (KEEP(201).NE.0) THEN
4726
4926
CALL ZMUMPS_643(
4727
4927
& INODE,PTRFAC,KEEP,A,LA,STEP,
4728
$ KEEP8,N,MUST_BE_PERMUTED,IERR)
4928
& KEEP8,N,MUST_BE_PERMUTED,IERR)
4729
4929
IF(IERR.LT.0)THEN
4730
4930
INFO(1)=IERR
4731
4931
INFO(2)=0
4732
4932
GOTO 260
4733
4933
ENDIF
4734
IF (KEEP(201).EQ.1) THEN
4735
IF
4736
& ( IW(
4737
& PTRIST(STEP(INODE))+IW(PTRIST(STEP(INODE))+XXI)-1
4738
& )
4739
& .EQ.-7777) THEN
4740
MUST_BE_PERMUTED = .FALSE.
4741
ENDIF
4742
ENDIF
4743
4934
ENDIF
4744
4935
APOS = PTRFAC(IW( IPOS + 3 ))
4745
4936
IF ( NROW_L .NE. NROW_RECU ) THEN
4749
4940
LONG = NROW_L + NPIV
4750
4941
IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN
4751
4942
CALL ZMUMPS_95(NRHS, N, KEEP(28), IWCB,
4752
* LIWW, W, LWC,
4753
* POSWCB, POSIWCB, PTRICB, PTRACB)
4943
& LIWW, W, LWC,
4944
& POSWCB, POSIWCB, PTRICB, PTRACB)
4754
4945
IF ( POSWCB - LONG*NRHS .LT. PLEFTW - 1 ) THEN
4755
4946
INFO(1) = -11
4756
4947
INFO(2) = LONG * NRHS- POSWCB
4763
4954
PLEFTW = P_SOL_MAS + NROW_L * NRHS
4764
4955
DO K=1, NRHS
4765
4956
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4766
* W( P_SOL_MAS+(K-1)*NROW_L),NROW_L,
4767
* MPI_DOUBLE_COMPLEX,
4768
* COMM, IERR )
4957
& W( P_SOL_MAS+(K-1)*NROW_L),NROW_L,
4958
& MPI_DOUBLE_COMPLEX,
4959
& COMM, IERR )
4769
4960
ENDDO
4770
4961
IF (KEEP(201).EQ.1) THEN
4771
4962
IF ( NRHS == 1 ) THEN
4772
4963
CALL ZGEMV( 'T', NROW_L, NPIV, ALPHA, A( APOS ), NROW_L,
4773
* W( P_SOL_MAS ), 1, ZERO,
4774
* W( P_UPDATE ), 1 )
4964
& W( P_SOL_MAS ), 1, ZERO,
4965
& W( P_UPDATE ), 1 )
4775
4966
ELSE
4776
4967
CALL ZGEMM( 'T', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS),
4777
* NROW_L, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ),
4778
* NPIV )
4968
& NROW_L, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ),
4969
& NPIV )
4779
4970
ENDIF
4780
4971
ELSE
4781
4972
IF ( NRHS == 1 ) THEN
4782
4973
CALL ZGEMV( 'N', NPIV, NROW_L, ALPHA, A( APOS ), NPIV,
4783
* W( P_SOL_MAS ), 1, ZERO,
4784
* W( P_UPDATE ), 1 )
4974
& W( P_SOL_MAS ), 1, ZERO,
4975
& W( P_UPDATE ), 1 )
4785
4976
ELSE
4786
4977
CALL ZGEMM( 'N', 'N', NPIV, NRHS, NROW_L, ALPHA, A(APOS),
4787
* NPIV, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ),
4788
* NPIV )
4978
& NPIV, W( P_SOL_MAS ), NROW_L, ZERO, W( P_UPDATE ),
4979
& NPIV )
4789
4980
END IF
4790
4981
ENDIF
4791
4982
IF (KEEP(201).NE.0) THEN
4792
4983
CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28),
4793
$ A,LA,.TRUE.,IERR)
4984
& A,LA,.TRUE.,IERR)
4794
4985
IF(IERR.LT.0)THEN
4795
4986
INFO(1)=IERR
4796
4987
INFO(2)=0
4800
4991
PLEFTW = PLEFTW - NROW_L * NRHS
4801
4992
100 CONTINUE
4802
4993
CALL ZMUMPS_63( NRHS, INODE, W(P_UPDATE),
4803
* NPIV, NPIV,
4804
* MSGSOU,
4805
* BACKSLV_UPDATERHS,
4806
* COMM, IERR )
4994
& NPIV, NPIV,
4995
& MSGSOU,
4996
& BACKSLV_UPDATERHS,
4997
& COMM, IERR )
4807
4998
IF ( IERR .EQ. -1 ) THEN
4808
4999
CALL ZMUMPS_41(
4809
* .FALSE., FLAG,
4810
* BUFR, LBUFR, LBUFR_BYTES,
4811
* MYID, SLAVEF, COMM,
4812
* N, IWCB, LIWW, POSIWCB,
4813
* W, LWC, POSWCB,
4814
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
4815
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
4816
* FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
4817
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
4818
* RHS, LRHS, NRHS, MTYPE,
4819
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
4820
* )
5000
& .FALSE., FLAG,
5001
& BUFR, LBUFR, LBUFR_BYTES,
5002
& MYID, SLAVEF, COMM,
5003
& N, IWCB, LIWW, POSIWCB,
5004
& W, LWC, POSWCB,
5005
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
5006
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
5007
& FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
5008
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
5009
& RHS, LRHS, NRHS, MTYPE,
5010
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
5011
& )
4821
5012
IF ( INFO( 1 ) .LT. 0 ) GOTO 270
4822
5013
GOTO 100
4823
5014
ELSE IF ( IERR .EQ. -2 ) THEN
4833
5024
ELSE IF ( MSGTAG .EQ. BACKSLV_UPDATERHS ) THEN
4834
5025
POSITION = 0
4835
5026
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4836
* INODE, 1, MPI_INTEGER, COMM, IERR )
5027
& INODE, 1, MPI_INTEGER, COMM, IERR )
4837
5028
IPOS = PTRIST(STEP(INODE)) + 2 + KEEP(IXSZ)
4838
5029
LIELL = IW(IPOS-2)+IW(IPOS+1)
4839
5030
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4840
* NPIV, 1, MPI_INTEGER, COMM, IERR )
5031
& NPIV, 1, MPI_INTEGER, COMM, IERR )
4841
5032
NELIM = IW(IPOS-1)
4842
5033
IPOS = IPOS + 1
4843
5034
NPIV = IW(IPOS)
4859
5050
END IF
4860
5051
DO K=1, NRHS
4861
5052
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4862
* W2, NPIV, MPI_DOUBLE_COMPLEX,
4863
* COMM, IERR )
5053
& W2, NPIV, MPI_DOUBLE_COMPLEX,
5054
& COMM, IERR )
4864
5055
IPOSINRHSCOMP = POSINRHSCOMP(STEP(INODE))
4865
5056
I = 1
4866
5057
DO JJ = J1,J2
4870
5061
ENDDO
4871
5062
ENDDO
4872
5063
IW(PTRIST(STEP(INODE))+XXS) =
4873
* IW(PTRIST(STEP(INODE))+XXS) - 1
5064
& IW(PTRIST(STEP(INODE))+XXS) - 1
4874
5065
IF ( IW(PTRIST(STEP(INODE))+XXS).EQ.C_FINI ) THEN
4875
5066
IF (KEEP(201).NE.0) THEN
4876
5067
CALL ZMUMPS_643(
4877
5068
& INODE,PTRFAC,KEEP,A,LA,STEP,
4878
$ KEEP8,N,MUST_BE_PERMUTED,IERR)
5069
& KEEP8,N,MUST_BE_PERMUTED,IERR)
4879
5070
IF(IERR.LT.0)THEN
4880
5071
INFO(1)=IERR
4881
5072
INFO(2)=0
4882
5073
GOTO 260
4883
5074
ENDIF
4884
IF (KEEP(201).EQ.1) THEN
4885
IF
4886
& ( IW(
4887
& PTRIST(STEP(INODE))+IW(PTRIST(STEP(INODE))+XXI)-1
4888
& )
4889
& .EQ.-7777) THEN
4890
MUST_BE_PERMUTED = .FALSE.
4891
ENDIF
5075
IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN
5076
CALL ZMUMPS_755(
5077
& IW(IPOS+1+2*LIELL),
5078
& MUST_BE_PERMUTED )
4892
5079
ENDIF
4893
5080
ENDIF
4894
5081
APOS = PTRFAC(IW(INODEPOS))
4895
5082
IF (KEEP(201).EQ.1) THEN
4896
LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
4897
IF (MTYPE.NE.1) THEN
4898
TYPEF = TYPEF_L
4899
NROW_L = NPIV+NELIM
4900
CALL ZMUMPS_690( INODE, TYPEF,
4901
& IW(PTRIST(STEP(INODE))), LIWFAC, NROW_L,
4902
& PANEL_SIZE, TailleEcrite)
4903
ENDIF
4904
IF (PANEL_SIZE.LT.0) THEN
4905
WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=',
4906
& PANEL_SIZE
4907
CALL MUMPS_ABORT()
4908
ENDIF
5083
LIWFAC = IW(PTRIST(STEP(INODE))+XXI)
5084
TYPEF = TYPEF_L
5085
NROW_L = NPIV+NELIM
5086
PANEL_SIZE = ZMUMPS_690(NROW_L)
5087
IF (PANEL_SIZE.LT.0) THEN
5088
WRITE(6,*) ' Internal error in bwd solve PANEL_SIZE=',
5089
& PANEL_SIZE
5090
CALL MUMPS_ABORT()
5091
ENDIF
4909
5092
ENDIF
4910
5093
IF ( POSIWCB - 2 .LT. 0 .or.
4911
* POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN
5094
& POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN
4912
5095
CALL ZMUMPS_95( NRHS, N, KEEP(28), IWCB,
4913
* LIWW, W, LWC,
4914
* POSWCB, POSIWCB, PTRICB, PTRACB)
5096
& LIWW, W, LWC,
5097
& POSWCB, POSIWCB, PTRICB, PTRACB)
4915
5098
IF ( POSWCB - LIELL*NRHS .LT. PLEFTW - 1 ) THEN
4916
5099
INFO( 1 ) = -11
4917
5100
INFO( 2 ) = LIELL * NRHS - POSWCB - PLEFTW + 1
4959
5142
ENDDO
4960
5143
ENDDO
4961
5144
IF ( KEEP(201).EQ.1 .AND.
4962
* (( NELIM .GT. 0 ).OR. (MTYPE.NE.1 ))) THEN
5145
& (( NELIM .GT. 0 ).OR. (MTYPE.NE.1 ))) THEN
4963
5146
J = NPIV / PANEL_SIZE
4964
5147
TWOBYTWO = KEEP(50).EQ.2 .AND. KEEP(105).GT.0
4965
5148
IF (TWOBYTWO) THEN
4966
5149
CALL ZMUMPS_641(PANEL_SIZE, PANEL_POS,
4967
& LPANEL_POS, IW(IPOS+1+LIELL), NPIV, NPANELS)
5150
& LPANEL_POS, IW(IPOS+1+LIELL), NPIV, NPANELS,
5151
& NROW_L, NBENTRIES_ALLPANELS)
4968
5152
ELSE
4969
5153
IF (NPIV.EQ.J*PANEL_SIZE) THEN
4970
NPIV_LAST = NPIV
4971
NBJLAST = PANEL_SIZE
4972
NPANELS = J
4973
ELSE
4974
NPIV_LAST = (J+1)* PANEL_SIZE
4975
NBJLAST = NPIV-J*PANEL_SIZE
4976
NPANELS = J+1
4977
ENDIF
4978
JJ=NPIV_LAST
5154
NPIV_LAST = NPIV
5155
NBJLAST = PANEL_SIZE
5156
NPANELS = J
5157
ELSE
5158
NPIV_LAST = (J+1)* PANEL_SIZE
5159
NBJLAST = NPIV-J*PANEL_SIZE
5160
NPANELS = J+1
5161
ENDIF
5162
NBENTRIES_ALLPANELS =
5163
& int(NROW_L,8) * int(NPIV,8)
5164
& - int( ( J * ( J - 1 ) ) / 2,8 )
5165
& * int(PANEL_SIZE,8) * int(PANEL_SIZE,8)
5166
& - int(J,8)
5167
& * int(MOD(NPIV, PANEL_SIZE),8)
5168
& * int(PANEL_SIZE,8)
5169
JJ=NPIV_LAST
4979
5170
ENDIF
4980
APOSDEB = APOS + TailleEcrite
5171
APOSDEB = APOS + NBENTRIES_ALLPANELS
4981
5172
DO IPANEL=NPANELS,1,-1
4982
5173
IF (TWOBYTWO) THEN
4983
5174
NBJ = PANEL_POS(IPANEL+1)-PANEL_POS(IPANEL)
4991
5182
BEG_PANEL = JJ- PANEL_SIZE+1
4992
5183
ENDIF
4993
5184
LDAJ = NROW_L-BEG_PANEL+1
4994
APOSDEB = APOSDEB - NBJ*LDAJ
5185
APOSDEB = APOSDEB - int(NBJ,8)*int(LDAJ,8)
4995
5186
PTWCB_PANEL = PTRACB(STEP(INODE)) + BEG_PANEL - 1
4996
5187
NCB_PANEL = LDAJ - NBJ
4997
5188
IF (KEEP(50).NE.1 .AND.MUST_BE_PERMUTED) THEN
4998
5189
CALL ZMUMPS_667(TYPEF, TMP_NBPANELS,
4999
* I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW)
5190
& I_PIVRPTR, I_PIVR, IPOS + 1 + 2 * LIELL, IW, LIW)
5000
5191
CALL ZMUMPS_698(
5001
* IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)),
5002
* NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
5003
* IW(I_PIVRPTR+IPANEL-1)-1,
5004
* A(APOSDEB),
5005
* LDAJ, NBJ, BEG_PANEL-1)
5192
& IW(I_PIVR + IW(I_PIVRPTR+IPANEL-1)-IW(I_PIVRPTR)),
5193
& NPIV-IW(I_PIVRPTR+IPANEL-1)+1,
5194
& IW(I_PIVRPTR+IPANEL-1)-1,
5195
& A(APOSDEB),
5196
& LDAJ, NBJ, BEG_PANEL-1)
5006
5197
ENDIF
5007
5198
IF ( NRHS == 1 ) THEN
5008
5199
IF (NCB_PANEL.NE.0) THEN
5009
5200
CALL ZGEMV( 'T', NCB_PANEL, NBJ, ALPHA,
5010
* A( APOSDEB + NBJ ), LDAJ,
5011
* W( NBJ + PTWCB_PANEL ),
5012
* 1, ONE,
5013
* W(PTWCB_PANEL), 1 )
5201
& A( APOSDEB + int(NBJ,8) ), LDAJ,
5202
& W( NBJ + PTWCB_PANEL ),
5203
& 1, ONE,
5204
& W(PTWCB_PANEL), 1 )
5014
5205
ENDIF
5015
5206
CALL ZTRSV('L','T','U', NBJ, A(APOSDEB), LDAJ,
5016
* W(PTWCB_PANEL), 1)
5207
& W(PTWCB_PANEL), 1)
5017
5208
ELSE
5018
5209
IF (NCB_PANEL.NE.0) THEN
5019
5210
CALL ZGEMM( 'T', 'N', NBJ, NRHS, NCB_PANEL, ALPHA,
5020
* A(APOSDEB +NBJ), LDAJ, W(NBJ+PTWCB_PANEL),LIELL,
5021
* ONE, W(PTWCB_PANEL),LIELL)
5211
& A(APOSDEB + int(NBJ,8)), LDAJ,
5212
& W(NBJ+PTWCB_PANEL),LIELL,
5213
& ONE, W(PTWCB_PANEL),LIELL)
5022
5214
ENDIF
5023
5215
CALL ZTRSM('L','L','T','U',NBJ, NRHS, ONE,
5024
* A(APOSDEB),
5025
* LDAJ, W(PTWCB_PANEL), LIELL)
5216
& A(APOSDEB),
5217
& LDAJ, W(PTWCB_PANEL), LIELL)
5026
5218
ENDIF
5027
5219
IF (.NOT. TWOBYTWO) JJ=BEG_PANEL-1
5028
5220
ENDDO
5030
5222
ENDIF
5031
5223
IF (NELIM .GT.0) THEN
5032
5224
IF ( KEEP(50) .eq. 0 ) THEN
5033
IST = APOS + NPIV * LIELL
5225
IST = APOS + int(NPIV,8) * int(LIELL,8)
5034
5226
ELSE
5035
IST = APOS + NPIV * NPIV
5227
IST = APOS + int(NPIV,8) * int(NPIV,8)
5036
5228
END IF
5037
5229
IF ( NRHS == 1 ) THEN
5038
5230
CALL ZGEMV( 'N', NPIV, NELIM, ALPHA,
5039
* A( IST ), NPIV,
5040
* W( NPIV + PTRACB(STEP(INODE)) ),
5041
* 1, ONE,
5042
* W(PTRACB(STEP(INODE))), 1 )
5231
& A( IST ), NPIV,
5232
& W( NPIV + PTRACB(STEP(INODE)) ),
5233
& 1, ONE,
5234
& W(PTRACB(STEP(INODE))), 1 )
5043
5235
ELSE
5044
5236
CALL ZGEMM( 'N', 'N', NPIV, NRHS, NELIM, ALPHA,
5045
* A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL,
5046
* ONE, W(PTRACB(STEP(INODE))),LIELL)
5237
& A(IST), NPIV, W(NPIV+PTRACB(STEP(INODE))),LIELL,
5238
& ONE, W(PTRACB(STEP(INODE))),LIELL)
5047
5239
END IF
5048
5240
ENDIF
5049
5241
IF ( NRHS == 1 ) THEN
5050
5242
CALL ZTRSV( 'U', 'N', 'U', NPIV, A(APOS), LDA,
5051
* W(PTRACB(STEP(INODE))),1)
5243
& W(PTRACB(STEP(INODE))),1)
5052
5244
ELSE
5053
5245
CALL ZTRSM( 'L','U', 'N', 'U', NPIV, NRHS, ONE,
5054
* A(APOS), LDA,
5055
* W(PTRACB(STEP(INODE))),LIELL)
5246
& A(APOS), LDA,
5247
& W(PTRACB(STEP(INODE))),LIELL)
5056
5248
END IF
5057
5249
1234 CONTINUE
5058
5250
IF (KEEP(201).NE.0) THEN
5059
5251
CALL ZMUMPS_598(INODE,PTRFAC,KEEP(28),
5060
$ A,LA,.TRUE.,IERR)
5252
& A,LA,.TRUE.,IERR)
5061
5253
IF(IERR.LT.0)THEN
5062
5254
INFO(1)=IERR
5063
5255
INFO(2)=0
5069
5261
JJ = IW( IPOS + I - 1 )
5070
5262
DO K=1,NRHS
5071
5263
RHS( JJ, K ) = W( PTRACB(STEP(INODE))+I-1
5072
* + (K-1)*LIELL )
5264
& + (K-1)*LIELL )
5073
5265
ENDDO
5074
5266
END DO
5075
5267
IN = INODE
5079
5271
MYLEAFE = MYLEAFE - 1
5080
5272
IF (MYLEAFE .EQ. 0) THEN
5081
5273
CALL ZMUMPS_242( DUMMY, 1, MPI_INTEGER, MYID, COMM,
5082
* FEUILLE, SLAVEF )
5274
& FEUILLE, SLAVEF )
5083
5275
NBFINF = NBFINF - 1
5084
5276
ENDIF
5085
5277
IWCB( PTRICB(STEP(INODE)) + 1 ) = 0
5086
5278
CALL ZMUMPS_151(NRHS, N, KEEP(28),
5087
* IWCB, LIWW, W, LWC,
5088
* POSWCB, POSIWCB, PTRICB, PTRACB)
5279
& IWCB, LIWW, W, LWC,
5280
& POSWCB, POSIWCB, PTRICB, PTRACB)
5089
5281
GOTO 270
5090
5282
ENDIF
5091
5283
DO I = 0, SLAVEF - 1
5092
5284
DEJA_SEND( I ) = .FALSE.
5093
5285
END DO
5094
5286
IN = -IN
5095
300 CONTINUE
5287
DO WHILE (IN.GT.0)
5096
5288
POOL_FIRST_POS = IIPOOL
5097
5289
IF (MUMPS_275(STEP(IN),PROCNODE_STEPS,
5098
* SLAVEF) .EQ. MYID) THEN
5290
& SLAVEF) .EQ. MYID) THEN
5099
5291
IPOOL(IIPOOL ) = IN
5100
5292
IIPOOL = IIPOOL + 1
5101
5293
ELSE
5102
5294
PROCDEST = MUMPS_275( STEP(IN), PROCNODE_STEPS,
5103
* SLAVEF )
5295
& SLAVEF )
5104
5296
IF ( .NOT. DEJA_SEND( PROCDEST ) ) THEN
5105
5297
110 CALL ZMUMPS_78( NRHS, IN, 0, 0,
5106
* LIELL, LIELL,
5107
* IW( POSINDICES ) ,
5108
* W( PTRACB(STEP(INODE))),
5109
* PROCDEST, NOEUD, COMM, IERR )
5298
& LIELL, LIELL,
5299
& IW( POSINDICES ) ,
5300
& W( PTRACB(STEP(INODE))),
5301
& PROCDEST, NOEUD, COMM, IERR )
5110
5302
IF ( IERR .EQ. -1 ) THEN
5111
5303
CALL ZMUMPS_41(
5112
* .FALSE., FLAG,
5113
* BUFR, LBUFR, LBUFR_BYTES,
5114
* MYID, SLAVEF, COMM,
5115
* N, IWCB, LIWW, POSIWCB,
5116
* W, LWC, POSWCB,
5117
* IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
5118
* IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
5119
* FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
5120
* PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
5121
* RHS, LRHS, NRHS, MTYPE,
5122
* RHSCOMP, LRHSCOMP, POSINRHSCOMP
5123
* )
5304
& .FALSE., FLAG,
5305
& BUFR, LBUFR, LBUFR_BYTES,
5306
& MYID, SLAVEF, COMM,
5307
& N, IWCB, LIWW, POSIWCB,
5308
& W, LWC, POSWCB,
5309
& IIPOOL, NBFINF, PTRICB, PTRACB, INFO,
5310
& IPOOL, LPOOL, PANEL_POS, LPANEL_POS, STEP,
5311
& FRERE, FILS, PROCNODE_STEPS, PLEFTW, KEEP,KEEP8,
5312
& PTRIST, PTRFAC, IW, LIW, A, LA, W2, MYLEAFE,
5313
& RHS, LRHS, NRHS, MTYPE,
5314
& RHSCOMP, LRHSCOMP, POSINRHSCOMP
5315
& )
5124
5316
IF ( INFO( 1 ) .LT. 0 ) GOTO 270
5125
5317
GOTO 110
5126
5318
ELSE IF ( IERR .eq. -2 ) THEN
5127
5319
INFO(1) = -17
5128
5320
INFO(2) = LIELL * NRHS * KEEP(35) +
5129
* ( LIELL + 2 ) * KEEP(34)
5321
& ( LIELL + 2 ) * KEEP(34)
5130
5322
GOTO 260
5131
5323
ELSE IF ( IERR .eq. -3 ) THEN
5132
5324
INFO(1) = -20
5133
5325
INFO(2) = LIELL * NRHS * KEEP(35) +
5134
* ( LIELL + 2 ) * KEEP(34)
5326
& ( LIELL + 2 ) * KEEP(34)
5135
5327
GOTO 260
5136
5328
END IF
5137
5329
DEJA_SEND( PROCDEST ) = .TRUE.
5138
5330
END IF
5139
5331
END IF
5140
IN = FRERE( STEP( IN ) )
5141
IF ( IN .GT. 0 ) GOTO 300
5332
IN = FRERE( STEP( IN ) )
5333
END DO
5142
5334
DO I=1,(IIPOOL-POOL_FIRST_POS)/2
5143
5335
TMP=IPOOL(POOL_FIRST_POS+I-1)
5144
5336
IPOOL(POOL_FIRST_POS+I-1)=IPOOL(IIPOOL-I)
5146
5338
ENDDO
5147
5339
IWCB( PTRICB(STEP( INODE )) + 1 ) = 0
5148
5340
CALL ZMUMPS_151(NRHS, N, KEEP(28),
5149
* IWCB, LIWW, W, LWC,
5150
* POSWCB, POSIWCB, PTRICB, PTRACB)
5341
& IWCB, LIWW, W, LWC,
5342
& POSWCB, POSIWCB, PTRICB, PTRACB)
5151
5343
END IF
5152
5344
ELSE IF (MSGTAG.EQ.TERREUR) THEN
5153
5345
INFO(1) = -001
5154
5346
INFO(2) = MSGSOU
5155
5347
GO TO 270
5156
5348
ELSE IF ( (MSGTAG.EQ.UPDATE_LOAD).OR.
5157
* (MSGTAG.EQ.TAG_DUMMY) ) THEN
5349
& (MSGTAG.EQ.TAG_DUMMY) ) THEN
5158
5350
GO TO 270
5159
5351
ELSE
5160
5352
INFO(1) = -100
5168
5360
RETURN
5169
5361
END SUBROUTINE ZMUMPS_42
5170
5362
SUBROUTINE ZMUMPS_641(PANEL_SIZE, PANEL_POS,
5171
* LEN_PANEL_POS, INDICES, NPIV,
5172
* NPANELS)
5363
& LEN_PANEL_POS, INDICES, NPIV,
5364
& NPANELS, NFRONT_OR_NASS,
5365
& NBENTRIES_ALLPANELS)
5173
5366
IMPLICIT NONE
5174
INTEGER, intent (in) :: PANEL_SIZE, NPIV
5175
INTEGER, intent (in) :: INDICES(NPIV)
5176
INTEGER, intent (in) :: LEN_PANEL_POS
5177
INTEGER, intent (out):: NPANELS
5178
INTEGER, intent (out):: PANEL_POS(LEN_PANEL_POS)
5367
INTEGER, intent (in) :: PANEL_SIZE, NPIV
5368
INTEGER, intent (in) :: INDICES(NPIV)
5369
INTEGER, intent (in) :: LEN_PANEL_POS
5370
INTEGER, intent (out) :: NPANELS
5371
INTEGER, intent (out) :: PANEL_POS(LEN_PANEL_POS)
5372
INTEGER, intent (in) :: NFRONT_OR_NASS
5373
INTEGER(8), intent(out):: NBENTRIES_ALLPANELS
5179
5374
INTEGER NPANELS_MAX, I, NBeff
5375
INTEGER(8) :: NBENTRIES_THISPANEL
5376
NBENTRIES_ALLPANELS = 0_8
5180
5377
NPANELS_MAX = (NPIV+PANEL_SIZE-1)/PANEL_SIZE
5181
5378
IF (LEN_PANEL_POS .LT. NPANELS_MAX + 1) THEN
5182
WRITE(*,*) "Error in ZMUMPS_641",
5183
* LEN_PANEL_POS,NPANELS_MAX
5379
WRITE(*,*) "Error 1 in ZMUMPS_641",
5380
& LEN_PANEL_POS,NPANELS_MAX
5184
5381
CALL MUMPS_ABORT()
5185
5382
ENDIF
5186
5383
I = 1
5193
5390
IF ( INDICES(I+NBeff-1) < 0) THEN
5194
5391
NBeff=NBeff+1
5195
5392
ENDIF
5393
NBENTRIES_THISPANEL = int(NFRONT_OR_NASS-I+1,8) * int(NBeff,8)
5394
NBENTRIES_ALLPANELS = NBENTRIES_ALLPANELS + NBENTRIES_THISPANEL
5196
5395
I=I+NBeff
5197
5396
IF ( I .LE. NPIV ) GOTO 10
5198
5397
PANEL_POS(NPANELS+1)=NPIV+1
5199
5398
RETURN
5200
5399
END SUBROUTINE ZMUMPS_641
5201
5400
SUBROUTINE ZMUMPS_286( NRHS, DESCA_PAR, DESCB_PAR,
5202
* CNTXT_PAR,LOCAL_M,LOCAL_N,MBLOCK,NBLOCK,
5203
* IPIV,LPIV,MASTER_ROOT,MYID,COMM,
5204
* RHS_SEQ,SIZE_ROOT,A,INFO,MTYPE,LDLT )
5401
& CNTXT_PAR,LOCAL_M,LOCAL_N,MBLOCK,NBLOCK,
5402
& IPIV,LPIV,MASTER_ROOT,MYID,COMM,
5403
& RHS_SEQ,SIZE_ROOT,A,INFO,MTYPE,LDLT )
5205
5404
IMPLICIT NONE
5206
5405
INTEGER NRHS, MTYPE
5207
5406
INTEGER DESCA_PAR( 9 ), DESCB_PAR( 9 )
5230
5429
CALL MUMPS_ABORT()
5231
5430
ENDIF
5232
5431
CALL ZMUMPS_290( MYID, SIZE_ROOT, NRHS, RHS_SEQ,
5233
* LOCAL_M, LOCAL_N_RHS,
5234
* MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT,
5235
* NPROW, NPCOL, COMM )
5432
& LOCAL_M, LOCAL_N_RHS,
5433
& MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT,
5434
& NPROW, NPCOL, COMM )
5236
5435
IF ( LDLT .eq. 0 .OR. LDLT .eq. 2 ) THEN
5237
5436
IF ( MTYPE .eq. 1 ) THEN
5238
5437
CALL PZGETRS('N',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV,
5239
* RHS_PAR,1,1,DESCB_PAR,IERR)
5438
& RHS_PAR,1,1,DESCB_PAR,IERR)
5240
5439
ELSE
5241
5440
CALL PZGETRS('T',SIZE_ROOT,NRHS,A,1,1,DESCA_PAR,IPIV,
5242
* RHS_PAR, 1, 1, DESCB_PAR,IERR)
5441
& RHS_PAR, 1, 1, DESCB_PAR,IERR)
5243
5442
END IF
5244
5443
ELSE
5245
5444
CALL PZPOTRS( 'L', SIZE_ROOT, NRHS, A, 1, 1, DESCA_PAR,
5246
* RHS_PAR, 1, 1, DESCB_PAR, IERR )
5445
& RHS_PAR, 1, 1, DESCB_PAR, IERR )
5247
5446
END IF
5248
5447
IF ( IERR .LT. 0 ) THEN
5249
5448
WRITE(*,*) ' Problem during solve of the root'
5250
5449
CALL MUMPS_ABORT()
5251
5450
END IF
5252
5451
CALL ZMUMPS_156( MYID, SIZE_ROOT, NRHS,
5253
* RHS_SEQ, LOCAL_M, LOCAL_N_RHS,
5254
* MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT,
5255
* NPROW, NPCOL, COMM )
5452
& RHS_SEQ, LOCAL_M, LOCAL_N_RHS,
5453
& MBLOCK, NBLOCK, RHS_PAR, MASTER_ROOT,
5454
& NPROW, NPCOL, COMM )
5256
5455
DEALLOCATE(RHS_PAR)
5257
5456
RETURN
5258
5457
END SUBROUTINE ZMUMPS_286
Loggerhead is a web-based interface for Breezy
Version: 2.0.1