« back to all changes in this revision
Viewing changes to src/smumps_part4.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/smumps_part4.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
44
40
SUBROUTINE SMUMPS_246(MYID, N, STEP, FRERE, FILS,
45
* NA, LNA, NE, DAD, ND, PROCNODE, SLAVEF,
46
* NRLADU, NIRADU, NIRNEC, NRLNEC,
47
* NRLNEC_ACTIVE,
48
* NIRADU_OOC, NIRNEC_OOC,
49
* MAXFR, OPSA,
50
* KEEP,KEEP8, LOCAL_M, LOCAL_N, SBUF_RECOLD,
51
* SBUF_SEND, SBUF_REC, OPS_SUBTREE, NSTEPS,
52
* I_AM_CAND,NMB_PAR2, ISTEP_TO_INIV2, CANDIDATES,
53
* IFLAG, IERROR
54
* ,MAX_FRONT_SURFACE_LOCAL
55
* ,MAX_SIZE_FACTOR, ENTRIES_IN_FACTORS_LOC,
56
* ENTRIES_IN_FACTORS_TOT
57
* )
41
& NA, LNA, NE, DAD, ND, PROCNODE, SLAVEF,
42
& NRLADU, NIRADU, NIRNEC, NRLNEC,
43
& NRLNEC_ACTIVE,
44
& NIRADU_OOC, NIRNEC_OOC,
45
& MAXFR, OPSA,
46
& KEEP,KEEP8, LOCAL_M, LOCAL_N, SBUF_RECOLD,
47
& SBUF_SEND, SBUF_REC, OPS_SUBTREE, NSTEPS,
48
& I_AM_CAND,NMB_PAR2, ISTEP_TO_INIV2, CANDIDATES,
49
& IFLAG, IERROR
50
& ,MAX_FRONT_SURFACE_LOCAL
51
& ,MAX_SIZE_FACTOR, ENTRIES_IN_FACTORS_LOC,
52
& ENTRIES_IN_FACTORS_TOT
53
& )
58
54
IMPLICIT NONE
59
55
INTEGER MYID, N, LNA, IFLAG, IERROR
60
56
INTEGER NIRADU, NIRNEC
65
61
INTEGER*8 MAX_FRONT_SURFACE_LOCAL
66
62
INTEGER STEP(N)
67
63
INTEGER FRERE(NSTEPS), FILS(N), NA(LNA), NE(NSTEPS),
68
* ND(NSTEPS), PROCNODE(NSTEPS), DAD(NSTEPS)
64
& ND(NSTEPS), PROCNODE(NSTEPS), DAD(NSTEPS)
69
65
INTEGER SLAVEF, KEEP(500), LOCAL_M, LOCAL_N
70
66
INTEGER*8 KEEP8(150)
71
67
INTEGER*8 ENTRIES_IN_FACTORS_LOC, ENTRIES_IN_FACTORS_TOT
102
98
INTEGER SIZEHEADER, SIZEHEADER_OOC, XSIZE_OOC
103
99
INTEGER EXTRA_PERM_INFO_OOC
104
100
INTEGER NBROWMAX, NSLAVES_LOC, NSLAVES_PASSED,
105
* NELIMF, NFRF, NCBF,
106
* NSLAVESF, NBROWMAXF, LKJIB,
107
* LKJIBT, NBR, NBCOLFAC,
108
* NBROWAVG
101
& NELIMF, NFRF, NCBF,
102
& NSLAVESF, NBROWMAXF, LKJIB,
103
& LKJIBT, NBR, NBCOLFAC,
104
& NBROWAVG
109
105
INTEGER*8 LEV3MAXREC, CBMAXR, CBMAXS
110
106
INTEGER LWK_RR, LIWK_RR
111
107
INTEGER IROOT, SIZE_ROOT
118
114
INTEGER WHAT
119
115
INTEGER*8 IDUMMY8
120
116
INTRINSIC min, int, real
121
INTEGER SMUMPS_OOC_GET_PANEL_SIZE
122
EXTERNAL SMUMPS_OOC_GET_PANEL_SIZE
117
INTEGER SMUMPS_748
118
EXTERNAL SMUMPS_748
123
119
INTEGER MUMPS_275, MUMPS_330
124
120
LOGICAL MUMPS_170
125
121
INTEGER MUMPS_52
126
122
EXTERNAL MUMPS_503, MUMPS_52
127
123
EXTERNAL MUMPS_275, MUMPS_330,
128
* MUMPS_170
124
& MUMPS_170
129
125
logical :: FORCE_CAND, CONCERNED, UPDATES, STACKCB, MASTERSON
130
126
integer :: istat, IFSON, LEVELSON
131
127
IF (KEEP(50).eq.2) THEN
139
135
MAX_FRONT_SURFACE_LOCAL=0_8
140
136
MAX_SIZE_FACTOR=0_8
141
137
ALLOCATE( LSTKR(NSTEPS), TNSTK(NSTEPS), IPOOL(NSTEPS),
142
* LSTKI(NSTEPS) , stat=ALLOCOK)
138
& LSTKI(NSTEPS) , stat=ALLOCOK)
143
139
if (ALLOCOK .GT. 0) THEN
144
140
IFLAG =-7
145
141
IERROR = 4*NSTEPS
187
183
SBUFR = 1
188
184
IF (KEEP(38) .NE. 0 .AND. KEEP(60).EQ.0) THEN
189
185
INODE = KEEP(38)
190
NRLADU_ROOT_3 = int(LOCAL_M,kind=8)*int(LOCAL_N,kind=8)
186
NRLADU_ROOT_3 = int(LOCAL_M,KIND=8)*int(LOCAL_N,KIND=8)
191
187
NRLADU = NRLADU_ROOT_3
192
188
NRLNEC_ACTIVE = NRLADU_CURRENT
193
189
MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_ROOT_3)
194
190
NRLNEC = NRLADU
195
191
IF (MUMPS_275(STEP(INODE),PROCNODE,SLAVEF)
196
* .EQ. MYID) THEN
192
& .EQ. MYID) THEN
197
193
NIRADU = SIZEHEADER+2*ND(STEP(INODE))
198
194
NIRADU_OOC = SIZEHEADER_OOC+2*ND(STEP(INODE))
199
195
ELSE
229
225
IFSON = -IN
230
226
IFATH = DAD(STEP(INODE))
231
227
MASTER = MUMPS_275(STEP(INODE),PROCNODE,SLAVEF)
232
* .EQ. MYID
228
& .EQ. MYID
233
229
LEVEL = MUMPS_330(STEP(INODE),PROCNODE,SLAVEF)
234
230
INSSARBR = MUMPS_170(STEP(INODE),
235
$ PROCNODE,SLAVEF)
231
& PROCNODE,SLAVEF)
236
232
UPDATE=.FALSE.
237
233
if(.NOT.FORCE_CAND) then
238
234
UPDATE = ( (MASTER.AND.(LEVEL.NE.3) ).OR. LEVEL.EQ.2 )
268
264
WHAT = 5
269
265
IF (FORCE_CAND) THEN
270
266
NSLAVES_LOC=CANDIDATES(SLAVEF+1,
271
$ ISTEP_TO_INIV2(STEP(INODE)))
267
& ISTEP_TO_INIV2(STEP(INODE)))
272
268
ELSE
273
269
NSLAVES_LOC=SLAVEF-1
274
270
ENDIF
289
285
ENDIF
290
286
IF (LEVEL.EQ.3) THEN
291
287
IF (
292
* KEEP(60).LE.1
293
* ) THEN
288
& KEEP(60).LE.1
289
& ) THEN
294
290
NRLNEC = max(NRLNEC,NRLADU+ISTKR+
295
* int(LOCAL_M,8)*int(LOCAL_N,8))
291
& int(LOCAL_M,8)*int(LOCAL_N,8))
296
292
NRLADU_CURRENT = int(LOCAL_M,8)*int(LOCAL_N,8)
297
293
NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_ROOT_3 +
298
* NRLADU_CURRENT+ISTKR)
294
& NRLADU_CURRENT+ISTKR)
299
295
ENDIF
300
296
IF (MASTER) THEN
301
297
IF (NFR.GT.MAXFR) MAXFR = NFR
303
299
ENDIF
304
300
IF(KEEP(86).EQ.1)THEN
305
301
IF(MASTER.AND.(.NOT.MUMPS_170(STEP(INODE),
306
$ PROCNODE,SLAVEF)))THEN
302
& PROCNODE,SLAVEF)))THEN
307
303
IF(LEVEL.EQ.1)THEN
308
304
MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL,
309
$ NFR8*NFR8)
305
& NFR8*NFR8)
310
306
ELSEIF(LEVEL.EQ.2)THEN
311
307
IF(KEEP(50).EQ.0)THEN
312
308
MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL,
313
$ NFR8*NELIM8)
309
& NFR8*NELIM8)
314
310
ELSE
315
311
MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL,
316
$ NELIM8*NELIM8)
312
& NELIM8*NELIM8)
317
313
IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN
318
314
MAX_FRONT_SURFACE_LOCAL=max(MAX_FRONT_SURFACE_LOCAL,
319
$ NELIM8*(NELIM8+1_8))
315
& NELIM8*(NELIM8+1_8))
320
316
ENDIF
321
317
ENDIF
322
318
ENDIF
340
336
LKJIBT = min( NELIM, LKJIB * 2 )
341
337
ENDIF
342
338
SBUFS = max(SBUFS,
343
* LKJIBT*NBROWMAX+6)
339
& LKJIBT*NBROWMAX+6)
344
340
SBUFR = max( SBUFR, NBROWMAX*LKJIBT+6 )
345
341
endif
346
342
ENDIF
349
345
IF ( (MASTER) .AND. (LEVEL.EQ.1) ) THEN
350
346
NIRADU = NIRADU + 2*NFR + SIZEHEADER
351
347
NIRADU_OOC = NIRADU_OOC + 2*NFR + SIZEHEADER_OOC
352
PANEL_SIZE = SMUMPS_OOC_GET_PANEL_SIZE(
353
* 2*KEEP(226), NFR, KEEP(227), KEEP(50))
348
PANEL_SIZE = SMUMPS_748(
349
& 2_8*int(KEEP(226),8), NFR, KEEP(227), KEEP(50))
354
350
NIRADU_OOC = NIRADU_OOC +
355
* EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1)
351
& EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1)
356
352
IF (KEEP(50).EQ.0) THEN
357
353
NRLADU_CURRENT = int(NELIM,8)*int(2*NFR-NELIM,8)
358
354
NRLADU = NRLADU + NRLADU_CURRENT
372
368
ELSE
373
369
NBCOLFAC=NELIM
374
370
ENDIF
375
PANEL_SIZE = SMUMPS_OOC_GET_PANEL_SIZE(
376
* 2*KEEP(226), NBCOLFAC, KEEP(227), KEEP(50))
371
PANEL_SIZE = SMUMPS_748(
372
& 2_8*int(KEEP(226),8), NBCOLFAC, KEEP(227), KEEP(50))
377
373
NIRADU_OOC = NIRADU_OOC +
378
* EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1)
374
& EXTRA_PERM_INFO_OOC*(2+NELIM + NELIM/PANEL_SIZE+1)
379
375
NRLADU_CURRENT = int(NBCOLFAC,8)*int(NELIM,8)
380
376
NRLADU = NRLADU + NRLADU_CURRENT
381
377
MAX_SIZE_FACTOR=max(MAX_SIZE_FACTOR,NRLADU_CURRENT)
397
393
SIZECBI = 4 + NBROWMAX + NCB
398
394
IF (KEEP(50).NE.0) THEN
399
395
SIZECBI=SIZECBI+NSLAVES_LOC+
400
* XTRA_SLAVES_SYM
396
& XTRA_SLAVES_SYM
401
397
ELSE
402
398
SIZECBI=SIZECBI+NSLAVES_LOC+
403
* XTRA_SLAVES_UNSYM
399
& XTRA_SLAVES_UNSYM
404
400
ENDIF
405
401
ENDIF
406
402
ENDIF
407
403
NIRNEC = max0(NIRNEC,
408
* NIRADU+ISTKI+SIZECBI+MAXITEMPCB)
404
& NIRADU+ISTKI+SIZECBI+MAXITEMPCB)
409
405
NIRNEC_OOC = max0(NIRNEC_OOC,
410
* NIRADU_OOC+ISTKI_OOC+SIZECBI+MAXITEMPCB +
411
* (XSIZE_OOC-XSIZE_IC) )
406
& NIRADU_OOC+ISTKI_OOC+SIZECBI+MAXITEMPCB +
407
& (XSIZE_OOC-XSIZE_IC) )
412
408
CURRENT_ACTIVE_MEM = ISTKR+SIZECBINFR
413
409
IF (NSTK .NE. 0 .AND. INSSARBR .AND.
414
410
& KEEP(234).NE.0 .AND. KEEP(55).EQ.0) THEN
419
415
& int(NELIM,8)*int(NCB,8)
420
416
ENDIF
421
417
IF (MASTER .AND. KEEP(219).NE.0.AND.
422
* KEEP(50).EQ.2.AND.LEVEL.EQ.2) THEN
418
& KEEP(50).EQ.2.AND.LEVEL.EQ.2) THEN
423
419
CURRENT_ACTIVE_MEM = CURRENT_ACTIVE_MEM + int(NELIM,8)
424
420
ENDIF
425
421
IF (SLAVEF.EQ.1) THEN
426
422
NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM)
427
423
NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+
428
* NRLADU_ROOT_3+CURRENT_ACTIVE_MEM)
424
& NRLADU_ROOT_3+CURRENT_ACTIVE_MEM)
429
425
ELSE
430
426
NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+MAXTEMPCB)
431
427
NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+
432
* NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+MAXTEMPCB)
428
& NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+MAXTEMPCB)
433
429
ENDIF
434
430
IF (NFR.GT.MAXFR) MAXFR = NFR
435
431
IF (NSTK.GT.0) THEN
447
443
ITOP = ITOP - 1
448
444
IF (ITOP.LT.0) THEN
449
445
write(*,*) MYID,
450
* ': ERROR 2 in SMUMPS_246. ITOP = ',ITOP
446
& ': ERROR 2 in SMUMPS_246. ITOP = ',ITOP
451
447
CALL MUMPS_ABORT()
452
448
ENDIF
453
449
70 CONTINUE
456
452
DO WHILE (IFSON.GT.0)
457
453
UPDATES=.FALSE.
458
454
MASTERSON = MUMPS_275(STEP(IFSON),PROCNODE,SLAVEF)
459
* .EQ.MYID
455
& .EQ.MYID
460
456
LEVELSON = MUMPS_330(STEP(IFSON),PROCNODE,SLAVEF)
461
457
if(.NOT.FORCE_CAND) then
462
458
UPDATES =((MASTERSON.AND.(LEVELSON.NE.3)).OR.
463
* LEVELSON.EQ.2)
459
& LEVELSON.EQ.2)
464
460
else
465
461
if(MASTERSON.and.(LEVELSON.ne.3)) then
466
462
UPDATES = .TRUE.
479
475
ITOP = ITOP - 1
480
476
IF (ITOP.LT.0) THEN
481
477
write(*,*) MYID,
482
* ': ERROR 2 in SMUMPS_246. ITOP = ',ITOP
478
& ': ERROR 2 in SMUMPS_246. ITOP = ',ITOP
483
479
CALL MUMPS_ABORT()
484
480
ENDIF
485
481
ENDIF
487
483
END DO
488
484
ENDIF
489
485
IF (
490
* ( (INODE.NE.KEEP(20)).OR.(KEEP(60).EQ.0) )
491
* .AND.
492
* ( (INODE.NE.KEEP(38)).OR.(KEEP(60).LE.1) )
493
* )
494
*THEN
486
& ( (INODE.NE.KEEP(20)).OR.(KEEP(60).EQ.0) )
487
& .AND.
488
& ( (INODE.NE.KEEP(38)).OR.(KEEP(60).LE.1) )
489
& )
490
&THEN
495
491
ENTRIES_NODE_LOWER_PART = int(NFR-NELIM,8) * int(NELIM,8)
496
492
IF ( KEEP(50).EQ.0 ) THEN
497
493
ENTRIES_NODE_UPPER_PART = int(NFR,8) * int(NELIM,8)
498
494
ELSE
499
495
ENTRIES_NODE_UPPER_PART =
500
* (int(NELIM,8)*int(NELIM+1,8))/2_8
501
ENDIF
502
CALL MUMPS_511(NFR, NELIM, NELIM,KEEP(50),
503
* 1,OPS_NODE)
496
& (int(NELIM,8)*int(NELIM+1,8))/2_8
497
ENDIF
498
IF (KEEP(50).EQ.2 .AND. LEVEL.EQ.3) THEN
499
CALL MUMPS_511(NFR, NELIM, NELIM,0,
500
& 1,OPS_NODE)
501
ELSE
502
CALL MUMPS_511(NFR, NELIM, NELIM,KEEP(50),
503
& 1,OPS_NODE)
504
ENDIF
504
505
IF (LEVEL.EQ.2) THEN
505
506
CALL MUMPS_511(NFR, NELIM, NELIM,KEEP(50),
506
* 2,OPS_NODE_MASTER)
507
& 2,OPS_NODE_MASTER)
507
508
OPS_NODE_SLAVE=OPS_NODE-OPS_NODE_MASTER
508
509
ENDIF
509
510
ELSE
512
513
ENTRIES_NODE_LOWER_PART = 0_8
513
514
ENDIF
514
515
ENTRIES_IN_FACTORS_TOT = ENTRIES_IN_FACTORS_TOT +
515
* ENTRIES_NODE_UPPER_PART +
516
* ENTRIES_NODE_LOWER_PART
516
& ENTRIES_NODE_UPPER_PART +
517
& ENTRIES_NODE_LOWER_PART
517
518
IF (UPDATE.OR.LEVEL.EQ.3) THEN
518
519
IF ( LEVEL .EQ. 3 ) THEN
519
520
OPSA_LOC = OPSA_LOC + OPS_NODE / dble( SLAVEF )
521
522
& ENTRIES_NODE_UPPER_PART /
522
523
& int(SLAVEF,8)
523
524
IF (MASTER)
524
* ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC +
525
* mod(ENTRIES_NODE_UPPER_PART,
526
* int(SLAVEF,8))
525
& ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC +
526
& mod(ENTRIES_NODE_UPPER_PART,
527
& int(SLAVEF,8))
527
528
ELSE IF (MASTER .AND. LEVEL.EQ.2) THEN
528
529
OPSA_LOC = OPSA_LOC + OPS_NODE_MASTER
529
530
ENTRIES_IN_FACTORS_LOC = ENTRIES_IN_FACTORS_LOC +
543
544
& int(NSLAVES_LOC,8)
544
545
ENDIF
545
546
IF (MUMPS_170(STEP(INODE),
546
* PROCNODE, SLAVEF) .OR. NE(STEP(INODE))==0) THEN
547
& PROCNODE, SLAVEF) .OR. NE(STEP(INODE))==0) THEN
547
548
IF (LEVEL == 1) THEN
548
549
OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE
549
550
ELSE
550
551
CALL MUMPS_511(NFR, NELIM, NELIM,KEEP(50),
551
* 1,OPS_NODE)
552
& 1,OPS_NODE)
552
553
OPS_SBTR_LOC = OPS_SBTR_LOC + OPS_NODE
553
554
ENDIF
554
555
ENDIF
592
593
WHAT = 4
593
594
IF (FORCE_CAND) THEN
594
595
NSLAVES_LOC=CANDIDATES(SLAVEF+1,
595
$ ISTEP_TO_INIV2(STEP(IFATH)))
596
& ISTEP_TO_INIV2(STEP(IFATH)))
596
597
ELSE
597
598
NSLAVES_LOC=SLAVEF-1
598
599
ENDIF
604
605
& NCBF, NFRF, NSLAVES_LOC, NBROWMAXF, IDUMMY8 )
605
606
ENDIF
606
607
IF(LEVEL.EQ.1.AND.UPDATE.AND.
607
* (UPDATEF.OR.LEVELF.EQ.2)
608
* .AND.LEVELF.NE.3) THEN
608
& (UPDATEF.OR.LEVELF.EQ.2)
609
& .AND.LEVELF.NE.3) THEN
609
610
IF ( INSSARBR .AND. KEEP(234).NE.0) THEN
610
611
NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+
611
* NRLADU_ROOT_3+CURRENT_ACTIVE_MEM)
612
& NRLADU_ROOT_3+CURRENT_ACTIVE_MEM)
612
613
NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM)
613
614
ELSE
614
615
NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,NRLADU_CURRENT+
615
* NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+SIZECB)
616
& NRLADU_ROOT_3+CURRENT_ACTIVE_MEM+SIZECB)
616
617
NRLNEC = max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+SIZECB)
617
618
ENDIF
618
619
ENDIF
619
620
IF (UPDATE .AND. LEVEL.EQ.2 .AND. .NOT. MASTER) THEN
620
621
NRLNEC =
621
* max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+NRLADU_CURRENT)
622
& max(NRLNEC,NRLADU+CURRENT_ACTIVE_MEM+NRLADU_CURRENT)
622
623
NRLNEC_ACTIVE = max(NRLNEC_ACTIVE,2_8*NRLADU_CURRENT+
623
* NRLADU_ROOT_3+CURRENT_ACTIVE_MEM)
624
& NRLADU_ROOT_3+CURRENT_ACTIVE_MEM)
624
625
ENDIF
625
626
IF (LEVELF.EQ.3) THEN
626
627
IF (LEVEL.EQ.1) THEN
702
703
ENDIF
703
704
CBMAXR = int(NBR,8)*int(min(NFRF,NCB),8)
704
705
IF (LEVEL.EQ.2)
705
* CBMAXR = min(CBMAXR, SIZECB_SLAVE)
706
& CBMAXR = min(CBMAXR, SIZECB_SLAVE)
706
707
IF ( KEEP(50).NE.0 ) THEN
707
708
CBMAXR = min(CBMAXR,(int(NFRF,8)*int(NFRF+1,8))/2_8)
708
709
ELSE
725
726
SIZECBI = 2 * NFR + SIZEHEADER
726
727
IF (LEVEL.EQ.1) THEN
727
728
IF (KEEP(50).NE.0.AND.LEVELF.NE.3
728
* .AND.COMPRESSCB) THEN
729
& .AND.COMPRESSCB) THEN
729
730
SIZECB = (NCB8*(NCB8+1_8))/2_8
730
731
ELSE
731
732
SIZECB = NCB8*NCB8
833
834
BLOCKING_RHS = - 2 * BLOCKING_RHS
834
835
ENDIF
835
836
NRLNEC_ACTIVE = max(NRLNEC_ACTIVE, MAX_SIZE_FACTOR+
836
* int(4*KEEP(127)*BLOCKING_RHS,8))
837
& int(4*KEEP(127)*BLOCKING_RHS,8))
837
838
SBUF_RECOLD = max(int(SBUFR,8),SBUFR_CB)
838
839
SBUF_RECOLD = max(SBUF_RECOLD,
839
840
& MAXTEMPCB+int(MAXITEMPCB,8)) + 10_8
853
854
SBUF_SEND= 1
854
855
ENDIF
855
856
DEALLOCATE( LSTKR, TNSTK, IPOOL,
856
* LSTKI )
857
& LSTKI )
857
858
OPS_SUBTREE = real(OPS_SBTR_LOC)
858
859
OPSA = real(OPSA_LOC)
859
860
KEEP(66) = int(OPSA_LOC/1000000.d0)
860
861
RETURN
861
862
END SUBROUTINE SMUMPS_246
862
863
RECURSIVE SUBROUTINE
863
* SMUMPS_271( COMM_LOAD, ASS_IRECV,
864
* INODE, NELIM_ROOT, root,
865
*
866
* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
867
* IWPOS, IWPOSCB, IPTRLU,
868
* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
869
* PTLUST_S, PTRFAC,
870
* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
871
* IFLAG, IERROR, COMM,
872
* NBPROCFILS,
873
* IPOOL, LPOOL, LEAF,
874
* NBFIN, MYID, SLAVEF,
875
*
876
* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
877
* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
878
* LPTRAR, NELT, FRTPTR, FRTELT,
879
* ISTEP_TO_INIV2, TAB_POS_IN_PERE )
864
& SMUMPS_271( COMM_LOAD, ASS_IRECV,
865
& INODE, NELIM_ROOT, root,
866
&
867
& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
868
& IWPOS, IWPOSCB, IPTRLU,
869
& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
870
& PTLUST_S, PTRFAC,
871
& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
872
& IFLAG, IERROR, COMM,
873
& NBPROCFILS,
874
& IPOOL, LPOOL, LEAF,
875
& NBFIN, MYID, SLAVEF,
876
&
877
& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
878
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
879
& LPTRAR, NELT, FRTPTR, FRTELT,
880
& ISTEP_TO_INIV2, TAB_POS_IN_PERE )
880
881
IMPLICIT NONE
881
882
INCLUDE 'smumps_root.h'
882
883
INCLUDE 'mpif.h'
887
888
INTEGER INODE, NELIM_ROOT
888
889
INTEGER LBUFR, LBUFR_BYTES
889
890
INTEGER BUFR( LBUFR )
890
INTEGER POSFAC,IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS
891
INTEGER N, LIW, LA
891
INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS
892
INTEGER IWPOS, IWPOSCB
893
INTEGER N, LIW
892
894
INTEGER IW( LIW )
893
895
REAL A( LA )
894
INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), PTRFAC(KEEP(28)),
895
*PTRAST(KEEP(28))
896
INTEGER STEP(N),
897
* PIMASTER(KEEP(28)),
898
* PAMASTER(KEEP(28))
896
INTEGER(8) :: PTRAST(KEEP(28))
897
INTEGER(8) :: PTRFAC(KEEP(28))
898
INTEGER(8) :: PAMASTER(KEEP(28))
899
INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
900
INTEGER STEP(N), PIMASTER(KEEP(28))
899
901
INTEGER COMP
900
902
INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) )
901
903
INTEGER NBPROCFILS(KEEP(28))
912
914
INTEGER INTARR(max(1,KEEP(14)))
913
915
REAL DBLARR(max(1,KEEP(13)))
914
916
INTEGER ISTEP_TO_INIV2(KEEP(71)),
915
* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
917
& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
916
918
INCLUDE 'mumps_tags.h'
917
INTEGER I, J, OPSFAC, APOS, LCONT, NCOL_TO_SEND, LDA
919
INTEGER I, J, LCONT, NCOL_TO_SEND, LDA
920
INTEGER(8) :: OPSFAC, APOS, SHIFT_VAL_SON, POSELT
918
921
INTEGER FPERE, IOLDPS, NFRONT, NPIV, NASS, NSLAVES,
919
* H_INODE, NELIM, NBCOL, LIST_NELIM_ROW,
920
* LIST_NELIM_COL, NELIM_LOCAL, TYPE_SON,
921
* POSELT, NROW, NCOL, NBROW, SHIFT_LIST_ROW_SON,
922
* SHIFT_LIST_COL_SON, SHIFT_VAL_SON,LDAFS, IERR,
923
* STATUS( MPI_STATUS_SIZE ), ISON, PDEST_MASTER_ISON
922
& H_INODE, NELIM, NBCOL, LIST_NELIM_ROW,
923
& LIST_NELIM_COL, NELIM_LOCAL, TYPE_SON,
924
& NROW, NCOL, NBROW, SHIFT_LIST_ROW_SON,
925
& SHIFT_LIST_COL_SON, LDAFS, IERR,
926
& STATUS( MPI_STATUS_SIZE ), ISON, PDEST_MASTER_ISON
924
927
LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
925
928
INTEGER MSGSOU, MSGTAG
926
929
LOGICAL INVERT, FLAG
930
933
FPERE = KEEP(38)
931
934
TYPE_SON = MUMPS_330(STEP(INODE),PROCNODE_STEPS,SLAVEF)
932
935
IF ( MUMPS_275( STEP(INODE), PROCNODE_STEPS,
933
* SLAVEF ).EQ.MYID) THEN
936
& SLAVEF ).EQ.MYID) THEN
934
937
IOLDPS = PTLUST_S(STEP(INODE))
935
938
NFRONT = IW(IOLDPS+KEEP(IXSZ))
936
939
NPIV = IW(IOLDPS+1+KEEP(IXSZ))
944
947
IF (NELIM.LE.0) THEN
945
948
write(6,*) ' ERROR 1 in SMUMPS_271 ', NELIM
946
949
write(6,*) MYID,':Process root2son: INODE=',INODE,
947
* 'Header=',IW(PTLUST_S(STEP(INODE)):PTLUST_S(STEP(INODE))
948
* +5+KEEP(IXSZ))
950
& 'Header=',IW(PTLUST_S(STEP(INODE)):PTLUST_S(STEP(INODE))
951
& +5+KEEP(IXSZ))
949
952
CALL MUMPS_ABORT()
950
953
ENDIF
951
954
NELIM_LOCAL = NELIM_ROOT
970
973
ELSE
971
974
LDAFS = NASS
972
975
END IF
973
SHIFT_VAL_SON = NPIV * LDAFS + NPIV
976
SHIFT_VAL_SON = int(NPIV,8) * int(LDAFS,8) + int(NPIV,8)
974
977
CALL SMUMPS_80( COMM_LOAD,
975
* ASS_IRECV,
976
* N, INODE, FPERE,
977
* PTLUST_S(1), PTRAST(1),
978
* root, NROW, NCOL, SHIFT_LIST_ROW_SON,
979
* SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDAFS,
980
* ROOT_NON_ELIM_CB, MYID, COMM,
981
* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
982
* IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
983
* PTRIST, PTLUST_S(1), PTRFAC(1), PTRAST(1),
984
* STEP, PIMASTER, PAMASTER,
985
* NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
986
* IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
987
* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
988
* INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE,
989
* LPTRAR, NELT, FRTPTR, FRTELT,
990
* ISTEP_TO_INIV2, TAB_POS_IN_PERE )
978
& ASS_IRECV,
979
& N, INODE, FPERE,
980
& PTLUST_S(1), PTRAST(1),
981
& root, NROW, NCOL, SHIFT_LIST_ROW_SON,
982
& SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDAFS,
983
& ROOT_NON_ELIM_CB, MYID, COMM,
984
& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
985
& IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
986
& PTRIST, PTLUST_S(1), PTRFAC(1), PTRAST(1),
987
& STEP, PIMASTER, PAMASTER,
988
& NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
989
& IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
990
& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
991
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, .FALSE., ND, FRERE,
992
& LPTRAR, NELT, FRTPTR, FRTELT,
993
& ISTEP_TO_INIV2, TAB_POS_IN_PERE )
991
994
IF (IFLAG.LT.0 ) RETURN
992
995
IF (TYPE_SON.EQ.1) THEN
993
996
NROW = NFRONT - NASS
994
997
NCOL = NELIM
995
998
SHIFT_LIST_ROW_SON = H_INODE + NASS
996
999
SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV
997
SHIFT_VAL_SON = NASS * NFRONT + NPIV
1000
SHIFT_VAL_SON = int(NASS,8) * int(NFRONT,8) + int(NPIV,8)
998
1001
IF ( KEEP( 50 ) .eq. 0 ) THEN
999
1002
INVERT = .FALSE.
1000
1003
ELSE
1001
1004
INVERT = .TRUE.
1002
1005
END IF
1003
1006
CALL SMUMPS_80( COMM_LOAD, ASS_IRECV,
1004
* N, INODE, FPERE,
1005
* PTLUST_S, PTRAST,
1006
* root, NROW, NCOL, SHIFT_LIST_ROW_SON,
1007
* SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT,
1008
* ROOT_NON_ELIM_CB, MYID, COMM,
1009
*
1010
* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
1011
* IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
1012
* PTRIST, PTLUST_S, PTRFAC,
1013
* PTRAST, STEP, PIMASTER, PAMASTER,
1014
* NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
1015
* IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
1016
* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
1017
* INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE,
1018
* LPTRAR, NELT, FRTPTR, FRTELT,
1019
* ISTEP_TO_INIV2, TAB_POS_IN_PERE )
1007
& N, INODE, FPERE,
1008
& PTLUST_S, PTRAST,
1009
& root, NROW, NCOL, SHIFT_LIST_ROW_SON,
1010
& SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT,
1011
& ROOT_NON_ELIM_CB, MYID, COMM,
1012
&
1013
& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
1014
& IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
1015
& PTRIST, PTLUST_S, PTRFAC,
1016
& PTRAST, STEP, PIMASTER, PAMASTER,
1017
& NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
1018
& IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
1019
& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
1020
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE,
1021
& LPTRAR, NELT, FRTPTR, FRTELT,
1022
& ISTEP_TO_INIV2, TAB_POS_IN_PERE )
1020
1023
IF (IFLAG.LT.0 ) RETURN
1021
1024
ENDIF
1022
1025
IOLDPS = PTLUST_S(STEP(INODE))
1034
1037
LDA = NPIV+NBROW
1035
1038
ENDIF
1036
1039
CALL SMUMPS_324(A(POSELT), LDA,
1037
* NPIV, NBROW, KEEP(50))
1040
& NPIV, NBROW, KEEP(50))
1038
1041
IW(IOLDPS + KEEP(IXSZ)) = NBCOL
1039
1042
IW(IOLDPS + 1 +KEEP(IXSZ)) = NASS - NPIV
1040
1043
IF (TYPE_SON.EQ.2) THEN
1043
1046
IW(IOLDPS + 2 +KEEP(IXSZ)) = NFRONT
1044
1047
ENDIF
1045
1048
IW(IOLDPS + 3 +KEEP(IXSZ)) = NPIV
1046
CALL SMUMPS_93(0,MYID,N,IOLDPS,TYPE_SON,IW,LIW,
1047
* A, LA, POSFAC, LRLU, LRLUS,
1048
* IWPOS, PTRAST,PTRFAC,STEP, KEEP,KEEP8, .FALSE.,INODE,IERR)
1049
CALL SMUMPS_93(0_8,MYID,N,IOLDPS,TYPE_SON,IW,LIW,
1050
& A, LA, POSFAC, LRLU, LRLUS,
1051
& IWPOS, PTRAST,PTRFAC,STEP, KEEP,KEEP8, .FALSE.,INODE,IERR)
1049
1052
IF(IERR.LT.0)THEN
1050
1053
IFLAG=IERR
1051
1054
IERROR=0
1054
1057
ELSE
1055
1058
ISON = INODE
1056
1059
PDEST_MASTER_ISON = MUMPS_275(STEP(ISON),
1057
* PROCNODE_STEPS,SLAVEF)
1060
& PROCNODE_STEPS,SLAVEF)
1061
DO WHILE ( PTRIST(STEP(ISON)) .EQ. 0)
1062
BLOCKING = .TRUE.
1063
SET_IRECV = .FALSE.
1064
MESSAGE_RECEIVED = .FALSE.
1065
CALL SMUMPS_329( COMM_LOAD, ASS_IRECV,
1066
& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
1067
& PDEST_MASTER_ISON, MAITRE_DESC_BANDE,
1068
& STATUS,
1069
& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
1070
& IWPOS, IWPOSCB, IPTRLU,
1071
& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
1072
& PTLUST_S, PTRFAC,
1073
& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
1074
& IFLAG, IERROR, COMM,
1075
& NBPROCFILS,
1076
& IPOOL, LPOOL, LEAF,
1077
& NBFIN, MYID, SLAVEF,
1078
&
1079
& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
1080
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR,
1081
& NELT, FRTPTR, FRTELT,
1082
& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )
1083
IF ( IFLAG .LT. 0 ) RETURN
1084
ENDDO
1058
1085
DO WHILE (
1059
* ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE.
1060
* IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) .OR.
1061
* ( KEEP(50) .NE. 0 .AND.
1062
* IW( PTRIST(STEP(ISON)) + 6 +KEEP(IXSZ)) .NE. 0 ) )
1086
& ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE.
1087
& IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) .OR.
1088
& ( KEEP(50) .NE. 0 .AND.
1089
& IW( PTRIST(STEP(ISON)) + 6 +KEEP(IXSZ)) .NE. 0 ) )
1063
1090
IF ( KEEP(50).eq.0) THEN
1064
1091
MSGSOU = PDEST_MASTER_ISON
1065
1092
MSGTAG = BLOC_FACTO
1066
1093
ELSE
1067
1094
IF ( IW( PTRIST(STEP(ISON)) + 1 +KEEP(IXSZ)) .NE.
1068
* IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) THEN
1095
& IW( PTRIST(STEP(ISON)) + 3 +KEEP(IXSZ)) ) THEN
1069
1096
MSGSOU = PDEST_MASTER_ISON
1070
1097
MSGTAG = BLOC_FACTO_SYM
1071
1098
ELSE
1077
1104
SET_IRECV = .FALSE.
1078
1105
MESSAGE_RECEIVED = .FALSE.
1079
1106
CALL SMUMPS_329( COMM_LOAD, ASS_IRECV,
1080
* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
1081
* MSGSOU, MSGTAG,
1082
* STATUS,
1083
* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
1084
* IWPOS, IWPOSCB, IPTRLU,
1085
* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
1086
* PTLUST_S, PTRFAC,
1087
* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
1088
* IFLAG, IERROR, COMM,
1089
* NBPROCFILS,
1090
* IPOOL, LPOOL, LEAF,
1091
* NBFIN, MYID, SLAVEF,
1092
*
1093
* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
1094
* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR,
1095
* NELT, FRTPTR, FRTELT,
1096
* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )
1107
& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
1108
& MSGSOU, MSGTAG,
1109
& STATUS,
1110
& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
1111
& IWPOS, IWPOSCB, IPTRLU,
1112
& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
1113
& PTLUST_S, PTRFAC,
1114
& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
1115
& IFLAG, IERROR, COMM,
1116
& NBPROCFILS,
1117
& IPOOL, LPOOL, LEAF,
1118
& NBFIN, MYID, SLAVEF,
1119
&
1120
& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
1121
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR,
1122
& NELT, FRTPTR, FRTELT,
1123
& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )
1097
1124
IF ( IFLAG .LT. 0 ) RETURN
1098
1125
END DO
1099
1126
IOLDPS = PTRIST(STEP(INODE))
1104
1131
NELIM = NASS-NPIV
1105
1132
IF (NELIM.LE.0) THEN
1106
1133
write(6,*) MYID,': INODE,LCONT, NROW, NPIV, NASS, NELIM=',
1107
* INODE,LCONT, NROW, NPIV, NASS, NELIM
1134
& INODE,LCONT, NROW, NPIV, NASS, NELIM
1108
1135
write(6,*) MYID,': IOLDPS=',IOLDPS
1109
1136
write(6,*) MYID,': ERROR 2 in SMUMPS_271 '
1110
1137
CALL MUMPS_ABORT()
1122
1149
SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NPIV
1123
1150
NCOL_TO_SEND = NELIM
1124
1151
IF (IW(IOLDPS+XXS).EQ.S_NOLCBNOCONTIG38.OR.
1125
* IW(IOLDPS+XXS).EQ.S_ALL) THEN
1126
SHIFT_VAL_SON = NPIV
1152
& IW(IOLDPS+XXS).EQ.S_ALL) THEN
1153
SHIFT_VAL_SON = int(NPIV,8)
1127
1154
LDA = LCONT + NPIV
1128
1155
ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCBCONTIG38) THEN
1129
SHIFT_VAL_SON=NROW*(LCONT+NPIV-NELIM)
1130
LDA =NELIM
1156
SHIFT_VAL_SON = int(NROW,8)*int(LCONT+NPIV-NELIM,8)
1157
LDA = NELIM
1131
1158
ELSE IF (IW(IOLDPS+XXS).EQ.S_NOLCLEANED38) THEN
1132
SHIFT_VAL_SON=0
1159
SHIFT_VAL_SON=0_8
1133
1160
LDA = NELIM
1134
1161
ELSE
1135
1162
write(*,*) MYID,": internal error in SMUMPS_271",
1136
* IW(IOLDPS+XXS), "INODE=",INODE
1163
& IW(IOLDPS+XXS), "INODE=",INODE
1137
1164
CALL MUMPS_ABORT()
1138
1165
ENDIF
1139
1166
IF ( KEEP( 50 ) .eq. 0 ) THEN
1142
1169
INVERT = .TRUE.
1143
1170
END IF
1144
1171
CALL SMUMPS_80( COMM_LOAD, ASS_IRECV,
1145
* N, INODE, FPERE,
1146
* PTRIST, PTRAST,
1147
* root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,
1148
* SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA,
1149
* ROOT_NON_ELIM_CB, MYID, COMM,
1150
*
1151
* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
1152
* IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
1153
* PTRIST, PTLUST_S, PTRFAC,
1154
* PTRAST, STEP, PIMASTER, PAMASTER,
1155
* NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
1156
* IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
1157
* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
1158
* INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE,
1159
* LPTRAR, NELT, FRTPTR, FRTELT,
1160
* ISTEP_TO_INIV2, TAB_POS_IN_PERE )
1172
& N, INODE, FPERE,
1173
& PTRIST, PTRAST,
1174
& root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,
1175
& SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA,
1176
& ROOT_NON_ELIM_CB, MYID, COMM,
1177
&
1178
& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
1179
& IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
1180
& PTRIST, PTLUST_S, PTRFAC,
1181
& PTRAST, STEP, PIMASTER, PAMASTER,
1182
& NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
1183
& IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
1184
& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
1185
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, INVERT, ND, FRERE,
1186
& LPTRAR, NELT, FRTPTR, FRTELT,
1187
& ISTEP_TO_INIV2, TAB_POS_IN_PERE )
1161
1188
IF (IFLAG.LT.0 ) RETURN
1162
1189
IF (KEEP(214).EQ.2) THEN
1163
1190
CALL SMUMPS_314( N, INODE,
1164
* PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
1165
* LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
1166
* IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, ITLOC,
1167
* IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON
1168
$ )
1191
& PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
1192
& LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
1193
& IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, ITLOC,
1194
& IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, TYPE_SON
1195
& )
1169
1196
ENDIF
1170
1197
IF (IFLAG.LT.0) THEN
1171
1198
CALL SMUMPS_44( MYID, SLAVEF, COMM )
1174
1201
RETURN
1175
1202
END SUBROUTINE SMUMPS_271
1176
1203
SUBROUTINE SMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA,
1177
* INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8,
1178
* DKEEP,PIVNUL_LIST,LPN_LIST,
1179
*
1180
* PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
1181
* PP_LastPIVRPTRFilled_L,
1182
* PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1183
* PP_LastPIVRPTRFilled_U)
1204
& INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU, SEUIL,KEEP,KEEP8,
1205
& DKEEP,PIVNUL_LIST,LPN_LIST,
1206
&
1207
& PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
1208
& PP_LastPIVRPTRFilled_L,
1209
& PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1210
& PP_LastPIVRPTRFilled_U)
1184
1211
IMPLICIT NONE
1185
INTEGER NFRONT,NASS,N,LA,LIW,INODE,IFLAG,INOPV,NOFFW
1212
INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW
1213
INTEGER(8) :: LA
1186
1214
REAL A(LA)
1187
1215
REAL UU, SEUIL
1188
INTEGER IW(LIW)
1189
INTEGER IOLDPS, POSELT
1216
INTEGER IW(LIW)
1217
INTEGER(8) :: POSELT
1218
INTEGER IOLDPS
1190
1219
INTEGER KEEP(500)
1191
1220
INTEGER*8 KEEP8(150)
1192
1221
INTEGER LPN_LIST
1193
1222
INTEGER PIVNUL_LIST(LPN_LIST)
1194
1223
REAL DKEEP(30)
1195
1224
INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
1196
* PP_LastPIVRPTRFilled_L,
1197
* PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1198
* PP_LastPIVRPTRFilled_U
1225
& PP_LastPIVRPTRFilled_L,
1226
& PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1227
& PP_LastPIVRPTRFilled_U
1199
1228
INCLUDE 'mumps_headers.h'
1200
1229
REAL SWOP
1201
INTEGER APOS, XSIZE
1230
INTEGER XSIZE
1231
INTEGER(8) :: APOS, IDIAG
1232
INTEGER(8) :: J1, J2, J3, JJ
1233
INTEGER(8) :: NFRONT8
1202
1234
REAL AMROW
1203
1235
REAL ZERO,RMAX,ONE
1204
1236
INTEGER NPIV,NASSW,IPIV
1205
INTEGER NPIVP1,JMAX,J1,J3,JJ,J2,IDIAG,ISW,ISWPS1
1237
INTEGER NPIVP1,JMAX,J,ISW,ISWPS1
1206
1238
INTEGER ISWPS2,KSW
1207
1239
INTEGER SMUMPS_IXAMAX
1208
1240
INTRINSIC max
1214
1246
XSIZE = KEEP(IXSZ)
1215
1247
NPIV = IW(IOLDPS+1+XSIZE)
1216
1248
NPIVP1 = NPIV + 1
1249
NFRONT8 = int(NFRONT,8)
1217
1250
IF (KEEP(201).EQ.1) THEN
1218
1251
CALL SMUMPS_667(TYPEF_L, NBPANELS_L,
1219
* I_PIVRPTR_L, I_PIVR_L,
1220
* IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
1221
* IW, LIW)
1252
& I_PIVRPTR_L, I_PIVR_L,
1253
& IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
1254
& IW, LIW)
1222
1255
CALL SMUMPS_667(TYPEF_U, NBPANELS_U,
1223
* I_PIVRPTR_U, I_PIVR_U,
1224
* IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
1225
* IW, LIW)
1256
& I_PIVRPTR_U, I_PIVR_U,
1257
& IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
1258
& IW, LIW)
1226
1259
ENDIF
1227
1260
NASSW = iabs(IW(IOLDPS+3+XSIZE))
1228
1261
IF(INOPV .EQ. -1) THEN
1229
APOS = POSELT + NFRONT*(NPIVP1-1) + NPIV
1262
APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8)
1230
1263
IDIAG = APOS
1231
1264
IF(abs(A(APOS)).LT.SEUIL) THEN
1232
1265
IF(real(A(APOS)) .GE. ZERO) THEN
1233
A(APOS) = SEUIL
1266
A(APOS) = real(SEUIL)
1234
1267
ELSE
1235
A(APOS) = -SEUIL
1268
A(APOS) = real(-SEUIL)
1236
1269
ENDIF
1237
1270
KEEP(98) = KEEP(98)+1
1238
1271
ENDIF
1239
1272
IF (KEEP(201).EQ.1) THEN
1240
1273
CALL SMUMPS_680( IW(I_PIVRPTR_L),
1241
* NBPANELS_L,
1242
* IW(I_PIVR_L), NASS, NPIVP1, NPIVP1,
1243
* PP_LastPanelonDisk_L,
1244
* PP_LastPIVRPTRFilled_L)
1274
& NBPANELS_L,
1275
& IW(I_PIVR_L), NASS, NPIVP1, NPIVP1,
1276
& PP_LastPanelonDisk_L,
1277
& PP_LastPIVRPTRFilled_L)
1245
1278
CALL SMUMPS_680( IW(I_PIVRPTR_U),
1246
* NBPANELS_U,
1247
* IW(I_PIVR_U), NASS, NPIVP1, NPIVP1,
1248
* PP_LastPanelonDisk_U,
1249
* PP_LastPIVRPTRFilled_U)
1279
& NBPANELS_U,
1280
& IW(I_PIVR_U), NASS, NPIVP1, NPIVP1,
1281
& PP_LastPanelonDisk_U,
1282
& PP_LastPIVRPTRFilled_U)
1250
1283
ENDIF
1251
1284
GO TO 420
1252
1285
ENDIF
1253
1286
INOPV = 0
1254
1287
DO 460 IPIV=NPIVP1,NASSW
1255
APOS = POSELT + NFRONT*(IPIV-1) + NPIV
1288
APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8)
1256
1289
JMAX = 1
1257
1290
IF (UU.GT.ZERO) GO TO 340
1258
1291
IF (abs(A(APOS)).EQ.ZERO) GO TO 630
1259
1292
GO TO 380
1260
1293
340 AMROW = ZERO
1261
1294
J1 = APOS
1262
J2 = APOS - NPIV + NASS - 1
1263
J3 = NASS -NPIV
1264
JMAX = SMUMPS_IXAMAX(J3,A(J1),1)
1265
JJ = JMAX + J1 - 1
1295
J2 = APOS + int(- NPIV + NASS - 1,8)
1296
J = NASS -NPIV
1297
JMAX = SMUMPS_IXAMAX(J,A(J1),1)
1298
JJ = J1 + int(JMAX - 1,8)
1266
1299
AMROW = abs(A(JJ))
1267
1300
RMAX = AMROW
1268
J1 = J2 + 1
1269
J2 = APOS - NPIV + NFRONT - 1
1301
J1 = J2 + 1_8
1302
J2 = APOS +int(- NPIV + NFRONT - 1,8)
1270
1303
IF (J2.LT.J1) GO TO 370
1271
1304
DO 360 JJ=J1,J2
1272
1305
RMAX = max(abs(A(JJ)),RMAX)
1273
1306
360 CONTINUE
1274
370 IDIAG = APOS + IPIV - NPIVP1
1307
370 IDIAG = APOS + int(IPIV - NPIVP1,8)
1275
1308
IF (RMAX.LE.DKEEP(1)) THEN
1276
1309
KEEP(109) = KEEP(109)+1
1277
1310
ISW = IOLDPS+IW(IOLDPS+1+XSIZE)+6+XSIZE+
1279
1312
PIVNUL_LIST(KEEP(109)) = IW(ISW)
1280
1313
IF(DKEEP(2).GT.ZERO) THEN
1281
1314
IF(real(A(IDIAG)) .GE. ZERO) THEN
1282
A(IDIAG) = DKEEP(2)
1315
A(IDIAG) = real(DKEEP(2))
1283
1316
ELSE
1284
A(IDIAG) = -DKEEP(2)
1317
A(IDIAG) = real(-DKEEP(2))
1285
1318
ENDIF
1286
1319
ELSE
1287
1320
J1 = APOS
1288
J2 = APOS - NPIV + NFRONT - 1
1321
J2 = APOS +int(- NPIV + NFRONT - 1,8)
1289
1322
DO JJ=J1,J2
1290
1323
A(JJ)= real(ZERO)
1291
1324
ENDDO
1301
1334
IF (AMROW.LE. max(UU*RMAX,SEUIL)) GO TO 460
1302
1335
NOFFW = NOFFW + 1
1303
1336
380 IF (IPIV.EQ.NPIVP1) GO TO 400
1304
J1 = POSELT + NPIV*NFRONT
1305
J2 = J1 + NFRONT - 1
1306
J3 = POSELT + (IPIV-1)*NFRONT
1337
J1 = POSELT + int(NPIV,8)*NFRONT8
1338
J2 = J1 + NFRONT8 - 1_8
1339
J3 = POSELT + int(IPIV-1,8)*NFRONT8
1307
1340
DO 390 JJ=J1,J2
1308
1341
SWOP = A(JJ)
1309
1342
A(JJ) = A(J3)
1310
1343
A(J3) = SWOP
1311
J3 = J3 + 1
1344
J3 = J3 + 1_8
1312
1345
390 CONTINUE
1313
1346
ISWPS1 = IOLDPS + 5 + NPIVP1 + XSIZE
1314
1347
ISWPS2 = IOLDPS + 5 + IPIV + XSIZE
1316
1349
IW(ISWPS1) = IW(ISWPS2)
1317
1350
IW(ISWPS2) = ISW
1318
1351
400 IF (JMAX.EQ.1) GO TO 420
1319
J1 = POSELT + NPIV
1320
J2 = POSELT + NPIV + JMAX - 1
1352
J1 = POSELT + int(NPIV,8)
1353
J2 = POSELT + int(NPIV + JMAX - 1,8)
1321
1354
DO 410 KSW=1,NFRONT
1322
1355
SWOP = A(J1)
1323
1356
A(J1) = A(J2)
1324
1357
A(J2) = SWOP
1325
J1 = J1 + NFRONT
1326
J2 = J2 + NFRONT
1358
J1 = J1 + NFRONT8
1359
J2 = J2 + NFRONT8
1327
1360
410 CONTINUE
1328
1361
ISWPS1 = IOLDPS + 5 + NFRONT + NPIV + 1 +XSIZE
1329
1362
ISWPS2 = IOLDPS + 5 + NFRONT + NPIV + JMAX +XSIZE
1345
1378
420 CONTINUE
1346
1379
IF (KEEP(201).EQ.1) THEN
1347
1380
CALL SMUMPS_680( IW(I_PIVRPTR_L),
1348
* NBPANELS_L,
1349
* IW(I_PIVR_L), NASS, NPIVP1, IPIV,
1350
* PP_LastPanelonDisk_L,
1351
* PP_LastPIVRPTRFilled_L)
1381
& NBPANELS_L,
1382
& IW(I_PIVR_L), NASS, NPIVP1, IPIV,
1383
& PP_LastPanelonDisk_L,
1384
& PP_LastPIVRPTRFilled_L)
1352
1385
CALL SMUMPS_680( IW(I_PIVRPTR_U),
1353
* NBPANELS_U,
1354
* IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX,
1355
* PP_LastPanelonDisk_U,
1356
* PP_LastPIVRPTRFilled_U)
1386
& NBPANELS_U,
1387
& IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX,
1388
& PP_LastPanelonDisk_U,
1389
& PP_LastPIVRPTRFilled_U)
1357
1390
ENDIF
1358
1391
430 CONTINUE
1359
1392
RETURN
1360
1393
END SUBROUTINE SMUMPS_221
1361
1394
SUBROUTINE SMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA,
1362
* INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,KEEP,
1363
* PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
1364
* PP_LastPIVRPTRFilled_L,
1365
* PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1366
* PP_LastPIVRPTRFilled_U)
1395
& INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,KEEP,
1396
& PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
1397
& PP_LastPIVRPTRFilled_L,
1398
& PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1399
& PP_LastPIVRPTRFilled_U)
1367
1400
IMPLICIT NONE
1368
INTEGER NFRONT,NASS,N,LIW,LA,INODE,INOPV
1401
INTEGER NFRONT,NASS,N,LIW,INODE,INOPV
1402
INTEGER(8) :: LA
1369
1403
INTEGER KEEP(500)
1370
1404
REAL UU, SEUIL
1371
1405
REAL A(LA)
1373
1407
REAL AMROW
1374
1408
REAL ZERO,RMAX
1375
1409
REAL SWOP
1376
INTEGER APOS, POSELT, IOLDPS
1410
INTEGER(8) :: APOS, POSELT
1411
INTEGER(8) :: J1, J2, J3_8, JJ, IDIAG
1412
INTEGER(8) :: NFRONT8
1413
INTEGER IOLDPS
1377
1414
INTEGER NOFFW,NPIV,IPIV
1378
INTEGER NPIVP1,JMAX,J1,J3,JJ,J2,IDIAG,ISW,ISWPS1
1415
INTEGER J, J3
1416
INTEGER NPIVP1,JMAX,ISW,ISWPS1
1379
1417
INTEGER ISWPS2,KSW,XSIZE
1380
1418
INTEGER TYPEF_L, I_PIVRPTR_L, I_PIVR_L, NBPANELS_L
1381
1419
INTEGER TYPEF_U, I_PIVRPTR_U, I_PIVR_U, NBPANELS_U
1382
1420
PARAMETER (TYPEF_L=1, TYPEF_U=2)
1383
1421
INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
1384
* PP_LastPIVRPTRFilled_L,
1385
* PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1386
* PP_LastPIVRPTRFilled_U
1422
& PP_LastPIVRPTRFilled_L,
1423
& PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
1424
& PP_LastPIVRPTRFilled_U
1387
1425
INTEGER SMUMPS_IXAMAX
1388
1426
INCLUDE 'mumps_headers.h'
1389
1427
INTRINSIC max
1390
1428
DATA ZERO /0.0E0/
1429
NFRONT8 = int(NFRONT,8)
1391
1430
INOPV = 0
1392
1431
XSIZE = KEEP(IXSZ)
1393
1432
NPIV = IW(IOLDPS+1+XSIZE)
1394
1433
NPIVP1 = NPIV + 1
1395
1434
IF (KEEP(201).EQ.1 .AND. KEEP(50).NE.1) THEN
1396
1435
CALL SMUMPS_667(TYPEF_L, NBPANELS_L,
1397
* I_PIVRPTR_L, I_PIVR_L,
1398
* IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)
1399
* +KEEP(IXSZ),
1400
* IW, LIW)
1436
& I_PIVRPTR_L, I_PIVR_L,
1437
& IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)
1438
& +KEEP(IXSZ),
1439
& IW, LIW)
1401
1440
CALL SMUMPS_667(TYPEF_U, NBPANELS_U,
1402
* I_PIVRPTR_U, I_PIVR_U,
1403
* IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
1404
* IW, LIW)
1441
& I_PIVRPTR_U, I_PIVR_U,
1442
& IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
1443
& IW, LIW)
1405
1444
ENDIF
1406
1445
DO 460 IPIV=NPIVP1,NASS
1407
APOS = POSELT + NFRONT*NPIV + (IPIV-1)
1446
APOS = POSELT + NFRONT8*int(NPIV,8) + int(IPIV-1,8)
1408
1447
JMAX = 1
1409
1448
AMROW = ZERO
1410
1449
J1 = APOS
1411
1450
J3 = NASS -NPIV
1412
1451
JMAX = SMUMPS_IXAMAX(J3,A(J1),NFRONT)
1413
JJ = J1 + (JMAX-1)*NFRONT
1452
JJ = J1 + int(JMAX-1,8)*NFRONT8
1414
1453
AMROW = abs(A(JJ))
1415
1454
RMAX = AMROW
1416
J1 = APOS + (NASS-NPIV) * NFRONT
1455
J1 = APOS + int(NASS-NPIV,8) * NFRONT8
1417
1456
J3 = NFRONT - NASS
1418
1457
IF (J3.EQ.0) GOTO 370
1419
DO 360 JJ=1,J3
1458
DO 360 J=1,J3
1420
1459
RMAX = max(abs(A(J1)),RMAX)
1421
J1 = J1 + NFRONT
1460
J1 = J1 + NFRONT8
1422
1461
360 CONTINUE
1423
1462
370 IF (RMAX.EQ.ZERO) GO TO 460
1424
IDIAG = APOS + (IPIV - NPIVP1)*NFRONT
1463
IDIAG = APOS + int(IPIV - NPIVP1,8)*NFRONT8
1425
1464
IF (abs(A(IDIAG)).GE.max(UU*RMAX,SEUIL)) THEN
1426
1465
JMAX = IPIV - NPIV
1427
1466
GO TO 380
1429
1468
IF (AMROW.LT.max(UU*RMAX,SEUIL)) GO TO 460
1430
1469
NOFFW = NOFFW + 1
1431
1470
380 IF (IPIV.EQ.NPIVP1) GO TO 400
1432
J1 = POSELT + NPIV
1433
J3 = POSELT + (IPIV-1)
1434
DO 390 JJ= 1,NFRONT
1435
SWOP = A(J1)
1436
A(J1) = A(J3)
1437
A(J3) = SWOP
1438
J1 = J1 + NFRONT
1439
J3 = J3 + NFRONT
1471
J1 = POSELT + int(NPIV,8)
1472
J3_8 = POSELT + int(IPIV-1,8)
1473
DO 390 J= 1,NFRONT
1474
SWOP = A(J1)
1475
A(J1) = A(J3_8)
1476
A(J3_8) = SWOP
1477
J1 = J1 + NFRONT8
1478
J3_8 = J3_8 + NFRONT8
1440
1479
390 CONTINUE
1441
1480
ISWPS1 = IOLDPS + 5 + NPIVP1 + NFRONT + XSIZE
1442
1481
ISWPS2 = IOLDPS + 5 + IPIV + NFRONT + XSIZE
1444
1483
IW(ISWPS1) = IW(ISWPS2)
1445
1484
IW(ISWPS2) = ISW
1446
1485
400 IF (JMAX.EQ.1) GO TO 420
1447
J1 = POSELT + NPIV*NFRONT
1448
J2 = POSELT + (NPIV + JMAX - 1)*NFRONT
1486
J1 = POSELT + int(NPIV,8) * NFRONT8
1487
J2 = POSELT + int(NPIV + JMAX - 1,8) * NFRONT8
1449
1488
DO 410 KSW=1,NFRONT
1450
1489
SWOP = A(J1)
1451
1490
A(J1) = A(J2)
1452
1491
A(J2) = SWOP
1453
J1 = J1 + 1
1454
J2 = J2 + 1
1492
J1 = J1 + 1_8
1493
J2 = J2 + 1_8
1455
1494
410 CONTINUE
1456
1495
ISWPS1 = IOLDPS + 5 + NPIV + 1 + XSIZE
1457
1496
ISWPS2 = IOLDPS + 5 + NPIV + JMAX + XSIZE
1465
1504
420 CONTINUE
1466
1505
IF (KEEP(201).EQ.1) THEN
1467
1506
CALL SMUMPS_680( IW(I_PIVRPTR_L),
1468
* NBPANELS_L,
1469
* IW(I_PIVR_L), NASS, NPIVP1, NPIV+JMAX,
1470
* PP_LastPanelonDisk_L,
1471
* PP_LastPIVRPTRFilled_L)
1507
& NBPANELS_L,
1508
& IW(I_PIVR_L), NASS, NPIVP1, NPIV+JMAX,
1509
& PP_LastPanelonDisk_L,
1510
& PP_LastPIVRPTRFilled_L)
1472
1511
CALL SMUMPS_680( IW(I_PIVRPTR_U),
1473
* NBPANELS_U,
1474
* IW(I_PIVR_U), NASS, NPIVP1, IPIV,
1475
* PP_LastPanelonDisk_U,
1476
* PP_LastPIVRPTRFilled_U)
1512
& NBPANELS_U,
1513
& IW(I_PIVR_U), NASS, NPIVP1, IPIV,
1514
& PP_LastPanelonDisk_U,
1515
& PP_LastPIVRPTRFilled_U)
1477
1516
ENDIF
1478
1517
430 CONTINUE
1479
1518
RETURN
1480
1519
END SUBROUTINE SMUMPS_220
1481
1520
SUBROUTINE SMUMPS_225(IBEG_BLOCK,
1482
* NFRONT,NASS,N,INODE,IW,LIW,A,LA,
1483
* IOLDPS,POSELT,IFINB,LKJIB,LKJIT,XSIZE)
1521
& NFRONT,NASS,N,INODE,IW,LIW,A,LA,
1522
& IOLDPS,POSELT,IFINB,LKJIB,LKJIT,XSIZE)
1484
1523
IMPLICIT NONE
1485
INTEGER NFRONT,NASS,N,LA,LIW,INODE,IFINB,LKJIB,IBEG_BLOCK
1524
INTEGER NFRONT,NASS,N,LIW,INODE,IFINB,LKJIB,IBEG_BLOCK
1525
INTEGER(8) :: LA
1486
1526
REAL A(LA)
1487
1527
INTEGER IW(LIW)
1488
1528
REAL VALPIV
1489
INTEGER APOS, UUPOS, IOLDPS, POSELT
1529
INTEGER(8) :: APOS, POSELT, UUPOS, LPOS
1530
INTEGER(8) :: NFRONT8
1531
INTEGER IOLDPS
1490
1532
INTEGER LKJIT, XSIZE
1491
1533
REAL ONE, ALPHA
1492
1534
INTEGER NPIV,JROW2
1493
INTEGER NEL2,NPIVP1,KROW,LPOS,NEL
1535
INTEGER NEL2,NPIVP1,KROW,NEL
1494
1536
INCLUDE 'mumps_headers.h'
1495
PARAMETER(ONE=1.0E0, ALPHA=-1.0E0)
1537
PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0)
1538
NFRONT8= int(NFRONT,8)
1496
1539
NPIV = IW(IOLDPS+1+XSIZE)
1497
1540
NPIVP1 = NPIV + 1
1498
1541
NEL = NFRONT - NPIVP1
1515
1558
IBEG_BLOCK = NPIVP1+1
1516
1559
ENDIF
1517
1560
ELSE
1518
APOS = POSELT + NPIV*(NFRONT + 1)
1561
APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8)
1519
1562
VALPIV = ONE/A(APOS)
1520
LPOS = APOS + NFRONT
1563
LPOS = APOS + NFRONT8
1521
1564
DO 541 KROW = 1,NEL2
1522
1565
A(LPOS) = A(LPOS)*VALPIV
1523
LPOS = LPOS + NFRONT
1566
LPOS = LPOS + NFRONT8
1524
1567
541 CONTINUE
1525
LPOS = APOS + NFRONT
1526
UUPOS = APOS+1
1568
LPOS = APOS + NFRONT8
1569
UUPOS = APOS + 1_8
1527
1570
CALL SGER(NEL,NEL2,ALPHA,A(UUPOS),1,A(LPOS),NFRONT,
1528
* A(LPOS+1),NFRONT)
1571
& A(LPOS+1_8),NFRONT)
1529
1572
ENDIF
1530
1573
RETURN
1531
1574
END SUBROUTINE SMUMPS_225
1532
1575
SUBROUTINE SMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA,IOLDPS,
1533
* POSELT,XSIZE)
1576
& POSELT,XSIZE)
1534
1577
IMPLICIT NONE
1535
INTEGER NFRONT,N,INODE,LA,LIW,XSIZE
1578
INTEGER NFRONT,N,INODE,LIW,XSIZE
1579
INTEGER(8) :: LA
1536
1580
REAL A(LA)
1537
1581
INTEGER IW(LIW)
1538
1582
REAL ALPHA,VALPIV
1539
INTEGER APOS, POSELT, UUPOS
1583
INTEGER(8) :: APOS, POSELT, UUPOS
1584
INTEGER(8) :: NFRONT8, LPOS, IRWPOS
1540
1585
INTEGER IOLDPS,NPIV,NEL
1541
INTEGER LPOS,JROW,IRWPOS
1586
INTEGER JROW
1542
1587
INCLUDE 'mumps_headers.h'
1543
REAL ONE
1544
DATA ONE /1.0E0/
1588
REAL, PARAMETER :: ONE = 1.0E0
1589
NFRONT8= int(NFRONT,8)
1545
1590
NPIV = IW(IOLDPS+1+XSIZE)
1546
1591
NEL = NFRONT - NPIV - 1
1547
APOS = POSELT + (NPIV)*NFRONT + NPIV
1592
APOS = POSELT + int(NPIV,8) * NFRONT8 + int(NPIV,8)
1548
1593
IF (NEL.EQ.0) GO TO 650
1549
1594
VALPIV = ONE/A(APOS)
1550
LPOS = APOS + NFRONT
1595
LPOS = APOS + NFRONT8
1551
1596
DO 340 JROW = 1,NEL
1552
1597
A(LPOS) = VALPIV*A(LPOS)
1553
LPOS = LPOS + NFRONT
1598
LPOS = LPOS + NFRONT8
1554
1599
340 CONTINUE
1555
LPOS = APOS + NFRONT
1556
UUPOS = APOS+1
1600
LPOS = APOS + NFRONT8
1601
UUPOS = APOS+1_8
1557
1602
DO 440 JROW = 1,NEL
1558
IRWPOS = LPOS + 1
1603
IRWPOS = LPOS + 1_8
1559
1604
ALPHA = -A(LPOS)
1560
1605
CALL SAXPY(NEL,ALPHA,A(UUPOS),1,A(IRWPOS),1)
1561
LPOS = LPOS + NFRONT
1606
LPOS = LPOS + NFRONT8
1562
1607
440 CONTINUE
1563
1608
650 RETURN
1564
1609
END SUBROUTINE SMUMPS_229
1565
1610
SUBROUTINE SMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA,
1566
* IOLDPS,POSELT,IFINB,XSIZE)
1611
& IOLDPS,POSELT,IFINB,XSIZE)
1567
1612
IMPLICIT NONE
1568
1613
INCLUDE 'mumps_headers.h'
1569
INTEGER NFRONT,NASS,N,LA,LIW,INODE,IFINB
1614
INTEGER NFRONT,NASS,N,LIW,INODE,IFINB
1615
INTEGER(8) :: LA
1570
1616
REAL A(LA)
1571
1617
INTEGER IW(LIW)
1572
1618
REAL ALPHA,VALPIV
1573
INTEGER APOS, POSELT,UUPOS
1619
INTEGER(8) :: APOS, POSELT, UUPOS, LPOS, IRWPOS
1620
INTEGER(8) :: NFRONT8
1574
1621
INTEGER IOLDPS,NPIV,KROW, XSIZE
1575
INTEGER NEL,LPOS,ICOL,NEL2,IRWPOS
1622
INTEGER NEL,ICOL,NEL2
1576
1623
INTEGER NPIVP1
1577
REAL ONE
1578
DATA ONE /1.0E0/
1624
REAL, PARAMETER :: ONE = 1.0E0
1625
NFRONT8=int(NFRONT,8)
1579
1626
NPIV = IW(IOLDPS+1+XSIZE)
1580
1627
NPIVP1 = NPIV + 1
1581
1628
NEL = NFRONT - NPIVP1
1582
1629
NEL2 = NASS - NPIVP1
1583
1630
IFINB = 0
1584
1631
IF (NPIVP1.EQ.NASS) IFINB = 1
1585
APOS = POSELT + NPIV*(NFRONT + 1)
1632
APOS = POSELT + int(NPIV,8)*(NFRONT8 + 1_8)
1586
1633
VALPIV = ONE/A(APOS)
1587
LPOS = APOS + NFRONT
1634
LPOS = APOS + NFRONT8
1588
1635
DO 541 KROW = 1,NEL
1589
1636
A(LPOS) = A(LPOS)*VALPIV
1590
LPOS = LPOS + NFRONT
1637
LPOS = LPOS + NFRONT8
1591
1638
541 CONTINUE
1592
LPOS = APOS + NFRONT
1593
UUPOS = APOS+1
1639
LPOS = APOS + NFRONT8
1640
UUPOS = APOS + 1_8
1594
1641
DO 440 ICOL = 1,NEL
1595
IRWPOS = LPOS + 1
1642
IRWPOS = LPOS + 1_8
1596
1643
ALPHA = -A(LPOS)
1597
1644
CALL SAXPY(NEL2,ALPHA,A(UUPOS),1,A(IRWPOS),1)
1598
LPOS = LPOS + NFRONT
1645
LPOS = LPOS + NFRONT8
1599
1646
440 CONTINUE
1600
1647
RETURN
1601
1648
END SUBROUTINE SMUMPS_228
1602
1649
SUBROUTINE SMUMPS_231(A,LA,NFRONT,
1603
* NPIV,NASS,POSELT)
1650
& NPIV,NASS,POSELT)
1604
1651
IMPLICIT NONE
1605
INTEGER LA,POSELT
1652
INTEGER(8) :: LA,POSELT
1606
1653
REAL A(LA)
1607
1654
INTEGER NFRONT, NPIV, NASS
1608
INTEGER NEL1,NEL11,LPOS2,LPOS1,LPOS
1655
INTEGER(8) :: LPOS, LPOS1, LPOS2
1656
INTEGER NEL1,NEL11
1609
1657
REAL ALPHA, ONE
1610
PARAMETER(ONE=1.0E0, ALPHA=-1.0E0)
1658
PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0)
1611
1659
NEL1 = NFRONT - NASS
1612
1660
NEL11 = NFRONT - NPIV
1613
LPOS2 = POSELT + NASS*NFRONT
1661
LPOS2 = POSELT + int(NASS,8)*int(NFRONT,8)
1614
1662
CALL STRSM('L','L','N','N',NPIV,NEL1,ONE,A(POSELT),NFRONT,
1615
* A(LPOS2),NFRONT)
1616
LPOS = LPOS2 + NPIV
1617
LPOS1 = POSELT + NPIV
1663
& A(LPOS2),NFRONT)
1664
LPOS = LPOS2 + int(NPIV,8)
1665
LPOS1 = POSELT + int(NPIV,8)
1618
1666
CALL SGEMM('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1),
1619
* NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1667
& NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1620
1668
RETURN
1621
1669
END SUBROUTINE SMUMPS_231
1622
1670
SUBROUTINE SMUMPS_642(A,LAFAC,NFRONT,
1627
1675
USE SMUMPS_OOC
1628
1676
IMPLICIT NONE
1629
1677
INTEGER NFRONT, NPIV, NASS
1630
INTEGER LAFAC, LIWFAC, TYPEFile, MYID, IFLAG_OOC,
1678
INTEGER(8) :: LAFAC
1679
INTEGER LIWFAC, TYPEFile, MYID, IFLAG_OOC,
1631
1680
& LNextPiv2beWritten, UNextPiv2beWritten, STRAT
1632
1681
REAL A(LAFAC)
1633
1682
INTEGER IW(LIWFAC)
1634
1683
INTEGER*8 KEEP8(150)
1635
1684
TYPE(IO_BLOCK) :: MonBloc
1636
INTEGER NEL1,NEL11,LPOS2,LPOS1,LPOS
1685
INTEGER(8) :: LPOS2,LPOS1,LPOS
1686
INTEGER NEL1,NEL11
1637
1687
REAL ALPHA, ONE
1638
PARAMETER(ONE=1.0E0, ALPHA=-1.0E0)
1688
LOGICAL LAST_CALL
1689
PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0)
1639
1690
NEL1 = NFRONT - NASS
1640
1691
NEL11 = NFRONT - NPIV
1641
LPOS2 = 1 + NASS*NFRONT
1692
LPOS2 = 1_8 + int(NASS,8) * int(NFRONT,8)
1642
1693
CALL STRSM('L','L','N','N',NPIV,NEL1,ONE,A(1),NFRONT,
1643
* A(LPOS2),NFRONT)
1694
& A(LPOS2),NFRONT)
1695
LAST_CALL=.FALSE.
1644
1696
CALL SMUMPS_688
1645
1697
& ( STRAT, TYPEFile,
1646
1698
& A, LAFAC, MonBloc,
1647
1699
& LNextPiv2beWritten, UNextPiv2beWritten,
1648
1700
& IW, LIWFAC,
1649
& MYID, KEEP8(31), IFLAG_OOC )
1650
LPOS = LPOS2 + NPIV
1651
LPOS1 = 1 + NPIV
1701
& MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )
1702
LPOS = LPOS2 + int(NPIV,8)
1703
LPOS1 = int(1 + NPIV,8)
1652
1704
CALL SGEMM('N','N',NEL11,NEL1,NPIV,ALPHA,A(LPOS1),
1653
* NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1705
& NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1654
1706
RETURN
1655
1707
END SUBROUTINE SMUMPS_642
1656
1708
SUBROUTINE SMUMPS_232(A,LA,NFRONT,NPIV,NASS,POSELT,LKJIB)
1657
INTEGER LA, NFRONT, NPIV, NASS, LKJIB
1709
INTEGER NFRONT, NPIV, NASS, LKJIB
1710
INTEGER (8) :: POSELT, LA
1658
1711
REAL A(LA)
1659
INTEGER POSELT
1660
INTEGER POSELT_LOCAL
1661
INTEGER NEL1, NEL11, NPBEG, LPOS, LPOS1, LPOS2
1712
INTEGER(8) :: POSELT_LOCAL, LPOS, LPOS1, LPOS2
1713
INTEGER NEL1, NEL11, NPBEG
1662
1714
REAL ALPHA, ONE
1663
PARAMETER(ONE=1.0E0, ALPHA=-1.0E0)
1715
PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0)
1664
1716
POSELT_LOCAL = POSELT
1665
1717
NEL1 = NASS - NPIV
1666
1718
NPBEG = NPIV - LKJIB + 1
1667
1719
NEL11 = NFRONT - NPIV
1668
LPOS2 = POSELT_LOCAL + NPIV*NFRONT + NPBEG - 1
1669
POSELT_LOCAL = POSELT_LOCAL + (NPBEG-1)*NFRONT + NPBEG - 1
1720
LPOS2 = POSELT_LOCAL + int(NPIV,8)*int(NFRONT,8)
1721
& + int(NPBEG - 1,8)
1722
POSELT_LOCAL = POSELT_LOCAL + int(NPBEG-1,8)*int(NFRONT,8)
1723
& + int(NPBEG-1,8)
1670
1724
CALL STRSM('L','L','N','N',LKJIB,NEL1,ONE,A(POSELT_LOCAL),
1671
* NFRONT,A(LPOS2),NFRONT)
1672
LPOS = LPOS2 + LKJIB
1673
LPOS1 = POSELT_LOCAL + LKJIB
1725
& NFRONT,A(LPOS2),NFRONT)
1726
LPOS = LPOS2 + int(LKJIB,8)
1727
LPOS1 = POSELT_LOCAL + int(LKJIB,8)
1674
1728
CALL SGEMM('N','N',NEL11,NEL1,LKJIB,ALPHA,A(LPOS1),
1675
* NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1729
& NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1676
1730
RETURN
1677
1731
END SUBROUTINE SMUMPS_232
1678
1732
SUBROUTINE SMUMPS_233(IBEG_BLOCK,
1679
* NFRONT,NASS,N,INODE,IW,LIW,A,LA,
1680
* IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT,XSIZE )
1733
& NFRONT,NASS,N,INODE,IW,LIW,A,LA,
1734
& IOLDPS,POSELT,LKJIB_ORIG,LKJIB,LKJIT,XSIZE )
1681
1735
IMPLICIT NONE
1682
INTEGER NFRONT, NASS,N,LA,LIW
1736
INTEGER NFRONT, NASS,N,LIW
1737
INTEGER(8) :: LA
1683
1738
REAL A(LA)
1684
1739
INTEGER IW(LIW)
1685
1740
INTEGER LKJIB_ORIG,LKJIB, INODE, IBEG_BLOCK
1686
INTEGER POSELT
1741
INTEGER(8) :: POSELT, LPOS, LPOS1, LPOS2, POSLOCAL
1742
INTEGER(8) :: IPOS, KPOS
1743
INTEGER(8) :: NFRONT8
1687
1744
INTEGER IOLDPS, NPIV, JROW2, NPBEG
1688
1745
INTEGER NONEL, LKJIW, NEL1, NEL11
1689
INTEGER LBP, IPOS, KPOS, LPOS2, HF
1690
INTEGER LPOS1,LPOS,LBPT,I1,K1,II,ISWOP,LBP1
1691
INTEGER LKJIT, POSLOCAL, XSIZE
1746
INTEGER LBP, HF
1747
INTEGER LBPT,I1,K1,II,ISWOP,LBP1
1748
INTEGER LKJIT, XSIZE
1692
1749
INCLUDE 'mumps_headers.h'
1693
1750
REAL ALPHA, ONE
1694
PARAMETER(ONE=1.0E0, ALPHA=-1.0E0)
1751
PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0)
1752
NFRONT8=int(NFRONT,8)
1695
1753
NPIV = IW(IOLDPS+1+XSIZE)
1696
1754
JROW2 = iabs(IW(IOLDPS+3+XSIZE))
1697
1755
NPBEG = IBEG_BLOCK
1708
1766
LKJIW = NPIV - NPBEG + 1
1709
1767
NEL11 = NFRONT - NPIV
1710
1768
IF ((NEL1.NE.0).AND.(LKJIW.NE.0)) THEN
1711
LPOS2 = POSELT + JROW2*NFRONT + NPBEG - 1
1712
POSLOCAL = POSELT + (NPBEG-1)*NFRONT + NPBEG - 1
1769
LPOS2 = POSELT + int(JROW2,8)*NFRONT8 +
1770
& int(NPBEG - 1,8)
1771
POSLOCAL = POSELT + int(NPBEG-1,8)*NFRONT8 + int(NPBEG - 1,8)
1713
1772
CALL STRSM('L','L','N','N',LKJIW,NEL1,ONE,
1714
* A(POSLOCAL),NFRONT,
1715
* A(LPOS2),NFRONT)
1716
LPOS = LPOS2 + LKJIW
1717
LPOS1 = POSLOCAL + LKJIW
1773
& A(POSLOCAL),NFRONT,
1774
& A(LPOS2),NFRONT)
1775
LPOS = LPOS2 + int(LKJIW,8)
1776
LPOS1 = POSLOCAL + int(LKJIW,8)
1718
1777
CALL SGEMM('N','N',NEL11,NEL1,LKJIW,ALPHA,A(LPOS1),
1719
* NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1778
& NFRONT,A(LPOS2),NFRONT,ONE,A(LPOS),NFRONT)
1720
1779
ENDIF
1721
1780
RETURN
1722
1781
END SUBROUTINE SMUMPS_233
1723
1782
SUBROUTINE SMUMPS_236(A,LA,NPIVB,NFRONT,
1724
* NPIV,NASS,POSELT)
1783
& NPIV,NASS,POSELT)
1725
1784
IMPLICIT NONE
1726
INTEGER NPIVB,NASS,LA
1785
INTEGER NPIVB,NASS
1786
INTEGER(8) :: LA
1727
1787
REAL A(LA)
1728
INTEGER APOS, POSELT
1788
INTEGER(8) :: APOS, POSELT
1729
1789
INTEGER NFRONT, NPIV, NASSL
1730
INTEGER LPOS, LPOS1, LPOS2, NEL1, NEL11, NPIVE
1790
INTEGER(8) :: LPOS, LPOS1, LPOS2
1791
INTEGER NEL1, NEL11, NPIVE
1731
1792
REAL ALPHA, ONE
1732
PARAMETER(ONE=1.0E0, ALPHA=-1.0E0)
1793
PARAMETER (ONE = 1.0E0, ALPHA=-1.0E0)
1733
1794
NEL1 = NFRONT - NASS
1734
1795
NEL11 = NFRONT - NPIV
1735
1796
NPIVE = NPIV - NPIVB
1736
1797
NASSL = NASS - NPIVB
1737
APOS = POSELT + NPIVB*NFRONT + NPIVB
1738
LPOS2 = APOS + NASSL
1798
APOS = POSELT + int(NPIVB,8)*int(NFRONT,8)
1799
& + int(NPIVB,8)
1800
LPOS2 = APOS + int(NASSL,8)
1739
1801
CALL STRSM('R','U','N','U',NEL1,NPIVE,ONE,A(APOS),NFRONT,
1740
* A(LPOS2),NFRONT)
1741
LPOS = LPOS2 + NFRONT*NPIVE
1742
LPOS1 = APOS + NFRONT*NPIVE
1802
& A(LPOS2),NFRONT)
1803
LPOS = LPOS2 + int(NFRONT,8)*int(NPIVE,8)
1804
LPOS1 = APOS + int(NFRONT,8)*int(NPIVE,8)
1743
1805
CALL SGEMM('N','N',NEL1,NEL11,NPIVE,ALPHA,A(LPOS2),
1744
* NFRONT,A(LPOS1),NFRONT,ONE,A(LPOS),NFRONT)
1806
& NFRONT,A(LPOS1),NFRONT,ONE,A(LPOS),NFRONT)
1745
1807
RETURN
1746
1808
END SUBROUTINE SMUMPS_236
1747
1809
SUBROUTINE SMUMPS_217(N, NZ, NSCA,
1748
* ASPK, IRN, ICN, COLSCA, ROWSCA, S, MAXS,
1749
* ICNTL, INFO)
1810
& ASPK, IRN, ICN, COLSCA, ROWSCA, WK, LWK, WK_REAL,
1811
& LWK_REAL, ICNTL, INFO)
1812
IMPLICIT NONE
1750
1813
INTEGER N, NZ, NSCA, MAXS
1751
1814
INTEGER IRN(NZ), ICN(NZ)
1752
1815
INTEGER ICNTL(40), INFO(40)
1753
1816
REAL ASPK(NZ)
1754
1817
REAL COLSCA(*), ROWSCA(*)
1755
REAL S(MAXS)
1818
INTEGER LWK, LWK_REAL
1819
REAL WK(LWK)
1820
REAL WK_REAL(LWK_REAL)
1756
1821
INTEGER MPG,LP
1757
INTEGER ISPW1, IWNOR
1758
INTEGER I, K, ITOT
1822
INTEGER IWNOR
1823
INTEGER I, K
1759
1824
LOGICAL PROK
1760
1825
REAL ONE
1761
1826
PARAMETER( ONE = 1.0E0 )
1767
1832
101 FORMAT(/' ****** SCALING OF ORIGINAL MATRIX '/)
1768
1833
IF (NSCA.EQ.1) THEN
1769
1834
IF (PROK)
1770
* WRITE (MPG,*) ' DIAGONAL SCALING '
1835
& WRITE (MPG,*) ' DIAGONAL SCALING '
1771
1836
ELSEIF (NSCA.EQ.2) THEN
1772
1837
IF (PROK)
1773
* WRITE (MPG,*) ' SCALING BASED ON (MC29)'
1838
& WRITE (MPG,*) ' SCALING BASED ON (MC29)'
1774
1839
ELSEIF (NSCA.EQ.3) THEN
1775
1840
IF (PROK)
1776
* WRITE (MPG,*) ' COLUMN SCALING'
1841
& WRITE (MPG,*) ' COLUMN SCALING'
1777
1842
ELSEIF (NSCA.EQ.4) THEN
1778
1843
IF (PROK)
1779
* WRITE (MPG,*) ' ROW AND COLUMN SCALING (1 Pass)'
1844
& WRITE (MPG,*) ' ROW AND COLUMN SCALING (1 Pass)'
1780
1845
ELSEIF (NSCA.EQ.5) THEN
1781
1846
IF (PROK)
1782
* WRITE (MPG,*) ' MC29 FOLLOWED BY ROW &COL SCALING'
1847
& WRITE (MPG,*) ' MC29 FOLLOWED BY ROW &COL SCALING'
1783
1848
ELSEIF (NSCA.EQ.6) THEN
1784
1849
IF (PROK)
1785
* WRITE (MPG,*) ' MC29 FOLLOWED BY COLUMN SCALING'
1850
& WRITE (MPG,*) ' MC29 FOLLOWED BY COLUMN SCALING'
1786
1851
ENDIF
1787
1852
DO 10 I=1,N
1788
1853
COLSCA(I) = ONE
1790
1855
10 CONTINUE
1791
1856
IF ((NSCA.EQ.5).OR.
1792
1857
& (NSCA.EQ.6)) THEN
1793
ITOT = 5*N + NZ
1794
IF (ITOT.GT.MAXS) GOTO 400
1795
ISPW1 = MAXS - NZ + 1
1858
IF (NZ.GT.LWK) GOTO 400
1796
1859
DO 15 K=1,NZ
1797
S(ISPW1+K-1) = ASPK(K)
1860
WK(K) = ASPK(K)
1798
1861
15 CONTINUE
1799
ELSE
1800
ISPW1 = MAXS + 1
1801
ITOT = 5*N
1802
IF (ITOT.GT.MAXS) GOTO 400
1803
1862
ENDIF
1804
IWNOR = ISPW1 - 5*N
1863
IF (5*N.GT.LWK_REAL) GOTO 410
1864
IWNOR = 1
1805
1865
IF (NSCA.EQ.1) THEN
1806
1866
CALL SMUMPS_238(N,NZ,ASPK,IRN,ICN,
1807
* COLSCA,ROWSCA,MPG)
1867
& COLSCA,ROWSCA,MPG)
1808
1868
ELSEIF (NSCA.EQ.2) THEN
1809
1869
CALL SMUMPS_239(N,NZ,ASPK,IRN,ICN,
1810
* ROWSCA,COLSCA,S(IWNOR),MPG,MPG,NSCA)
1870
& ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA)
1811
1871
ELSEIF (NSCA.EQ.3) THEN
1812
CALL SMUMPS_241(N,NZ,ASPK,IRN,ICN,S(IWNOR),COLSCA,
1813
* MPG)
1872
CALL SMUMPS_241(N,NZ,ASPK,IRN,ICN,WK_REAL(IWNOR),
1873
& COLSCA, MPG)
1814
1874
ELSEIF (NSCA.EQ.4) THEN
1815
1875
CALL SMUMPS_287(N,NZ,IRN,ICN,ASPK,
1816
* S(IWNOR),S(IWNOR+N),COLSCA,ROWSCA,MPG)
1876
& WK_REAL(IWNOR),WK_REAL(IWNOR+N),COLSCA,ROWSCA,MPG)
1817
1877
ELSEIF (NSCA.EQ.5) THEN
1818
CALL SMUMPS_239(N,NZ,S(ISPW1),IRN,ICN,
1819
* ROWSCA,COLSCA,S(IWNOR),MPG,MPG,NSCA)
1820
CALL SMUMPS_241(N,NZ,S(ISPW1),IRN,ICN,S(IWNOR),
1821
* COLSCA, MPG)
1878
CALL SMUMPS_239(N,NZ,WK,IRN,ICN,
1879
& ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA)
1880
CALL SMUMPS_241(N,NZ,WK,IRN,ICN,WK_REAL(IWNOR),
1881
& COLSCA, MPG)
1822
1882
ELSEIF (NSCA.EQ.6) THEN
1823
CALL SMUMPS_239(N,NZ,S(ISPW1),IRN,ICN,
1824
* ROWSCA,COLSCA,S(IWNOR),MPG,MPG,NSCA)
1825
CALL SMUMPS_240(NSCA,N,NZ,IRN,ICN,S(ISPW1),
1826
* S(IWNOR+N),ROWSCA,MPG)
1827
CALL SMUMPS_241(N,NZ,S(ISPW1),IRN,ICN,S(IWNOR),
1828
* COLSCA, MPG)
1883
CALL SMUMPS_239(N,NZ,WK,IRN,ICN,
1884
& ROWSCA,COLSCA,WK_REAL(IWNOR),MPG,MPG,NSCA)
1885
CALL SMUMPS_240(NSCA,N,NZ,IRN,ICN,WK,
1886
& WK_REAL(IWNOR+N),ROWSCA,MPG)
1887
CALL SMUMPS_241(N,NZ,WK,IRN,ICN,
1888
& WK_REAL(IWNOR), COLSCA, MPG)
1829
1889
ENDIF
1830
1890
GOTO 500
1831
1891
400 INFO(1) = -5
1832
INFO(2) = ITOT-MAXS
1833
IF ((LP.GT.0).AND.(ICNTL(4).GE.1))
1834
* WRITE(LP,*) '*** ERROR: Not enough space to scale matrix'
1835
500 RETURN
1892
INFO(2) = NZ-LWK
1893
IF ((LP.GT.0).AND.(ICNTL(4).GE.1))
1894
& WRITE(LP,*) '*** ERROR: Not enough space to scale matrix'
1895
GOTO 500
1896
410 INFO(1) = -5
1897
INFO(2) = 5*N-LWK_REAL
1898
IF ((LP.GT.0).AND.(ICNTL(4).GE.1))
1899
& WRITE(LP,*) '*** ERROR: Not enough space to scale matrix'
1900
GOTO 500
1901
500 CONTINUE
1902
RETURN
1836
1903
END SUBROUTINE SMUMPS_217
1837
1904
SUBROUTINE SMUMPS_287(N,NZ,IRN,ICN,VAL,
1838
* RNOR,CNOR,COLSCA,ROWSCA,MPRINT)
1905
& RNOR,CNOR,COLSCA,ROWSCA,MPRINT)
1839
1906
INTEGER N, NZ
1840
REAL VAL(NZ),RNOR(N),CNOR(N)
1907
REAL VAL(NZ)
1908
REAL RNOR(N),CNOR(N)
1841
1909
REAL COLSCA(N),ROWSCA(N)
1842
1910
REAL CMIN,CMAX,RMIN,ARNOR,ACNOR
1843
1911
INTEGER IRN(NZ), ICN(NZ)
1847
1915
REAL ZERO, ONE
1848
1916
PARAMETER(ZERO=0.0E0, ONE=1.0E0)
1849
1917
DO 50 J=1,N
1850
CNOR(J) = real(ZERO)
1851
RNOR(J) = real(ZERO)
1918
CNOR(J) = ZERO
1919
RNOR(J) = ZERO
1852
1920
50 CONTINUE
1853
1921
DO 100 K=1,NZ
1854
1922
I = IRN(K)
1855
1923
J = ICN(K)
1856
1924
IF ((I.LE.0).OR.(I.GT.N).OR.
1857
* (J.LE.0).OR.(J.GT.N)) GOTO 100
1925
& (J.LE.0).OR.(J.GT.N)) GOTO 100
1858
1926
VDIAG = abs(VAL(K))
1859
IF (VDIAG.GT.abs(CNOR(J))) THEN
1927
IF (VDIAG.GT.CNOR(J)) THEN
1860
1928
CNOR(J) = VDIAG
1861
1929
ENDIF
1862
IF (VDIAG.GT.abs(RNOR(I))) THEN
1930
IF (VDIAG.GT.RNOR(I)) THEN
1863
1931
RNOR(I) = VDIAG
1864
1932
ENDIF
1865
1933
100 CONTINUE
1866
1934
IF (MPRINT.GT.0) THEN
1867
CMIN = abs( CNOR(1) )
1868
CMAX = abs( CNOR(1) )
1869
RMIN = abs( RNOR(1) )
1935
CMIN = CNOR(1)
1936
CMAX = CNOR(1)
1937
RMIN = RNOR(1)
1870
1938
DO 111 I=1,N
1871
ARNOR = abs(RNOR(I))
1872
ACNOR = abs(CNOR(I))
1939
ARNOR = RNOR(I)
1940
ACNOR = CNOR(I)
1873
1941
IF (ACNOR.GT.CMAX) CMAX=ACNOR
1874
1942
IF (ACNOR.LT.CMIN) CMIN=ACNOR
1875
1943
IF (ARNOR.LT.RMIN) RMIN=ARNOR
1880
1948
WRITE(MPRINT,*) ' MINIMUM NORM-MAX OF ROWS :',RMIN
1881
1949
ENDIF
1882
1950
DO 120 J=1,N
1883
IF (abs(CNOR(J)).LE.ZERO) THEN
1884
CNOR(J) = real(ONE)
1951
IF (CNOR(J).LE.ZERO) THEN
1952
CNOR(J) = ONE
1885
1953
ELSE
1886
CNOR(J) = real(ONE)/CNOR(J)
1954
CNOR(J) = ONE / CNOR(J)
1887
1955
ENDIF
1888
1956
120 CONTINUE
1889
1957
DO 130 J=1,N
1890
IF (abs(RNOR(J)).LE.ZERO) THEN
1891
RNOR(J) = real(ONE)
1958
IF (RNOR(J).LE.ZERO) THEN
1959
RNOR(J) = ONE
1892
1960
ELSE
1893
RNOR(J) = real(ONE)/RNOR(J)
1961
RNOR(J) = ONE / RNOR(J)
1894
1962
ENDIF
1895
1963
130 CONTINUE
1896
1964
DO 110 I=1,N
1897
ROWSCA(I) = ROWSCA(I) * real(RNOR(I))
1898
COLSCA(I) = COLSCA(I) * real(CNOR(I))
1965
ROWSCA(I) = ROWSCA(I) * RNOR(I)
1966
COLSCA(I) = COLSCA(I) * CNOR(I)
1899
1967
110 CONTINUE
1900
1968
IF (MPRINT.GT.0)
1901
* WRITE(MPRINT,*) ' END OF SCALING BY MAX IN ROW AND COL'
1969
& WRITE(MPRINT,*) ' END OF SCALING BY MAX IN ROW AND COL'
1902
1970
RETURN
1903
1971
END SUBROUTINE SMUMPS_287
1904
1972
SUBROUTINE SMUMPS_239(N,NZ,VAL,ROWIND,COLIND,
1905
* RNOR,CNOR,WNOR,MPRINT,MP,
1906
* NSCA)
1973
& RNOR,CNOR,WNOR,MPRINT,MP,
1974
& NSCA)
1907
1975
INTEGER N, NZ
1908
1976
REAL VAL(NZ)
1909
1977
REAL WNOR(5*N)
1910
REAL RNOR(N),CNOR(N)
1978
REAL RNOR(N), CNOR(N)
1911
1979
INTEGER COLIND(NZ),ROWIND(NZ)
1912
1980
INTEGER J,I,K
1913
1981
INTEGER MPRINT,MP,NSCA
1915
1983
REAL ZERO, ONE
1916
1984
PARAMETER( ZERO = 0.0E0, ONE = 1.0E0 )
1917
1985
DO 15 I=1,N
1918
RNOR(I) = ZERO
1919
CNOR(I) = ZERO
1986
RNOR(I) = ZERO
1987
CNOR(I) = ZERO
1920
1988
15 CONTINUE
1921
1989
CALL SMUMPS_216(N,N,NZ,VAL,ROWIND,COLIND,
1922
* RNOR,CNOR,WNOR, MP,IFAIL9)
1990
& RNOR,CNOR,WNOR, MP,IFAIL9)
1923
1991
*CVD$ NODEPCHK
1924
1992
*CVD$ VECTOR
1925
1993
*CVD$ CONCUR
1936
2004
100 CONTINUE
1937
2005
ENDIF
1938
2006
IF (MPRINT.GT.0)
1939
* WRITE(MPRINT,*) ' END OF SCALING USING MC29'
2007
& WRITE(MPRINT,*) ' END OF SCALING USING MC29'
1940
2008
RETURN
1941
2009
END SUBROUTINE SMUMPS_239
1942
2010
SUBROUTINE SMUMPS_241(N,NZ,VAL,IRN,ICN,
1943
* CNOR,COLSCA,MPRINT)
2011
& CNOR,COLSCA,MPRINT)
1944
2012
INTEGER N,NZ
1945
REAL VAL(NZ),CNOR(N)
2013
REAL VAL(NZ)
2014
REAL CNOR(N)
1946
2015
REAL COLSCA(N)
1947
2016
INTEGER IRN(NZ), ICN(NZ)
1948
2017
REAL VDIAG
1951
2020
REAL ZERO, ONE
1952
2021
PARAMETER (ZERO=0.0E0,ONE=1.0E0)
1953
2022
DO 10 J=1,N
1954
CNOR(J) = real(ZERO)
2023
CNOR(J) = ZERO
1955
2024
10 CONTINUE
1956
2025
DO 100 K=1,NZ
1957
2026
I = IRN(K)
1958
2027
J = ICN(K)
1959
2028
IF ((I.LE.0).OR.(I.GT.N).OR.
1960
* (J.LE.0).OR.(J.GT.N)) GOTO 100
2029
& (J.LE.0).OR.(J.GT.N)) GOTO 100
1961
2030
VDIAG = abs(VAL(K))
1962
IF (VDIAG.GT.abs(CNOR(J))) THEN
2031
IF (VDIAG.GT.CNOR(J)) THEN
1963
2032
CNOR(J) = VDIAG
1964
2033
ENDIF
1965
2034
100 CONTINUE
1966
2035
DO 110 J=1,N
1967
IF (abs(CNOR(J)).LE.ZERO) THEN
1968
CNOR(J) = real(ONE)
2036
IF (CNOR(J).LE.ZERO) THEN
2037
CNOR(J) = ONE
1969
2038
ELSE
1970
CNOR(J) = real(ONE)/CNOR(J)
2039
CNOR(J) = ONE/CNOR(J)
1971
2040
ENDIF
1972
2041
110 CONTINUE
1973
2042
DO 215 I=1,N
1974
COLSCA(I) = COLSCA(I) * real(CNOR(I))
2043
COLSCA(I) = COLSCA(I) * CNOR(I)
1975
2044
215 CONTINUE
1976
2045
IF (MPRINT.GT.0) WRITE(MPRINT,*) ' END OF COLUMN SCALING'
1977
2046
RETURN
1978
2047
END SUBROUTINE SMUMPS_241
1979
2048
SUBROUTINE SMUMPS_238(N,NZ,VAL,IRN,ICN,
1980
* COLSCA,ROWSCA,MPRINT)
2049
& COLSCA,ROWSCA,MPRINT)
1981
2050
INTEGER N, NZ
1982
2051
REAL VAL(NZ)
1983
2052
REAL ROWSCA(N),COLSCA(N)
2008
2077
RETURN
2009
2078
END SUBROUTINE SMUMPS_238
2010
2079
SUBROUTINE SMUMPS_240(NSCA,N,NZ,IRN,ICN,VAL,
2011
* RNOR,ROWSCA,MPRINT)
2080
& RNOR,ROWSCA,MPRINT)
2012
2081
INTEGER N, NZ, NSCA
2013
2082
INTEGER IRN(NZ), ICN(NZ)
2014
REAL VAL(NZ),RNOR(N)
2083
REAL VAL(NZ)
2084
REAL RNOR(N)
2015
2085
REAL ROWSCA(N)
2016
2086
REAL VDIAG
2017
2087
INTEGER MPRINT
2019
2089
REAL ZERO,ONE
2020
2090
PARAMETER (ZERO=0.0E0, ONE=1.0E0)
2021
2091
DO 50 J=1,N
2022
RNOR(J) = real(ZERO)
2092
RNOR(J) = ZERO
2023
2093
50 CONTINUE
2024
2094
DO 100 K=1,NZ
2025
2095
I = IRN(K)
2026
2096
J = ICN(K)
2027
2097
IF ((I.LE.0).OR.(I.GT.N).OR.
2028
* (J.LE.0).OR.(J.GT.N)) GOTO 100
2098
& (J.LE.0).OR.(J.GT.N)) GOTO 100
2029
2099
VDIAG = abs(VAL(K))
2030
IF (VDIAG.GT.abs(RNOR(I))) THEN
2100
IF (VDIAG.GT.RNOR(I)) THEN
2031
2101
RNOR(I) = VDIAG
2032
2102
ENDIF
2033
2103
100 CONTINUE
2034
2104
DO 130 J=1,N
2035
IF (real(RNOR(J)).LE.real(ZERO)) THEN
2036
RNOR(J) = real(ONE)
2105
IF (RNOR(J).LE.ZERO) THEN
2106
RNOR(J) = ONE
2037
2107
ELSE
2038
RNOR(J) = real(ONE)/RNOR(J)
2108
RNOR(J) = ONE/RNOR(J)
2039
2109
ENDIF
2040
2110
130 CONTINUE
2041
2111
DO 110 I=1,N
2042
ROWSCA(I) = ROWSCA(I)* real(RNOR(I))
2112
ROWSCA(I) = ROWSCA(I)* RNOR(I)
2043
2113
110 CONTINUE
2044
2114
IF ( (NSCA.EQ.4) .OR. (NSCA.EQ.6) ) THEN
2045
2115
DO 150 K=1,NZ
2046
2116
I = IRN(K)
2047
2117
J = ICN(K)
2048
2118
IF (min(I,J).LT.1 .OR. I.GT.N .OR. J.GT.N) GOTO 150
2049
VAL(K) = VAL(K) * real(RNOR(I))
2119
VAL(K) = VAL(K) * RNOR(I)
2050
2120
150 CONTINUE
2051
2121
ENDIF
2052
2122
IF (MPRINT.GT.0)
2053
* WRITE(MPRINT,'(A)') ' END OF ROW SCALING'
2123
& WRITE(MPRINT,'(A)') ' END OF ROW SCALING'
2054
2124
RETURN
2055
2125
END SUBROUTINE SMUMPS_240
2056
2126
SUBROUTINE SMUMPS_216(M,N,NE,A,IRN,ICN,R,C,W,LP,IFAIL)
2112
2182
IF (W(I2+J).EQ.ZERO) W(I2+J) = ONE
2113
2183
W(I3+J) = W(I3+J)/W(I2+J)
2114
2184
50 CONTINUE
2115
SM = SMIN*NE
2185
SM = SMIN*real(NE)
2116
2186
DO 60 K = 1,NE
2117
2187
IF (abs(A(K)).EQ.ZERO) GO TO 60
2118
2188
I = IRN(K)
2198
2268
210 CONTINUE
2199
2269
RETURN
2200
2270
220 IF (LP.GT.0) WRITE (LP,'(/A/A,I3)')
2201
+ ' **** Error return from SMUMPS_216 ****',' IFAIL =',IFAIL
2271
& ' **** Error return from SMUMPS_216 ****',' IFAIL =',IFAIL
2202
2272
END SUBROUTINE SMUMPS_216
2203
2273
SUBROUTINE SMUMPS_27( id, ANORMINF, LSCAL )
2204
2274
USE SMUMPS_STRUC_DEF
2221
2291
KEEP =>id%KEEP
2222
2292
KEEP8 =>id%KEEP8
2223
2293
I_AM_SLAVE = ( id%MYID .ne. MASTER .OR.
2224
* ( id%MYID .eq. MASTER .AND.
2225
* KEEP(46) .eq. 1 ) )
2294
& ( id%MYID .eq. MASTER .AND.
2295
& KEEP(46) .eq. 1 ) )
2226
2296
IF (id%MYID .EQ. MASTER) THEN
2227
2297
ALLOCATE( SUMR( id%N ), stat =allocok )
2228
2298
IF (allocok .GT.0 ) THEN
2236
2306
IF (KEEP(55).EQ.0) THEN
2237
2307
IF (.NOT.LSCAL) THEN
2238
2308
CALL SMUMPS_207(id%A(1),
2239
* id%NZ, id%N,
2240
* id%IRN(1), id%JCN(1),
2241
* SUMR, KEEP,KEEP8 )
2309
& id%NZ, id%N,
2310
& id%IRN(1), id%JCN(1),
2311
& SUMR, KEEP,KEEP8 )
2242
2312
ELSE
2243
2313
CALL SMUMPS_289(id%A(1),
2244
* id%NZ, id%N,
2245
* id%IRN(1), id%JCN(1),
2246
* SUMR, KEEP, KEEP8,
2247
* id%COLSCA(1))
2314
& id%NZ, id%N,
2315
& id%IRN(1), id%JCN(1),
2316
& SUMR, KEEP, KEEP8,
2317
& id%COLSCA(1))
2248
2318
ENDIF
2249
2319
ELSE
2250
2320
MTYPE = 1
2251
2321
IF (.NOT.LSCAL) THEN
2252
2322
CALL SMUMPS_119(MTYPE, id%N,
2253
* id%NELT, id%ELTPTR,
2254
* id%LELTVAR, id%ELTVAR,
2255
* id%NA_ELT, id%A_ELT(1),
2256
* SUMR, KEEP,KEEP8 )
2323
& id%NELT, id%ELTPTR,
2324
& id%LELTVAR, id%ELTVAR,
2325
& id%NA_ELT, id%A_ELT(1),
2326
& SUMR, KEEP,KEEP8 )
2257
2327
ELSE
2258
2328
CALL SMUMPS_135(MTYPE, id%N,
2259
* id%NELT, id%ELTPTR(1),
2260
* id%LELTVAR, id%ELTVAR(1),
2261
* id%NA_ELT, id%A_ELT(1),
2262
* SUMR, KEEP,KEEP8, id%COLSCA(1))
2329
& id%NELT, id%ELTPTR(1),
2330
& id%LELTVAR, id%ELTVAR(1),
2331
& id%NA_ELT, id%A_ELT(1),
2332
& SUMR, KEEP,KEEP8, id%COLSCA(1))
2263
2333
ENDIF
2264
2334
ENDIF
2265
2335
ENDIF
2271
2341
RETURN
2272
2342
ENDIF
2273
2343
IF ( I_AM_SLAVE .and.
2274
* id%NZ_loc .NE. 0 ) THEN
2344
& id%NZ_loc .NE. 0 ) THEN
2275
2345
IF (.NOT.LSCAL) THEN
2276
2346
CALL SMUMPS_207(id%A_loc,
2277
* id%NZ_loc, id%N,
2278
* id%IRN_loc, id%JCN_loc,
2279
* SUMR_LOC, id%KEEP,id%KEEP8 )
2347
& id%NZ_loc, id%N,
2348
& id%IRN_loc, id%JCN_loc,
2349
& SUMR_LOC, id%KEEP,id%KEEP8 )
2280
2350
ELSE
2281
2351
CALL SMUMPS_289(id%A_loc,
2282
* id%NZ_loc, id%N,
2283
* id%IRN_loc, id%JCN_loc,
2284
* SUMR_LOC, id%KEEP,id%KEEP8,
2285
* id%COLSCA)
2352
& id%NZ_loc, id%N,
2353
& id%IRN_loc, id%JCN_loc,
2354
& SUMR_LOC, id%KEEP,id%KEEP8,
2355
& id%COLSCA)
2286
2356
ENDIF
2287
2357
ELSE
2288
SUMR_LOC = real(ZERO)
2358
SUMR_LOC = ZERO
2289
2359
ENDIF
2290
2360
IF ( id%MYID .eq. MASTER ) THEN
2291
2361
CALL MPI_REDUCE( SUMR_LOC, SUMR,
2292
* id%N, MPI_REAL,
2293
* MPI_SUM,MASTER,id%COMM, IERR)
2362
& id%N, MPI_REAL,
2363
& MPI_SUM,MASTER,id%COMM, IERR)
2294
2364
ELSE
2295
2365
CALL MPI_REDUCE( SUMR_LOC, DUMMY,
2296
* id%N, MPI_REAL,
2297
* MPI_SUM,MASTER,id%COMM, IERR)
2366
& id%N, MPI_REAL,
2367
& MPI_SUM,MASTER,id%COMM, IERR)
2298
2368
END IF
2299
2369
DEALLOCATE (SUMR_LOC)
2300
2370
ENDIF
2313
2383
ENDIF
2314
2384
ENDIF
2315
2385
CALL MPI_BCAST(ANORMINF, 1,
2316
* MPI_REAL, MASTER,
2317
* id%COMM, IERR )
2386
& MPI_REAL, MASTER,
2387
& id%COMM, IERR )
2318
2388
IF (id%MYID .eq. MASTER) DEALLOCATE (SUMR)
2319
2389
RETURN
2320
2390
END SUBROUTINE SMUMPS_27
2443
2513
& SMUMPS_672,
2444
2514
& SMUMPS_674,
2445
2515
& SMUMPS_662,
2446
& SMUMPS_CHKCONVGLO,
2447
& SMUMPS_CHK1CONV,
2516
& SMUMPS_743,
2517
& SMUMPS_745,
2448
2518
& SMUMPS_660,
2449
2519
& SMUMPS_670,
2450
2520
& SMUMPS_671,
2451
2521
& SMUMPS_657,
2452
2522
& SMUMPS_656
2453
INTEGER SMUMPS_CHKCONVGLO
2454
INTEGER SMUMPS_CHK1CONV
2455
REAL SMUMPS_ERRSCALOC
2456
REAL SMUMPS_ERRSCA1
2523
INTEGER SMUMPS_743
2524
INTEGER SMUMPS_745
2525
REAL SMUMPS_737
2526
REAL SMUMPS_738
2457
2527
INTRINSIC abs
2458
2528
REAL RONE, RZERO
2459
2529
PARAMETER(RONE=1.0E0,RZERO=0.0E0)
2684
2754
& (ITER.EQ.NB1).OR.
2685
2755
& ((ITER.EQ.NB1+NB2+NB3).AND.
2686
2756
& (NB1+NB3.GT.0))) THEN
2687
INFERRROW = SMUMPS_ERRSCALOC(ROWSCA,
2757
INFERRROW = SMUMPS_737(ROWSCA,
2688
2758
& WRKRC(ITDRPTR), M,
2689
2759
& IWRK(IMYRPTR),INUMMYR)
2690
INFERRCOL = SMUMPS_ERRSCALOC(COLSCA,
2760
INFERRCOL = SMUMPS_737(COLSCA,
2691
2761
& WRKRC(ITDCPTR), N,
2692
2762
& IWRK(IMYCPTR),INUMMYC)
2693
2763
INFERRL = INFERRCOL
2717
2787
& (ITER.EQ.NB1).OR.
2718
2788
& ((ITER.EQ.NB1+NB2+NB3).AND.
2719
2789
& (NB1+NB3.GT.0))) THEN
2720
INFERRROW = SMUMPS_ERRSCA1(ROWSCA,
2790
INFERRROW = SMUMPS_738(ROWSCA,
2721
2791
& WRKRC(ITDRPTR), M)
2722
INFERRCOL = SMUMPS_ERRSCA1(COLSCA,
2792
INFERRCOL = SMUMPS_738(COLSCA,
2723
2793
& WRKRC(ITDCPTR), N)
2724
2794
INFERRL = INFERRCOL
2725
2795
IF(INFERRROW > INFERRL) THEN
2785
2855
IF((EPS .GT. RZERO) .OR.
2786
2856
& ((ITER.EQ.NB1+NB2).AND.
2787
2857
& (NB2.GT.0))) THEN
2788
ONEERRROW = SMUMPS_ERRSCALOC(ROWSCA,
2858
ONEERRROW = SMUMPS_737(ROWSCA,
2789
2859
& WRKRC(ITDRPTR), M,
2790
2860
& IWRK(IMYRPTR),INUMMYR)
2791
ONEERRCOL = SMUMPS_ERRSCALOC(COLSCA,
2861
ONEERRCOL = SMUMPS_737(COLSCA,
2792
2862
& WRKRC(ITDCPTR), N,
2793
2863
& IWRK(IMYCPTR),INUMMYC)
2794
2864
ONEERRL = ONEERRCOL
2813
2883
IF((EPS .GT. RZERO) .OR.
2814
2884
& ((ITER.EQ.NB1+NB2).AND.
2815
2885
& (NB2.GT.0))) THEN
2816
ONEERRROW = SMUMPS_ERRSCA1(ROWSCA,
2886
ONEERRROW = SMUMPS_738(ROWSCA,
2817
2887
& WRKRC(ITDRPTR), M)
2818
ONEERRCOL = SMUMPS_ERRSCA1(COLSCA,
2888
ONEERRCOL = SMUMPS_738(COLSCA,
2819
2889
& WRKRC(ITDCPTR), N)
2820
2890
ONEERRL = ONEERRCOL
2821
2891
IF(ONEERRROW > ONEERRL) THEN
2912
2982
& SMUMPS_673,
2913
2983
& SMUMPS_692,
2914
2984
& SMUMPS_663,
2915
& SMUMPS_CHKCONVGLOSYM,
2916
& SMUMPS_CHK1CONV,
2985
& SMUMPS_742,
2986
& SMUMPS_745,
2917
2987
& SMUMPS_661,
2918
2988
& SMUMPS_657,
2919
2989
& SMUMPS_656,
2920
2990
& SMUMPS_670,
2921
2991
& SMUMPS_671
2922
INTEGER SMUMPS_CHKCONVGLOSYM
2923
INTEGER SMUMPS_CHK1CONV
2924
REAL SMUMPS_ERRSCALOC
2925
REAL SMUMPS_ERRSCA1
2992
INTEGER SMUMPS_742
2993
INTEGER SMUMPS_745
2994
REAL SMUMPS_737
2995
REAL SMUMPS_738
2926
2996
INTRINSIC abs
2927
2997
REAL RONE, RZERO
2928
2998
PARAMETER(RONE=1.0E0,RZERO=0.0E0)
3077
3147
& (ITER.EQ.NB1).OR.
3078
3148
& ((ITER.EQ.NB1+NB2+NB3).AND.
3079
3149
& (NB1+NB3.GT.0))) THEN
3080
INFERRL = SMUMPS_ERRSCALOC(SCA,
3150
INFERRL = SMUMPS_737(SCA,
3081
3151
& WRKRC(ITDRPTR), N,
3082
3152
& IWRK(IMYRPTR),INUMMYR)
3083
3153
CALL MPI_ALLREDUCE(INFERRL, INFERRG,
3099
3169
& (ITER.EQ.NB1).OR.
3100
3170
& ((ITER.EQ.NB1+NB2+NB3).AND.
3101
3171
& (NB1+NB3.GT.0))) THEN
3102
INFERRL = SMUMPS_ERRSCA1(SCA,
3172
INFERRL = SMUMPS_738(SCA,
3103
3173
& WRKRC(ITDRPTR), N)
3104
3174
INFERRG = INFERRL
3105
3175
IF(INFERRG.LE.EPS) THEN
3106
CALL SMUMPS_666(SCA, WRKRC(ITDRPTR), N)
3176
CALL SMUMPS_666(SCA, WRKRC(ITDRPTR), N)
3107
3177
IF(ITER .LE. NB1) THEN
3108
3178
ITER = NB1+1
3109
3179
CYCLE
3155
3225
IF((EPS .GT. RZERO) .OR.
3156
3226
& ((ITER.EQ.NB1+NB2).AND.
3157
3227
& (NB2.GT.0))) THEN
3158
ONEERRL = SMUMPS_ERRSCALOC(SCA,
3228
ONEERRL = SMUMPS_737(SCA,
3159
3229
& WRKRC(ITDRPTR), N,
3160
3230
& IWRK(IMYRPTR),INUMMYR)
3161
3231
CALL MPI_ALLREDUCE(ONEERRL, ONEERRG,
3172
3242
IF((EPS .GT. RZERO) .OR.
3173
3243
& ((ITER.EQ.NB1+NB2).AND.
3174
3244
& (NB2.GT.0))) THEN
3175
ONEERRL = SMUMPS_ERRSCA1(SCA,
3245
ONEERRL = SMUMPS_738(SCA,
3176
3246
& WRKRC(ITDRPTR), N)
3177
3247
ONEERRG = ONEERRL
3178
3248
IF(ONEERRG.LE.EPS) THEN
3364
3434
ENDDO
3365
3435
RETURN
3366
3436
END SUBROUTINE SMUMPS_660
3367
INTEGER FUNCTION SMUMPS_CHK1LOC(D, DSZ, INDX, INDXSZ, EPS)
3437
INTEGER FUNCTION SMUMPS_744(D, DSZ, INDX, INDXSZ, EPS)
3368
3438
IMPLICIT NONE
3369
3439
INTEGER DSZ, INDXSZ
3370
3440
REAL D(DSZ)
3373
3443
INTEGER I, IID
3374
3444
REAL RONE
3375
3445
PARAMETER(RONE=1.0E0)
3376
SMUMPS_CHK1LOC = 1
3446
SMUMPS_744 = 1
3377
3447
DO I=1, INDXSZ
3378
3448
IID = INDX(I)
3379
3449
IF (.NOT.( (D(IID).LE.(RONE+EPS)).AND.
3380
3450
& ((RONE-EPS).LE.D(IID)) )) THEN
3381
SMUMPS_CHK1LOC = 0
3451
SMUMPS_744 = 0
3382
3452
ENDIF
3383
3453
ENDDO
3384
3454
RETURN
3385
END FUNCTION SMUMPS_CHK1LOC
3386
INTEGER FUNCTION SMUMPS_CHK1CONV(D, DSZ, EPS)
3455
END FUNCTION SMUMPS_744
3456
INTEGER FUNCTION SMUMPS_745(D, DSZ, EPS)
3387
3457
IMPLICIT NONE
3388
3458
INTEGER DSZ
3389
3459
REAL D(DSZ)
3391
3461
INTEGER I
3392
3462
REAL RONE
3393
3463
PARAMETER(RONE=1.0E0)
3394
SMUMPS_CHK1CONV = 1
3464
SMUMPS_745 = 1
3395
3465
DO I=1, DSZ
3396
3466
IF (.NOT.( (D(I).LE.(RONE+EPS)).AND.
3397
3467
& ((RONE-EPS).LE.D(I)) )) THEN
3398
SMUMPS_CHK1CONV = 0
3468
SMUMPS_745 = 0
3399
3469
ENDIF
3400
3470
ENDDO
3401
3471
RETURN
3402
END FUNCTION SMUMPS_CHK1CONV
3403
INTEGER FUNCTION SMUMPS_CHKCONVGLO(DR, M, INDXR, INDXRSZ,
3472
END FUNCTION SMUMPS_745
3473
INTEGER FUNCTION SMUMPS_743(DR, M, INDXR, INDXRSZ,
3404
3474
& DC, N, INDXC, INDXCSZ, EPS, COMM)
3405
3475
IMPLICIT NONE
3406
3476
INCLUDE 'mpif.h'
3409
3479
INTEGER INDXR(INDXRSZ), INDXC(INDXCSZ)
3410
3480
REAL EPS
3411
3481
INTEGER COMM
3412
EXTERNAL SMUMPS_CHK1LOC
3413
INTEGER SMUMPS_CHK1LOC
3482
EXTERNAL SMUMPS_744
3483
INTEGER SMUMPS_744
3414
3484
INTEGER GLORES, MYRESR, MYRESC, MYRES
3415
3485
INTEGER IERR
3416
MYRESR = SMUMPS_CHK1LOC(DR, M, INDXR, INDXRSZ, EPS)
3417
MYRESC = SMUMPS_CHK1LOC(DC, N, INDXC, INDXCSZ, EPS)
3486
MYRESR = SMUMPS_744(DR, M, INDXR, INDXRSZ, EPS)
3487
MYRESC = SMUMPS_744(DC, N, INDXC, INDXCSZ, EPS)
3418
3488
MYRES = MYRESR + MYRESC
3419
3489
CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER,
3420
3490
& MPI_SUM, COMM, IERR)
3421
SMUMPS_CHKCONVGLO = GLORES
3491
SMUMPS_743 = GLORES
3422
3492
RETURN
3423
END FUNCTION SMUMPS_CHKCONVGLO
3424
REAL FUNCTION SMUMPS_ERRSCALOC(D, TMPD, DSZ,
3493
END FUNCTION SMUMPS_743
3494
REAL FUNCTION SMUMPS_737(D, TMPD, DSZ,
3425
3495
& INDX, INDXSZ)
3426
3496
IMPLICIT NONE
3427
3497
INTEGER DSZ, INDXSZ
3440
3510
ERRMAX = abs(RONE-TMPD(IIND))
3441
3511
ENDIF
3442
3512
ENDDO
3443
SMUMPS_ERRSCALOC = ERRMAX
3513
SMUMPS_737 = ERRMAX
3444
3514
RETURN
3445
END FUNCTION SMUMPS_ERRSCALOC
3446
REAL FUNCTION SMUMPS_ERRSCA1(D, TMPD, DSZ)
3515
END FUNCTION SMUMPS_737
3516
REAL FUNCTION SMUMPS_738(D, TMPD, DSZ)
3447
3517
IMPLICIT NONE
3448
3518
INTEGER DSZ
3449
3519
REAL D(DSZ)
3459
3529
ERRMAX1 = abs(RONE-TMPD(I))
3460
3530
ENDIF
3461
3531
ENDDO
3462
SMUMPS_ERRSCA1 = ERRMAX1
3532
SMUMPS_738 = ERRMAX1
3463
3533
RETURN
3464
END FUNCTION SMUMPS_ERRSCA1
3534
END FUNCTION SMUMPS_738
3465
3535
SUBROUTINE SMUMPS_665(D, TMPD, DSZ,
3466
3536
& INDX, INDXSZ)
3467
3537
IMPLICIT NONE
4116
4186
ENDDO
4117
4187
RETURN
4118
4188
END SUBROUTINE SMUMPS_663
4119
INTEGER FUNCTION SMUMPS_CHKCONVGLOSYM(D, N, INDXR, INDXRSZ,
4189
INTEGER FUNCTION SMUMPS_742(D, N, INDXR, INDXRSZ,
4120
4190
& EPS, COMM)
4121
4191
IMPLICIT NONE
4122
4192
INCLUDE 'mpif.h'
4125
4195
INTEGER INDXR(INDXRSZ)
4126
4196
REAL EPS
4127
4197
INTEGER COMM
4128
EXTERNAL SMUMPS_CHK1LOC
4129
INTEGER SMUMPS_CHK1LOC
4198
EXTERNAL SMUMPS_744
4199
INTEGER SMUMPS_744
4130
4200
INTEGER GLORES, MYRESR, MYRESC, MYRES
4131
4201
INTEGER IERR
4132
MYRESR = SMUMPS_CHK1LOC(D, N, INDXR, INDXRSZ, EPS)
4202
MYRESR = SMUMPS_744(D, N, INDXR, INDXRSZ, EPS)
4133
4203
MYRES = 2*MYRESR
4134
4204
CALL MPI_ALLREDUCE(MYRES, GLORES, 1, MPI_INTEGER,
4135
4205
& MPI_SUM, COMM, IERR)
4136
SMUMPS_CHKCONVGLOSYM = GLORES
4206
SMUMPS_742 = GLORES
4137
4207
RETURN
4138
END FUNCTION SMUMPS_CHKCONVGLOSYM
4208
END FUNCTION SMUMPS_742
4139
4209
SUBROUTINE SMUMPS_661(MYID, NUMPROCS,COMM,
4140
4210
& IRN_loc, JCN_loc, NZ_loc,
4141
4211
& PARTVEC, N,
4277
4347
SUBROUTINE SMUMPS_628(IW,LREC,SIZE_FREE,XSIZE)
4278
4348
INTEGER, intent(in) :: LREC, XSIZE
4279
4349
INTEGER, intent(in) :: IW(LREC)
4280
INTEGER, intent(out):: SIZE_FREE
4350
INTEGER(8), intent(out):: SIZE_FREE
4281
4351
INCLUDE 'mumps_headers.h'
4282
4352
IF (IW(1+XXS).EQ.S_NOLCBCONTIG .OR.
4283
* IW(1+XXS).EQ.S_NOLCBNOCONTIG) THEN
4284
SIZE_FREE=IW(1+XSIZE+2)*IW(1+XSIZE+3)
4353
& IW(1+XXS).EQ.S_NOLCBNOCONTIG) THEN
4354
SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE+3),8)
4285
4355
ELSE IF (IW(1+XXS).EQ.S_NOLCBCONTIG38 .OR.
4286
* IW(1+XXS).EQ.S_NOLCBNOCONTIG38) THEN
4287
SIZE_FREE=IW(1+XSIZE+2)*(IW(1+XSIZE)+
4288
* IW(1+XSIZE + 3) -
4289
* ( IW(1+XSIZE + 4)
4290
* - IW(1+XSIZE + 3) ) )
4356
& IW(1+XXS).EQ.S_NOLCBNOCONTIG38) THEN
4357
SIZE_FREE=int(IW(1+XSIZE+2),8)*int(IW(1+XSIZE)+
4358
& IW(1+XSIZE + 3) -
4359
& ( IW(1+XSIZE + 4)
4360
& - IW(1+XSIZE + 3) ), 8)
4291
4361
ELSE
4292
SIZE_FREE=0
4362
SIZE_FREE=0_8
4293
4363
ENDIF
4294
4364
RETURN
4295
4365
END SUBROUTINE SMUMPS_628
4296
4366
SUBROUTINE SMUMPS_629
4297
*(IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT)
4367
&(IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT)
4298
4368
IMPLICIT NONE
4299
4369
INCLUDE 'mumps_headers.h'
4300
INTEGER LIW,IXXP,ICURRENT,NEXT,RCURRENT,ISIZE2SHIFT
4370
INTEGER(8) :: RCURRENT
4371
INTEGER LIW,IXXP,ICURRENT,NEXT,ISIZE2SHIFT
4301
4372
INTEGER IW(LIW)
4373
INTEGER(8) :: RSIZE
4302
4374
ICURRENT=NEXT
4303
RCURRENT=RCURRENT-IW(ICURRENT+XXR)
4375
CALL MUMPS_729( RSIZE, IW(ICURRENT + XXR) )
4376
RCURRENT = RCURRENT - RSIZE
4304
4377
NEXT=IW(ICURRENT+XXP)
4305
4378
IW(IXXP)=ICURRENT+ISIZE2SHIFT
4306
4379
IXXP=ICURRENT+XXP
4324
4397
END SUBROUTINE SMUMPS_630
4325
4398
SUBROUTINE SMUMPS_631(A, LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT)
4326
4399
IMPLICIT NONE
4327
INTEGER LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT
4400
INTEGER(8) :: LA, BEG2SHIFT, END2SHIFT, RSIZE2SHIFT
4328
4401
REAL A(LA)
4329
INTEGER I
4330
IF (RSIZE2SHIFT.GT.0) THEN
4331
DO I=END2SHIFT,BEG2SHIFT,-1
4402
INTEGER(8) :: I
4403
IF (RSIZE2SHIFT.GT.0_8) THEN
4404
DO I=END2SHIFT,BEG2SHIFT,-1_8
4332
4405
A(I+RSIZE2SHIFT)=A(I)
4333
4406
ENDDO
4334
ELSE IF (RSIZE2SHIFT.LT.0) THEN
4407
ELSE IF (RSIZE2SHIFT.LT.0_8) THEN
4335
4408
DO I=BEG2SHIFT,END2SHIFT
4336
4409
A(I+RSIZE2SHIFT)=A(I)
4337
4410
ENDDO
4339
4412
RETURN
4340
4413
END SUBROUTINE SMUMPS_631
4341
4414
SUBROUTINE SMUMPS_94(N,KEEP28,IW,LIW,A,LA,
4342
* LRLU,IPTRLU,IWPOS,
4343
* IWPOSCB,PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, ITLOC,
4344
* KEEP216,LRLUS,XSIZE)
4415
& LRLU,IPTRLU,IWPOS,
4416
& IWPOSCB,PTRIST,PTRAST,STEP,PIMASTER,PAMASTER, ITLOC,
4417
& KEEP216,LRLUS,XSIZE)
4345
4418
IMPLICIT NONE
4346
INTEGER N,LIW,LA,LRLU,KEEP28,
4347
& IPTRLU,IWPOS,IWPOSCB,KEEP216,XSIZE
4348
INTEGER, intent(IN):: LRLUS
4349
INTEGER IW(LIW),PTRIST(KEEP28),PTRAST(KEEP28),
4419
INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS
4420
INTEGER N,LIW,KEEP28,
4421
& IWPOS,IWPOSCB,KEEP216,XSIZE
4422
INTEGER(8) :: PTRAST(KEEP28), PAMASTER(KEEP28)
4423
INTEGER IW(LIW),PTRIST(KEEP28),
4350
4424
& STEP(N),
4351
* PIMASTER(KEEP28),
4352
* PAMASTER(KEEP28), ITLOC(N)
4425
& PIMASTER(KEEP28),
4426
& ITLOC(N)
4353
4427
REAL A(LA)
4354
4428
INCLUDE 'mumps_headers.h'
4355
INTEGER ICURRENT, NEXT, RCURRENT, STATE_NEXT
4356
INTEGER ISIZE2SHIFT, RSIZE2SHIFT
4357
INTEGER IBEGCONTIG, RBEGCONTIG
4429
INTEGER ICURRENT, NEXT, STATE_NEXT
4430
INTEGER(8) :: RCURRENT
4431
INTEGER ISIZE2SHIFT
4432
INTEGER(8) :: RSIZE2SHIFT
4433
INTEGER IBEGCONTIG
4434
INTEGER(8) :: RBEGCONTIG
4435
INTEGER(8) :: RBEG2SHIFT, REND2SHIFT
4358
4436
INTEGER INODE
4359
INTEGER FREE_IN_REC
4437
INTEGER(8) :: FREE_IN_REC
4438
INTEGER(8) :: RCURRENT_SIZE
4360
4439
INTEGER IXXP
4361
4440
ISIZE2SHIFT=0
4362
RSIZE2SHIFT=0
4441
RSIZE2SHIFT=0_8
4363
4442
ICURRENT = LIW-XSIZE+1
4364
RCURRENT = LA+1
4443
RCURRENT = LA+1_8
4365
4444
IBEGCONTIG = -999999
4366
RBEGCONTIG = -999999
4445
RBEGCONTIG = -999999_8
4367
4446
NEXT = IW(ICURRENT+XXP)
4368
4447
IF (NEXT.EQ.TOP_OF_STACK) RETURN
4369
4448
STATE_NEXT = IW(NEXT+XXS)
4370
4449
IXXP = ICURRENT+XXP
4371
4450
10 CONTINUE
4372
4451
IF ( STATE_NEXT .NE. S_FREE .AND.
4373
* (KEEP216.EQ.3.OR.
4374
* (STATE_NEXT .NE. S_NOLCBNOCONTIG .AND.
4375
* STATE_NEXT .NE. S_NOLCBCONTIG .AND.
4376
* STATE_NEXT .NE. S_NOLCBNOCONTIG38 .AND.
4377
* STATE_NEXT .NE. S_NOLCBCONTIG38))) THEN
4452
& (KEEP216.EQ.3.OR.
4453
& (STATE_NEXT .NE. S_NOLCBNOCONTIG .AND.
4454
& STATE_NEXT .NE. S_NOLCBCONTIG .AND.
4455
& STATE_NEXT .NE. S_NOLCBNOCONTIG38 .AND.
4456
& STATE_NEXT .NE. S_NOLCBCONTIG38))) THEN
4378
4457
CALL SMUMPS_629(IW,LIW,
4379
* IXXP, ICURRENT, NEXT, RCURRENT, ISIZE2SHIFT)
4458
& IXXP, ICURRENT, NEXT, RCURRENT, ISIZE2SHIFT)
4459
CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR))
4380
4460
IF (IBEGCONTIG < 0) THEN
4381
4461
IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1
4382
4462
ENDIF
4383
IF (RBEGCONTIG < 0) THEN
4384
RBEGCONTIG=RCURRENT+IW(ICURRENT+XXR)-1
4463
IF (RBEGCONTIG < 0_8) THEN
4464
RBEGCONTIG=RCURRENT+RCURRENT_SIZE-1_8
4385
4465
ENDIF
4386
4466
INODE=IW(ICURRENT+XXN)
4387
IF (RSIZE2SHIFT .NE. 0) THEN
4467
IF (RSIZE2SHIFT .NE. 0_8) THEN
4388
4468
IF (PTRAST(STEP(INODE)).EQ.RCURRENT)
4389
* PTRAST(STEP(INODE))=
4390
* PTRAST(STEP(INODE))+RSIZE2SHIFT
4469
& PTRAST(STEP(INODE))=
4470
& PTRAST(STEP(INODE))+RSIZE2SHIFT
4391
4471
IF (PAMASTER(STEP(INODE)).EQ.RCURRENT)
4392
* PAMASTER(STEP(INODE))=
4393
* PAMASTER(STEP(INODE))+RSIZE2SHIFT
4472
& PAMASTER(STEP(INODE))=
4473
& PAMASTER(STEP(INODE))+RSIZE2SHIFT
4394
4474
ENDIF
4395
4475
IF (ISIZE2SHIFT .NE. 0) THEN
4396
4476
IF (PTRIST(STEP(INODE)).EQ.ICURRENT)
4397
* PTRIST(STEP(INODE))=
4398
* PTRIST(STEP(INODE))+ISIZE2SHIFT
4477
& PTRIST(STEP(INODE))=
4478
& PTRIST(STEP(INODE))+ISIZE2SHIFT
4399
4479
IF (PIMASTER(STEP(INODE)).EQ.ICURRENT)
4400
* PIMASTER(STEP(INODE))=
4401
* PIMASTER(STEP(INODE))+ISIZE2SHIFT
4480
& PIMASTER(STEP(INODE))=
4481
& PIMASTER(STEP(INODE))+ISIZE2SHIFT
4402
4482
ENDIF
4403
4483
IF (NEXT .NE. TOP_OF_STACK) THEN
4404
4484
STATE_NEXT=IW(NEXT+XXS)
4414
4494
ENDIF
4415
4495
IBEGCONTIG=-9999
4416
4496
25 CONTINUE
4417
IF (RBEGCONTIG .GT.0 .AND. RSIZE2SHIFT .NE. 0) THEN
4497
IF (RBEGCONTIG .GT.0_8 .AND. RSIZE2SHIFT .NE. 0_8) THEN
4418
4498
CALL SMUMPS_631(A,LA,RCURRENT,RBEGCONTIG,RSIZE2SHIFT)
4419
4499
ENDIF
4420
RBEGCONTIG=-99999
4500
RBEGCONTIG=-99999_8
4421
4501
30 CONTINUE
4422
4502
IF (NEXT.EQ. TOP_OF_STACK) GOTO 100
4423
4503
IF (STATE_NEXT .EQ. S_NOLCBCONTIG .OR.
4424
* STATE_NEXT .EQ. S_NOLCBNOCONTIG .OR.
4425
* STATE_NEXT .EQ. S_NOLCBCONTIG38 .OR.
4426
* STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN
4504
& STATE_NEXT .EQ. S_NOLCBNOCONTIG .OR.
4505
& STATE_NEXT .EQ. S_NOLCBCONTIG38 .OR.
4506
& STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN
4427
4507
IF ( KEEP216.eq.3) THEN
4428
4508
WRITE(*,*) "Internal error 2 in SMUMPS_94"
4429
4509
ENDIF
4430
IF (RBEGCONTIG > 0) GOTO 25
4510
IF (RBEGCONTIG > 0_8) GOTO 25
4431
4511
CALL SMUMPS_629
4432
* (IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT)
4512
& (IW,LIW,IXXP,ICURRENT,NEXT, RCURRENT,ISIZE2SHIFT)
4433
4513
IF (IBEGCONTIG < 0 ) THEN
4434
4514
IBEGCONTIG=ICURRENT+IW(ICURRENT+XXI)-1
4435
4515
ENDIF
4436
4516
CALL SMUMPS_628(IW(ICURRENT),
4437
* LIW-ICURRENT+1,
4438
* FREE_IN_REC,
4439
* XSIZE)
4517
& LIW-ICURRENT+1,
4518
& FREE_IN_REC,
4519
& XSIZE)
4440
4520
IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG) THEN
4441
4521
CALL SMUMPS_627(A,LA,RCURRENT,
4442
* IW(ICURRENT+XSIZE+2),
4443
* IW(ICURRENT+XSIZE),
4444
* IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), 0,
4445
* IW(ICURRENT+XXS),RSIZE2SHIFT)
4522
& IW(ICURRENT+XSIZE+2),
4523
& IW(ICURRENT+XSIZE),
4524
& IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3), 0,
4525
& IW(ICURRENT+XXS),RSIZE2SHIFT)
4446
4526
ELSE IF (STATE_NEXT .EQ. S_NOLCBNOCONTIG38) THEN
4447
4527
CALL SMUMPS_627(A,LA,RCURRENT,
4448
* IW(ICURRENT+XSIZE+2),
4449
* IW(ICURRENT+XSIZE),
4450
* IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3),
4451
* IW(ICURRENT+XSIZE+4)-IW(ICURRENT+XSIZE+3),
4452
* IW(ICURRENT+XXS),RSIZE2SHIFT)
4453
ELSE IF (RSIZE2SHIFT .GT.0) THEN
4454
CALL SMUMPS_631(A, LA, RCURRENT+FREE_IN_REC,
4455
* RCURRENT+IW(ICURRENT+XXR)-1,
4456
* RSIZE2SHIFT)
4528
& IW(ICURRENT+XSIZE+2),
4529
& IW(ICURRENT+XSIZE),
4530
& IW(ICURRENT+XSIZE)+IW(ICURRENT+XSIZE+3),
4531
& IW(ICURRENT+XSIZE+4)-IW(ICURRENT+XSIZE+3),
4532
& IW(ICURRENT+XXS),RSIZE2SHIFT)
4533
ELSE IF (RSIZE2SHIFT .GT.0_8) THEN
4534
RBEG2SHIFT = RCURRENT + FREE_IN_REC
4535
CALL MUMPS_729(RCURRENT_SIZE, IW(ICURRENT+XXR))
4536
REND2SHIFT = RCURRENT + RCURRENT_SIZE - 1_8
4537
CALL SMUMPS_631(A, LA,
4538
& RBEG2SHIFT, REND2SHIFT,
4539
& RSIZE2SHIFT)
4457
4540
ENDIF
4458
4541
INODE=IW(ICURRENT+XXN)
4459
4542
IF (ISIZE2SHIFT.NE.0) THEN
4460
4543
PTRIST(STEP(INODE))=PTRIST(STEP(INODE))+ISIZE2SHIFT
4461
4544
ENDIF
4462
4545
PTRAST(STEP(INODE))=PTRAST(STEP(INODE))+RSIZE2SHIFT+
4463
* FREE_IN_REC
4464
IW(ICURRENT+XXR)=IW(ICURRENT+XXR)-FREE_IN_REC
4546
& FREE_IN_REC
4547
CALL MUMPS_724(IW(ICURRENT+XXR),FREE_IN_REC)
4465
4548
IF (STATE_NEXT.EQ.S_NOLCBCONTIG.OR.
4466
* STATE_NEXT.EQ.S_NOLCBNOCONTIG) THEN
4549
& STATE_NEXT.EQ.S_NOLCBNOCONTIG) THEN
4467
4550
IW(ICURRENT+XXS)=S_NOLCLEANED
4468
4551
ELSE
4469
4552
IW(ICURRENT+XXS)=S_NOLCLEANED38
4470
4553
ENDIF
4471
4554
RSIZE2SHIFT=RSIZE2SHIFT+FREE_IN_REC
4472
RBEGCONTIG=-9999
4555
RBEGCONTIG=-9999_8
4473
4556
IF (NEXT.EQ.TOP_OF_STACK) THEN
4474
4557
GOTO 20
4475
4558
ELSE
4482
4565
ENDIF
4483
4566
40 CONTINUE
4484
4567
IF (STATE_NEXT == S_FREE) THEN
4485
ICURRENT=NEXT
4486
RCURRENT=RCURRENT-IW(ICURRENT+XXR)
4487
ISIZE2SHIFT = ISIZE2SHIFT+IW(ICURRENT+XXI)
4488
RSIZE2SHIFT = RSIZE2SHIFT+IW(ICURRENT+XXR)
4568
ICURRENT = NEXT
4569
CALL MUMPS_729( RCURRENT_SIZE, IW(ICURRENT + XXR) )
4570
ISIZE2SHIFT = ISIZE2SHIFT + IW(ICURRENT+XXI)
4571
RSIZE2SHIFT = RSIZE2SHIFT + RCURRENT_SIZE
4572
RCURRENT = RCURRENT - RCURRENT_SIZE
4489
4573
NEXT=IW(ICURRENT+XXP)
4490
4574
IF (NEXT.EQ.TOP_OF_STACK) THEN
4491
4575
WRITE(*,*) "Internal error 1 in SMUMPS_94"
4502
4586
RETURN
4503
4587
END SUBROUTINE SMUMPS_94
4504
4588
SUBROUTINE SMUMPS_632(IREC, IW, LIW,
4505
* ISIZEHOLE, RSIZEHOLE)
4589
& ISIZEHOLE, RSIZEHOLE)
4506
4590
IMPLICIT NONE
4507
4591
INTEGER, intent(in) :: IREC, LIW
4508
4592
INTEGER, intent(in) :: IW(LIW)
4509
INTEGER, intent(out):: ISIZEHOLE, RSIZEHOLE
4593
INTEGER, intent(out):: ISIZEHOLE
4594
INTEGER(8), intent(out) :: RSIZEHOLE
4510
4595
INTEGER IRECLOC
4596
INTEGER(8) :: RECLOC_SIZE
4511
4597
INCLUDE 'mumps_headers.h'
4512
4598
ISIZEHOLE=0
4513
RSIZEHOLE=0
4599
RSIZEHOLE=0_8
4514
4600
IRECLOC = IREC + IW( IREC+XXI )
4515
4601
10 CONTINUE
4602
CALL MUMPS_729(RECLOC_SIZE, IW(IRECLOC+XXR))
4516
4603
IF (IW(IRECLOC+XXS).EQ.S_FREE) THEN
4517
4604
ISIZEHOLE=ISIZEHOLE+IW(IRECLOC+XXI)
4518
RSIZEHOLE=RSIZEHOLE+IW(IRECLOC+XXR)
4605
RSIZEHOLE=RSIZEHOLE+RECLOC_SIZE
4519
4606
IRECLOC=IRECLOC+IW(IRECLOC+XXI)
4520
4607
GOTO 10
4521
4608
ENDIF
4522
4609
RETURN
4523
4610
END SUBROUTINE SMUMPS_632
4524
4611
SUBROUTINE SMUMPS_627(A, LA, RCURRENT,
4525
* NROW, NCB, LD, NELIM, NODESTATE, ISHIFT)
4612
& NROW, NCB, LD, NELIM, NODESTATE, ISHIFT)
4526
4613
IMPLICIT NONE
4527
4614
INCLUDE 'mumps_headers.h'
4528
4615
INTEGER LD, NROW, NCB, NELIM, NODESTATE
4529
INTEGER ISHIFT, LA, RCURRENT
4616
INTEGER(8) :: ISHIFT
4617
INTEGER(8) :: LA, RCURRENT
4530
4618
REAL A(LA)
4531
INTEGER I,J,IOLD,INEW
4619
INTEGER I,J
4620
INTEGER(8) :: IOLD,INEW
4532
4621
LOGICAL NELIM_ROOT
4533
4622
NELIM_ROOT=.TRUE.
4534
4623
IF (NODESTATE.EQ. S_NOLCBNOCONTIG) THEN
4539
4628
ENDIF
4540
4629
ELSE IF (NODESTATE .NE. S_NOLCBNOCONTIG38) THEN
4541
4630
WRITE(*,*) "Internal error 2 in SMUMPS_627"
4542
* ,NODESTATE
4631
& ,NODESTATE
4543
4632
CALL MUMPS_ABORT()
4544
4633
ENDIF
4545
IF (ISHIFT .LT.0) THEN
4634
IF (ISHIFT .LT.0_8) THEN
4546
4635
WRITE(*,*) "Internal error 3 in SMUMPS_627",ISHIFT
4547
4636
CALL MUMPS_ABORT()
4548
4637
ENDIF
4549
4638
IF (NELIM_ROOT) THEN
4550
IOLD=RCURRENT+LD*NROW-1-NCB+NELIM
4639
IOLD=RCURRENT+int(LD,8)*int(NROW,8)+int(NELIM-1-NCB,8)
4551
4640
ELSE
4552
IOLD = RCURRENT+LD*NROW-1
4641
IOLD = RCURRENT+int(LD,8)*int(NROW,8)-1_8
4553
4642
ENDIF
4554
INEW = RCURRENT+LD*NROW+ISHIFT-1
4643
INEW = RCURRENT+int(LD,8)*int(NROW,8)+ISHIFT-1_8
4555
4644
DO I = NROW, 1, -1
4556
IF (I.EQ.NROW .AND. ISHIFT.EQ.0.AND.
4557
* .NOT. NELIM_ROOT) THEN
4558
IOLD=IOLD-LD
4559
INEW=INEW-NCB
4645
IF (I.EQ.NROW .AND. ISHIFT.EQ.0_8.AND.
4646
& .NOT. NELIM_ROOT) THEN
4647
IOLD=IOLD-int(LD,8)
4648
INEW=INEW-int(NCB,8)
4560
4649
CYCLE
4561
4650
ENDIF
4562
4651
IF (NELIM_ROOT) THEN
4563
4652
DO J=1,NELIM
4564
A( INEW ) = A( IOLD - J + 1)
4565
INEW = INEW - 1
4653
A( INEW ) = A( IOLD + int(- J + 1,8))
4654
INEW = INEW - 1_8
4566
4655
ENDDO
4567
4656
ELSE
4568
4657
DO J=1, NCB
4569
A( INEW ) = A( IOLD - J + 1)
4570
INEW = INEW - 1
4658
A( INEW ) = A( IOLD + int(- J + 1, 8))
4659
INEW = INEW - 1_8
4571
4660
ENDDO
4572
4661
ENDIF
4573
IOLD = IOLD - LD
4662
IOLD = IOLD - int(LD,8)
4574
4663
ENDDO
4575
4664
IF (NELIM_ROOT) THEN
4576
4665
NODESTATE=S_NOLCBCONTIG38
4580
4669
RETURN
4581
4670
END SUBROUTINE SMUMPS_627
4582
4671
SUBROUTINE SMUMPS_700(BUFR,LBUFR,
4583
* LBUFR_BYTES,
4584
* root, N, IW, LIW, A, LA,
4585
* NBPROCFILS, LRLU, IPTRLU, IWPOS, IWPOSCB,
4586
* PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,
4587
* COMP, LRLUS, IPOOL, LPOOL, LEAF,
4588
* FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,
4589
* KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, ITLOC,
4590
* ND,PROCNODE_STEPS,SLAVEF )
4672
& LBUFR_BYTES,
4673
& root, N, IW, LIW, A, LA,
4674
& NBPROCFILS, LRLU, IPTRLU, IWPOS, IWPOSCB,
4675
& PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,
4676
& COMP, LRLUS, IPOOL, LPOOL, LEAF,
4677
& FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,
4678
& KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, ITLOC,
4679
& ND,PROCNODE_STEPS,SLAVEF )
4591
4680
USE SMUMPS_LOAD
4592
4681
USE SMUMPS_OOC
4593
4682
IMPLICIT NONE
4595
4684
TYPE (SMUMPS_ROOT_STRUC ) :: root
4596
4685
INTEGER KEEP( 500 )
4597
4686
INTEGER*8 KEEP8(150)
4598
INTEGER LBUFR, LBUFR_BYTES, N, LIW, LA, LRLU, IPTRLU,
4599
* IWPOS, IWPOSCB, COMP, COMM, COMM_LOAD, IFLAG,
4600
* IERROR, LRLUS
4687
INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS
4688
INTEGER(8) :: PAMASTER(KEEP(28))
4689
INTEGER(8) :: PTRAST(KEEP(28))
4690
INTEGER(8) :: PTRFAC(KEEP(28))
4691
INTEGER LBUFR, LBUFR_BYTES, N, LIW,
4692
& IWPOS, IWPOSCB, COMP, COMM, COMM_LOAD, IFLAG,
4693
& IERROR
4601
4694
INTEGER LPOOL, LEAF
4602
4695
INTEGER IPOOL( LEAF )
4603
INTEGER PTRIST(KEEP(28)), PTRAST(KEEP(28))
4604
INTEGER PTLUST_S(KEEP(28)), PTRFAC(KEEP(28))
4605
INTEGER STEP(N),
4606
* PIMASTER(KEEP(28)),
4607
* PAMASTER(KEEP(28)), ITLOC( N )
4696
INTEGER PTRIST(KEEP(28))
4697
INTEGER PTLUST_S(KEEP(28))
4698
INTEGER STEP(N), PIMASTER(KEEP(28)), ITLOC( N )
4608
4699
INTEGER BUFR( LBUFR_BYTES ), NBPROCFILS( KEEP(28) )
4609
4700
INTEGER IW( LIW )
4610
4701
INTEGER ND(KEEP(28)), PROCNODE_STEPS(KEEP(28)),SLAVEF
4615
4706
REAL DBLARR(max(1,KEEP(13)))
4616
4707
INCLUDE 'mpif.h'
4617
4708
INTEGER IERR
4618
INTEGER POSITION, LOCAL_M, LOCAL_N, POS_ROOT, LREQI, LREQA
4709
INTEGER POSITION, LOCAL_M, LOCAL_N, LREQI
4710
INTEGER(8) :: LREQA, POS_ROOT
4619
4711
INTEGER NROW_SON, NCOL_SON, IROOT, ISON
4620
4712
INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET
4621
4713
INCLUDE 'mumps_headers.h'
4622
4714
POSITION = 0
4623
4715
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4624
* ISON, 1, MPI_INTEGER, COMM, IERR )
4625
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4626
* NROW_SON, 1, MPI_INTEGER, COMM, IERR )
4627
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4628
* NCOL_SON, 1, MPI_INTEGER, COMM, IERR )
4629
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4630
* NBROWS_ALREADY_SENT, 1, MPI_INTEGER,
4631
* COMM, IERR )
4632
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4633
* NBROWS_PACKET, 1, MPI_INTEGER,
4634
* COMM, IERR )
4716
& ISON, 1, MPI_INTEGER, COMM, IERR )
4717
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4718
& NROW_SON, 1, MPI_INTEGER, COMM, IERR )
4719
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4720
& NCOL_SON, 1, MPI_INTEGER, COMM, IERR )
4721
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4722
& NBROWS_ALREADY_SENT, 1, MPI_INTEGER,
4723
& COMM, IERR )
4724
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4725
& NBROWS_PACKET, 1, MPI_INTEGER,
4726
& COMM, IERR )
4635
4727
IROOT = KEEP( 38 )
4636
4728
IF ( PTRIST( STEP(IROOT) ) .NE. 0 .OR.
4637
* PTLUST_S( STEP(IROOT)) .NE. 0 ) THEN
4729
& PTLUST_S( STEP(IROOT)) .NE. 0 ) THEN
4638
4730
IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NROW_SON .OR.
4639
* NROW_SON*NCOL_SON .EQ. 0)THEN
4731
& NROW_SON.EQ.0 .OR. NCOL_SON .EQ. 0)THEN
4640
4732
NBPROCFILS(STEP(IROOT)) = NBPROCFILS(STEP(IROOT))-1
4641
4733
IF ( NBPROCFILS( STEP(IROOT) ) .eq. 0 ) THEN
4642
4734
IF (KEEP(201).EQ.1) THEN
4645
4737
CALL SMUMPS_580(IERR)
4646
4738
ENDIF
4647
4739
CALL SMUMPS_507( N, IPOOL, LPOOL,
4648
* PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76),
4649
* KEEP(80), KEEP(47),
4650
* STEP, IROOT + N)
4740
& PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76),
4741
& KEEP(80), KEEP(47),
4742
& STEP, IROOT + N)
4651
4743
IF (KEEP(47) .GE. 3) THEN
4652
4744
CALL SMUMPS_500(
4653
$ IPOOL, LPOOL,
4654
* PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
4655
* MYID, STEP, N, ND, FILS )
4745
& IPOOL, LPOOL,
4746
& PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
4747
& MYID, STEP, N, ND, FILS )
4656
4748
ENDIF
4657
4749
ENDIF
4658
4750
ENDIF
4659
4751
ELSE
4660
4752
IF (NBROWS_ALREADY_SENT + NBROWS_PACKET .EQ. NROW_SON
4661
* .OR.
4662
* NROW_SON*NCOL_SON .EQ. 0)THEN
4753
& .OR.
4754
& NROW_SON*NCOL_SON .EQ. 0)THEN
4663
4755
NBPROCFILS(STEP( IROOT ) ) = -1
4664
4756
ENDIF
4665
4757
IF (KEEP(60) == 0) THEN
4666
4758
CALL SMUMPS_284( root, IROOT, N,
4667
* IW, LIW, A, LA,
4668
* FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,
4669
* LRLU, IPTRLU,
4670
* IWPOS, IWPOSCB, PTRIST, PTRAST,
4671
* STEP, PIMASTER, PAMASTER, ITLOC,
4672
* COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR )
4759
& IW, LIW, A, LA,
4760
& FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,
4761
& LRLU, IPTRLU,
4762
& IWPOS, IWPOSCB, PTRIST, PTRAST,
4763
& STEP, PIMASTER, PAMASTER, ITLOC,
4764
& COMP, LRLUS, IFLAG, KEEP,KEEP8, IERROR )
4673
4765
IF ( IFLAG .LT. 0 ) RETURN
4674
4766
ELSE
4675
4767
PTRIST(STEP(IROOT)) = -55555
4676
4768
ENDIF
4677
4769
END IF
4678
4770
LREQI = NBROWS_PACKET + NCOL_SON
4679
LREQA = NBROWS_PACKET * NCOL_SON
4680
IF ( (LREQA.NE.0) .AND.
4681
* (PTRIST(STEP(IROOT)).LT.0).AND.
4682
* KEEP(60)==0) THEN
4771
LREQA = int(NBROWS_PACKET,8) * int(NCOL_SON,8)
4772
IF ( (LREQA.NE.0_8) .AND.
4773
& (PTRIST(STEP(IROOT)).LT.0).AND.
4774
& KEEP(60)==0) THEN
4683
4775
WRITE(*,*) ' Error in SMUMPS_700'
4684
4776
CALL MUMPS_ABORT()
4685
4777
ENDIF
4686
IF (LREQA.NE.0) THEN
4687
CALL SMUMPS_22(.FALSE.,0,.FALSE.,.FALSE.,
4688
* MYID,N,KEEP,KEEP8,IW,LIW,A, LA,
4689
* LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST,
4690
* PTRAST, STEP, PIMASTER, PAMASTER, ITLOC,
4691
* LREQI, LREQA, -1234, S_NOTFREE, .FALSE.,
4692
* COMP, LRLUS, IFLAG, IERROR
4693
$ )
4778
IF (LREQA.NE.0_8) THEN
4779
CALL SMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE.,
4780
& MYID,N,KEEP,KEEP8,IW,LIW,A, LA,
4781
& LRLU, IPTRLU, IWPOS, IWPOSCB, PTRIST,
4782
& PTRAST, STEP, PIMASTER, PAMASTER, ITLOC,
4783
& LREQI, LREQA, -1234, S_NOTFREE, .FALSE.,
4784
& COMP, LRLUS, IFLAG, IERROR
4785
& )
4694
4786
IF ( IFLAG .LT. 0 ) RETURN
4695
4787
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4696
* IW( IWPOSCB + 1 ), LREQI,
4697
* MPI_INTEGER, COMM, IERR )
4788
& IW( IWPOSCB + 1 ), LREQI,
4789
& MPI_INTEGER, COMM, IERR )
4698
4790
CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,
4699
* A( IPTRLU + 1 ), LREQA,
4700
* MPI_REAL, COMM, IERR )
4791
& A( IPTRLU + 1_8 ), int(LREQA),
4792
& MPI_REAL, COMM, IERR )
4701
4793
IF (KEEP(60) .EQ.0) THEN
4702
4794
IF ( PTRIST(STEP(IROOT)) .NE. 0 ) THEN
4703
4795
LOCAL_N = -IW( PTRIST(STEP( IROOT )) + KEEP(IXSZ) )
4707
4799
LOCAL_N = IW( PTLUST_S(STEP( IROOT ) ) + 1 + KEEP(IXSZ))
4708
4800
LOCAL_M = IW( PTLUST_S(STEP( IROOT ) ) + 2 + KEEP(IXSZ))
4709
4801
POS_ROOT = PTRFAC(IW(PTLUST_S(STEP(IROOT))+4+
4710
* KEEP(IXSZ)))
4802
& KEEP(IXSZ)))
4711
4803
END IF
4712
4804
CALL SMUMPS_38( NBROWS_PACKET, NCOL_SON,
4713
* IW( IWPOSCB + 1 ),
4714
* IW( IWPOSCB + NBROWS_PACKET + 1 ),
4715
* A( IPTRLU + 1 ),
4716
* A( POS_ROOT ), LOCAL_M, LOCAL_N )
4805
& IW( IWPOSCB + 1 ),
4806
& IW( IWPOSCB + NBROWS_PACKET + 1 ),
4807
& A( IPTRLU + 1_8 ),
4808
& A( POS_ROOT ), LOCAL_M, LOCAL_N )
4717
4809
ELSE
4718
4810
CALL SMUMPS_38( NBROWS_PACKET, NCOL_SON,
4719
* IW( IWPOSCB + 1 ),
4720
* IW( IWPOSCB + NBROWS_PACKET + 1 ),
4721
* A( IPTRLU + 1 ),
4722
* root%SCHUR_POINTER(1),
4723
* root%SCHUR_LLD , root%SCHUR_NLOC)
4811
& IW( IWPOSCB + 1 ),
4812
& IW( IWPOSCB + NBROWS_PACKET + 1 ),
4813
& A( IPTRLU + 1_8 ),
4814
& root%SCHUR_POINTER(1),
4815
& root%SCHUR_LLD , root%SCHUR_NLOC)
4724
4816
ENDIF
4725
4817
IWPOSCB = IWPOSCB + LREQI
4726
4818
IPTRLU = IPTRLU + LREQA
4727
4819
LRLU = LRLU + LREQA
4728
4820
LRLUS = LRLUS + LREQA
4729
4821
CALL SMUMPS_471(.FALSE.,.FALSE.,
4730
* LA-LRLUS,0,-LREQA,KEEP,KEEP8,LRLU)
4822
& LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU)
4731
4823
ENDIF
4732
4824
RETURN
4733
4825
END SUBROUTINE SMUMPS_700
4734
4826
SUBROUTINE SMUMPS_224(NFRONT,NASS,IBEGKJI, LPIV, TIPIV,
4735
* N,INODE,IW,LIW,A,LA,
4736
* INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU,SEUIL,KEEP,KEEP8,
4737
* DKEEP,PIVNUL_LIST,LPN_LIST,
4738
* PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
4739
* PP_LastPIVRPTRFilled_L,
4740
* PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
4741
* PP_LastPIVRPTRFilled_U)
4827
& N,INODE,IW,LIW,A,LA,
4828
& INOPV,NOFFW,IFLAG,IOLDPS,POSELT,UU,SEUIL,KEEP,KEEP8,
4829
& DKEEP,PIVNUL_LIST,LPN_LIST,
4830
& PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
4831
& PP_LastPIVRPTRFilled_L,
4832
& PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
4833
& PP_LastPIVRPTRFilled_U)
4742
4834
IMPLICIT NONE
4743
4835
INTEGER IBEGKJI, LPIV
4744
4836
INTEGER TIPIV(LPIV)
4745
INTEGER NFRONT,NASS,N,LA,LIW,INODE,IFLAG,INOPV,NOFFW
4746
REAL A(LA)
4837
INTEGER(8) :: LA
4838
REAL A(LA)
4839
INTEGER NFRONT,NASS,N,LIW,INODE,IFLAG,INOPV,NOFFW
4747
4840
REAL UU, SEUIL
4748
4841
INTEGER IW(LIW)
4749
INTEGER IOLDPS, POSELT
4842
INTEGER IOLDPS
4843
INTEGER(8) :: POSELT
4750
4844
INTEGER KEEP(500)
4751
4845
INTEGER*8 KEEP8(150)
4752
4846
INTEGER LPN_LIST
4753
4847
INTEGER PIVNUL_LIST(LPN_LIST)
4754
4848
REAL DKEEP(30)
4755
4849
INTEGER PP_FIRST2SWAP_L, PP_LastPanelonDisk_L,
4756
* PP_LastPIVRPTRFilled_L,
4757
* PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
4758
* PP_LastPIVRPTRFilled_U
4850
& PP_LastPIVRPTRFilled_L,
4851
& PP_FIRST2SWAP_U, PP_LastPanelonDisk_U,
4852
& PP_LastPIVRPTRFilled_U
4759
4853
REAL SWOP
4760
INTEGER APOS,ILOC
4854
INTEGER(8) :: APOS, IDIAG
4855
INTEGER(8) :: J1, J2, JJ, J3_8
4856
INTEGER(8) :: NFRONT8
4857
INTEGER ILOC
4761
4858
REAL ZERO, RMAX, AMROW, ONE
4762
4859
INTEGER NPIV,NASSW,IPIV
4763
INTEGER NPIVP1,JMAX,J1,J3,JJ,J2,IDIAG,ISW,ISWPS1
4860
INTEGER NPIVP1,JMAX,J3,ISW,ISWPS1
4764
4861
INTEGER ISWPS2,KSW, HF
4765
4862
INCLUDE 'mumps_headers.h'
4766
4863
INTEGER SMUMPS_IXAMAX
4771
4868
INTEGER TYPEF_U, I_PIVRPTR_U, I_PIVR_U, NBPANELS_U
4772
4869
INTEGER XSIZE
4773
4870
PARAMETER (TYPEF_L=1, TYPEF_U=2)
4871
NFRONT8=int(NFRONT,8)
4774
4872
XSIZE = KEEP(IXSZ)
4775
4873
NPIV = IW(IOLDPS+1+XSIZE)
4776
4874
HF = 6 + IW(IOLDPS+5+XSIZE)+XSIZE
4777
4875
NPIVP1 = NPIV + 1
4778
4876
IF (KEEP(201).EQ.1) THEN
4779
4877
CALL SMUMPS_667(TYPEF_L, NBPANELS_L,
4780
* I_PIVRPTR_L, I_PIVR_L,
4781
* IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
4782
* IW, LIW)
4878
& I_PIVRPTR_L, I_PIVR_L,
4879
& IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
4880
& IW, LIW)
4783
4881
CALL SMUMPS_667(TYPEF_U, NBPANELS_U,
4784
* I_PIVRPTR_U, I_PIVR_U,
4785
* IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
4786
* IW, LIW)
4882
& I_PIVRPTR_U, I_PIVR_U,
4883
& IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE,
4884
& IW, LIW)
4787
4885
ENDIF
4788
4886
ILOC = NPIVP1 - IBEGKJI + 1
4789
4887
TIPIV(ILOC) = ILOC
4790
4888
NASSW = iabs(IW(IOLDPS+3+XSIZE))
4791
4889
IF(INOPV .EQ. -1) THEN
4792
APOS = POSELT + NFRONT*(NPIVP1-1) + NPIV
4890
APOS = POSELT + NFRONT8*int(NPIVP1-1,8) + int(NPIV,8)
4793
4891
IDIAG = APOS
4794
4892
IF(abs(A(APOS)).LT.SEUIL) THEN
4795
4893
IF(real(A(APOS)) .GE. ZERO) THEN
4796
A(APOS) = SEUIL
4894
A(APOS) = real(SEUIL)
4797
4895
ELSE
4798
A(APOS) = -SEUIL
4896
A(APOS) = real(-SEUIL)
4799
4897
ENDIF
4800
4898
KEEP(98) = KEEP(98)+1
4801
4899
ENDIF
4802
4900
IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN
4803
4901
CALL SMUMPS_680( IW(I_PIVRPTR_L),
4804
* NBPANELS_L,
4805
* IW(I_PIVR_L), NASS, NPIVP1, NPIVP1,
4806
* PP_LastPanelonDisk_L,
4807
* PP_LastPIVRPTRFilled_L)
4902
& NBPANELS_L,
4903
& IW(I_PIVR_L), NASS, NPIVP1, NPIVP1,
4904
& PP_LastPanelonDisk_L,
4905
& PP_LastPIVRPTRFilled_L)
4808
4906
CALL SMUMPS_680( IW(I_PIVRPTR_U),
4809
* NBPANELS_U,
4810
* IW(I_PIVR_U), NASS, NPIVP1, NPIVP1,
4811
* PP_LastPanelonDisk_U,
4812
* PP_LastPIVRPTRFilled_U)
4907
& NBPANELS_U,
4908
& IW(I_PIVR_U), NASS, NPIVP1, NPIVP1,
4909
& PP_LastPanelonDisk_U,
4910
& PP_LastPIVRPTRFilled_U)
4813
4911
ENDIF
4814
4912
GO TO 420
4815
4913
ENDIF
4816
4914
INOPV = 0
4817
4915
DO 460 IPIV=NPIVP1,NASSW
4818
APOS = POSELT + NFRONT*(IPIV-1) + NPIV
4916
APOS = POSELT + NFRONT8*int(IPIV-1,8) + int(NPIV,8)
4819
4917
JMAX = 1
4820
4918
IF (UU.GT.ZERO) GO TO 340
4821
IF (A(APOS).EQ.ZERO) GO TO 630
4919
IF (A(APOS).EQ.real(ZERO)) GO TO 630
4822
4920
GO TO 380
4823
4921
340 AMROW = ZERO
4824
4922
J1 = APOS
4825
J2 = APOS - NPIV + NASS - 1
4923
J2 = APOS +int(- NPIV + NASS - 1,8)
4826
4924
J3 = NASS -NPIV
4827
4925
JMAX = SMUMPS_IXAMAX(J3,A(J1),1)
4828
JJ = JMAX + J1 - 1
4926
JJ = int(JMAX,8) + J1 - 1_8
4829
4927
AMROW = abs(A(JJ))
4830
4928
RMAX = AMROW
4831
J1 = J2 + 1
4832
J2 = APOS - NPIV + NFRONT - 1
4929
J1 = J2 + 1_8
4930
J2 = APOS +int(- NPIV + NFRONT - 1,8)
4833
4931
IF (J2.LT.J1) GO TO 370
4834
4932
DO 360 JJ=J1,J2
4835
4933
RMAX = max(abs(A(JJ)),RMAX)
4836
4934
360 CONTINUE
4837
370 IDIAG = APOS + IPIV - NPIVP1
4935
370 IDIAG = APOS + int(IPIV - NPIVP1,8)
4838
4936
IF (RMAX.LE.DKEEP(1)) THEN
4839
4937
KEEP(109) = KEEP(109)+1
4840
4938
ISW = IOLDPS+IW(IOLDPS+1+KEEP(IXSZ))+6+KEEP(IXSZ)+
4842
4940
PIVNUL_LIST(KEEP(109)) = IW(ISW)
4843
4941
IF(DKEEP(2).GT.ZERO) THEN
4844
4942
IF(real(A(IDIAG)) .GE. ZERO) THEN
4845
A(IDIAG) = DKEEP(2)
4943
A(IDIAG) = real(DKEEP(2))
4846
4944
ELSE
4847
A(IDIAG) = -DKEEP(2)
4945
A(IDIAG) = real(-DKEEP(2))
4848
4946
ENDIF
4849
4947
ELSE
4850
4948
J1 = APOS
4851
J2 = APOS - NPIV + NFRONT - 1
4949
J2 = APOS +int(- NPIV + NFRONT - 1,8)
4852
4950
DO JJ=J1,J2
4853
4951
A(JJ)= real(ZERO)
4854
4952
ENDDO
4864
4962
IF (AMROW.LE.max(UU*RMAX,SEUIL)) GO TO 460
4865
4963
NOFFW = NOFFW + 1
4866
4964
380 IF (IPIV.EQ.NPIVP1) GO TO 400
4867
J1 = POSELT + NPIV*NFRONT
4868
J2 = J1 + NFRONT - 1
4869
J3 = POSELT + (IPIV-1)*NFRONT
4965
J1 = POSELT + int(NPIV,8)*NFRONT8
4966
J2 = J1 + NFRONT8 - 1_8
4967
J3_8 = POSELT + int(IPIV-1,8)*NFRONT8
4870
4968
DO 390 JJ=J1,J2
4871
4969
SWOP = A(JJ)
4872
A(JJ) = A(J3)
4873
A(J3) = SWOP
4874
J3 = J3 + 1
4970
A(JJ) = A(J3_8)
4971
A(J3_8) = SWOP
4972
J3_8 = J3_8 + 1_8
4875
4973
390 CONTINUE
4876
4974
ISWPS1 = IOLDPS + HF - 1 + NPIVP1
4877
4975
ISWPS2 = IOLDPS + HF - 1 + IPIV
4880
4978
IW(ISWPS2) = ISW
4881
4979
400 IF (JMAX.EQ.1) GO TO 420
4882
4980
TIPIV(ILOC) = ILOC + JMAX - 1
4883
J1 = POSELT + NPIV
4884
J2 = POSELT + NPIV + JMAX - 1
4981
J1 = POSELT + int(NPIV,8)
4982
J2 = POSELT + int(NPIV + JMAX - 1,8)
4885
4983
DO 410 KSW=1,NASS
4886
4984
SWOP = A(J1)
4887
4985
A(J1) = A(J2)
4888
4986
A(J2) = SWOP
4889
J1 = J1 + NFRONT
4890
J2 = J2 + NFRONT
4987
J1 = J1 + NFRONT8
4988
J2 = J2 + NFRONT8
4891
4989
410 CONTINUE
4892
4990
ISWPS1 = IOLDPS + HF - 1 + NFRONT + NPIV + 1
4893
4991
ISWPS2 = IOLDPS + HF - 1 + NFRONT + NPIV + JMAX
4909
5007
420 CONTINUE
4910
5008
IF (KEEP(201).EQ.1) THEN
4911
5009
CALL SMUMPS_680( IW(I_PIVRPTR_L),
4912
* NBPANELS_L,
4913
* IW(I_PIVR_L), NASS, NPIVP1, IPIV,
4914
* PP_LastPanelonDisk_L,
4915
* PP_LastPIVRPTRFilled_L)
5010
& NBPANELS_L,
5011
& IW(I_PIVR_L), NASS, NPIVP1, IPIV,
5012
& PP_LastPanelonDisk_L,
5013
& PP_LastPIVRPTRFilled_L)
4916
5014
CALL SMUMPS_680( IW(I_PIVRPTR_U),
4917
* NBPANELS_U,
4918
* IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX,
4919
* PP_LastPanelonDisk_U,
4920
* PP_LastPIVRPTRFilled_U)
5015
& NBPANELS_U,
5016
& IW(I_PIVR_U), NASS, NPIVP1, NPIV+JMAX,
5017
& PP_LastPanelonDisk_U,
5018
& PP_LastPIVRPTRFilled_U)
4921
5019
ENDIF
4922
5020
430 CONTINUE
4923
5021
RETURN
4924
5022
END SUBROUTINE SMUMPS_224
4925
5023
SUBROUTINE SMUMPS_294( COMM_LOAD, ASS_IRECV,
4926
* N, INODE, FPERE,
4927
* IW, LIW,
4928
* IOLDPS, POSELT, A, LA, LDA_FS,
4929
* IBEGKJI, IEND, TIPIV, LPIV, LASTBL, NB_BLOC_FAC,
4930
*
4931
* COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF,
4932
* IFLAG, IERROR, IPOOL,LPOOL,
4933
* SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
4934
* LRLUS, COMP,
4935
* PTRIST, PTRAST, PTLUST_S, PTRFAC,
4936
* STEP, PIMASTER, PAMASTER,
4937
* NSTK_S,NBPROCFILS,PROCNODE_STEPS, root,
4938
* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
4939
* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
4940
* LPTRAR, NELT, FRTPTR, FRTELT,
4941
* ISTEP_TO_INIV2, TAB_POS_IN_PERE )
5024
& N, INODE, FPERE,
5025
& IW, LIW,
5026
& IOLDPS, POSELT, A, LA, LDA_FS,
5027
& IBEGKJI, IEND, TIPIV, LPIV, LASTBL, NB_BLOC_FAC,
5028
&
5029
& COMM, MYID, BUFR, LBUFR,LBUFR_BYTES,NBFIN,LEAF,
5030
& IFLAG, IERROR, IPOOL,LPOOL,
5031
& SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
5032
& LRLUS, COMP,
5033
& PTRIST, PTRAST, PTLUST_S, PTRFAC,
5034
& STEP, PIMASTER, PAMASTER,
5035
& NSTK_S,NBPROCFILS,PROCNODE_STEPS, root,
5036
& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
5037
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
5038
& LPTRAR, NELT, FRTPTR, FRTELT,
5039
& ISTEP_TO_INIV2, TAB_POS_IN_PERE )
4942
5040
USE SMUMPS_COMM_BUFFER
4943
5041
USE SMUMPS_LOAD
4944
5042
IMPLICIT NONE
4947
5045
TYPE (SMUMPS_ROOT_STRUC) :: root
4948
5046
INTEGER COMM_LOAD, ASS_IRECV
4949
5047
INTEGER N, INODE, FPERE, LIW, IBEGKJI, IEND, LPIV,
4950
* IOLDPS, POSELT, LA, LDA_FS, NB_BLOC_FAC
5048
& IOLDPS, LDA_FS, NB_BLOC_FAC
5049
INTEGER(8) :: POSELT, LA
4951
5050
INTEGER IW(LIW), TIPIV(LPIV)
4952
5051
LOGICAL LASTBL
4953
5052
REAL A(LA)
4957
5056
INTEGER KEEP(500)
4958
5057
INTEGER*8 KEEP8(150)
4959
5058
INTEGER NBFIN, IFLAG, IERROR, LEAF, LPOOL,
4960
* SLAVEF, ICNTL(40)
4961
INTEGER POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS,
4962
* COMP
5059
& SLAVEF, ICNTL(40)
5060
INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS
5061
INTEGER IWPOS, IWPOSCB, COMP
4963
5062
INTEGER BUFR( LBUFR ), IPOOL(LPOOL),
4964
* ITLOC(N), FILS(N),
4965
* PTRARW(LPTRAR), PTRAIW(LPTRAR),
4966
* ND( KEEP(28) ), FRERE( KEEP(28) )
5063
& ITLOC(N), FILS(N),
5064
& PTRARW(LPTRAR), PTRAIW(LPTRAR),
5065
& ND( KEEP(28) ), FRERE( KEEP(28) )
4967
5066
INTEGER INTARR(max(1,KEEP(14)))
4968
INTEGER PTRIST(KEEP(28)), PTRAST(KEEP(28)), PTLUST_S(KEEP(28)),
4969
* PTRFAC(KEEP(28)),
4970
* STEP(N),
4971
* PIMASTER(KEEP(28)),
4972
* PAMASTER(KEEP(28)), NSTK_S(KEEP(28)),
4973
* NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28))
5067
INTEGER(8) :: PTRAST (KEEP(28))
5068
INTEGER(8) :: PTRFAC (KEEP(28))
5069
INTEGER(8) :: PAMASTER(KEEP(28))
5070
INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),
5071
& STEP(N), PIMASTER(KEEP(28)),
5072
& NSTK_S(KEEP(28)),
5073
& NBPROCFILS(KEEP(28)), PROCNODE_STEPS(KEEP(28))
4974
5074
INTEGER ISTEP_TO_INIV2(KEEP(71)),
4975
* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
5075
& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
4976
5076
DOUBLE PRECISION OPASSW, OPELIW
4977
5077
REAL DBLARR(max(1,KEEP(13)))
4978
5078
EXTERNAL SMUMPS_329
4979
5079
INCLUDE 'mumps_headers.h'
4980
INTEGER NPIV, NCOL, APOS, PDEST, NSLAVES
4981
INTEGER IERR, IERR_MPI, LREQA, LREQI
5080
INTEGER(8) :: APOS, LREQA
5081
INTEGER NPIV, NCOL, PDEST, NSLAVES
5082
INTEGER IERR, IERR_MPI, LREQI
4982
5083
INTEGER STATUS( MPI_STATUS_SIZE )
4983
5084
LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
4984
5085
DOUBLE PRECISION FLOP1,FLOP2
4989
5090
ENDIF
4990
5091
NPIV = IEND - IBEGKJI + 1
4991
5092
NCOL = LDA_FS - IBEGKJI + 1
4992
APOS = POSELT + LDA_FS*(IBEGKJI-1) + IBEGKJI - 1
5093
APOS = POSELT + int(LDA_FS,8)*int(IBEGKJI-1,8) +
5094
& int(IBEGKJI - 1,8)
4993
5095
IF (IBEGKJI > 0) THEN
4994
5096
CALL MUMPS_511( LDA_FS, IBEGKJI-1, LPIV,
4995
* KEEP(50),2,FLOP1)
5097
& KEEP(50),2,FLOP1)
4996
5098
ELSE
4997
FLOP1=0
5099
FLOP1=0.0D0
4998
5100
ENDIF
4999
5101
CALL MUMPS_511( LDA_FS, IEND, LPIV,
5000
* KEEP(50),2,FLOP2)
5102
& KEEP(50),2,FLOP2)
5001
5103
FLOP2 = FLOP1 - FLOP2
5002
5104
CALL SMUMPS_190(1, .FALSE., FLOP2, KEEP,KEEP8)
5003
5105
IF ((NPIV.GT.0) .OR.
5004
* ((NPIV.EQ.0).AND.(LASTBL)) ) THEN
5106
& ((NPIV.EQ.0).AND.(LASTBL)) ) THEN
5005
5107
PDEST = IOLDPS + 6 + KEEP(IXSZ)
5006
5108
IERR = -1
5007
5109
IF ( NPIV .NE. 0 ) THEN
5009
5111
END IF
5010
5112
DO WHILE (IERR .EQ.-1)
5011
5113
CALL SMUMPS_65( INODE, LDA_FS, NCOL,
5012
* NPIV, FPERE, LASTBL, TIPIV, A(APOS),
5013
* IW(PDEST), NSLAVES, KEEP(50), NB_BLOC_FAC,
5014
* COMM, IERR )
5114
& NPIV, FPERE, LASTBL, TIPIV, A(APOS),
5115
& IW(PDEST), NSLAVES, KEEP(50), NB_BLOC_FAC,
5116
& COMM, IERR )
5015
5117
IF (IERR.EQ.-1) THEN
5016
5118
BLOCKING = .FALSE.
5017
5119
SET_IRECV = .TRUE.
5018
5120
MESSAGE_RECEIVED = .FALSE.
5019
5121
CALL SMUMPS_329( COMM_LOAD, ASS_IRECV,
5020
* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
5021
* MPI_ANY_SOURCE, MPI_ANY_TAG,
5022
* STATUS, BUFR, LBUFR,
5023
* LBUFR_BYTES,
5024
* PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,
5025
* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
5026
* PTLUST_S, PTRFAC,
5027
* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,
5028
* IERROR, COMM,
5029
* NBPROCFILS,
5030
* IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
5031
* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
5032
* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
5033
* LPTRAR, NELT, FRTPTR, FRTELT,
5034
* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )
5122
& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
5123
& MPI_ANY_SOURCE, MPI_ANY_TAG,
5124
& STATUS, BUFR, LBUFR,
5125
& LBUFR_BYTES,
5126
& PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,
5127
& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
5128
& PTLUST_S, PTRFAC,
5129
& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,
5130
& IERROR, COMM,
5131
& NBPROCFILS,
5132
& IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
5133
& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,
5134
& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,
5135
& LPTRAR, NELT, FRTPTR, FRTELT,
5136
& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )
5035
5137
IF (MESSAGE_RECEIVED) POSELT = PTRAST(STEP(INODE))
5036
5138
IF ( IFLAG .LT. 0 ) GOTO 500
5037
5139
ENDIF
5039
5141
IF (IERR .EQ. -2 .OR. IERR.EQ.-3 ) THEN
5040
5142
IF (IERR.EQ.-2) IFLAG = -17
5041
5143
IF (IERR.EQ.-3) IFLAG = -20
5042
LREQA = NCOL*NPIV
5144
LREQA = int(NCOL,8)*int(NPIV,8)
5043
5145
LREQI = NPIV + 6 + 2*NSLAVES
5044
IERROR = LREQI * KEEP( 34 )+ LREQA * KEEP( 35 )
5146
CALL MUMPS_731(
5147
& int(LREQI,8) * int(KEEP(34),8) + LREQA * int(KEEP(35),8),
5148
& IERROR)
5045
5149
GOTO 300
5046
5150
ENDIF
5047
5151
ENDIF
5051
5155
500 RETURN
5052
5156
END SUBROUTINE SMUMPS_294
5053
5157
SUBROUTINE SMUMPS_273( ROOT,
5054
* INODE, NELIM, NSLAVES, ROW_LIST,
5055
* COL_LIST, SLAVE_LIST,
5056
*
5057
* PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU,
5058
* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
5059
* PTLUST_S, PTRFAC,
5060
* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, ITLOC, COMP,
5061
* IFLAG, IERROR,
5062
* IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8,
5063
* COMM,COMM_LOAD,FILS,ND )
5158
& INODE, NELIM, NSLAVES, ROW_LIST,
5159
& COL_LIST, SLAVE_LIST,
5160
&
5161
& PROCNODE_STEPS, IWPOS, IWPOSCB, IPTRLU,
5162
& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
5163
& PTLUST_S, PTRFAC,
5164
& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, ITLOC, COMP,
5165
& IFLAG, IERROR,
5166
& IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8,
5167
& COMM,COMM_LOAD,FILS,ND )
5064
5168
USE SMUMPS_LOAD
5065
5169
IMPLICIT NONE
5066
5170
INCLUDE 'smumps_root.h'
5069
5173
INTEGER KEEP( 500 )
5070
5174
INTEGER*8 KEEP8(150)
5071
5175
INTEGER ROW_LIST(*), COL_LIST(*),
5072
* SLAVE_LIST(*)
5073
INTEGER IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS
5074
INTEGER N, LIW, LA
5176
& SLAVE_LIST(*)
5177
INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA
5178
INTEGER IWPOS, IWPOSCB
5179
INTEGER N, LIW
5075
5180
INTEGER IW( LIW )
5076
5181
REAL A( LA )
5077
INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28)), PTRFAC(KEEP(28))
5078
INTEGER PTRAST(KEEP(28))
5079
INTEGER STEP(N),
5080
* PIMASTER(KEEP(28)),
5081
* PAMASTER(KEEP(28))
5182
INTEGER PTRIST( KEEP(28) ), PTLUST_S(KEEP(28))
5183
INTEGER(8) :: PTRFAC(KEEP(28))
5184
INTEGER(8) :: PTRAST(KEEP(28))
5185
INTEGER(8) :: PAMASTER(KEEP(28))
5186
INTEGER STEP(N), PIMASTER(KEEP(28))
5082
5187
INTEGER COMP
5083
5188
INTEGER NSTK_S(KEEP(28)), ITLOC( N ), PROCNODE_STEPS( KEEP(28) )
5084
5189
INTEGER IFLAG, IERROR
5087
5192
INTEGER MYID, SLAVEF
5088
5193
INTEGER COMM,COMM_LOAD,ND(KEEP(28)),FILS(N)
5089
5194
INTEGER IROOT, TYPE_INODE, DEB_ROW, DEB_COL,
5090
* NOINT, NOREAL
5195
& NOINT
5196
INTEGER(8) :: NOREAL
5091
5197
INCLUDE 'mumps_headers.h'
5092
5198
INCLUDE 'mumps_tags.h'
5093
5199
INTEGER MUMPS_330
5113
5219
PIMASTER(STEP(INODE)) = 0
5114
5220
ELSE
5115
5221
NOINT = 6 + NSLAVES + NELIM + NELIM + KEEP(IXSZ)
5116
NOREAL= 0
5117
CALL SMUMPS_22(.FALSE.,0,.FALSE.,.FALSE.,
5118
* MYID,N,KEEP,KEEP8,IW,LIW, A, LA,
5119
* LRLU, IPTRLU,IWPOS,IWPOSCB,
5120
* PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, ITLOC,
5121
* NOINT, NOREAL, INODE, S_NOTFREE, .TRUE.,
5122
* COMP, LRLUS, IFLAG, IERROR
5123
$ )
5222
NOREAL= 0_8
5223
CALL SMUMPS_22(.FALSE.,0_8,.FALSE.,.FALSE.,
5224
& MYID,N,KEEP,KEEP8,IW,LIW, A, LA,
5225
& LRLU, IPTRLU,IWPOS,IWPOSCB,
5226
& PTRIST,PTRAST,STEP, PIMASTER, PAMASTER, ITLOC,
5227
& NOINT, NOREAL, INODE, S_NOTFREE, .TRUE.,
5228
& COMP, LRLUS, IFLAG, IERROR
5229
& )
5124
5230
IF ( IFLAG .LT. 0 ) THEN
5125
5231
WRITE(*,*) ' Failure in int space allocation in CB area ',
5126
* ' during assembly of root : SMUMPS_273',
5127
* ' size required was :', NOINT,
5128
* 'INODE=',INODE,' NELIM=',NELIM, ' NSLAVES=', NSLAVES
5232
& ' during assembly of root : SMUMPS_273',
5233
& ' size required was :', NOINT,
5234
& 'INODE=',INODE,' NELIM=',NELIM, ' NSLAVES=', NSLAVES
5129
5235
RETURN
5130
5236
ENDIF
5131
5237
PIMASTER(STEP( INODE )) = IWPOSCB + 1
5132
PAMASTER(STEP( INODE )) = IPTRLU + 1
5238
PAMASTER(STEP( INODE )) = IPTRLU + 1_8
5133
5239
IW( IWPOSCB + 1+KEEP(IXSZ) ) = 2*NELIM
5134
5240
IW( IWPOSCB + 2+KEEP(IXSZ) ) = NELIM
5135
5241
IW( IWPOSCB + 3+KEEP(IXSZ) ) = 0
5138
5244
IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES
5139
5245
IF (NSLAVES.GT.0) THEN
5140
5246
IW( IWPOSCB+7+KEEP(IXSZ):IWPOSCB+7+KEEP(IXSZ)+NSLAVES-1) =
5141
* SLAVE_LIST(1:NSLAVES)
5247
& SLAVE_LIST(1:NSLAVES)
5142
5248
ENDIF
5143
5249
DEB_ROW = IWPOSCB+7+NSLAVES+KEEP(IXSZ)
5144
5250
IW(DEB_ROW : DEB_ROW+NELIM -1) = ROW_LIST(1:NELIM)
5147
5253
ENDIF
5148
5254
IF (NSTK_S(STEP(IROOT)) .EQ. 0 ) THEN
5149
5255
CALL SMUMPS_507(N, IPOOL, LPOOL, PROCNODE_STEPS,
5150
* SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47),
5151
* STEP, IROOT )
5256
& SLAVEF, KEEP(28), KEEP(76), KEEP(80), KEEP(47),
5257
& STEP, IROOT )
5152
5258
IF (KEEP(47) .GE. 3) THEN
5153
5259
CALL SMUMPS_500(
5154
$ IPOOL, LPOOL,
5155
* PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
5156
* MYID, STEP, N, ND, FILS )
5260
& IPOOL, LPOOL,
5261
& PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,
5262
& MYID, STEP, N, ND, FILS )
5157
5263
ENDIF
5158
5264
END IF
5159
5265
RETURN
5160
5266
END SUBROUTINE SMUMPS_273
5161
5267
SUBROUTINE SMUMPS_534( N,FRERE, FILS,
5162
* NA,NE,ND,PERM,SYM,INFO,LP,K47,K81,K215,K234,K55,
5163
* PROCNODE,SLAVEF,PEAK
5164
$ )
5268
& NA,NE,ND,PERM,SYM,INFO,LP,K47,K81,K215,K234,K55,
5269
& PROCNODE,SLAVEF,PEAK
5270
& )
5165
5271
IMPLICIT NONE
5166
5272
INTEGER N,PERM,SYM, LP, SIZE_MEM_SBTR
5167
5273
INTEGER FRERE(N), FILS(N)
5170
5276
INTEGER SLAVEF,PROCNODE(N)
5171
5277
REAL PEAK
5172
5278
INTEGER NBROOT, NBLEAF, LNA, allocok, LEAF, I, NSTEPS,
5173
* K47_LOC, K81_LOC
5279
& K47_LOC, K81_LOC
5174
5280
INTEGER, ALLOCATABLE, DIMENSION (:) :: NEW_NA, STEP
5175
5281
INTEGER TEMP_MEM(1),SBTR_WHICH_M
5176
INTEGER, ALLOCATABLE, DIMENSION (:,:) :: MEM_SUBTREE,MY_ROOT,
5177
$ MY_SIZE,MY_LEAF
5282
DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: MEM_SUBTREE
5283
INTEGER, ALLOCATABLE, DIMENSION (:,:) :: MY_ROOT,
5284
& MY_SIZE,MY_LEAF
5178
5285
INTEGER, ALLOCATABLE, DIMENSION (:) :: DEPTH_FIRST
5179
5286
REAL, ALLOCATABLE, DIMENSION (:) :: COST_TRAV
5180
5287
INTEGER DUMMY_DAD(1), DUMMY_DAD_LENGTH
5279
5386
RETURN
5280
5387
ENDIF
5281
5388
CALL SMUMPS_363(N,FRERE, STEP, FILS,
5282
* NEW_NA,LNA,NE,ND,
5283
* DUMMY_DAD, DUMMY_DAD_LENGTH, USE_DAD,
5284
* NSTEPS,PERM,SYM,INFO,LP,K47_LOC,K81_LOC,0,K215,K234,K55,
5285
* PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK,SBTR_WHICH_M
5286
$ ,1,1,DEPTH_FIRST,COST_TRAV,MY_LEAF,MY_SIZE,MY_ROOT
5287
*)
5389
& NEW_NA,LNA,NE,ND,
5390
& DUMMY_DAD, DUMMY_DAD_LENGTH, USE_DAD,
5391
& NSTEPS,PERM,SYM,INFO,LP,K47_LOC,K81_LOC,0,K215,K234,K55,
5392
& PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK,SBTR_WHICH_M
5393
& ,1,1,DEPTH_FIRST,COST_TRAV,MY_LEAF,MY_SIZE,MY_ROOT
5394
&)
5288
5395
NA(1:NBLEAF)=NEW_NA(3:2+NBLEAF)
5289
5396
NA(N)=NBROOT
5290
5397
IF (N.GT.1) THEN
5307
5414
RETURN
5308
5415
END SUBROUTINE SMUMPS_534
5309
5416
SUBROUTINE SMUMPS_363(N,FRERE, STEP, FILS,
5310
* NA,LNA,NE,ND, DAD, LDAD, USE_DAD,
5311
* NSTEPS,PERM,SYM,INFO,LP,K47,K81,K76,K215,K234,K55,
5312
* PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK
5313
$ ,SBTR_WHICH_M,SIZE_DEPTH_FIRST,SIZE_COST_TRAV,
5314
$ DEPTH_FIRST_TRAV,COST_TRAV,MY_FIRST_LEAF,
5315
$ MY_NB_LEAF,MY_ROOT_SBTR
5316
$ )
5417
& NA,LNA,NE,ND, DAD, LDAD, USE_DAD,
5418
& NSTEPS,PERM,SYM,INFO,LP,K47,K81,K76,K215,K234,K55,
5419
& PROCNODE,MEM_SUBTREE,SLAVEF, SIZE_MEM_SBTR, PEAK
5420
& ,SBTR_WHICH_M,SIZE_DEPTH_FIRST,SIZE_COST_TRAV,
5421
& DEPTH_FIRST_TRAV,COST_TRAV,MY_FIRST_LEAF,
5422
& MY_NB_LEAF,MY_ROOT_SBTR
5423
& )
5317
5424
IMPLICIT NONE
5318
5425
INTEGER N,PERM,SYM, NSTEPS, LNA, LP, SIZE_MEM_SBTR,LDAD
5319
5426
INTEGER FRERE(NSTEPS), FILS(N), STEP(N)
5323
5430
LOGICAL USE_DAD
5324
5431
INTEGER INFO(40)
5325
5432
INTEGER SLAVEF,PROCNODE(NSTEPS)
5326
INTEGER MEM_SUBTREE(SIZE_MEM_SBTR,SLAVEF),SBTR_WHICH_M
5433
DOUBLE PRECISION, intent(out) :: MEM_SUBTREE(SIZE_MEM_SBTR,SLAVEF)
5434
INTEGER :: SBTR_WHICH_M
5327
5435
INTEGER MY_FIRST_LEAF(SIZE_MEM_SBTR,SLAVEF),
5328
$ MY_ROOT_SBTR(SIZE_MEM_SBTR,SLAVEF),
5329
$ MY_NB_LEAF(SIZE_MEM_SBTR,SLAVEF)
5436
& MY_ROOT_SBTR(SIZE_MEM_SBTR,SLAVEF),
5437
& MY_NB_LEAF(SIZE_MEM_SBTR,SLAVEF)
5330
5438
EXTERNAL MUMPS_283,MUMPS_275
5331
5439
LOGICAL MUMPS_283
5332
5440
INTEGER MUMPS_275
5351
5459
INTEGER*8, DIMENSION (:), ALLOCATABLE :: T1,T2
5352
5460
INTEGER, DIMENSION (:), ALLOCATABLE :: RESULT
5353
5461
INTEGER*8 MEM_SIZE,FACT_SIZE,SUM,MEM_SEC_PERM,FACT_SIZE_T,
5354
$ MEM_SIZE_T,TOTAL_MEM_SIZE,TMP_TOTAL_MEM_SIZE,TMP_SUM,
5355
$ SIZECB, SIZECB_LASTSON
5462
& MEM_SIZE_T,TOTAL_MEM_SIZE,TMP_TOTAL_MEM_SIZE,TMP_SUM,
5463
& SIZECB, SIZECB_LASTSON
5356
5464
INTEGER*8 TMP8
5357
5465
LOGICAL SBTR_M
5358
5466
INTEGER INDICE(SLAVEF),ID,FIRST_LEAF,SIZE_SBTR
5360
5468
LOGICAL MUMPS_170,MUMPS_167
5361
5469
DOUBLE PRECISION COST_NODE
5362
5470
INCLUDE 'mumps_headers.h'
5363
TOTAL_MEM_SIZE=0
5471
TOTAL_MEM_SIZE=0_8
5364
5472
ROOT_OF_CUR_SBTR=0
5365
5473
IF((PERM.EQ.0).OR.(PERM.EQ.1).OR.
5366
$ (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR.
5367
$ (PERM.EQ.5).OR.(PERM.EQ.6))THEN
5474
& (PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4).OR.
5475
& (PERM.EQ.5).OR.(PERM.EQ.6))THEN
5368
5476
LOCAL_PERM=0
5369
5477
ENDIF
5370
5478
IF (K47 == 4 .OR. ((K47.GE.2).AND.(K81.GE. 1))) THEN
5373
5481
ENDDO
5374
5482
DO I=1,SLAVEF
5375
5483
DO x=1,SIZE_MEM_SBTR
5376
MEM_SUBTREE(x,I)=-1
5484
MEM_SUBTREE(x,I)=-1.0D0
5377
5485
ENDDO
5378
5486
ENDDO
5379
5487
ENDIF
5380
5488
SBTR_M=((K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1))))
5381
MEM_SIZE=0
5382
FACT_SIZE=0
5489
MEM_SIZE=0_8
5490
FACT_SIZE=0_8
5383
5491
IF ((PERM.GT.7).AND.
5384
* (.NOT.(K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1))))) THEN
5492
& (.NOT.(K47 == 4 .OR. ((K47.GE.2).AND.(K81 .GE. 1))))) THEN
5385
5493
WRITE(*,*) "Internal Error in SMUMPS_363",PERM
5386
5494
CALL MUMPS_ABORT()
5387
5495
END IF
5393
5501
ALLOCATE(M_TOTAL(NSTEPS), stat=allocok )
5394
5502
IF (allocok > 0) THEN
5395
5503
IF ( LP .GT. 0 )
5396
* WRITE(LP,*)'Memory allocation error in
5397
$ SMUMPS_363'
5504
& WRITE(LP,*)'Memory allocation error in
5505
& SMUMPS_363'
5398
5506
INFO(1)=-7
5399
5507
INFO(2)=NSTEPS
5400
5508
RETURN
5402
5510
ENDIF
5403
5511
ENDIF
5404
5512
ALLOCATE( IPOOL(NBLEAF), M(NSTEPS), fact(NSTEPS),
5405
* TNSTK(NSTEPS), stat=allocok )
5513
& TNSTK(NSTEPS), stat=allocok )
5406
5514
IF (allocok > 0) THEN
5407
5515
IF ( LP .GT. 0 )
5408
* WRITE(LP,*)'Memory allocation error in SMUMPS_363'
5516
& WRITE(LP,*)'Memory allocation error in SMUMPS_363'
5409
5517
INFO(1)=-7
5410
5518
INFO(2)=NSTEPS
5411
5519
RETURN
5417
5525
ENDDO
5418
5526
SIZE_TAB=max(II,NBROOT)
5419
5527
ALLOCATE(SON(II), TEMP(II),
5420
* TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok )
5528
& TAB1(SIZE_TAB), TAB2(SIZE_TAB), stat=allocok )
5421
5529
IF (allocok > 0) THEN
5422
5530
IF ( LP .GT. 0 )
5423
* WRITE(LP,*)'Memory allocation error in SMUMPS_363'
5531
& WRITE(LP,*)'Memory allocation error in SMUMPS_363'
5424
5532
INFO(1)=-7
5425
5533
INFO(2)=NSTEPS
5426
5534
RETURN
5427
5535
ENDIF
5428
5536
ALLOCATE(T1(SIZE_TAB),T2(SIZE_TAB),
5429
* RESULT(SIZE_TAB),stat=allocok)
5537
& RESULT(SIZE_TAB),stat=allocok)
5430
5538
IF (allocok > 0) THEN
5431
5539
IF ( LP .GT. 0 )
5432
* WRITE(LP,*)'Memory allocation error in SMUMPS_363'
5540
& WRITE(LP,*)'Memory allocation error in SMUMPS_363'
5433
5541
INFO(1)=-7
5434
5542
INFO(2)=SIZE_TAB
5435
5543
RETURN
5441
5549
CALL MUMPS_ABORT()
5442
5550
ENDIF
5443
5551
DO I=1,NBROOT
5444
TAB1(I)=ND(STEP(NA(I+2+NBLEAF)))
5552
TAB1(I)=int(ND(STEP(NA(I+2+NBLEAF))),8)
5445
5553
IPOOL(I)=NA(I+2+NBLEAF)
5446
5554
M(STEP(IPOOL(I)))=TAB1(I)*TAB1(I)
5447
5555
ENDDO
5453
5561
ALLOCATE(DEPTH(NSTEPS),stat=allocok)
5454
5562
IF (allocok > 0) THEN
5455
5563
IF ( LP .GT. 0 )
5456
* WRITE(LP,*)'Memory allocation error in
5457
$ SMUMPS_363'
5564
& WRITE(LP,*)'Memory allocation error in
5565
& SMUMPS_363'
5458
5566
INFO(1)=-7
5459
5567
INFO(2)=NSTEPS
5460
5568
RETURN
5506
5614
COST_NODE=0.0E0
5507
5615
ENDIF
5508
5616
DO I=1,NSTEPS
5509
M(I)=0
5617
M(I)=0_8
5510
5618
IF (SBTR_M.OR.(PERM.EQ.2)) THEN
5511
5619
IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN
5512
M_TOTAL(I)=0
5620
M_TOTAL(I)=0_8
5513
5621
ENDIF
5514
5622
ENDIF
5515
5623
ENDDO
5516
5624
DO I=1,NSTEPS
5517
fact(I)=0
5625
fact(I)=0_8
5518
5626
ENDDO
5519
5627
IPOOL(1:NBLEAF)=NA(3:2+NBLEAF)
5520
5628
LEAF = NBLEAF + 1
5524
5632
INODE = IPOOL(LEAF)
5525
5633
ENDIF
5526
5634
96 CONTINUE
5527
NFR = ND(STEP(INODE))
5635
NFR = int(ND(STEP(INODE)),8)
5528
5636
NSTK = NE(STEP(INODE))
5529
5637
NELIM4 = 0
5530
5638
IN = INODE
5531
5639
101 NELIM4 = NELIM4 + 1
5532
5640
IN = FILS(IN)
5533
5641
IF (IN .GT. 0 ) GOTO 101
5534
NELIM=NELIM4
5642
NELIM=int(NELIM4,8)
5535
5643
IF(NE(STEP(INODE)).EQ.0) THEN
5536
5644
M(STEP(INODE))=NFR*NFR
5537
5645
IF (SBTR_M.OR.(PERM.EQ.2)) THEN
5540
5648
ENDIF
5541
5649
IF((PERM.EQ.4).OR.(PERM.EQ.3))THEN
5542
5650
IF(MUMPS_170(STEP(INODE),
5543
$PROCNODE,SLAVEF))THEN
5651
&PROCNODE,SLAVEF))THEN
5544
5652
DEPTH(STEP(INODE))=0
5545
5653
ENDIF
5546
5654
ENDIF
5547
5655
IF ( SYM .eq. 0 ) THEN
5548
5656
fact(STEP(INODE))=fact(STEP(INODE))+
5549
& (2*NFR*NELIM)-(NELIM*NELIM)
5657
& (2_8*NFR*NELIM)-(NELIM*NELIM)
5550
5658
ELSE
5551
5659
fact(STEP(INODE))=fact(STEP(INODE))+NFR*NELIM
5552
5660
ENDIF
5566
5674
fact(STEP(IFATH))=fact(STEP(IFATH))+fact(STEP(INODE))
5567
5675
IF((PERM.EQ.3).OR.(PERM.EQ.4))THEN
5568
5676
DEPTH(STEP(IFATH))=max(DEPTH(STEP(INODE)),
5569
$ DEPTH(STEP(IFATH)))
5677
& DEPTH(STEP(IFATH)))
5570
5678
ENDIF
5571
5679
ENDIF
5572
5680
TNSTK(STEP(IFATH)) = TNSTK(STEP(IFATH)) - 1
5581
5689
I=I+1
5582
5690
GOTO 5700
5583
5691
ENDIF
5584
NCB=ND(STEP(INODE))-I
5692
NCB=int(ND(STEP(INODE))-I,8)
5585
5693
IN=-IN
5586
5694
IF(PERM.NE.7)THEN
5587
5695
DO I=1,NE(STEP(INODE))
5597
5705
ENDDO
5598
5706
ENDIF
5599
5707
IF(PERM.EQ.7) GOTO 213
5600
NFR = ND(STEP(INODE))
5708
NFR = int(ND(STEP(INODE)),8)
5601
5709
DO II=1,NE(STEP(INODE))
5602
TAB1(II)=0
5603
TAB2(II)=0
5710
TAB1(II)=0_8
5711
TAB2(II)=0_8
5604
5712
cour=SON(II)
5605
5713
NELIM4=1
5606
5714
151 cour=FILS(cour)
5608
5716
NELIM4=NELIM4+1
5609
5717
GOTO 151
5610
5718
ENDIF
5611
NELIM=NELIM4
5719
NELIM=int(NELIM4,8)
5612
5720
IF((SYM.EQ.0).OR.(K215.NE.0)) THEN
5613
SIZECB=(ND(STEP(SON(II)))-NELIM)*
5614
$ (ND(STEP(SON(II)))-NELIM)
5721
SIZECB=(int(ND(STEP(SON(II))),8)-NELIM)
5722
& *(int(ND(STEP(SON(II))),8)-NELIM)
5615
5723
ELSE
5616
SIZECB=(ND(STEP(SON(II)))-NELIM)*(ND(STEP(SON(II)))-
5617
$ NELIM+1)/2
5724
SIZECB=(int(ND(STEP(SON(II))),8)-NELIM)
5725
& *(int(ND(STEP(SON(II))),8)-
5726
& NELIM+1_8)/2_8
5618
5727
ENDIF
5619
5728
IF((PERM.EQ.0).OR.(PERM.EQ.5))THEN
5620
5729
IF (K234 .NE. 0 .AND. K55.EQ.0 ) THEN
5634
5743
ENDIF
5635
5744
IF(PERM.EQ.2)THEN
5636
5745
IF (MUMPS_170(STEP(INODE),
5637
$ PROCNODE,SLAVEF))THEN
5746
& PROCNODE,SLAVEF))THEN
5638
5747
TAB1(II)=M_TOTAL(STEP(SON(II)))-SIZECB
5639
$ -fact(STEP(SON(II)))
5748
& -fact(STEP(SON(II)))
5640
5749
TAB2(II)=SIZECB
5641
5750
ELSE
5642
5751
TAB1(II)=M(STEP(SON(II)))-SIZECB
5645
5754
ENDIF
5646
5755
IF(PERM.EQ.3)THEN
5647
5756
IF (MUMPS_170(STEP(INODE),
5648
$ PROCNODE,SLAVEF))THEN
5757
& PROCNODE,SLAVEF))THEN
5649
5758
TAB1(II)=M(STEP(SON(II)))-SIZECB
5650
5759
TAB2(II)=SIZECB
5651
5760
ELSE
5652
TAB1(II)=DEPTH(STEP(SON(II)))
5761
TAB1(II)=int(DEPTH(STEP(SON(II))),8)
5653
5762
TAB2(II)=M(STEP(SON(II)))
5654
5763
ENDIF
5655
5764
ENDIF
5656
5765
IF(PERM.EQ.4)THEN
5657
5766
IF (MUMPS_170(STEP(INODE),
5658
$ PROCNODE,SLAVEF))THEN
5767
& PROCNODE,SLAVEF))THEN
5659
5768
TAB1(II)=M(STEP(SON(II)))-
5660
5769
& SIZECB-fact(STEP(SON(II)))
5661
5770
TAB2(II)=SIZECB
5662
5771
ELSE
5663
TAB1(II)=DEPTH(STEP(SON(II)))
5772
TAB1(II)=int(DEPTH(STEP(SON(II))),8)
5664
5773
TAB2(II)=M(STEP(SON(II)))
5665
5774
ENDIF
5666
5775
ENDIF
5667
5776
ENDDO
5668
5777
CALL SMUMPS_462(SON,NE(STEP(INODE)),TAB1,TAB2,
5669
$ LOCAL_PERM
5778
& LOCAL_PERM
5670
5779
& ,RESULT,T1,T2)
5671
5780
IF(PERM.EQ.0) THEN
5672
5781
DO II=1,NE(STEP(INODE))
5677
5786
NELIM4=NELIM4+1
5678
5787
GOTO 153
5679
5788
ENDIF
5680
NELIM=NELIM4
5789
NELIM=int(NELIM4,8)
5681
5790
IF((SYM.EQ.0).OR.(K215.NE.0))THEN
5682
SIZECB=(ND(STEP(TEMP(II)))-NELIM)*
5683
$ (ND(STEP(TEMP(II)))-NELIM)
5791
SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)*
5792
& (int(ND(STEP(TEMP(II))),8)-NELIM)
5684
5793
ELSE
5685
SIZECB=(ND(STEP(TEMP(II)))-NELIM)*
5686
$ (ND(STEP(TEMP(II)))-NELIM+1)/2
5794
SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)*
5795
& (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8
5687
5796
ENDIF
5688
5797
TAB1(II)=SIZECB
5689
5798
ENDDO
5699
5808
NELIM4=NELIM4+1
5700
5809
GOTO 187
5701
5810
ENDIF
5702
NELIM=NELIM4
5811
NELIM=int(NELIM4,8)
5703
5812
IF((SYM.EQ.0).OR.(K215.NE.0))THEN
5704
SIZECB=(ND(STEP(TEMP(II)))-NELIM)*
5705
$ (ND(STEP(TEMP(II)))-NELIM)
5813
SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)*
5814
& (int(ND(STEP(TEMP(II))),8)-NELIM)
5706
5815
ELSE
5707
SIZECB=(ND(STEP(TEMP(II)))-NELIM)*
5708
$ (ND(STEP(TEMP(II)))-NELIM+1)/2
5816
SIZECB=(int(ND(STEP(TEMP(II))),8)-NELIM)*
5817
& (int(ND(STEP(TEMP(II))),8)-NELIM+1_8)/2_8
5709
5818
ENDIF
5710
5819
TAB1(II)=SIZECB+fact(STEP(TEMP(II)))
5711
5820
ENDDO
5715
5824
213 CONTINUE
5716
5825
IFATH=INODE
5717
5826
DO II=1,2
5718
SUM=0
5719
FACT_SIZE=0
5720
FACT_SIZE_T=0
5721
MEM_SIZE=0
5722
MEM_SIZE_T=0
5827
SUM=0_8
5828
FACT_SIZE=0_8
5829
FACT_SIZE_T=0_8
5830
MEM_SIZE=0_8
5831
MEM_SIZE_T=0_8
5723
5832
CB_MAX=0
5724
5833
CB_current=0
5725
TMP_SUM=0
5834
TMP_SUM=0_8
5726
5835
IF(II.EQ.1) TAB=>SON
5727
5836
IF(II.EQ.2) TAB=>TEMP
5728
5837
DO I=1,NE(STEP(INODE))
5733
5842
NELIM4=NELIM4+1
5734
5843
GOTO 149
5735
5844
ENDIF
5736
NELIM=NELIM4
5737
NFR=ND(STEP(TAB(I)))
5845
NELIM=int(NELIM4, 8)
5846
NFR=int(ND(STEP(TAB(I))),8)
5738
5847
IF((SYM.EQ.0).OR.(K215.NE.0))THEN
5739
5848
SIZECB=(NFR-NELIM)*(NFR-NELIM)
5740
5849
ELSE
5741
SIZECB=(NFR-NELIM)*(NFR-NELIM+1)/2
5850
SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8
5742
5851
ENDIF
5743
5852
MEM_SIZE=max(MEM_SIZE,(M(STEP(TAB(I)))+SUM+FACT_SIZE))
5744
5853
IF (SBTR_M.OR.(PERM.EQ.2)) THEN
5745
5854
MEM_SIZE_T=max(MEM_SIZE_T,(M_TOTAL(STEP(TAB(I)))+
5746
$ SUM+
5747
$ FACT_SIZE_T))
5855
& SUM+
5856
& FACT_SIZE_T))
5748
5857
FACT_SIZE_T=FACT_SIZE_T+fact(STEP(TAB(I)))
5749
5858
ENDIF
5750
5859
TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE,
5751
$ (M(STEP(TAB(I)))+SUM+FACT_SIZE))
5860
& (M(STEP(TAB(I)))+SUM+FACT_SIZE))
5752
5861
TMP_SUM=TMP_SUM+fact(STEP(TAB(I)))
5753
5862
SUM=SUM+SIZECB
5754
5863
SIZECB_LASTSON = SIZECB
5759
5868
IF((SYM.EQ.0).OR.(K215.NE.0))THEN
5760
5869
SIZECB=NCB*NCB
5761
5870
ELSE
5762
SIZECB=NCB*(NCB+1)/2
5871
SIZECB=(NCB*(NCB+1_8))/2_8
5763
5872
ENDIF
5764
5873
IF (K234.NE.0 .AND. K55.EQ.0) THEN
5765
TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE,((ND(STEP(IFATH))
5766
$ *ND(STEP(IFATH)))+SUM-SIZECB_LASTSON+TMP_SUM))
5874
TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE,
5875
& ( ( int(ND(STEP(IFATH)),8)
5876
& * int(ND(STEP(IFATH)),8) )
5877
& + SUM-SIZECB_LASTSON+TMP_SUM )
5878
& )
5767
5879
ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN
5768
TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE,((ND(STEP(IFATH))
5769
$ *ND(STEP(IFATH)))+SUM+TMP_SUM))
5880
TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE,
5881
& ( ( int(ND(STEP(IFATH)),8)
5882
& * int(ND(STEP(IFATH)),8) )
5883
& + SUM + TMP_SUM )
5884
& )
5770
5885
ELSE
5771
TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE,((ND(STEP(IFATH))
5772
$ *ND(STEP(IFATH)))+max(SUM,SIZECB)+TMP_SUM))
5886
TOTAL_MEM_SIZE=max(TOTAL_MEM_SIZE,
5887
& ( ( int(ND(STEP(IFATH)),8)
5888
& * int(ND(STEP(IFATH)),8))
5889
& + max(SUM,SIZECB) + TMP_SUM )
5890
& )
5773
5891
ENDIF
5774
5892
IF(II.EQ.1)THEN
5775
5893
TMP_TOTAL_MEM_SIZE=TOTAL_MEM_SIZE
5776
5894
ENDIF
5777
5895
IF((II.EQ.1).OR.(PERM.EQ.7)) THEN
5778
5896
IF (K234.NE.0 .AND. K55.EQ.0) THEN
5779
M(STEP(IFATH))=max(MEM_SIZE,((ND(STEP(IFATH))
5780
$ *ND(STEP(IFATH)))+SUM-SIZECB_LASTSON+
5781
$ FACT_SIZE))
5897
M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8)
5898
& *int(ND(STEP(IFATH)),8))+SUM-SIZECB_LASTSON+
5899
& FACT_SIZE))
5782
5900
ELSE IF (K234.NE.0 .AND. K55.NE.0) THEN
5783
M(STEP(IFATH))=max(MEM_SIZE,((ND(STEP(IFATH))
5784
$ *ND(STEP(IFATH)))+SUM+FACT_SIZE))
5901
M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8)
5902
& *int(ND(STEP(IFATH)),8))+SUM+FACT_SIZE))
5785
5903
ELSE
5786
M(STEP(IFATH))=max(MEM_SIZE,((ND(STEP(IFATH))
5787
$ *ND(STEP(IFATH)))+max(SUM,SIZECB)+FACT_SIZE))
5904
M(STEP(IFATH))=max(MEM_SIZE,((int(ND(STEP(IFATH)),8)
5905
& *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE))
5788
5906
ENDIF
5789
5907
IF (SBTR_M.OR.(PERM.EQ.2)) THEN
5790
5908
M_TOTAL(STEP(IFATH))=max(MEM_SIZE_T,
5791
$ ((ND(STEP(IFATH))
5792
$ *ND(STEP(IFATH)))+max(SUM,SIZECB)+
5793
$ FACT_SIZE_T))
5909
& ((int(ND(STEP(IFATH)),8)
5910
& *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+
5911
& FACT_SIZE_T))
5794
5912
ENDIF
5795
5913
ENDIF
5796
5914
IF((II.EQ.2).AND.(PERM.EQ.1).OR.(PERM.EQ.0).OR.
5797
$ (PERM.EQ.5).OR.(PERM.EQ.6).OR.
5798
$ (.NOT.SBTR_M.OR.(SBTR_WHICH_M.NE.1)))THEN
5799
MEM_SEC_PERM=max(MEM_SIZE,((ND(STEP(IFATH))
5800
$ *ND(STEP(IFATH)))+max(SUM,SIZECB)+FACT_SIZE))
5915
& (PERM.EQ.5).OR.(PERM.EQ.6).OR.
5916
& (.NOT.SBTR_M.OR.(SBTR_WHICH_M.NE.1)))THEN
5917
MEM_SEC_PERM=max(MEM_SIZE,((int(ND(STEP(IFATH)),8)
5918
& *int(ND(STEP(IFATH)),8))+max(SUM,SIZECB)+FACT_SIZE))
5801
5919
ENDIF
5802
5920
IF((PERM.EQ.2).OR.(PERM.EQ.3).OR.(PERM.EQ.4))THEN
5803
5921
MEM_SEC_PERM=huge(MEM_SEC_PERM)
5879
5997
WRITE(*,*)'INODE=',INODE,'RANK',RANK_TRAV
5880
5998
IF(MUMPS_167(STEP(INODE),PROCNODE,SLAVEF))THEN
5881
5999
DEPTH_FIRST_TRAV(STEP(INODE))=DEPTH_FIRST_TRAV(STEP(
5882
$ ROOT_OF_CUR_SBTR))
6000
& ROOT_OF_CUR_SBTR))
5883
6001
ELSE
5884
6002
DEPTH_FIRST_TRAV(STEP(INODE))=RANK_TRAV
5885
6003
ENDIF
5896
6014
IF (IN.GT.0) GO TO 395
5897
6015
IFATH = -IN
5898
6016
ENDIF
5899
NFR = ND(STEP(INODE))
6017
NFR4 = ND(STEP(INODE))
6018
NFR = int(NFR4,8)
5900
6019
NELIM4 = 0
5901
6020
IN = INODE
5902
6021
396 NELIM4 = NELIM4 + 1
5903
6022
IN = FILS(IN)
5904
6023
IF (IN .GT. 0 ) GOTO 396
5905
NELIM=NELIM4
6024
NELIM=int(NELIM4,8)
5906
6025
IF((SYM.EQ.0).OR.(K215.NE.0))THEN
5907
6026
SIZECB=(NFR-NELIM)*(NFR-NELIM)
5908
6027
ELSE
5909
SIZECB=(NFR-NELIM)*(NFR-NELIM+1)/2
6028
SIZECB=(NFR-NELIM)*(NFR-NELIM+1_8)/2_8
5910
6029
ENDIF
5911
NFR4=NFR
5912
6030
CALL MUMPS_511(NFR4,NELIM4,NELIM4,
5913
* SYM,1,COST_NODE)
6031
& SYM,1,COST_NODE)
5914
6032
IF(IFATH.NE.0)THEN
5915
6033
IF(MUMPS_167(STEP(INODE),PROCNODE,SLAVEF))THEN
5916
6034
COST_TRAV(STEP(INODE))=COST_TRAV(STEP(
5917
$ ROOT_OF_CUR_SBTR))
6035
& ROOT_OF_CUR_SBTR))
5918
6036
ELSE
5919
6037
COST_TRAV(STEP(INODE))=COST_NODE+
5920
$ COST_TRAV(STEP(IFATH))+
5921
$ (SIZECB*18)
6038
& COST_TRAV(STEP(IFATH))+
6039
& real(SIZECB*18_8)
5922
6040
ENDIF
5923
6041
ELSE
5924
6042
COST_TRAV(STEP(INODE))=COST_NODE
5930
6048
ENDIF
5931
6049
IF ( K47 == 4 .OR. ((K81.GE.1).AND.(K47.GE.2))) THEN
5932
6050
IF((SLAVEF.NE.1).AND.
5933
$ MUMPS_283(STEP(INODE),PROCNODE,SLAVEF))THEN
6051
& MUMPS_283(STEP(INODE),PROCNODE,SLAVEF))THEN
5934
6052
IF (NE(STEP(INODE)).NE.0) THEN
5935
6053
ID=MUMPS_275(STEP(INODE),PROCNODE,SLAVEF)
5936
6054
IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN
5937
6055
MEM_SUBTREE(INDICE(ID+1),ID+1)=
5938
$ M_TOTAL(STEP(INODE))
6056
& dble(M_TOTAL(STEP(INODE)))
5939
6057
ELSE
5940
MEM_SUBTREE(INDICE(ID+1),ID+1)=M(STEP(INODE))
6058
MEM_SUBTREE(INDICE(ID+1),ID+1)=
6059
& dble(M(STEP(INODE)))
5941
6060
ENDIF
5942
6061
MY_ROOT_SBTR(INDICE(ID+1),ID+1)=INODE
5943
6062
INDICE(ID+1)=INDICE(ID+1)+1
5947
6066
ID=MUMPS_275(STEP(INODE),PROCNODE,SLAVEF)
5948
6067
IF((SBTR_WHICH_M.EQ.1).AND.(PERM.NE.1))THEN
5949
6068
MEM_SUBTREE(INDICE(ID+1),ID+1)=
5950
$ M_TOTAL(STEP(INODE))
6069
& dble(M_TOTAL(STEP(INODE)))
5951
6070
ELSE
5952
MEM_SUBTREE(INDICE(ID+1),ID+1)=M(STEP(INODE))
6071
MEM_SUBTREE(INDICE(ID+1),ID+1)=
6072
& dble(M(STEP(INODE)))
5953
6073
ENDIF
5954
6074
INDICE(ID+1)=INDICE(ID+1)+1
5955
6075
ENDIF
5965
6085
TEMP(I)=IN
5966
6086
IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN
5967
6087
IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170(
5968
$ STEP(INODE),PROCNODE,SLAVEF)))THEN
5969
NFR = ND(STEP(INODE))
6088
& STEP(INODE),PROCNODE,SLAVEF)))THEN
6089
NFR4 = ND(STEP(INODE))
6090
NFR = int(NFR4,8)
5970
6091
NELIM4 = 0
5971
6092
II = TEMP(I)
5972
6093
845 NELIM4 = NELIM4 + 1
5973
6094
II = FILS(II)
5974
6095
IF (II .GT. 0 ) GOTO 845
5975
NELIM=NELIM4
5976
NFR4 = NFR
6096
NELIM=int(NELIM4,8)
5977
6097
CALL MUMPS_511(NFR4,NELIM4,NELIM4,
5978
* SYM,1,COST_NODE)
5979
TAB1(I)=COST_NODE+
5980
$ COST_TRAV(STEP(INODE))
5981
TAB2(I)=0.0E0
6098
& SYM,1,COST_NODE)
6099
TAB1(I)=int(COST_NODE+
6100
& COST_TRAV(STEP(INODE)),8)
6101
TAB2(I)=0_8
5982
6102
ELSE
5983
6103
SON(I)=IN
5984
6104
ENDIF
5989
6109
ENDDO
5990
6110
IF((PERM.EQ.5).OR.(PERM.EQ.6))THEN
5991
6111
IF((SLAVEF.NE.1).AND.(.NOT.MUMPS_170(
5992
$ STEP(INODE),PROCNODE,SLAVEF)))THEN
6112
& STEP(INODE),PROCNODE,SLAVEF)))THEN
5993
6113
CALL SMUMPS_462(TEMP,NE(STEP(INODE)),TAB1,TAB2,
5994
$ LOCAL_PERM
6114
& LOCAL_PERM
5995
6115
& ,RESULT,T1,T2)
5996
6116
TAB=>TEMP
5997
6117
DO I=NE(STEP(INODE)),1,-1
6058
6178
NBROOT=NA(2)
6059
6179
NBLEAF=NA(1)
6060
6180
PEAK=0.0E0
6061
FACT_SIZE=0
6181
FACT_SIZE=0_8
6062
6182
DO I=1,NBROOT
6063
6183
PEAK=max(PEAK,real(M(STEP(NA(2+NBLEAF+I)))))
6064
6184
FACT_SIZE=FACT_SIZE+fact(STEP(NA(2+NBLEAF+I)))
Loggerhead is a web-based interface for Breezy
Version: 2.0.1