~ubuntu-branches/ubuntu/lucid/mumps/lucid : revision 5

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

C

4

C

5

C This version of MUMPS is provided to you free of charge. It is public

6

C domain, based on public domain software developed during the Esprit IV

7

C European project PARASOL (1996-1999) by CERFACS, ENSEEIHT-IRIT and RAL.

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

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

C

15

C Up-to-date copies of the MUMPS package can be obtained

16

C from the Web pages:

23

C

24

C User documentation of any code that uses this software can

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

C in any scientific publication dependent upon the use of the

28

C package. You shall use reasonable endeavours to notify

29

C the authors of the package of this publication.

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

93

89

PROK = ((MP.GT.0).AND.(id%ICNTL(4).GE.3))

94

90

PROKG = ( MPG .GT. 0 .and. id%MYID .eq. MASTER )

95

91

IF ((id%MYID .eq. MASTER) .AND. PROK .AND. (id%ICNTL(5).EQ.0 ) )

96

* WRITE(MP,'(A,I4,I12,I15)')

97

* 'Entering driver (DMUMPS) WITH JOB, N, NZ =', JOB,N,NZ

92

& WRITE(MP,'(A,I4,I12,I15)')

93

& 'Entering driver (DMUMPS) WITH JOB, N, NZ =', JOB,N,NZ

98

94

IF ((id%MYID .eq. MASTER).AND. PROK .AND. (id%ICNTL(5).EQ.1 ) )

99

* WRITE(MP,'(A,I4,I12,I15)')

100

* 'Entering driver (DMUMPS) WITH JOB, N, NELT =', JOB,N,NELT

95

& WRITE(MP,'(A,I4,I12,I15)')

96

& 'Entering driver (DMUMPS) WITH JOB, N, NELT =', JOB,N,NELT

101

97

ELSE

102

98

MPG = 0

103

99

PROK = .FALSE.

116

112

COMM_SAVE = id%COMM

117

113

CALL MPI_COMM_DUP( COMM_SAVE, id%COMM, ierr )

118

114

CALL MPI_ALLREDUCE(JOB,JOBMIN,1,MPI_INTEGER,MPI_MAX,

119

* id%COMM,ierr)

115

& id%COMM,ierr)

120

116

CALL MPI_ALLREDUCE(JOB,JOBMAX,1,MPI_INTEGER,MPI_MIN,

121

* id%COMM,ierr)

117

& id%COMM,ierr)

122

118

IF ( JOBMIN .NE. JOBMAX ) THEN

123

119

id%INFO(1) = -3

124

120

id%INFO(2) = JOB

128

124

id%INFO(1)=0

129

125

id%INFO(2)=0

130

126

IF ( id%KEEP(40) .EQ. 1 - 456789 .OR.

131

* id%KEEP(40) .EQ. 2 - 456789 .OR.

132

* id%KEEP(40) .EQ. 3 -456789 ) THEN

127

& id%KEEP(40) .EQ. 2 - 456789 .OR.

128

& id%KEEP(40) .EQ. 3 -456789 ) THEN

133

129

IF ( id%N > 0 ) THEN

134

130

id%INFO(1)=-3

135

131

id%INFO(2)=JOB

136

132

ENDIF

137

133

ENDIF

134

CALL MPI_COMM_RANK(id%COMM, id%MYID, IERR)

138

135

CALL MUMPS_276( id%ICNTL,

139

136

& id%INFO,

140

137

& id%COMM, id%MYID )

189

186

LFACTO = .FALSE.

190

187

LSOLVE = .FALSE.

191

188

IF ((JOB.EQ.1).OR.(JOB.EQ.4).OR.

192

* (JOB.EQ.6)) LANAL = .TRUE.

189

& (JOB.EQ.6)) LANAL = .TRUE.

193

190

IF ((JOB.EQ.2).OR.(JOB.EQ.4).OR.

194

* (JOB.EQ.5).OR.(JOB.EQ.6)) LFACTO = .TRUE.

191

& (JOB.EQ.5).OR.(JOB.EQ.6)) LFACTO = .TRUE.

195

192

IF ((JOB.EQ.3).OR.(JOB.EQ.5).OR.

196

* (JOB.EQ.6)) LSOLVE = .TRUE.

193

& (JOB.EQ.6)) LSOLVE = .TRUE.

197

194

IF (MP.GT.0) CALL DMUMPS_349(id, MP)

198

195

OLDJOB = id%KEEP( 40 ) + 456789

199

196

IF ( LANAL ) THEN

232

229

UNS_PERM_DONE=.FALSE.

233

230

IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0) THEN

234

231

IF ( id%JOB .EQ. 2 .OR. id%JOB .EQ. 5 .OR.

235

* (id%JOB .EQ. 3 .AND. (id%ICNTL(10) .NE.0 .OR.

236

* id%ICNTL(11).NE. 0))) THEN

232

& (id%JOB .EQ. 3 .AND. (id%ICNTL(10) .NE.0 .OR.

233

& id%ICNTL(11).NE. 0))) THEN

237

234

UNS_PERM_DONE = .TRUE.

238

235

ALLOCATE(UNS_PERM_INV(id%N),stat=ierr)

239

236

IF (ierr .GT. 0) THEN

249

246

END DO

250

247

DO I = 1, id%NZ

251

248

J = id%JCN(I)

249

IF (J.LE.0.OR.J.GT.id%N) CYCLE

252

250

id%JCN(I)=UNS_PERM_INV(J)

253

251

END DO

254

252

DEALLOCATE(UNS_PERM_INV)

256

254

END IF

257

255

#endif

258

256

CALL MUMPS_276( id%ICNTL,

259

* id%INFO,

260

* id%COMM, id%MYID )

257

& id%INFO,

258

& id%COMM, id%MYID )

261

259

IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499

262

260

IF (LANAL) THEN

263

261

id%KEEP(40)=-1 -456789

268

266

IF (associated(id%IS1)) DEALLOCATE(id%IS1)

269

267

IF ( id%ICNTL(5) .EQ. 0 ) THEN

270

268

IF ( id%SYM .NE. 1

271

* .AND. (

272

* (id%ICNTL(6) .NE. 0 .AND. id%ICNTL(7) .NE.1)

273

* .OR.

274

* id%ICNTL(12) .NE. 1) ) THEN

269

& .AND. (

270

& (id%ICNTL(6) .NE. 0 .AND. id%ICNTL(7) .NE.1)

271

& .OR.

272

& id%ICNTL(12) .NE. 1) ) THEN

275

273

id%MAXIS1 = 11 * N

276

274

ELSE

277

275

id%MAXIS1 = 10 * N

284

282

id%INFO(1) = -7

285

283

id%INFO(2) = id%MAXIS1

286

284

IF ( LP .GT.0 )

287

* WRITE(LP,*) 'Problem in allocating work array for analysis.'

285

& WRITE(LP,*) 'Problem in allocating work array for analysis.'

288

286

GO TO 100

289

287

END IF

290

288

IF ( associated( id%PROCNODE ) )

291

* DEALLOCATE( id%PROCNODE )

289

& DEALLOCATE( id%PROCNODE )

292

290

ALLOCATE( id%PROCNODE(id%N), stat=ierr )

293

291

IF (ierr.gt.0) THEN

294

292

id%INFO(1) = -7

301

299

id%PROCNODE(1:id%N) = 0

302

300

IF ( id%ICNTL(5) .NE. 0 ) THEN

303

301

IF ( associated( id%ELTPROC ) )

304

* DEALLOCATE( id%ELTPROC )

302

& DEALLOCATE( id%ELTPROC )

305

303

ALLOCATE( id%ELTPROC(id%NELT), stat=ierr )

306

304

IF (ierr.gt.0) THEN

307

305

id%INFO(1) = -7

331

329

END IF

332

330

IF ( id%INFO( 1 ) .eq. -22 ) THEN

333

331

IF (LP.GT.0) WRITE(LP,*)

334

* 'Error in analysis: IRN/JCN badly allocated.'

332

& 'Error in analysis: IRN/JCN badly allocated.'

335

333

END IF

336

334

ELSE

337

335

IF ( .not. associated( id%ELTPTR ) ) THEN

367

365

END IF

368

366

IF ( id%INFO( 1 ) .eq. -22 ) THEN

369

367

IF (LP.GT.0) WRITE(LP,*)

370

* 'Error in analysis: ELTPTR/ELTVAR badly allocated.'

368

& 'Error in analysis: ELTPTR/ELTVAR badly allocated.'

371

369

END IF

372

370

ENDIF

373

371

100 CONTINUE

374

372

END IF

375

373

CALL MUMPS_276( id%ICNTL,

376

* id%INFO,

377

* id%COMM, id%MYID )

374

& id%INFO,

375

& id%COMM, id%MYID )

378

376

IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499

379

377

id%KEEP(52) = id%ICNTL(8)

380

378

IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2)

381

* id%KEEP(52) = 77

379

& id%KEEP(52) = 77

382

380

IF ((id%KEEP(52).EQ.77).AND.(id%SYM.EQ.1)) THEN

383

381

id%KEEP(52) = 0

384

382

ENDIF

387

385

ENDIF

388

386

IF(id%KEEP(52) .EQ. -1) id%KEEP(52) = 0

389

387

CALL DMUMPS_26( id )

390

IF (id%KEEP(52) .EQ. -2) THEN

391

id%ICNTL(8)=-2

392

ENDIF

388

IF (id%MYID .eq. MASTER) THEN

389

IF (id%KEEP(52) .NE. 0) THEN

390

id%INFOG(33)=id%KEEP(52)

391

ELSE

392

id%INFOG(33)=id%ICNTL(8)

393

ENDIF

394

ENDIF

393

395

IF (id%MYID .eq. MASTER) id%INFOG(24)=id%KEEP(95)

394

396

IF ( id%INFO( 1 ) .LT. 0 ) GO TO 499

395

397

id%KEEP(40) = 1 -456789

400

402

IF (id%KEEP(60).EQ.1) THEN

401

403

IF ( associated( id%SCHUR_CINTERFACE)) THEN

402

404

id%SCHUR=>id%SCHUR_CINTERFACE

403

* (1:id%SIZE_SCHUR*id%SIZE_SCHUR)

405

& (1:id%SIZE_SCHUR*id%SIZE_SCHUR)

404

406

ENDIF

405

407

IF ( .NOT. associated (id%SCHUR)) THEN

406

408

IF (LP.GT.0)

409

411

id%INFO(1)=-22

410

412

id%INFO(2)=9

411

413

ELSE IF ( size(id%SCHUR) .LT.

412

* id%SIZE_SCHUR * id%SIZE_SCHUR ) THEN

414

& id%SIZE_SCHUR * id%SIZE_SCHUR ) THEN

413

415

IF (LP.GT.0)

414

416

& write(LP,'(A)')

415

417

& ' SCHUR allocated but too small'

439

441

END IF

440

442

ENDIF

441

443

CALL MUMPS_633(id%KEEP(12),id%ICNTL(14),

442

* id%KEEP(50),id%KEEP(54),id%ICNTL(6),id%ICNTL(8))

444

& id%KEEP(50),id%KEEP(54),id%ICNTL(6),id%ICNTL(8))

443

445

CALL DMUMPS_635(N,id%KEEP,id%ICNTL,MPG)

444

IF( id%KEEP(52) .EQ. -2 .AND. id%ICNTL(8) .NE. -2) THEN

446

IF( id%KEEP(52) .EQ. -2 .AND. id%ICNTL(8) .NE. -2 .AND.

447

& id%ICNTL(8).NE. 77 ) THEN

445

448

IF ( MPG .GT. 0 ) THEN

446

449

WRITE(MPG,'(A)') ' ** WARNING : SCALING'

447

450

WRITE(MPG,'(A)')

448

* ' ** scaling already computed during analysis'

451

& ' ** scaling already computed during analysis'

449

452

WRITE(MPG,'(A)')

450

* ' ** keeping the scaling from the analysis'

453

& ' ** keeping the scaling from the analysis'

451

454

ENDIF

452

ELSE

455

ENDIF

456

IF (id%KEEP(52) .NE. -2) THEN

453

457

id%KEEP(52)=id%ICNTL(8)

454

458

ENDIF

455

459

IF ( id%KEEP(52) .GT. 8 .OR. id%KEEP(52).LT.-2)

456

* id%KEEP(52) = 77

460

& id%KEEP(52) = 77

457

461

IF (id%KEEP(52).EQ.77) THEN

458

462

IF (id%SYM.EQ.1) THEN

459

463

id%KEEP(52) = 0

465

469

IF ( MPG .GT. 0 ) THEN

466

470

WRITE(MPG,'(A)') ' ** WARNING : SCALING'

467

471

WRITE(MPG,'(A)')

468

* ' ** column permutation applied:'

472

& ' ** column permutation applied:'

469

473

WRITE(MPG,'(A)')

470

* ' ** column scaling has to be permuted'

474

& ' ** column scaling has to be permuted'

471

475

ENDIF

472

476

ENDIF

473

477

IF ( id%KEEP( 19 ) .ne. 0 .and. id%KEEP( 52 ).ne. 0 ) THEN

485

489

END IF

486

490

END IF

487

491

IF (id%KEEP(54) .NE. 0 .AND.

488

* id%KEEP(52).NE.7 .AND. id%KEEP(52).NE.8 .AND.

489

* id%KEEP(52) .NE. 0 ) THEN

492

& id%KEEP(52).NE.7 .AND. id%KEEP(52).NE.8 .AND.

493

& id%KEEP(52) .NE. 0 ) THEN

490

494

id%KEEP(52) = 0

491

495

IF ( MPG .GT. 0 .and. id%ICNTL(8) .ne. 0 ) THEN

492

496

WRITE(MPG,'(A)')

493

* ' ** Warning: This scaling option not available'

497

& ' ** Warning: This scaling option not available'

494

498

WRITE(MPG,'(A)') ' ** for distributed matrix entry'

495

499

END IF

496

500

END IF

497

501

IF ( id%KEEP(50) .NE. 0 ) THEN

498

502

IF ( id%KEEP(52).ne. 1 .and.

499

* id%KEEP(52).ne. -1 .and.

500

* id%KEEP(52).ne. 0 .and.

501

* id%KEEP(52).ne. 7 .and.

502

* id%KEEP(52).ne. 8 .and.

503

* id%KEEP(52).ne. -2 .and.

504

* id%KEEP(52).ne. 77) THEN

503

& id%KEEP(52).ne. -1 .and.

504

& id%KEEP(52).ne. 0 .and.

505

& id%KEEP(52).ne. 7 .and.

506

& id%KEEP(52).ne. 8 .and.

507

& id%KEEP(52).ne. -2 .and.

508

& id%KEEP(52).ne. 77) THEN

505

509

IF ( MPG .GT. 0 ) THEN

506

510

WRITE(MPG,'(A)')

507

* ' ** Warning: Scaling option n.a. for symmetric matrix'

511

& ' ** Warning: Scaling option n.a. for symmetric matrix'

508

512

END IF

509

513

id%KEEP(52) = 0

510

514

END IF

511

515

END IF

512

516

IF (id%KEEP(55) .NE. 0 .AND.

513

* ( id%KEEP(52) .gt. 0 ) ) THEN

517

& ( id%KEEP(52) .gt. 0 ) ) THEN

514

518

id%KEEP(52) = 0

515

519

IF ( MPG .GT. 0 ) THEN

516

520

WRITE(MPG,'(A)') ' ** Warning: Scaling not applied.'

517

521

WRITE(MPG,'(A)')

518

* ' ** (only user scaling av. for elt. entry)'

522

& ' ** (only user scaling av. for elt. entry)'

519

523

END IF

520

524

END IF

521

525

IF ( id%KEEP(52) .eq. -1 ) THEN

534

538

END IF

535

539

END IF

536

540

IF (id%KEEP(52).GT.0 .AND.

537

* id%KEEP(52) .LE.8) THEN

541

& id%KEEP(52) .LE.8) THEN

538

542

IF ( associated(id%COLSCA))

539

* DEALLOCATE( id%COLSCA )

543

& DEALLOCATE( id%COLSCA )

540

544

IF ( associated(id%ROWSCA))

541

* DEALLOCATE( id%ROWSCA )

545

& DEALLOCATE( id%ROWSCA )

542

546

ALLOCATE( id%COLSCA(N), stat=ierr)

543

547

IF (ierr .GT.0) id%INFO(1)=-13

544

548

ALLOCATE( id%ROWSCA(N), stat=ierr)

549

553

END IF

550

554

IF (ierr .GT.0) id%INFO(1)=-13

551

555

IF (.NOT. associated(id%ROWSCA))

552

* ALLOCATE( id%ROWSCA(1), stat=ierr)

556

& ALLOCATE( id%ROWSCA(1), stat=ierr)

553

557

IF (ierr .GT.0) id%INFO(1)=-13

554

558

IF ( id%INFO(1) .eq. -13 ) THEN

555

559

IF ( LP .GT. 0 )

556

* WRITE(LP,*) 'Problems in allocations before facto'

560

& WRITE(LP,*) 'Problems in allocations before facto'

557

561

GOTO 200

558

562

END IF

559

563

200 CONTINUE

562

566

IF ( id%root%yes ) THEN

563

567

IF ( associated( id%SCHUR_CINTERFACE )) THEN

564

568

id%SCHUR=>id%SCHUR_CINTERFACE

565

* (1:id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+

566

* id%root%SCHUR_MLOC)

569

& (1:id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+

570

& id%root%SCHUR_MLOC)

567

571

ENDIF

568

572

IF (id%SCHUR_LLD < id%root%SCHUR_MLOC) THEN

569

573

IF (LP.GT.0) write(LP,*)

578

582

id%INFO(1)=-22

579

583

id%INFO(2)=9

580

584

ELSE IF (size(id%SCHUR) <

581

* id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+

582

* id%root%SCHUR_MLOC) THEN

585

& id%SCHUR_LLD*(id%root%SCHUR_NLOC-1)+

586

& id%root%SCHUR_MLOC) THEN

583

587

IF (LP.GT.0) THEN

584

588

write(LP,'(A)')

585

589

& ' SCHUR allocated but too small'

602

606

ENDIF

603

607

ENDIF

604

608

CALL MUMPS_276( id%ICNTL,

605

* id%INFO,

606

* id%COMM, id%MYID )

609

& id%INFO,

610

& id%COMM, id%MYID )

607

611

IF ( id%INFO(1) .LT. 0 ) GO TO 499

608

612

CALL DMUMPS_142(id)

613

IF (id%MYID .eq. MASTER) id%INFOG(33)=id%KEEP(52)

609

614

IF (id%KEEP(60).EQ.2.OR.id%KEEP(60).EQ.3) THEN

610

615

IF (id%root%yes) THEN

611

616

IF (id%root%SCHUR_NLOC==0) THEN

632

637

CALL MPI_BCAST( ICNTL20, 1, MPI_INTEGER, MASTER, id%COMM, ierr )

633

638

CALL MPI_BCAST( ICNTL21, 1, MPI_INTEGER, MASTER, id%COMM, ierr )

634

639

CALL MPI_BCAST( id%KEEP(221), 1, MPI_INTEGER, MASTER, id%COMM,

635

* ierr )

640

& ierr )

636

641

id%KEEP(40) = 2 -456789

637

642

IF ( id%MYID .EQ. MASTER ) THEN

638

643

IF (ICNTL20 == 0 .OR. ICNTL21==0) THEN

734

739

IF (ICNTL21==1) THEN

735

740

IF (id%MYID==MASTER) NRHS_TMP=id%NRHS

736

741

CALL MPI_BCAST( NRHS_TMP, 1, MPI_INTEGER, MASTER,

737

* id%COMM, ierr )

742

& id%COMM, ierr )

738

743

IF ( id%MYID .ne. MASTER .OR.

739

* ( id%MYID .eq. MASTER .AND.

740

* id%KEEP(46) .eq. 1 ) ) THEN

744

& ( id%MYID .eq. MASTER .AND.

745

& id%KEEP(46) .eq. 1 ) ) THEN

741

746

IF ( id%LSOL_LOC < id%KEEP(89) ) THEN

742

747

id%INFO(1)= -29

743

748

id%INFO(2)= id%LSOL_LOC

763

768

GOTO 333

764

769

END IF

765

770

IF (size(id%SOL_LOC) <

766

* (NRHS_TMP-1)*id%LSOL_LOC+id%KEEP(89)) THEN

771

& (NRHS_TMP-1)*id%LSOL_LOC+id%KEEP(89)) THEN

767

772

id%INFO(1)=-22

768

773

id%INFO(2)=14

769

774

GOTO 333

796

801

END IF

797

802

333 CONTINUE

798

803

CALL MUMPS_276( id%ICNTL,

799

* id%INFO,

800

* id%COMM, id%MYID )

804

& id%INFO,

805

& id%COMM, id%MYID )

801

806

IF ( id%INFO(1) .LT. 0 ) GO TO 499

802

807

CALL DMUMPS_301(id)

803

808

IF (id%INFO(1).LT.0) GOTO 499

806

811

IF (MP.GT.0) CALL DMUMPS_349(id, MP)

807

812

GOTO 500

808

813

499 PROK = ((id%ICNTL(1).GT.0).AND.

809

* (id%ICNTL(4).GE.1))

814

& (id%ICNTL(4).GE.1))

810

815

IF (PROK) WRITE (id%ICNTL(1),99995) id%INFO(1)

811

816

IF (PROK) WRITE (id%ICNTL(1),99994) id%INFO(2)

812

817

500 CONTINUE

813

818

#if ! defined(LARGEMATRICES)

814

819

IF (id%MYID .eq. MASTER .AND. id%KEEP(23) .NE. 0

815

* .AND. NOERRORBEFOREPERM) THEN

820

& .AND. NOERRORBEFOREPERM) THEN

816

821

IF (id%JOB .NE. 3 .OR. UNS_PERM_DONE) THEN

817

822

DO I = 1, id%NZ

818

823

J=id%JCN(I)

824

IF (J.LE.0.OR.J.GT.id%N) CYCLE

819

825

id%JCN(I)=id%UNS_PERM(J)

820

826

END DO

821

827

END IF

824

830

510 CONTINUE

825

831

CALL DMUMPS_300( id%INFO, id%INFOG, id%COMM, id%MYID )

826

832

CALL MPI_BCAST( id%RINFOG(1), 20, MPI_DOUBLE_PRECISION, MASTER,

827

* id%COMM, ierr )

833

& id%COMM, ierr )

828

834

IF (id%MYID.EQ.MASTER.and.MPG.GT.0.and.

829

* id%INFOG(1).lt.0) THEN

835

& id%INFOG(1).lt.0) THEN

830

836

WRITE(MPG,'(A,I12)') ' On return from DMUMPS, INFOG(1)=',

831

* id%INFOG(1)

837

& id%INFOG(1)

832

838

WRITE(MPG,'(A,I12)') ' On return from DMUMPS, INFOG(2)=',

833

* id%INFOG(2)

839

& id%INFOG(2)

834

840

END IF

835

841

CALL MPI_COMM_FREE( id%COMM, ierr )

836

842

id%COMM = COMM_SAVE

843

849

IMPLICIT NONE

844

850

INCLUDE 'mpif.h'

845

851

INTEGER INFO(40), INFOG(40), COMM, MYID

846

INTEGER*4 TMP1(2),TMP(2)

852

INTEGER TMP1(2),TMP(2)

847

853

INTEGER ROOT, ierr

848

854

INTEGER MASTER

849

855

PARAMETER (MASTER=0)

855

861

TMP1(1) = INFO(1)

856

862

TMP1(2) = MYID

857

863

CALL MPI_ALLREDUCE(TMP1,TMP,1,MPI_2INTEGER,

858

* MPI_MINLOC,COMM,ierr )

864

& MPI_MINLOC,COMM,ierr )

859

865

INFOG(2) = INFO(2)

860

866

ROOT = TMP(2)

861

867

CALL MPI_BCAST( INFOG(1), 1, MPI_INTEGER, ROOT, COMM, ierr )

930

936

ENDIF

931

937

980 FORMAT (/'***********CONTROL PARAMETERS (ICNTL)**************'/)

932

938

990 FORMAT (

933

1 'ICNTL(1) Output stream for error messages =',I10/

934

2 'ICNTL(2) Output stream for diagnostic messages =',I10/

935

3 'ICNTL(3) Output stream for global information =',I10/

936

4 'ICNTL(4) Level of printing =',I10)

939

& 'ICNTL(1) Output stream for error messages =',I10/

940

& 'ICNTL(2) Output stream for diagnostic messages =',I10/

941

& 'ICNTL(3) Output stream for global information =',I10/

942

& 'ICNTL(4) Level of printing =',I10)

937

943

991 FORMAT (

938

1 'ICNTL(5) Matrix format ( keep(55) ) =',I10/

939

2 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/

940

3 'ICNTL(7) Ordering =',I10/

941

4 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/

942

5 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/

943

7 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/

944

8 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/

945

9 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10)

944

& 'ICNTL(5) Matrix format ( keep(55) ) =',I10/

945

& 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/

946

& 'ICNTL(7) Ordering =',I10/

947

& 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/

948

& 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/

949

& 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/

950

& 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/

951

& 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10)

946

952

992 FORMAT (

947

1 'ICNTL(8) Scaling strategy =',I10)

953

& 'ICNTL(8) Scaling strategy =',I10)

948

954

993 FORMAT (

949

1 'ICNTL(14) Percent of memory increase =',I10)

955

& 'ICNTL(14) Percent of memory increase =',I10)

950

956

995 FORMAT (

951

1 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/

952

2 'ICNTL(10) Max steps iterative refinement =',I10/

953

3 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10)

957

& 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/

958

& 'ICNTL(10) Max steps iterative refinement =',I10/

959

& 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10)

954

960

998 FORMAT (

955

1 ' Size of SCHUR matrix (SIZE_SHUR) =',I10)

961

& ' Size of SCHUR matrix (SIZE_SHUR) =',I10)

956

962

END SUBROUTINE DMUMPS_349

957

963

SUBROUTINE DMUMPS_350(id, LP)

958

964

USE DMUMPS_STRUC_DEF

1032

1038

ENDIF

1033

1039

980 FORMAT (/'******INTERNAL VALUE OF PARAMETERS (ICNTL/KEEP)****'/)

1034

1040

990 FORMAT (

1035

1 'ICNTL(1) Output stream for error messages =',I10/

1036

2 'ICNTL(2) Output stream for diagnostic messages =',I10/

1037

3 'ICNTL(3) Output stream for global information =',I10/

1038

4 'ICNTL(4) Level of printing =',I10)

1041

& 'ICNTL(1) Output stream for error messages =',I10/

1042

& 'ICNTL(2) Output stream for diagnostic messages =',I10/

1043

& 'ICNTL(3) Output stream for global information =',I10/

1044

& 'ICNTL(4) Level of printing =',I10)

1039

1045

991 FORMAT (

1040

1 'ICNTL(5) Matrix format ( keep(55) ) =',I10/

1041

2 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/

1042

3 'ICNTL(7) Ordering =',I10/

1043

4 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/

1044

5 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/

1045

7 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/

1046

8 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/

1047

9 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10)

1046

& 'ICNTL(5) Matrix format ( keep(55) ) =',I10/

1047

& 'ICNTL(6) Maximum transversal ( keep(23) ) =',I10/

1048

& 'ICNTL(7) Ordering =',I10/

1049

& 'ICNTL(12) LDLT ordering strat ( keep(95) ) =',I10/

1050

& 'ICNTL(13) Parallel root (0=on, 1=off) =',I10/

1051

& 'ICNTL(18) Distributed matrix ( keep(54) ) =',I10/

1052

& 'ICNTL(19) Schur option ( keep(60) 0=off,else=on ) =',I10/

1053

& 'ICNTL(22) Out-off-core option (0=Off, >0=ON) =',I10)

1048

1054

992 FORMAT (

1049

1 'ICNTL(8) Scaling strategy ( keep(52) ) =',I10)

1055

& 'ICNTL(8) Scaling strategy ( keep(52) ) =',I10)

1050

1056

993 FORMAT (

1051

1 'ICNTL(14) Percent of memory increase ( keep(12) ) =',I10)

1057

& 'ICNTL(14) Percent of memory increase ( keep(12) ) =',I10)

1052

1058

995 FORMAT (

1053

1 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/

1054

2 'ICNTL(10) Max steps iterative refinement =',I10/

1055

3 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10/

1056

4 'ICNTL(20) Dense (0) or sparse (1) RHS =',I10/

1057

4 'ICNTL(21) Gathered (0) or distributed(1) solution =',I10)

1059

& 'ICNTL(9) Solve A x=b (1) or A''x = b (else) =',I10/

1060

& 'ICNTL(10) Max steps iterative refinement =',I10/

1061

& 'ICNTL(11) Error analysis ( 0= off, else=on) =',I10/

1062

& 'ICNTL(20) Dense (0) or sparse (1) RHS =',I10/

1063

& 'ICNTL(21) Gathered (0) or distributed(1) solution =',I10)

1058

1064

END SUBROUTINE DMUMPS_350

1059

1065

SUBROUTINE DMUMPS_24( MYID, SLAVEF, N,

1060

* PROCNODE, STEP, PTRAIW, PTRARW, ISTEP_TO_INIV2,

1061

* I_AM_CAND,

1062

* KEEP, KEEP8, ICNTL, id )

1066

& PROCNODE, STEP, PTRAIW, PTRARW, ISTEP_TO_INIV2,

1067

& I_AM_CAND,

1068

& KEEP, KEEP8, ICNTL, id )

1063

1069

USE DMUMPS_STRUC_DEF

1064

1070

IMPLICIT NONE

1065

1071

TYPE (DMUMPS_STRUC) :: id

1067

1073

INTEGER KEEP( 500 ), ICNTL( 40 )

1068

1074

INTEGER*8 KEEP8(150)

1069

1075

INTEGER PROCNODE( KEEP(28) ), STEP( N ),

1070

* PTRAIW( N ), PTRARW( N )

1076

& PTRAIW( N ), PTRARW( N )

1071

1077

INTEGER ISTEP_TO_INIV2(KEEP(71))

1072

1078

LOGICAL I_AM_CAND(max(1,KEEP(56)))

1073

1079

LOGICAL I_AM_SLAVE

1092

1098

IRANK = IRANK + 1

1093

1099

END IF

1094

1100

IF ( (ITYPE .EQ. 1.OR.ITYPE.EQ.2) .AND.

1095

* IRANK .EQ. MYID ) THEN

1101

& IRANK .EQ. MYID ) THEN

1096

1102

KEEP( 14 ) = KEEP( 14 ) + 3 + PTRAIW( I ) + PTRARW( I )

1097

1103

KEEP( 13 ) = KEEP( 13 ) + 1 + PTRAIW( I ) + PTRARW( I )

1098

1104

ELSE IF ( ITYPE .EQ. 3 ) THEN

1131

1137

IRANK =IRANK + 1

1132

1138

END IF

1133

1139

IF (

1134

* ( ITYPE .eq. 2 .and.

1135

* IRANK .eq. MYID )

1136

* .or.

1137

* ( ITYPE .eq. 1 .and.

1138

* IRANK .eq. MYID )

1139

* ) THEN

1140

& ( ITYPE .eq. 2 .and.

1141

& IRANK .eq. MYID )

1142

& .or.

1143

& ( ITYPE .eq. 1 .and.

1144

& IRANK .eq. MYID )

1145

& ) THEN

1140

1146

NCOL = PTRAIW( I )

1141

1147

NROW = PTRARW( I )

1142

1148

id%INTARR( IPTRI ) = NCOL

1148

1154

IPTRR = IPTRR + NCOL + NROW + 1

1149

1155

ELSE IF ( ITYPE .eq. 2 ) THEN

1150

1156

IF ( I_AM_CAND(ISTEP_TO_INIV2(ISTEP)))

1151

* THEN

1157

& THEN

1152

1158

NCOL = PTRAIW( I )

1153

1159

NROW = 0

1154

1160

id%INTARR( IPTRI ) = NCOL

1178

1184

RETURN

1179

1185

END SUBROUTINE DMUMPS_24

1180

1186

SUBROUTINE DMUMPS_148(N, NZ, ASPK,

1181

* IRN, ICN, PERM,

1182

* LSCAL,COLSCA,ROWSCA,

1183

* MYID, SLAVEF, PROCNODE_STEPS, NBRECORDS,

1184

* LP, COMM, root, KEEP, KEEP8, FILS, RG2L,

1185

* INTARR, DBLARR, PTRAIW, PTRARW, FRERE_STEPS,

1186

* STEP, A, LA, ISTEP_TO_INIV2, I_AM_CAND, CANDIDATES )

1187

& IRN, ICN, PERM,

1188

& LSCAL,COLSCA,ROWSCA,

1189

& MYID, SLAVEF, PROCNODE_STEPS, NBRECORDS,

1190

& LP, COMM, root, KEEP, KEEP8, FILS, RG2L,

1191

& INTARR, DBLARR, PTRAIW, PTRARW, FRERE_STEPS,

1192

& STEP, A, LA, ISTEP_TO_INIV2, I_AM_CAND, CANDIDATES )

1187

1193

IMPLICIT NONE

1188

1194

INCLUDE 'dmumps_root.h'

1189

1195

INTEGER N,NZ, COMM, NBRECORDS

1200

1206

INTEGER CANDIDATES(SLAVEF+1, max(1,KEEP(56)))

1201

1207

LOGICAL LSCAL

1202

1208

TYPE (DMUMPS_ROOT_STRUC) :: root

1203

INTEGER LA

1209

INTEGER(8) :: LA

1204

1210

INTEGER PTRAIW( N ), PTRARW( N ), FRERE_STEPS( KEEP(28) )

1205

1211

INTEGER STEP(N)

1206

1212

INTEGER INTARR( max(1,KEEP(14)) )

1216

1222

INTEGER INODE, ISTEP

1217

1223

INTEGER NBUFS

1218

1224

INTEGER ARROW_ROOT, TAILLE

1219

INTEGER LOCAL_M, LOCAL_N, PTR_ROOT

1225

INTEGER LOCAL_M, LOCAL_N

1226

INTEGER(8) :: PTR_ROOT

1220

1227

INTEGER TYPENODE_TMP, MASTER_NODE

1221

1228

LOGICAL I_AM_CAND_LOC, I_AM_SLAVE

1222

1229

INTEGER I1, IA, JARR, ILOCROOT, JLOCROOT

1248

1255

END DO

1249

1256

IF ( KEEP(38) .NE. 0 ) THEN

1250

1257

IF (KEEP(60)==0) THEN

1251

LOCAL_M = NUMROC( root%ROOT_SIZE, root%MBLOCK,

1252

* root%MYROW, 0, root%NPROW )

1253

LOCAL_M = max( 1, LOCAL_M )

1254

LOCAL_N = NUMROC( root%ROOT_SIZE, root%NBLOCK,

1255

* root%MYCOL, 0, root%NPCOL )

1256

PTR_ROOT = LA - LOCAL_M * LOCAL_N + 1

1257

IF ( PTR_ROOT .LE. LA ) THEN

1258

A( PTR_ROOT:LA ) = dble(ZERO)

1259

END IF

1258

LOCAL_M = NUMROC( root%ROOT_SIZE, root%MBLOCK,

1259

& root%MYROW, 0, root%NPROW )

1260

LOCAL_M = max( 1, LOCAL_M )

1261

LOCAL_N = NUMROC( root%ROOT_SIZE, root%NBLOCK,

1262

& root%MYCOL, 0, root%NPCOL )

1263

PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8

1264

IF ( PTR_ROOT .LE. LA ) THEN

1265

A( PTR_ROOT:LA ) = dble(ZERO)

1266

END IF

1260

1267

ELSE

1261

1268

DO I = 1, root%SCHUR_NLOC

1262

root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1:

1263

* (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=dble(ZERO)

1269

root%SCHUR_POINTER(int(I-1,8)*int(root%SCHUR_LLD,8)+1_8:

1270

& int(I-1,8)*int(root%SCHUR_LLD,8)+int(root%SCHUR_MLOC,8))=

1271

& dble(ZERO)

1264

1272

ENDDO

1265

1273

ENDIF

1266

1274

END IF

1291

1299

IOLD = IRN(K)

1292

1300

JOLD = ICN(K)

1293

1301

IF ( (IOLD.GT.N).OR.(JOLD.GT.N).OR.(IOLD.LT.1)

1294

* .OR.(JOLD.LT.1) ) THEN

1302

& .OR.(JOLD.LT.1) ) THEN

1295

1303

GOTO 120

1296

1304

END IF

1297

1305

IF (LSCAL) THEN

1317

1325

IARR = abs( ISEND )

1318

1326

ISTEP = abs( STEP(IARR) )

1319

1327

TYPENODE_TMP = MUMPS_330( ISTEP,

1320

* PROCNODE_STEPS, SLAVEF )

1328

& PROCNODE_STEPS, SLAVEF )

1321

1329

MASTER_NODE = MUMPS_275( ISTEP,

1322

* PROCNODE_STEPS, SLAVEF )

1330

& PROCNODE_STEPS, SLAVEF )

1323

1331

I_AM_CAND_LOC = .FALSE.

1324

1332

IF (TYPENODE_TMP .EQ. 2 .AND. I_AM_SLAVE) THEN

1325

1333

I_AM_CAND_LOC = I_AM_CAND(ISTEP_TO_INIV2(ISTEP))

1357

1365

END IF

1358

1366

END IF

1359

1367

IF ( DEST .eq. 0 .or.

1360

* ( DEST .eq. -1 .and. KEEP( 46 ) .eq. 1 .AND.

1361

* ( I_AM_CAND_LOC .OR. MASTER_NODE .EQ. 0 ) )) THEN

1368

& ( DEST .eq. -1 .and. KEEP( 46 ) .eq. 1 .AND.

1369

& ( I_AM_CAND_LOC .OR. MASTER_NODE .EQ. 0 ) )) THEN

1362

1370

IARR = ISEND

1363

1371

JARR = JSEND

1364

1372

IF ( TYPENODE_TMP .eq. 3 ) THEN

1365

1373

ARROW_ROOT = ARROW_ROOT + 1

1366

1374

IF ( IROW_GRID .EQ. root%MYROW .AND.

1367

* JCOL_GRID .EQ. root%MYCOL ) THEN

1375

& JCOL_GRID .EQ. root%MYCOL ) THEN

1368

1376

ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) /

1369

* ( root%MBLOCK * root%NPROW ) )

1370

* + mod( IPOSROOT - 1, root%MBLOCK ) + 1

1377

& ( root%MBLOCK * root%NPROW ) )

1378

& + mod( IPOSROOT - 1, root%MBLOCK ) + 1

1371

1379

JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) /

1372

* ( root%NBLOCK * root%NPCOL ) )

1373

* + mod( JPOSROOT - 1, root%NBLOCK ) + 1

1380

& ( root%NBLOCK * root%NPCOL ) )

1381

& + mod( JPOSROOT - 1, root%NBLOCK ) + 1

1374

1382

IF (KEEP(60)==0) THEN

1375

A( PTR_ROOT + ( JLOCROOT - 1 ) * LOCAL_M

1376

* + ILOCROOT - 1 ) = A( PTR_ROOT + (JLOCROOT - 1)

1377

* * LOCAL_M + ILOCROOT - 1 ) + VAL

1383

A( PTR_ROOT

1384

& + int(JLOCROOT - 1,8) * int(LOCAL_M,8)

1385

& + int(ILOCROOT - 1,8) )

1386

& = A( PTR_ROOT

1387

& + int(JLOCROOT - 1,8) * int(LOCAL_M,8)

1388

& + int(ILOCROOT - 1,8) )

1389

& + VAL

1378

1390

ELSE

1379

root%SCHUR_POINTER( ( JLOCROOT - 1 ) * root%SCHUR_LLD

1380

* + ILOCROOT ) = root%SCHUR_POINTER( (JLOCROOT - 1)

1381

* * root%SCHUR_LLD + ILOCROOT) + VAL

1391

root%SCHUR_POINTER( int(JLOCROOT - 1,8)

1392

& * int(root%SCHUR_LLD,8)

1393

& + int(ILOCROOT,8) )

1394

& = root%SCHUR_POINTER( int(JLOCROOT - 1,8)

1395

& * int(root%SCHUR_LLD,8)

1396

& + int(ILOCROOT,8))

1397

& + VAL

1382

1398

ENDIF

1383

1399

ELSE

1384

1400

WRITE(*,*) MYID,':INTERNAL Error: root arrowhead '

1385

1401

WRITE(*,*) MYID,':is not belonging to me. IARR,JARR='

1386

* ,IARR,JARR

1402

& ,IARR,JARR

1387

1403

CALL MUMPS_ABORT()

1388

1404

END IF

1389

1405

ELSE IF ( IARR .GE. 0 ) THEN

1408

1424

IW4(IARR,1) = IW4(IARR,1) - 1

1409

1425

DBLARR(IAS) = VAL

1410

1426

IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0 )

1411

* .AND. IW4(IARR,1) .EQ. 0 .AND.

1412

* STEP( IARR) > 0 ) THEN

1427

& .AND. IW4(IARR,1) .EQ. 0 .AND.

1428

& STEP( IARR) > 0 ) THEN

1413

1429

IF (MUMPS_275( abs(STEP(IARR)),

1414

* PROCNODE_STEPS,SLAVEF ) == MYID) THEN

1430

& PROCNODE_STEPS,SLAVEF ) == MYID) THEN

1415

1431

TAILLE = INTARR( PTRAIW(IARR) )

1416

1432

CALL DMUMPS_310( N, PERM,

1417

* INTARR( PTRAIW(IARR) + 3 ),

1418

* DBLARR( PTRARW(IARR) + 1 ),

1419

* TAILLE, 1, TAILLE )

1433

& INTARR( PTRAIW(IARR) + 3 ),

1434

& DBLARR( PTRARW(IARR) + 1 ),

1435

& TAILLE, 1, TAILLE )

1420

1436

END IF

1421

1437

END IF

1422

1438

ENDIF

1426

1442

DEST=CANDIDATES(I,ISTEP_TO_INIV2(ISTEP))

1427

1443

IF (KEEP(46).EQ.0) DEST=DEST+1

1428

1444

IF (DEST.NE.0)

1429

* CALL DMUMPS_34( ISEND, JSEND, VAL,

1430

* DEST, BUFI, BUFR, NBRECORDS, NBUFS,

1431

* LP, COMM, KEEP(46))

1445

& CALL DMUMPS_34( ISEND, JSEND, VAL,

1446

& DEST, BUFI, BUFR, NBRECORDS, NBUFS,

1447

& LP, COMM, KEEP(46))

1432

1448

ENDDO

1433

1449

DEST = MASTER_NODE

1434

1450

IF (KEEP(46).EQ.0) DEST=DEST+1

1435

1451

IF ( DEST .NE. 0 ) THEN

1436

1452

CALL DMUMPS_34( ISEND, JSEND, VAL,

1437

* DEST, BUFI, BUFR, NBRECORDS, NBUFS,

1438

* LP, COMM, KEEP(46))

1453

& DEST, BUFI, BUFR, NBRECORDS, NBUFS,

1454

& LP, COMM, KEEP(46))

1439

1455

ENDIF

1440

1456

ELSE IF ( DEST .GT. 0 ) THEN

1441

1457

CALL DMUMPS_34( ISEND, JSEND, VAL,

1442

* DEST, BUFI, BUFR, NBRECORDS, NBUFS,

1443

* LP, COMM, KEEP(46))

1458

& DEST, BUFI, BUFR, NBRECORDS, NBUFS,

1459

& LP, COMM, KEEP(46))

1444

1460

END IF

1445

1461

120 CONTINUE

1446

1462

KEEP(49) = ARROW_ROOT

1447

1463

IF (NBUFS.GT.0) THEN

1448

1464

CALL DMUMPS_18(

1449

* BUFI, BUFR, NBRECORDS, NBUFS,

1450

* LP, COMM, KEEP( 46 ) )

1465

& BUFI, BUFR, NBRECORDS, NBUFS,

1466

& LP, COMM, KEEP( 46 ) )

1451

1467

ENDIF

1452

1468

IF ( KEEP( 46 ) .NE. 0 ) DEALLOCATE( IW4 )

1453

1469

IF (NBUFS.GT.0) THEN

1457

1473

RETURN

1458

1474

END SUBROUTINE DMUMPS_148

1459

1475

SUBROUTINE DMUMPS_34(ISEND, JSEND, VAL,

1460

* DEST, BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM,

1461

* TYPE_PARALL )

1476

& DEST, BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM,

1477

& TYPE_PARALL )

1462

1478

IMPLICIT NONE

1463

1479

INTEGER ISEND, JSEND, DEST, NBUFS, NBRECORDS, TYPE_PARALL

1464

1480

INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS )

1474

1490

TAILLE_SENDI = BUFI(1,DEST) * 2 + 1

1475

1491

TAILLE_SENDR = BUFI(1,DEST)

1476

1492

CALL MPI_SEND(BUFI(1,DEST),TAILLE_SENDI,

1477

* MPI_INTEGER,

1478

* DEST, ARROWHEAD, COMM, IERR )

1493

& MPI_INTEGER,

1494

& DEST, ARROWHEAD, COMM, IERR )

1479

1495

CALL MPI_SEND( BUFR(1,DEST), TAILLE_SENDR,

1480

* MPI_DOUBLE_PRECISION, DEST,

1481

* ARROWHEAD, COMM, IERR )

1496

& MPI_DOUBLE_PRECISION, DEST,

1497

& ARROWHEAD, COMM, IERR )

1482

1498

BUFI(1,DEST) = 0

1483

1499

ENDIF

1484

1500

IREQ = BUFI(1,DEST) + 1

1490

1506

RETURN

1491

1507

END SUBROUTINE DMUMPS_34

1492

1508

SUBROUTINE DMUMPS_18(

1493

* BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM,

1494

* TYPE_PARALL )

1509

& BUFI, BUFR, NBRECORDS, NBUFS, LP, COMM,

1510

& TYPE_PARALL )

1495

1511

IMPLICIT NONE

1496

1512

INTEGER NBUFS, NBRECORDS, TYPE_PARALL

1497

1513

INTEGER BUFI( NBRECORDS * 2 + 1, NBUFS )

1506

1522

TAILLE_SENDR = BUFI(1,ISLAVE)

1507

1523

BUFI(1,ISLAVE) = - BUFI(1,ISLAVE)

1508

1524

CALL MPI_SEND(BUFI(1,ISLAVE),TAILLE_SENDI,

1509

* MPI_INTEGER,

1510

* ISLAVE, ARROWHEAD, COMM, IERR )

1525

& MPI_INTEGER,

1526

& ISLAVE, ARROWHEAD, COMM, IERR )

1511

1527

IF ( TAILLE_SENDR .NE. 0 ) THEN

1512

1528

CALL MPI_SEND( BUFR(1,ISLAVE), TAILLE_SENDR,

1513

* MPI_DOUBLE_PRECISION, ISLAVE,

1514

* ARROWHEAD, COMM, IERR )

1529

& MPI_DOUBLE_PRECISION, ISLAVE,

1530

& ARROWHEAD, COMM, IERR )

1515

1531

END IF

1516

1532

ENDDO

1517

1533

RETURN

1518

1534

END SUBROUTINE DMUMPS_18

1519

1535

RECURSIVE SUBROUTINE DMUMPS_310( N, PERM,

1520

* INTLIST, DBLLIST, TAILLE, LO, HI )

1536

& INTLIST, DBLLIST, TAILLE, LO, HI )

1521

1537

IMPLICIT NONE

1522

1538

INTEGER N, TAILLE

1523

1539

INTEGER PERM( N )

1552

1568

ENDIF

1553

1569

IF ( I <= J ) GOTO 10

1554

1570

IF ( LO < J ) CALL DMUMPS_310(N, PERM,

1555

* INTLIST, DBLLIST, TAILLE, LO, J)

1571

& INTLIST, DBLLIST, TAILLE, LO, J)

1556

1572

IF ( I < HI ) CALL DMUMPS_310(N, PERM,

1557

* INTLIST, DBLLIST, TAILLE, I, HI)

1573

& INTLIST, DBLLIST, TAILLE, I, HI)

1558

1574

RETURN

1559

1575

END SUBROUTINE DMUMPS_310

1560

1576

SUBROUTINE DMUMPS_145( N,

1561

* DBLARR, LDBLARR, INTARR, LINTARR, PTRAIW, PTRARW,

1562

* KEEP, KEEP8, MYID, COMM, NBRECORDS,

1563

* A, LA, root,

1564

* PROCNODE_STEPS,

1565

* SLAVEF, PERM, FRERE_STEPS, STEP, INFO1, INFO2

1566

* )

1577

& DBLARR, LDBLARR, INTARR, LINTARR, PTRAIW, PTRARW,

1578

& KEEP, KEEP8, MYID, COMM, NBRECORDS,

1579

& A, LA, root,

1580

& PROCNODE_STEPS,

1581

& SLAVEF, PERM, FRERE_STEPS, STEP, INFO1, INFO2

1582

& )

1567

1583

IMPLICIT NONE

1568

1584

INCLUDE 'dmumps_root.h'

1569

1585

INTEGER N, MYID, LDBLARR, LINTARR,

1570

* COMM

1586

& COMM

1571

1587

INTEGER INTARR(LINTARR)

1572

1588

INTEGER PTRAIW(N), PTRARW(N)

1573

1589

INTEGER KEEP(500)

1574

1590

INTEGER*8 KEEP8(150)

1575

INTEGER LA

1591

INTEGER(8), intent(IN) :: LA

1576

1592

INTEGER PROCNODE_STEPS( KEEP(28) ), PERM( N )

1577

1593

INTEGER SLAVEF, NBRECORDS

1578

1594

DOUBLE PRECISION A( LA )

1586

1602

INTEGER IREC, NB_REC, IARR, JARR, IA, I1, I, allocok

1587

1603

INTEGER IS, IS1, ISHIFT, IIW, IAS

1588

1604

INTEGER LOCAL_M, LOCAL_N, ILOCROOT, JLOCROOT,

1589

* IPOSROOT, JPOSROOT, TAILLE,

1590

* IPROC

1605

& IPOSROOT, JPOSROOT, TAILLE,

1606

& IPROC

1591

1607

INTEGER FRERE_STEPS( KEEP(28) ), STEP(N)

1592

INTEGER ARROW_ROOT, TYPE_PARALL, PTR_ROOT

1608

INTEGER(8) :: PTR_ROOT

1609

INTEGER ARROW_ROOT, TYPE_PARALL

1593

1610

INTEGER MUMPS_330, MUMPS_275

1594

1611

EXTERNAL MUMPS_330, MUMPS_275

1595

1612

DOUBLE PRECISION VAL

1629

1646

IF ( KEEP(38).NE.0) THEN

1630

1647

IF (KEEP(60)==0) THEN

1631

1648

LOCAL_M = NUMROC( root%ROOT_SIZE, root%MBLOCK,

1632

* root%MYROW, 0, root%NPROW )

1649

& root%MYROW, 0, root%NPROW )

1633

1650

LOCAL_M = max( 1, LOCAL_M )

1634

1651

LOCAL_N = NUMROC( root%ROOT_SIZE, root%NBLOCK,

1635

* root%MYCOL, 0, root%NPCOL )

1636

PTR_ROOT = LA - LOCAL_M * LOCAL_N + 1

1652

& root%MYCOL, 0, root%NPCOL )

1653

PTR_ROOT = LA - int(LOCAL_M,8) * int(LOCAL_N,8) + 1_8

1637

1654

IF ( PTR_ROOT .LE. LA ) THEN

1638

1655

A( PTR_ROOT:LA ) = dble(ZERO)

1639

1656

END IF

1640

1657

ELSE

1641

1658

DO I=1, root%SCHUR_NLOC

1642

1659

root%SCHUR_POINTER((I-1)*root%SCHUR_LLD+1:

1643

* (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=dble(ZERO)

1660

& (I-1)*root%SCHUR_LLD+root%SCHUR_MLOC)=dble(ZERO)

1644

1661

ENDDO

1645

1662

ENDIF

1646

1663

END IF

1657

1674

ENDDO

1658

1675

DO WHILE (.NOT.FINI)

1659

1676

CALL MPI_RECV( BUFI(1), 2*NBRECORDS+1,

1660

* MPI_INTEGER, MASTER,

1661

* ARROWHEAD,

1662

* COMM, STATUS, IERR )

1677

& MPI_INTEGER, MASTER,

1678

& ARROWHEAD,

1679

& COMM, STATUS, IERR )

1663

1680

NB_REC = BUFI(1)

1664

1681

IF (NB_REC.LE.0) THEN

1665

1682

FINI = .TRUE.

1667

1684

ENDIF

1668

1685

IF (NB_REC.EQ.0) EXIT

1669

1686

CALL MPI_RECV( BUFR(1), NBRECORDS, MPI_DOUBLE_PRECISION,

1670

* MASTER, ARROWHEAD,

1671

* COMM, STATUS, IERR )

1687

& MASTER, ARROWHEAD,

1688

& COMM, STATUS, IERR )

1672

1689

DO IREC=1, NB_REC

1673

1690

IARR = BUFI( IREC * 2 )

1674

1691

JARR = BUFI( IREC * 2 + 1 )

1675

1692

VAL = BUFR( IREC )

1676

1693

IF ( MUMPS_330( abs(STEP(abs(IARR))),

1677

* PROCNODE_STEPS, SLAVEF ) .eq. 3 ) THEN

1694

& PROCNODE_STEPS, SLAVEF ) .eq. 3 ) THEN

1678

1695

ARROW_ROOT = ARROW_ROOT + 1

1679

1696

IF ( IARR .GT. 0 ) THEN

1680

1697

IPOSROOT = root%RG2L_ROW( IARR )

1684

1701

JPOSROOT = root%RG2L_COL( -IARR )

1685

1702

END IF

1686

1703

ILOCROOT = root%MBLOCK * ( ( IPOSROOT - 1 ) /

1687

* ( root%MBLOCK * root%NPROW ) )

1688

* + mod( IPOSROOT - 1, root%MBLOCK ) + 1

1704

& ( root%MBLOCK * root%NPROW ) )

1705

& + mod( IPOSROOT - 1, root%MBLOCK ) + 1

1689

1706

JLOCROOT = root%NBLOCK * ( ( JPOSROOT - 1 ) /

1690

* ( root%NBLOCK * root%NPCOL ) )

1691

* + mod( JPOSROOT - 1, root%NBLOCK ) + 1

1707

& ( root%NBLOCK * root%NPCOL ) )

1708

& + mod( JPOSROOT - 1, root%NBLOCK ) + 1

1692

1709

IF (KEEP(60)==0) THEN

1693

A( PTR_ROOT + ( JLOCROOT - 1 ) * LOCAL_M

1694

* + ILOCROOT - 1 ) = A( PTR_ROOT + (JLOCROOT - 1)

1695

* * LOCAL_M + ILOCROOT - 1 ) + VAL

1710

A( PTR_ROOT + int(JLOCROOT - 1,8) * int(LOCAL_M,8)

1711

& + int(ILOCROOT - 1,8) )

1712

& = A( PTR_ROOT + int(JLOCROOT - 1,8)

1713

& * int(LOCAL_M,8)

1714

& + int(ILOCROOT - 1,8))

1715

& + VAL

1696

1716

ELSE

1697

root%SCHUR_POINTER(( JLOCROOT - 1 ) * root%SCHUR_LLD

1698

* + ILOCROOT ) = root%SCHUR_POINTER( (JLOCROOT - 1)

1699

* * root%SCHUR_LLD + ILOCROOT) + VAL

1717

root%SCHUR_POINTER( int(JLOCROOT-1,8)

1718

& * int(root%SCHUR_LLD,8)

1719

& + int(ILOCROOT,8) )

1720

& = root%SCHUR_POINTER( int(JLOCROOT - 1,8)

1721

& * int(root%SCHUR_LLD,8)

1722

& + int(ILOCROOT,8))

1723

& + VAL

1700

1724

ENDIF

1701

1725

ELSE IF (IARR.GE.0) THEN

1702

1726

IF (IARR.EQ.JARR) THEN

1720

1744

IW4(IARR,1) = IW4(IARR,1) - 1

1721

1745

DBLARR(IAS) = VAL

1722

1746

IF ( (KEEP(50) .NE. 0 .OR. KEEP(234).NE.0)

1723

* .AND. IW4(IARR,1) .EQ. 0

1724

* .AND. STEP(IARR) > 0 ) THEN

1747

& .AND. IW4(IARR,1) .EQ. 0

1748

& .AND. STEP(IARR) > 0 ) THEN

1725

1749

IPROC = MUMPS_275( abs(STEP(IARR)),

1726

* PROCNODE_STEPS,SLAVEF )

1750

& PROCNODE_STEPS,SLAVEF )

1727

1751

IF ( TYPE_PARALL .eq. 0 ) THEN

1728

1752

IPROC = IPROC + 1

1729

1753

END IF

1730

1754

IF (IPROC .EQ. MYID) THEN

1731

1755

TAILLE = INTARR( PTRAIW(IARR) )

1732

1756

CALL DMUMPS_310( N, PERM,

1733

* INTARR( PTRAIW(IARR) + 3 ),

1734

* DBLARR( PTRARW(IARR) + 1 ),

1735

* TAILLE, 1, TAILLE )

1757

& INTARR( PTRAIW(IARR) + 3 ),

1758

& DBLARR( PTRARW(IARR) + 1 ),

1759

& TAILLE, 1, TAILLE )

1736

1760

END IF

1737

1761

END IF

1738

1762

ENDIF

1746

1770

RETURN

1747

1771

END SUBROUTINE DMUMPS_145

1748

1772

SUBROUTINE DMUMPS_266( MYID, BUFR, LBUFR,

1749

* LBUFR_BYTES,

1750

* IWPOS, IWPOSCB,

1751

* IPTRLU, LRLU, LRLUS,

1752

* TNBPROCFILS, N, IW, LIW, A, LA,

1753

* PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,

1754

* KEEP,KEEP8, ITLOC,

1755

* IFLAG, IERROR )

1773

& LBUFR_BYTES,

1774

& IWPOS, IWPOSCB,

1775

& IPTRLU, LRLU, LRLUS,

1776

& TNBPROCFILS, N, IW, LIW, A, LA,

1777

& PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,

1778

& KEEP,KEEP8, ITLOC,

1779

& IFLAG, IERROR )

1756

1780

USE DMUMPS_LOAD

1757

1781

IMPLICIT NONE

1758

1782

INTEGER MYID

1760

1784

INTEGER*8 KEEP8(150)

1761

1785

INTEGER LBUFR, LBUFR_BYTES

1762

1786

INTEGER BUFR( LBUFR )

1763

INTEGER IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, LIW, LA

1787

INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA

1788

INTEGER IWPOS, IWPOSCB, N, LIW

1764

1789

INTEGER IW( LIW )

1765

1790

DOUBLE PRECISION A( LA )

1791

INTEGER(8) :: PAMASTER(KEEP(28))

1792

INTEGER(8) :: PTRAST(KEEP(28))

1766

1793

INTEGER PTRIST(KEEP(28)), STEP(N),

1767

* PIMASTER(KEEP(28)), PAMASTER(KEEP(28)),

1768

* PTRAST(KEEP(28)), TNBPROCFILS( KEEP(28) ), ITLOC( N )

1794

& PIMASTER(KEEP(28)),

1795

& TNBPROCFILS( KEEP(28) ), ITLOC( N )

1769

1796

INTEGER COMP, IFLAG, IERROR

1770

1797

INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES

1771

1798

INTEGER NSLAVES_RECU, NFRONT

1772

INTEGER LREQ, LREQCB

1799

INTEGER LREQ

1800

INTEGER(8) :: LREQCB

1773

1801

DOUBLE PRECISION FLOP1

1774

1802

INCLUDE 'mumps_headers.h'

1775

1803

INODE = BUFR( 1 )

1781

1809

NSLAVES_RECU = BUFR( 7 )

1782

1810

IF ( KEEP(50) .eq. 0 ) THEN

1783

1811

FLOP1 = dble( NASS * NROW ) +

1784

* dble(NROW*NASS)*dble(2*NCOL-NASS-1)

1812

& dble(NROW*NASS)*dble(2*NCOL-NASS-1)

1785

1813

ELSE

1786

1814

FLOP1 = dble( NASS ) * dble( NROW )

1787

* * ( 2 * NCOL - NROW - NASS + 1)

1815

& * dble( 2 * NCOL - NROW - NASS + 1)

1788

1816

END IF

1789

1817

CALL DMUMPS_190(1,.TRUE.,FLOP1, KEEP,KEEP8)

1790

1818

IF ( KEEP(50) .eq. 0 ) THEN

1793

1821

NSLAVES = NSLAVES_RECU + XTRA_SLAVES_SYM

1794

1822

END IF

1795

1823

LREQ = NROW + NCOL + 6 + NSLAVES + KEEP(IXSZ)

1796

LREQCB = NCOL * NROW

1797

CALL DMUMPS_22(.FALSE., 0, .FALSE.,.TRUE.,

1798

* MYID,N, KEEP,KEEP8, IW, LIW, A, LA,

1799

* LRLU, IPTRLU,IWPOS,IWPOSCB,

1800

* PTRIST,PTRAST, STEP, PIMASTER,PAMASTER, ITLOC,

1801

* LREQ, LREQCB, INODE, S_ACTIVE, .TRUE.,

1802

* COMP, LRLUS, IFLAG, IERROR

1803

$ )

1824

LREQCB = int(NCOL,8) * int(NROW,8)

1825

CALL DMUMPS_22(.FALSE., 0_8, .FALSE.,.TRUE.,

1826

& MYID,N, KEEP,KEEP8, IW, LIW, A, LA,

1827

& LRLU, IPTRLU,IWPOS,IWPOSCB,

1828

& PTRIST,PTRAST, STEP, PIMASTER,PAMASTER, ITLOC,

1829

& LREQ, LREQCB, INODE, S_ACTIVE, .TRUE.,

1830

& COMP, LRLUS, IFLAG, IERROR

1831

& )

1804

1832

IF ( IFLAG .LT. 0 ) RETURN

1805

1833

PTRIST(STEP(INODE)) = IWPOSCB + 1

1806

PTRAST(STEP(INODE)) = IPTRLU + 1

1834

PTRAST(STEP(INODE)) = IPTRLU + 1_8

1807

1835

IW( IWPOSCB + 1+KEEP(IXSZ) ) = NCOL

1808

1836

IW( IWPOSCB + 2+KEEP(IXSZ) ) = - NASS

1809

1837

IW( IWPOSCB + 3+KEEP(IXSZ) ) = NROW

1811

1839

IW( IWPOSCB + 5+KEEP(IXSZ) ) = NASS

1812

1840

IW( IWPOSCB + 6+KEEP(IXSZ) ) = NSLAVES

1813

1841

IW( IWPOSCB + 7+KEEP(IXSZ)+NSLAVES :

1814

* IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL )

1815

*= BUFR( 8 + NSLAVES_RECU : 7 + NSLAVES_RECU + NROW + NCOL )

1842

& IWPOSCB + 6+KEEP(IXSZ)+NSLAVES + NROW + NCOL )

1843

&= BUFR( 8 + NSLAVES_RECU : 7 + NSLAVES_RECU + NROW + NCOL )

1816

1844

IF ( KEEP(50) .eq. 0 ) THEN

1817

1845

IW( IWPOSCB + 7+KEEP(IXSZ) ) = 0

1818

1846

IF (NSLAVES_RECU.GT.0)

1824

1852

IW( IWPOSCB + 8+KEEP(IXSZ) ) = NFRONT

1825

1853

IW( IWPOSCB + 9+KEEP(IXSZ) ) = 0

1826

1854

IW( IWPOSCB + 7+XTRA_SLAVES_SYM+KEEP(IXSZ):

1827

* IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) =

1828

* BUFR( 8: 7 + NSLAVES_RECU )

1855

& IWPOSCB + 6+XTRA_SLAVES_SYM+KEEP(IXSZ)+NSLAVES_RECU ) =

1856

& BUFR( 8: 7 + NSLAVES_RECU )

1829

1857

END IF

1830

1858

TNBPROCFILS(STEP( INODE )) = NBPROCFILS

1831

1859

RETURN

1840

1868

PARAMETER( MASTER = 0 )

1841

1869

INTEGER color

1842

1870

CALL MPI_COMM_SIZE(id%COMM, id%NPROCS, IERR )

1843

CALL MPI_COMM_RANK(id%COMM, id%MYID, IERR )

1844

1871

IF ( id%PAR .eq. 0 ) THEN

1845

1872

IF ( id%MYID .eq. MASTER ) THEN

1846

1873

color = MPI_UNDEFINED

1857

1884

IF (id%PAR .ne. 0 .or. id%MYID .NE. MASTER) THEN

1858

1885

CALL MPI_COMM_DUP( id%COMM_NODES, id%COMM_LOAD, IERR )

1859

1886

ENDIF

1860

CALL DMUMPS_20( id%NSLAVES,

1887

CALL DMUMPS_20( id%NSLAVES, id%LWK_USER,

1861

1888

& id%CNTL, id%ICNTL,

1862

1889

& id%KEEP, id%KEEP8, id%INFO, id%INFOG,

1863

1890

& id%RINFO, id%RINFOG,

1870

1897

id%LRHS = 1

1871

1898

CALL DMUMPS_61( id%KEEP( 34 ), id%KEEP(35) )

1872

1899

NULLIFY(id%BUFR)

1900

id%NZ_loc = 0

1873

1901

id%MAXIS1 = 0

1874

1902

id%INST_Number = -1

1875

1903

NULLIFY(id%IRN)

1880

1908

NULLIFY(id%A_loc)

1881

1909

NULLIFY(id%MAPPING)

1882

1910

NULLIFY(id%RHS)

1911

NULLIFY(id%REDRHS)

1883

1912

NULLIFY(id%RHS_SPARSE)

1884

1913

NULLIFY(id%IRHS_SPARSE)

1885

1914

NULLIFY(id%IRHS_PTR)

1904

1933

NULLIFY(id%FRTPTR)

1905

1934

NULLIFY(id%FRTELT)

1906

1935

NULLIFY(id%NA)

1936

id%LNA=0

1907

1937

NULLIFY(id%PROCNODE_STEPS)

1908

id%LNA=0

1909

1938

NULLIFY(id%S)

1910

1939

NULLIFY(id%PROCNODE)

1911

1940

NULLIFY(id%POIDS)

1972

2001

RETURN

1973

2002

END SUBROUTINE DMUMPS_163

1974

2003

SUBROUTINE DMUMPS_252( COMM_LOAD, ASS_IRECV,

1975

* N, INODE, IW, LIW, A, LA, IFLAG,

1976

* IERROR, ND,

1977

* FILS, FRERE, DAD, MAXFRW, root,

1978

* OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST,

1979

* STEP, PIMASTER, PAMASTER,PTRARW,

1980

* PTRAIW, ITLOC, NSTEPS, SON_LEVEL2,

1981

* COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS,

1982

* ICNTL, KEEP,KEEP8,INTARR,DBLARR,

1983

*

1984

* NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID,

1985

* BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF,

1986

* PERM,

1987

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, JOBASS, ETATASS

1988

* )

2004

& N, INODE, IW, LIW, A, LA, IFLAG,

2005

& IERROR, ND,

2006

& FILS, FRERE, DAD, MAXFRW, root,

2007

& OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC, PTRAST,

2008

& STEP, PIMASTER, PAMASTER,PTRARW,

2009

& PTRAIW, ITLOC, NSTEPS, SON_LEVEL2,

2010

& COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS,

2011

& ICNTL, KEEP,KEEP8,INTARR,DBLARR,

2012

&

2013

& NSTK_S,NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID,

2014

& BUFR, LBUFR, LBUFR_BYTES, NBFIN, IPOOL, LPOOL, LEAF,

2015

& PERM,

2016

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, JOBASS, ETATASS

2017

& )

1989

2018

USE DMUMPS_COMM_BUFFER

1990

2019

USE DMUMPS_LOAD

1991

2020

IMPLICIT NONE

1993

2022

INCLUDE 'mpif.h'

1994

2023

INTEGER STATUS( MPI_STATUS_SIZE ), IERR

1995

2024

TYPE (DMUMPS_ROOT_STRUC) :: root

2025

INTEGER COMM_LOAD, ASS_IRECV

1996

2026

INTEGER IZERO

1997

2027

PARAMETER (IZERO=0)

1998

INTEGER ASS_IRECV, COMM_LOAD

1999

INTEGER N,LIW,LA,NSTEPS

2028

INTEGER N,LIW,NSTEPS

2029

INTEGER(8) LA, LRLU, LRLUS, IPTRLU, POSFAC

2000

2030

INTEGER KEEP(500), ICNTL(40)

2001

2031

INTEGER*8 KEEP8(150)

2002

2032

INTEGER IFLAG,IERROR,INODE,MAXFRW,

2003

* LRLU, IPTRLU,IWPOS, LRLUS,

2004

* POSFAC, IWPOSCB, COMP, IERR_MPI

2033

& IWPOS, IWPOSCB, COMP, IERR_MPI

2005

2034

INTEGER JOBASS,ETATASS

2006

2035

LOGICAL SON_LEVEL2

2007

2036

DOUBLE PRECISION A(LA)

2015

2044

INTEGER BUFR( LBUFR )

2016

2045

INTEGER IDUMMY(1)

2017

2046

INTEGER IW(LIW), ITLOC(N),

2018

* PTRARW(N), PTRAIW(N), ND(KEEP(28)), PERM(N),

2019

* FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)),

2020

* PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), PTRFAC(KEEP(28)),

2021

* PTRAST(KEEP(28)), STEP(N),

2022

* PIMASTER(KEEP(28)),

2023

* PAMASTER(KEEP(28))

2047

& PTRARW(N), PTRAIW(N), ND(KEEP(28)), PERM(N),

2048

& FILS(N), FRERE(KEEP(28)), DAD(KEEP(28)),

2049

& PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),

2050

& STEP(N), PIMASTER(KEEP(28))

2051

INTEGER(8) :: PTRFAC(KEEP(28)), PTRAST(KEEP(28)),

2052

& PAMASTER(KEEP(28))

2024

2053

INTEGER ISTEP_TO_INIV2(KEEP(71)),

2025

* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

2054

& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

2026

2055

INTEGER INTARR(max(1,KEEP(14)))

2027

2056

DOUBLE PRECISION DBLARR(max(1,KEEP(13)))

2028

2057

INTEGER MUMPS_275, MUMPS_330

2031

2060

INTEGER NBPANELS_L, NBPANELS_U

2032

2061

INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL

2033

2062

INTEGER NFS4FATHER

2034

INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ,LAELL,LAELL_REQ

2063

INTEGER(8) NFRONT8, LAELL8, LAELL_REQ8

2064

INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ

2035

2065

INTEGER LREQ_OOC

2036

INTEGER SIZFI, SIZFR, NCB

2037

INTEGER LAPOS2,J1,J2

2066

INTEGER(8) :: SIZFR

2067

INTEGER SIZFI, NCB

2068

INTEGER J1,J2

2038

2069

INTEGER NCOL, NROW, NCOLS, NROWS, LDA_SON

2039

INTEGER NELIM,JJ,JJ1,JJ2,J3,

2040

* IBROT,IORG

2041

INTEGER IACHK,JPOS,ICT11

2042

INTEGER JK,IJROW,NBCOL,ICT13,NUMORG,IOLDPS,J4

2043

INTEGER APOS, APOS2, AINPUT, POSELT, POSEL1, ICT12

2070

INTEGER(8) :: JJ2, JJ3, ICT13

2071

INTEGER NELIM,JJ,JJ1,J3,

2072

& IBROT,IORG

2073

INTEGER JPOS,ICT11

2074

INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4

2075

INTEGER(8) IACHK, JJ8, POSELT, LAPOS2

2076

INTEGER(8) APOS, APOS2, APOS3, POSEL1, ICT12

2077

INTEGER AINPUT

2044

2078

INTEGER NSLAVES, NSLSON, NPIVS,NPIV_ANA,NPIV

2045

2079

INTEGER PTRCOL, ISLAVE, PDEST,LEVEL

2046

2080

INTEGER ISON_IN_PLACE

2047

2081

INTEGER ISON_TOP

2048

INTEGER SIZE_ISON_TOP

2082

INTEGER(8) SIZE_ISON_TOP8

2049

2083

LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS,

2050

* RISK_OF_SAME_POS_THIS_LINE

2084

& RISK_OF_SAME_POS_THIS_LINE

2051

2085

LOGICAL LEVEL1, NIV1

2052

2086

INTEGER TROW_SIZE

2053

2087

INTEGER INDX, FIRST_INDEX, SHIFT_INDEX

2063

2097

LOGICAL MUMPS_167

2064

2098

LOGICAL SSARBR

2065

2099

LOGICAL COMPRESSCB

2066

INTEGER LCB

2100

INTEGER(8) :: LCB

2067

2101

DOUBLE PRECISION FLOP1,FLOP1_EFF

2068

2102

EXTERNAL MUMPS_170

2069

2103

LOGICAL MUMPS_170

2129

2163

LREQ_OOC = 0

2130

2164

IF (KEEP(201).EQ.1) THEN

2131

2165

CALL DMUMPS_684( KEEP(50), NFRONT, NFRONT, NASS1,

2132

* NBPANELS_L, NBPANELS_U, LREQ_OOC)

2166

& NBPANELS_L, NBPANELS_U, LREQ_OOC)

2133

2167

ENDIF

2134

2168

LREQ = HF + 2 * NFRONT + LREQ_OOC

2135

2169

IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN

2136

2170

CALL DMUMPS_94(N, KEEP(28),

2137

* IW, LIW, A, LA,

2138

* LRLU, IPTRLU,

2139

* IWPOS, IWPOSCB, PTRIST, PTRAST,

2140

* STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

2141

* KEEP(IXSZ))

2171

& IW, LIW, A, LA,

2172

& LRLU, IPTRLU,

2173

& IWPOS, IWPOSCB, PTRIST, PTRAST,

2174

& STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

2175

& KEEP(IXSZ))

2142

2176

COMP = COMP+1

2143

2177

IF (LRLU .NE. LRLUS) THEN

2144

2178

WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F'

2151

2185

IWPOS = IWPOS + LREQ

2152

2186

ISON_TOP = -9999

2153

2187

ISON_IN_PLACE = -9999

2154

SIZE_ISON_TOP = 0

2188

SIZE_ISON_TOP8 = 0_8

2155

2189

IF (KEEP(234).NE.0) THEN

2156

2190

IF ( IWPOSCB .NE. LIW ) THEN

2157

2191

IF ( IWPOSCB+IW(IWPOSCB+1+XXI).NE.LIW) THEN

2158

2192

ISON = IW( IWPOSCB + 1 + XXN )

2159

2193

IF ( DAD( STEP( ISON ) ) .EQ. INODE .AND.

2160

* MUMPS_330(STEP(ISON),PROCNODE_STEPS,SLAVEF)

2161

* .EQ. 1 )

2162

* THEN

2194

& MUMPS_330(STEP(ISON),PROCNODE_STEPS,SLAVEF)

2195

& .EQ. 1 )

2196

& THEN

2163

2197

ISON_TOP = ISON

2164

SIZE_ISON_TOP = IW( IWPOSCB + 1 + XXR )

2165

IF (LRLU .LT. NFRONT * NFRONT) THEN

2198

CALL MUMPS_729(SIZE_ISON_TOP8,IW(IWPOSCB + 1 + XXR))

2199

IF (LRLU .LT. int(NFRONT,8) * int(NFRONT,8)) THEN

2166

2200

ISON_IN_PLACE = ISON

2167

2201

ENDIF

2168

2202

END IF

2172

2206

NIV1 = .TRUE.

2173

2207

IF (KEEP(50).EQ.0 .AND. KEEP(234) .EQ. 0) THEN

2174

2208

CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT,

2175

* NFRONT_EFF,

2176

* NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2177

* IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2178

* INTARR, ITLOC, FILS, FRERE,

2179

* SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG)

2209

& NFRONT_EFF,

2210

& NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2211

& IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2212

& INTARR, ITLOC, FILS, FRERE,

2213

& SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG)

2180

2214

ELSE

2181

2215

CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF,

2182

* NFRONT, NFRONT_EFF, PERM,

2183

* NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2184

* IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2185

* INTARR, ITLOC, FILS, FRERE,

2186

* SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG,

2187

* ISON_IN_PLACE)

2216

& NFRONT, NFRONT_EFF, PERM,

2217

& NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2218

& IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2219

& INTARR, ITLOC, FILS, FRERE,

2220

& SON_LEVEL2, NIV1, NBPROCFILS, KEEP, KEEP8, IFLAG,

2221

& ISON_IN_PLACE)

2188

2222

IF (IFLAG.LT.0) GOTO 300

2189

2223

ENDIF

2190

2224

IF (NFRONT_EFF.NE.NFRONT) THEN

2191

2225

IF (NFRONT.GT.NFRONT_EFF) THEN

2192

2226

IF(MUMPS_170(STEP(INODE),PROCNODE_STEPS,

2193

$ SLAVEF))THEN

2227

& SLAVEF))THEN

2194

2228

NPIV=NASS1-(NFRONT_EFF-ND(STEP(INODE)))

2195

2229

CALL MUMPS_511(ND(STEP(INODE)),NPIV,NPIV,

2196

* KEEP(50),1,FLOP1)

2230

& KEEP(50),1,FLOP1)

2197

2231

NPIV=NPIV_ANA

2198

2232

CALL MUMPS_511(ND(STEP(INODE)),NPIV,NPIV,

2199

* KEEP(50),1,FLOP1_EFF)

2233

& KEEP(50),1,FLOP1_EFF)

2200

2234

CALL DMUMPS_190(0,.FALSE.,FLOP1-FLOP1_EFF,

2201

$ KEEP,KEEP8)

2235

& KEEP,KEEP8)

2202

2236

ENDIF

2203

2237

IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF))

2204

2238

NFRONT = NFRONT_EFF

2208

2242

GOTO 270

2209

2243

ENDIF

2210

2244

ENDIF

2245

NFRONT8=int(NFRONT,8)

2211

2246

IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN

2212

2247

CALL DMUMPS_691(KEEP(50),

2213

* NBPANELS_L, NBPANELS_U, NASS1,

2214

* IOLDPS + HF + 2 * NFRONT, IW, LIW)

2248

& NBPANELS_L, NBPANELS_U, NASS1,

2249

& IOLDPS + HF + 2 * NFRONT, IW, LIW)

2215

2250

ENDIF

2216

2251

NCB = NFRONT - NASS1

2217

2252

MAXFRW = max0(MAXFRW, NFRONT)

2218

2253

ICT11 = IOLDPS + HF - 1 + NFRONT

2219

LAELL = NFRONT * NFRONT

2220

LAELL_REQ = LAELL

2254

LAELL8 = NFRONT8 * NFRONT8

2255

LAELL_REQ8 = LAELL8

2221

2256

IF ( ISON_IN_PLACE > 0 ) THEN

2222

LAELL_REQ = LAELL - SIZE_ISON_TOP

2257

LAELL_REQ8 = LAELL8 - SIZE_ISON_TOP8

2223

2258

ENDIF

2224

IF (LRLU .LT. LAELL_REQ) THEN

2225

IF (LRLUS .LT. LAELL_REQ) THEN

2259

IF (LRLU .LT. LAELL_REQ8) THEN

2260

IF (LRLUS .LT. LAELL_REQ8) THEN

2226

2261

GOTO 280

2227

2262

ELSE

2228

2263

CALL DMUMPS_94

2229

* (N, KEEP(28), IW, LIW, A, LA, LRLU, IPTRLU,

2230

* IWPOS, IWPOSCB, PTRIST, PTRAST, STEP, PIMASTER,

2231

* PAMASTER,ITLOC,KEEP(216),LRLUS,KEEP(IXSZ))

2264

& (N, KEEP(28), IW, LIW, A, LA, LRLU, IPTRLU,

2265

& IWPOS, IWPOSCB, PTRIST, PTRAST, STEP, PIMASTER,

2266

& PAMASTER,ITLOC,KEEP(216),LRLUS,KEEP(IXSZ))

2232

2267

COMP = COMP + 1

2233

2268

IF (LRLU .NE. LRLUS) THEN

2234

2269

WRITE( *, * ) 'PB compress ass..mpi51f_niv1.F'

2237

2272

ENDIF

2238

2273

ENDIF

2239

2274

ENDIF

2240

LRLU = LRLU - LAELL

2241

LRLUS = LRLUS - LAELL + SIZE_ISON_TOP

2242

KEEP(67) = min(LRLUS, KEEP(67))

2275

LRLU = LRLU - LAELL8

2276

LRLUS = LRLUS - LAELL8 + SIZE_ISON_TOP8

2277

KEEP8(67) = min(LRLUS, KEEP8(67))

2243

2278

POSELT = POSFAC

2244

POSFAC = POSFAC + LAELL

2279

POSFAC = POSFAC + LAELL8

2245

2280

SSARBR=MUMPS_167(STEP(INODE),PROCNODE_STEPS,SLAVEF)

2246

2281

CALL DMUMPS_471(SSARBR,.FALSE.,

2247

* LA-LRLUS,

2248

* 0,

2249

* LAELL-SIZE_ISON_TOP,

2250

* KEEP,KEEP8,

2251

$ LRLU)

2282

& LA-LRLUS,

2283

& 0_8,

2284

& LAELL8-SIZE_ISON_TOP8,

2285

& KEEP,KEEP8,

2286

& LRLU)

2252

2287

#if ! defined(ALLOW_NON_INIT)

2253

LAPOS2 = min(POSELT +LAELL - 1, IPTRLU)

2288

LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU)

2254

2289

A(POSELT:LAPOS2) = dble(ZERO)

2255

2290

#else

2256

2291

IF ( KEEP(50) .eq. 0 .OR. NFRONT .LT. KEEP(63) ) THEN

2257

LAPOS2 = min(POSELT + LAELL - 1, IPTRLU)

2292

LAPOS2 = min(POSELT + LAELL8 - 1_8, IPTRLU)

2258

2293

A(POSELT:LAPOS2) = dble(ZERO)

2259

2294

ELSE

2260

2295

IF (ETATASS.EQ.1) THEN

2261

2296

APOS = POSELT

2262

DO JJ = 0, NFRONT - 1

2263

J3 = min(JJ,NASS1-1)

2264

A(APOS:APOS+J3) = dble(ZERO)

2265

APOS = APOS + NFRONT

2297

DO JJ8 = 0_8, NFRONT8 - 1_8

2298

JJ3 = min(JJ8,int(NASS1-1,8))

2299

A(APOS:APOS+JJ3) = dble(ZERO)

2300

APOS = APOS + NFRONT8

2266

2301

END DO

2267

2302

ELSE

2268

2303

APOS = POSELT

2269

DO JJ = 0, NFRONT - 1

2270

J3=min(APOS+JJ,IPTRLU)

2271

A(APOS:J3) = dble(ZERO)

2272

APOS = APOS + NFRONT

2304

DO JJ8 = 0_8, NFRONT8 - 1_8

2305

JJ3=min(APOS+JJ8,IPTRLU)

2306

A(APOS:JJ3) = dble(ZERO)

2307

APOS = APOS + NFRONT8

2273

2308

IF (APOS > IPTRLU ) EXIT

2274

2309

END DO

2275

2310

ENDIF

2279

2314

PTRFAC(STEP(INODE)) = POSELT

2280

2315

PTLUST_S(STEP(INODE)) = IOLDPS

2281

2316

IW(IOLDPS+XXI) = LREQ

2282

IW(IOLDPS+XXR) = LAELL

2317

CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR))

2283

2318

IW(IOLDPS+XXS) =-9999

2284

2319

IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999

2285

IF (KEEP(201).EQ.1) THEN

2286

IW(IOLDPS+XXWRITTENL) = 0

2287

IF (KEEP(50).EQ.0) THEN

2288

IW(IOLDPS+XXWRITTENU) = 0

2289

ENDIF

2290

ENDIF

2291

2320

IW(IOLDPS + KEEP(IXSZ)) = NFRONT

2292

2321

IW(IOLDPS + KEEP(IXSZ) + 1) = 0

2293

2322

IW(IOLDPS + KEEP(IXSZ) + 2) = -NASS1

2327

2356

IF ( .NOT. LEVEL1 .AND. NELIM.EQ.0 ) GOTO 205

2328

2357

IF (LEVEL1) THEN

2329

2358

J2 = J1 + LSTK - 1

2330

SIZFR = LSTK*LSTK

2331

IF (COMPRESSCB) SIZFR = (LSTK*(LSTK+1))/2

2359

SIZFR = int(LSTK,8)*int(LSTK,8)

2360

IF (COMPRESSCB) SIZFR = (int(LSTK,8)*int(LSTK+1,8))/2_8

2332

2361

ELSE

2333

2362

IF ( KEEP(50).eq.0 ) THEN

2334

SIZFR = NELIM * LSTK

2363

SIZFR = int(NELIM,8) * int(LSTK,8)

2335

2364

ELSE

2336

SIZFR = NELIM * NELIM

2365

SIZFR = int(NELIM,8) * int(NELIM,8)

2337

2366

END IF

2338

2367

J2 = J1 + NELIM - 1

2339

2368

ENDIF

2340

2369

IF (JOBASS.EQ.0) OPASSW = OPASSW + dble(SIZFR)

2341

2370

IACHK = PAMASTER(STEP(ISON))

2342

2371

IF ( KEEP(50) .eq. 0 ) THEN

2343

POSEL1 = PTRAST(STEP(INODE)) - NFRONT

2372

POSEL1 = PTRAST(STEP(INODE)) - NFRONT8

2344

2373

IF (NFRONT .EQ. LSTK.AND. ISON.EQ.ISON_IN_PLACE

2345

* .AND.IACHK + SIZFR - 1 .EQ. POSFAC - 1 ) THEN

2374

& .AND.IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8 ) THEN

2346

2375

GOTO 205

2347

2376

ENDIF

2348

2377

IF (J2.GE.J1) THEN

2349

2378

RESET_TO_ZERO = (IACHK .LT. POSFAC)

2350

RISK_OF_SAME_POS = IACHK + SIZFR - 1 .EQ. POSFAC - 1

2379

RISK_OF_SAME_POS = IACHK + SIZFR - 1_8 .EQ. POSFAC - 1_8

2351

2380

RISK_OF_SAME_POS_THIS_LINE = .FALSE.

2352

2381

DO 170 JJ = J1, J2

2353

APOS = POSEL1 + IW(JJ) * NFRONT

2382

APOS = POSEL1 + int(IW(JJ),8) * int(NFRONT,8)

2354

2383

IF (RISK_OF_SAME_POS) THEN

2355

2384

IF (JJ.EQ.J2) THEN

2356

2385

RISK_OF_SAME_POS_THIS_LINE =

2357

* (ISON .EQ. ISON_IN_PLACE)

2358

* .AND. ( APOS + IW(J1+LSTK-1)-1.EQ.

2359

* IACHK+LSTK-1 )

2386

& (ISON .EQ. ISON_IN_PLACE)

2387

& .AND. ( APOS + int(IW(J1+LSTK-1)-1,8).EQ.

2388

& IACHK+int(LSTK-1,8) )

2360

2389

ENDIF

2361

2390

ENDIF

2362

2391

IF (RESET_TO_ZERO) THEN

2363

2392

IF (RISK_OF_SAME_POS_THIS_LINE) THEN

2364

2393

DO JJ1 = 1, LSTK

2365

JJ2 = APOS + IW(J1 + JJ1 - 1) - 1

2366

IF ( IACHK+JJ1-1 .NE. JJ2 ) THEN

2367

A(JJ2) = A(IACHK + JJ1 - 1)

2368

A(IACHK + JJ1 -1) = dble(ZERO)

2394

JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8)

2395

IF ( IACHK+int(JJ1-1,8) .NE. JJ2 ) THEN

2396

A(JJ2) = A(IACHK + int(JJ1 - 1,8))

2397

A(IACHK + int(JJ1 -1,8)) = dble(ZERO)

2369

2398

ENDIF

2370

2399

ENDDO

2371

2400

ELSE

2372

2401

DO JJ1 = 1, LSTK

2373

JJ2 = APOS + IW(J1 + JJ1 - 1) - 1

2374

A(JJ2) = A(IACHK + JJ1 - 1)

2375

A(IACHK + JJ1 -1) = dble(ZERO)

2402

JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8

2403

A(JJ2) = A(IACHK + int(JJ1 - 1,8))

2404

A(IACHK + int(JJ1 -1,8)) = dble(ZERO)

2376

2405

ENDDO

2377

2406

ENDIF

2378

2407

ELSE

2379

2408

DO JJ1 = 1, LSTK

2380

JJ2 = APOS + IW(J1 + JJ1 - 1) - 1

2381

A(JJ2) = A(JJ2) + A(IACHK + JJ1 - 1)

2409

JJ2 = APOS + int(IW(J1+JJ1-1),8) - 1_8

2410

A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8))

2382

2411

ENDDO

2383

2412

ENDIF

2384

IACHK = IACHK + LSTK

2413

IACHK = IACHK + int(LSTK,8)

2385

2414

IF (IACHK .GE. POSFAC) RESET_TO_ZERO =.FALSE.

2386

2415

170 CONTINUE

2387

2416

END IF

2394

2423

IF (COMPRESSCB) THEN

2395

2424

LCB = SIZFR

2396

2425

ELSE

2397

LCB = LDA_SON*( J2 - J1 + 1)

2426

LCB = int(LDA_SON,8)* int(J2-J1+1,8)

2398

2427

ENDIF

2399

2428

CALL DMUMPS_178(A, LA,

2400

* PTRAST(STEP( INODE )), NFRONT, NASS1,

2401

* IACHK, LDA_SON, LCB,

2402

* IW( J1 ), J2 - J1 + 1, NELIM, ETATASS,

2403

* COMPRESSCB, (ISON.EQ.ISON_IN_PLACE)

2404

* )

2429

& PTRAST(STEP( INODE )), NFRONT, NASS1,

2430

& IACHK, LDA_SON, LCB,

2431

& IW( J1 ), J2 - J1 + 1, NELIM, ETATASS,

2432

& COMPRESSCB, (ISON.EQ.ISON_IN_PLACE)

2433

& )

2405

2434

ENDIF

2406

2435

205 IF (LEVEL1) THEN

2407

2436

IF (SAME_PROC) ISTCHK = PTRIST(STEP(ISON))

2433

2462

PIMASTER(STEP( ISON )) = -99999999

2434

2463

ENDIF

2435

2464

CALL DMUMPS_152(SSARBR, MYID, N, ISTCHK,

2436

* PAMASTER(STEP(ISON)),

2437

* IW, LIW, LRLU, LRLUS, IPTRLU,

2438

* IWPOSCB, LA, KEEP,KEEP8,

2439

* (ISON .EQ. ISON_TOP)

2440

* )

2465

& PAMASTER(STEP(ISON)),

2466

& IW, LIW, LRLU, LRLUS, IPTRLU,

2467

& IWPOSCB, LA, KEEP,KEEP8,

2468

& (ISON .EQ. ISON_TOP)

2469

& )

2441

2470

ENDIF

2442

2471

ELSE

2443

2472

PDEST = ISTCHK + 6 + KEEP(IXSZ)

2454

2483

SHIFT_INDEX = FIRST_INDEX - 1

2455

2484

INDX = PTRCOL + SHIFT_INDEX

2456

2485

CALL DMUMPS_210( COMM_LOAD, ASS_IRECV,

2457

* BUFR, LBUFR, LBUFR_BYTES,

2458

* INODE, ISON, NSLAVES, IDUMMY,

2459

* NFRONT, NASS1,NFS4FATHER,

2460

* TROW_SIZE, IW( INDX ),

2461

* PROCNODE_STEPS,

2462

* SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,

2463

* LRLUS, N, IW,

2464

* LIW, A, LA,

2465

* PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP,

2466

* PIMASTER, PAMASTER, NSTK_S, COMP,

2467

* IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL,

2468

* LEAF, NBFIN, ICNTL, KEEP, KEEP8, root,

2469

* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

2470

* INTARR, DBLARR, ND, FRERE,

2471

* LPTRAR, NELT, IW, IW,

2472

*

2473

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

2486

& BUFR, LBUFR, LBUFR_BYTES,

2487

& INODE, ISON, NSLAVES, IDUMMY,

2488

& NFRONT, NASS1,NFS4FATHER,

2489

& TROW_SIZE, IW( INDX ),

2490

& PROCNODE_STEPS,

2491

& SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,

2492

& LRLUS, N, IW,

2493

& LIW, A, LA,

2494

& PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP,

2495

& PIMASTER, PAMASTER, NSTK_S, COMP,

2496

& IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL,

2497

& LEAF, NBFIN, ICNTL, KEEP, KEEP8, root,

2498

& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

2499

& INTARR, DBLARR, ND, FRERE,

2500

& LPTRAR, NELT, IW, IW,

2501

&

2502

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

2474

2503

IF ( IFLAG .LT. 0 ) GOTO 500

2475

2504

EXIT

2476

2505

ENDIF

2481

2510

PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM

2482

2511

PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ)

2483

2512

CALL DMUMPS_71(

2484

* INODE, NFRONT, NASS1, NFS4FATHER,

2485

* ISON, MYID,

2486

* IZERO, IDUMMY, IW(PTRCOL), NCBSON,

2487

* COMM, IERR, IW(PDEST), NSLSON, SLAVEF,

2488

* KEEP, KEEP8, STEP, N,

2489

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

2490

* )

2513

& INODE, NFRONT, NASS1, NFS4FATHER,

2514

& ISON, MYID,

2515

& IZERO, IDUMMY, IW(PTRCOL), NCBSON,

2516

& COMM, IERR, IW(PDEST), NSLSON, SLAVEF,

2517

& KEEP, KEEP8, STEP, N,

2518

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

2519

& )

2491

2520

IF (IERR.EQ.-1) THEN

2492

2521

BLOCKING = .FALSE.

2493

2522

SET_IRECV = .TRUE.

2494

2523

MESSAGE_RECEIVED = .FALSE.

2495

2524

CALL DMUMPS_329(

2496

* COMM_LOAD, ASS_IRECV,

2497

* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

2498

* MPI_ANY_SOURCE, MPI_ANY_TAG,

2499

* STATUS,

2500

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

2501

* IWPOS, IWPOSCB, IPTRLU,

2502

* LRLU, LRLUS, N, IW, LIW, A, LA,

2503

* PTRIST, PTLUST_S, PTRFAC,

2504

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

2505

* IFLAG, IERROR, COMM,

2506

* NBPROCFILS,

2507

* IPOOL, LPOOL, LEAF,

2508

* NBFIN, MYID, SLAVEF,

2509

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

2510

* INTARR, DBLARR, ICNTL, KEEP, KEEP8, ND, FRERE,

2511

* LPTRAR, NELT, IW, IW,

2512

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

2525

& COMM_LOAD, ASS_IRECV,

2526

& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

2527

& MPI_ANY_SOURCE, MPI_ANY_TAG,

2528

& STATUS,

2529

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

2530

& IWPOS, IWPOSCB, IPTRLU,

2531

& LRLU, LRLUS, N, IW, LIW, A, LA,

2532

& PTRIST, PTLUST_S, PTRFAC,

2533

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

2534

& IFLAG, IERROR, COMM,

2535

& NBPROCFILS,

2536

& IPOOL, LPOOL, LEAF,

2537

& NBFIN, MYID, SLAVEF,

2538

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

2539

& INTARR, DBLARR, ICNTL, KEEP, KEEP8, ND, FRERE,

2540

& LPTRAR, NELT, IW, IW,

2541

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

2513

2542

IF ( IFLAG .LT. 0 ) GOTO 500

2514

2543

ENDIF

2515

2544

ENDDO

2536

2565

J3 = J2 + 1

2537

2566

J4 = J2 - INTARR(JJ)

2538

2567

IJROW = INTARR(J1)

2539

ICT12 = POSELT - NFRONT + IJROW - 1

2568

ICT12 = POSELT + int(IJROW - NFRONT - 1,8)

2540

2569

Cduplicates --> CVD$ DEPCHK

2541

2570

DO 240 JJ = J1, J2

2542

APOS2 = ICT12 + INTARR(JJ) * NFRONT

2543

IF (APOS2 .LT.0) THEN

2571

APOS2 = ICT12 + int(INTARR(JJ),8) * NFRONT8

2572

IF (APOS2 .LT.0_8) THEN

2544

2573

WRITE(*,*) "APOS2=",APOS2

2545

2574

WRITE(*,*) "INTARR(JJ)=",INTARR(JJ)

2546

2575

WRITE(*,*) "ICT12=",ICT12

2549

2578

AINPUT = AINPUT + 1

2550

2579

240 CONTINUE

2551

2580

IF (J3 .LE. J4) THEN

2552

ICT13 = POSELT + (IJROW - 1) * NFRONT

2581

ICT13 = POSELT + int(IJROW - 1,8) * NFRONT8

2553

2582

NBCOL = J4 - J3 + 1

2554

2583

Cduplicates--> CVD$ DEPCHK

2555

2584

CduplicatesCVD$ NODEPCHK

2556

2585

DO 250 JJ = 1, NBCOL

2557

JJ1 = ICT13 + INTARR(J3 + JJ - 1) - 1

2558

A(JJ1) = A(JJ1) + DBLARR(AINPUT + JJ - 1)

2586

APOS3 = ICT13 + int(INTARR(J3 + JJ - 1) - 1,8)

2587

A(APOS3) = A(APOS3) + DBLARR(AINPUT + JJ - 1)

2559

2588

250 CONTINUE

2560

2589

ENDIF

2561

2590

260 CONTINUE

2566

2595

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

2567

2596

LP = ICNTL(1)

2568

2597

WRITE( LP, * )

2569

*' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_252'

2598

&' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_252'

2570

2599

ENDIF

2571

2600

GOTO 490

2572

2601

280 CONTINUE

2573

2602

IFLAG = -9

2574

IERROR = LAELL_REQ - LRLUS

2603

IF (LAELL_REQ8 - LRLUS .GT. int(huge(IERROR),8)) THEN

2604

WRITE(*,*) "I8: OVERFLOW",LAELL_REQ8, LRLUS

2605

CALL MUMPS_ABORT()

2606

ENDIF

2607

IERROR = int(LAELL_REQ8 - LRLUS, 4)

2575

2608

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

2576

2609

LP = ICNTL(1)

2577

2610

WRITE( LP, * )

2578

*' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_252'

2611

&' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_252'

2579

2612

ENDIF

2580

2613

GOTO 490

2581

2614

290 CONTINUE

2582

2615

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

2583

2616

LP = ICNTL(1)

2584

2617

WRITE( LP, * )

2585

* ' FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_252'

2618

& ' FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_252'

2586

2619

ENDIF

2587

2620

IFLAG = -17

2588

2621

LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ)

2592

2625

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

2593

2626

LP = ICNTL(1)

2594

2627

WRITE( LP, * )

2595

* ' FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_252'

2628

& ' FAILURE, SEND BUFFER TOO SMALL DURING DMUMPS_252'

2596

2629

ENDIF

2597

2630

IFLAG = -17

2598

2631

LREQ = NCBSON + 6+NSLSON+KEEP(IXSZ)

2602

2635

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

2603

2636

LP = ICNTL(1)

2604

2637

WRITE( LP, * )

2605

* ' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING DMUMPS_252'

2638

& ' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING DMUMPS_252'

2606

2639

ENDIF

2607

2640

IFLAG = -13

2608

2641

IERROR = NUMSTK + 1

2611

2644

RETURN

2612

2645

END SUBROUTINE DMUMPS_252

2613

2646

SUBROUTINE DMUMPS_253(COMM_LOAD, ASS_IRECV,

2614

* N, INODE, IW, LIW, A, LA, IFLAG,

2615

* IERROR, ND, FILS, FRERE,

2616

* CAND,

2617

* ISTEP_TO_INIV2, TAB_POS_IN_PERE,

2618

* MAXFRW, root,

2619

* OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC,

2620

* PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S,

2621

* PTRAIW, ITLOC, NSTEPS,

2622

* COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS,

2623

* ICNTL, KEEP, KEEP8,INTARR,DBLARR,

2624

* NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID,

2625

* BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL,

2626

* PERM , MEM_DISTRIB)

2647

& N, INODE, IW, LIW, A, LA, IFLAG,

2648

& IERROR, ND, FILS, FRERE,

2649

& CAND,

2650

& ISTEP_TO_INIV2, TAB_POS_IN_PERE,

2651

& MAXFRW, root,

2652

& OPASSW, OPELIW, PTRIST, PTLUST_S, PTRFAC,

2653

& PTRAST, STEP, PIMASTER, PAMASTER, PTRARW, NSTK_S,

2654

& PTRAIW, ITLOC, NSTEPS,

2655

& COMP, LRLU, IPTRLU, IWPOS, IWPOSCB, POSFAC, LRLUS,

2656

& ICNTL, KEEP, KEEP8,INTARR,DBLARR,

2657

& NBPROCFILS, PROCNODE_STEPS, SLAVEF, COMM,MYID,

2658

& BUFR, LBUFR, LBUFR_BYTES, NBFIN, LEAF, IPOOL, LPOOL,

2659

& PERM , MEM_DISTRIB)

2627

2660

USE DMUMPS_COMM_BUFFER

2628

2661

USE DMUMPS_LOAD

2629

2662

IMPLICIT NONE

2632

2665

INTEGER IERR, STATUS( MPI_STATUS_SIZE )

2633

2666

TYPE (DMUMPS_ROOT_STRUC) :: root

2634

2667

INTEGER COMM_LOAD, ASS_IRECV

2635

INTEGER N,LIW,LA,NSTEPS, NBFIN

2668

INTEGER N,LIW,NSTEPS, NBFIN

2669

INTEGER(8) :: LA

2636

2670

INTEGER KEEP(500), ICNTL(40)

2637

2671

INTEGER*8 KEEP8(150)

2638

2672

INTEGER IFLAG,IERROR,INODE,MAXFRW,

2639

* LPOOL, LEAF,

2640

* LRLU, IPTRLU,IWPOS, LRLUS,

2641

* POSFAC, IWPOSCB, COMP

2673

& LPOOL, LEAF, IWPOS, IWPOSCB, COMP

2674

INTEGER(8) :: LRLUS, LRLU, IPTRLU, POSFAC

2642

2675

DOUBLE PRECISION A(LA)

2643

2676

DOUBLE PRECISION OPASSW, OPELIW

2644

2677

INTEGER COMM, SLAVEF, MYID, LBUFR, LBUFR_BYTES

2645

2678

INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB

2646

2679

INTEGER IPOOL(LPOOL)

2680

INTEGER(8) :: PTRAST(KEEP(28))

2681

INTEGER(8) :: PTRFAC(KEEP(28))

2682

INTEGER(8) :: PAMASTER(KEEP(28))

2647

2683

INTEGER IW(LIW), ITLOC(N),

2648

* PTRARW(N), PTRAIW(N), ND(KEEP(28)),

2649

* FILS(N), FRERE(KEEP(28)),

2650

* PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), PTRFAC(KEEP(28)),

2651

* PTRAST(KEEP(28)), STEP(N),

2652

* PIMASTER(KEEP(28)),

2653

* PAMASTER(KEEP(28)),

2654

* NSTK_S(KEEP(28)), PERM(N)

2684

& PTRARW(N), PTRAIW(N), ND(KEEP(28)),

2685

& FILS(N), FRERE(KEEP(28)),

2686

& PTRIST(KEEP(28)), PTLUST_S(KEEP(28)),

2687

& STEP(N),

2688

& PIMASTER(KEEP(28)),

2689

& NSTK_S(KEEP(28)), PERM(N)

2655

2690

INTEGER CAND(SLAVEF+1, max(1,KEEP(56)))

2656

2691

INTEGER ISTEP_TO_INIV2(KEEP(71)),

2657

* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

2692

& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

2658

2693

INTEGER NBPROCFILS(KEEP(28)),

2659

* PROCNODE_STEPS(KEEP(28)), BUFR(LBUFR)

2694

& PROCNODE_STEPS(KEEP(28)), BUFR(LBUFR)

2660

2695

INTEGER INTARR(max(1,KEEP(14)))

2661

2696

DOUBLE PRECISION DBLARR(max(1,KEEP(13)))

2662

2697

INTEGER LP, HS, HF, HF_OLD,NCBSON, NSLAVES_OLD

2663

2698

INTEGER IN,NUMSTK,NASS,ISON,IFSON,NASS1,IELL

2664

2699

INTEGER NFS4FATHER,I

2665

INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ,LAELL

2700

INTEGER NFRONT,NFRONT_EFF,ISTCHK,LSTK,LREQ

2701

INTEGER(8) :: NFRONT8, LAELL8

2666

2702

INTEGER LREQ_OOC

2667

2703

LOGICAL COMPRESSCB

2668

INTEGER LCB

2704

INTEGER(8) :: LCB

2669

2705

INTEGER NCB, IERR_MPI

2670

INTEGER LAPOS2,J1,J2,J3,MP

2671

INTEGER NELIM,JJ,JJ1,JJ2,NPIVS,NCOLS,NROWS,

2672

* IBROT,IORG

2673

INTEGER IACHK, LDAFS, LDA_SON

2674

INTEGER JK,IJROW,NBCOL,ICT13,NUMORG,IOLDPS,J4

2675

INTEGER APOS, APOS2, AINPUT, POSELT, POSEL1, ICT12

2706

INTEGER J1,J2,J3,MP

2707

INTEGER(8) :: JJ8, LAPOS2, JJ2, JJ3

2708

INTEGER NELIM,JJ,JJ1,NPIVS,NCOLS,NROWS,

2709

& IBROT,IORG

2710

INTEGER LDAFS, LDA_SON

2711

INTEGER JK,IJROW,NBCOL,NUMORG,IOLDPS,J4

2712

INTEGER(8) :: ICT13

2713

INTEGER(8) :: IACHK, APOS, APOS2, POSELT, ICT12, POSEL1

2714

INTEGER AINPUT

2676

2715

INTEGER NSLAVES, NSLSON

2677

2716

INTEGER NBLIG, PTRCOL, PTRROW, ISLAVE, PDEST

2678

2717

INTEGER PDEST1(1)

2687

2726

INTEGER MUMPS_275, MUMPS_330

2688

2727

EXTERNAL MUMPS_275, MUMPS_330

2689

2728

INTRINSIC real

2690

DOUBLE PRECISION DATA_SIZE

2691

2729

DOUBLE PRECISION ZERO

2692

2730

DATA ZERO /0.0D0/

2693

2731

INTEGER NELT, LPTRAR, NCBSON_MAX

2694

2732

logical :: force_cand

2695

2733

INTEGER ETATASS

2696

2734

INCLUDE 'mumps_headers.h'

2697

INTEGER APOSMAX

2735

INTEGER (8) :: APOSMAX

2698

2736

DOUBLE PRECISION MAXARR

2699

2737

INTEGER INIV2, SIZE_TMP_SLAVES_LIST, allocok

2700

2738

INTEGER, ALLOCATABLE, DIMENSION(:) :: TMP_SLAVES_LIST

2715

2753

IFSON = -IN

2716

2754

ISON = IFSON

2717

2755

NCBSON_MAX = 0

2756

NELT = 1

2757

LPTRAR = 1

2718

2758

DO WHILE (ISON .GT. 0)

2719

2759

NUMSTK = NUMSTK + 1

2720

2760

IF ( KEEP(48)==5 .AND. MUMPS_330(STEP(ISON),

2721

* PROCNODE_STEPS,SLAVEF) .EQ. 1) THEN

2761

& PROCNODE_STEPS,SLAVEF) .EQ. 1) THEN

2722

2762

NCBSON_MAX = max

2723

2763

& (

2724

2764

& IW(PIMASTER(STEP(ISON))+KEEP(IXSZ)), NCBSON_MAX

2730

2770

NFRONT = ND(STEP(INODE)) + NASS

2731

2771

NASS1 = NASS + NUMORG

2732

2772

NCB = NFRONT - NASS1

2733

DATA_SIZE = NASS1 * NCB

2734

2773

if((KEEP(24).eq.0).or.(KEEP(24).eq.1)) then

2735

2774

force_cand=.FALSE.

2736

2775

else

2748

2787

GOTO 265

2749

2788

ENDIF

2750

2789

CALL DMUMPS_472( NCBSON_MAX, SLAVEF, KEEP,KEEP8,

2751

* ICNTL, CAND(1,INIV2),

2752

* MEM_DISTRIB(0), NCB, NFRONT, NSLAVES,

2753

* TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2754

* TMP_SLAVES_LIST,

2755

* SIZE_TMP_SLAVES_LIST,INODE )

2790

& ICNTL, CAND(1,INIV2),

2791

& MEM_DISTRIB(0), NCB, NFRONT, NSLAVES,

2792

& TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2793

& TMP_SLAVES_LIST,

2794

& SIZE_TMP_SLAVES_LIST,INODE )

2756

2795

HF = NSLAVES + 6 + KEEP(IXSZ)

2757

2796

LREQ_OOC = 0

2758

2797

IF (KEEP(201).EQ.1) THEN

2759

2798

CALL DMUMPS_684(KEEP(50), NASS1, NFRONT, NASS1,

2760

* NBPANELS_L, NBPANELS_U, LREQ_OOC)

2799

& NBPANELS_L, NBPANELS_U, LREQ_OOC)

2761

2800

ENDIF

2762

2801

LREQ = HF + 2 * NFRONT + LREQ_OOC

2763

2802

IF ((IWPOS + LREQ -1) .GT. IWPOSCB) THEN

2764

2803

CALL DMUMPS_94(N, KEEP(28),

2765

* IW, LIW, A, LA,

2766

* LRLU, IPTRLU,

2767

* IWPOS, IWPOSCB, PTRIST, PTRAST,

2768

* STEP, PIMASTER, PAMASTER, ITLOC,LRLUS,

2769

* KEEP(216),KEEP(IXSZ))

2804

& IW, LIW, A, LA,

2805

& LRLU, IPTRLU,

2806

& IWPOS, IWPOSCB, PTRIST, PTRAST,

2807

& STEP, PIMASTER, PAMASTER, ITLOC,

2808

& KEEP(216),LRLUS,KEEP(IXSZ))

2770

2809

COMP = COMP+1

2771

2810

IF (LRLU .NE. LRLUS) THEN

2772

2811

WRITE( *, * ) 'PB compress ass..mpi51f_niv2'

2780

2819

NIV1 = .FALSE.

2781

2820

IF (KEEP(50).EQ.0 .AND. KEEP(234).EQ.0) THEN

2782

2821

CALL MUMPS_81(MYID, INODE, N, IOLDPS, HF, NFRONT,

2783

* NFRONT_EFF,

2784

* NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2785

* IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2786

* INTARR, ITLOC, FILS, FRERE,

2787

* SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG)

2822

& NFRONT_EFF,

2823

& NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2824

& IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2825

& INTARR, ITLOC, FILS, FRERE,

2826

& SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG)

2788

2827

ELSE

2789

2828

ISON_IN_PLACE = -9999

2790

2829

CALL MUMPS_86( MYID, INODE, N, IOLDPS, HF,

2791

* NFRONT, NFRONT_EFF, PERM,

2792

* NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2793

* IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2794

* INTARR, ITLOC, FILS, FRERE,

2795

* SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG,

2796

* ISON_IN_PLACE)

2830

& NFRONT, NFRONT_EFF, PERM,

2831

& NASS1, NASS, NUMSTK, NUMORG, IWPOSCB,

2832

& IFSON, STEP, PIMASTER, PTRAIW, IW, LIW,

2833

& INTARR, ITLOC, FILS, FRERE,

2834

& SON_LEVEL2, NIV1, NBPROCFILS, KEEP,KEEP8, IFLAG,

2835

& ISON_IN_PLACE)

2797

2836

IF (IFLAG.LT.0) GOTO 250

2798

2837

ENDIF

2799

2838

IF ( NFRONT .NE. NFRONT_EFF ) THEN

2802

2841

NSLAVES_OLD = NSLAVES

2803

2842

HF_OLD = HF

2804

2843

CALL DMUMPS_472( NCBSON_MAX,

2805

* SLAVEF, KEEP,KEEP8, ICNTL,

2806

* CAND(1,INIV2),

2807

* MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES,

2808

* TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2809

* TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE )

2844

& SLAVEF, KEEP,KEEP8, ICNTL,

2845

& CAND(1,INIV2),

2846

& MEM_DISTRIB(0), NCB, NFRONT_EFF, NSLAVES,

2847

& TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2848

& TMP_SLAVES_LIST, SIZE_TMP_SLAVES_LIST,INODE )

2810

2849

HF = NSLAVES + 6 + KEEP(IXSZ)

2811

2850

IWPOS = IWPOS - ((2*NFRONT)-(2*NFRONT_EFF)) -

2812

2851

& (NSLAVES_OLD - NSLAVES)

2830

2869

ENDIF

2831

2870

IF (KEEP(201).EQ.1.AND.KEEP(50).NE.1) THEN

2832

2871

CALL DMUMPS_691(KEEP(50),

2833

* NBPANELS_L, NBPANELS_U, NASS1,

2834

* IOLDPS + HF + 2 * NFRONT, IW, LIW)

2872

& NBPANELS_L, NBPANELS_U, NASS1,

2873

& IOLDPS + HF + 2 * NFRONT, IW, LIW)

2835

2874

ENDIF

2836

2875

MAXFRW = max0(MAXFRW, NFRONT)

2837

2876

PTLUST_S(STEP(INODE)) = IOLDPS

2849

2888

#endif

2850

2889

#endif

2851

2890

CALL DMUMPS_461(MYID, SLAVEF, COMM_LOAD,

2852

* TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2853

* NASS1, KEEP,KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE)

2891

& TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2892

& NASS1, KEEP,KEEP8, IW(IOLDPS+6+KEEP(IXSZ)), NSLAVES,INODE)

2854

2893

#if defined(OLD_LOAD_MECHANISM)

2855

2894

#if ! defined (CHECK_COHERENCE)

2856

2895

ENDIF

2859

2898

IF(KEEP(86).EQ.1)THEN

2860

2899

IF(mod(KEEP(24),2).eq.0)THEN

2861

2900

CALL DMUMPS_533(SLAVEF,CAND(SLAVEF+1,INIV2),

2862

* TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2863

* NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE)

2901

& TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2902

& NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE)

2864

2903

ELSEIF((KEEP(24).EQ.0).OR.(KEEP(24).EQ.1))THEN

2865

2904

CALL DMUMPS_533(SLAVEF,SLAVEF-1,

2866

* TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2867

* NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE)

2905

& TAB_POS_IN_PERE(1,ISTEP_TO_INIV2(STEP(INODE))),

2906

& NASS1, KEEP,KEEP8, TMP_SLAVES_LIST, NSLAVES,INODE)

2868

2907

ENDIF

2869

2908

ENDIF

2870

2909

DEALLOCATE(TMP_SLAVES_LIST)

2871

2910

IF (KEEP(50).EQ.0) THEN

2872

LAELL = NASS1 * NFRONT

2911

LAELL8 = int(NASS1,8) * int(NFRONT,8)

2873

2912

LDAFS = NFRONT

2874

2913

ELSE

2875

LAELL = NASS1**2

2876

IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) LAELL = LAELL+NASS1

2914

LAELL8 = int(NASS1,8)*int(NASS1,8)

2915

IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2)

2916

& LAELL8 = LAELL8+int(NASS1,8)

2877

2917

LDAFS = NASS1

2878

2918

ENDIF

2879

IF (LRLU .LT. LAELL) THEN

2880

IF (LRLUS .LT. LAELL) THEN

2919

IF (LRLU .LT. LAELL8) THEN

2920

IF (LRLUS .LT. LAELL8) THEN

2881

2921

GOTO 280

2882

2922

ELSE

2883

2923

CALL DMUMPS_94(N, KEEP(28),

2884

* IW, LIW, A, LA,

2885

* LRLU, IPTRLU,

2886

* IWPOS, IWPOSCB, PTRIST, PTRAST,

2887

* STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

2888

* KEEP(IXSZ))

2924

& IW, LIW, A, LA,

2925

& LRLU, IPTRLU,

2926

& IWPOS, IWPOSCB, PTRIST, PTRAST,

2927

& STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

2928

& KEEP(IXSZ))

2889

2929

IF (LRLU .NE. LRLUS) THEN

2890

2930

WRITE( *, * ) 'PB compress ass..mpi51f_niv2'

2891

2931

WRITE( *, * ) 'LRLU,LRLUS=',LRLU,LRLUS

2893

2933

ENDIF

2894

2934

ENDIF

2895

2935

ENDIF

2896

LRLU = LRLU - LAELL

2897

LRLUS = LRLUS - LAELL

2898

KEEP(67) = min(LRLUS, KEEP(67))

2936

LRLU = LRLU - LAELL8

2937

LRLUS = LRLUS - LAELL8

2938

KEEP8(67) = min(LRLUS, KEEP8(67))

2899

2939

POSELT = POSFAC

2900

2940

PTRAST(STEP(INODE)) = POSELT

2901

2941

PTRFAC(STEP(INODE)) = POSELT

2902

POSFAC = POSFAC + LAELL

2903

IW(IOLDPS+XXI) = LREQ

2904

IW(IOLDPS+XXR) = LAELL

2942

POSFAC = POSFAC + LAELL8

2943

IW(IOLDPS+XXI) = LREQ

2944

CALL MUMPS_730(LAELL8,IW(IOLDPS+XXR))

2905

2945

IW(IOLDPS+XXS) =-9999

2906

2946

IW(IOLDPS+XXS+1:IOLDPS+KEEP(IXSZ)-1)=-99999

2907

IF (KEEP(201).EQ.1) THEN

2908

IW(IOLDPS+XXWRITTENL) = 0

2909

IF (KEEP(50).EQ.0) THEN

2910

IW(IOLDPS+XXWRITTENU) = 0

2911

ENDIF

2912

ENDIF

2913

CALL DMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0,LAELL,

2914

$ KEEP,KEEP8,LRLU)

2915

POSEL1 = POSELT - LDAFS

2947

CALL DMUMPS_471(.FALSE.,.FALSE.,LA-LRLUS,0_8,LAELL8,

2948

& KEEP,KEEP8,LRLU)

2949

POSEL1 = POSELT - int(LDAFS,8)

2916

2950

#if ! defined(ALLOW_NON_INIT)

2917

LAPOS2 = POSELT + LAELL - 1

2951

LAPOS2 = POSELT + LAELL8 - 1_8

2918

2952

A(POSELT:LAPOS2) = dble(ZERO)

2919

2953

#else

2920

2954

IF ( KEEP(50) .eq. 0 .OR. LDAFS .lt. KEEP(63) ) THEN

2921

LAPOS2 = POSELT + LAELL - 1

2955

LAPOS2 = POSELT + LAELL8 - 1_8

2922

2956

A(POSELT:LAPOS2) = dble(ZERO)

2923

2957

ELSE

2924

2958

APOS = POSELT

2925

DO JJ = 0, LDAFS - 1

2926

A(APOS:APOS+JJ) = dble(ZERO)

2927

APOS = APOS + LDAFS

2959

DO JJ8 = 0_8, int(LDAFS-1,8)

2960

A(APOS:APOS+JJ8) = dble(ZERO)

2961

APOS = APOS + int(LDAFS,8)

2928

2962

END DO

2929

2963

IF (KEEP(219).NE.0.AND.KEEP(50).EQ.2) THEN

2930

A(APOS:APOS+LDAFS-1)=dble(ZERO)

2964

A(APOS:APOS+int(LDAFS,8)-1_8)=dble(ZERO)

2931

2965

ENDIF

2932

2966

END IF

2933

2967

#endif

2960

2994

IACHK = PAMASTER(STEP(ISON))

2961

2995

IF (KEEP(50).eq.0) THEN

2962

2996

DO 170 JJ = J1, J2

2963

APOS = POSEL1 + IW(JJ) * LDAFS

2997

APOS = POSEL1 + int(IW(JJ),8) * int(LDAFS,8)

2964

2998

DO 160 JJ1 = 1, LSTK

2965

JJ2 = APOS + IW(J1 + JJ1 - 1) - 1

2966

A(JJ2) = A(JJ2) + A(IACHK + JJ1 - 1)

2999

JJ2 = APOS + int(IW(J1 + JJ1 - 1),8) - 1_8

3000

A(JJ2) = A(JJ2) + A(IACHK + int(JJ1 - 1,8))

2967

3001

160 CONTINUE

2968

IACHK = IACHK + LSTK

3002

IACHK = IACHK + int(LSTK,8)

2969

3003

170 CONTINUE

2970

3004

ELSE

2971

3005

IF (NSLSON.EQ.0) THEN

2974

3008

LDA_SON = NELIM

2975

3009

ENDIF

2976

3010

IF (COMPRESSCB) THEN

2977

LCB = (NELIM*(NELIM+1))/2

3011

LCB = (int(NELIM,8)*int(NELIM+1,8))/2_8

2978

3012

ELSE

2979

LCB = LDA_SON*( NELIM )

3013

LCB = int(LDA_SON,8)*int(NELIM,8)

2980

3014

ENDIF

2981

3015

CALL DMUMPS_178( A, LA,

2982

* POSELT, LDAFS, NASS1,

2983

* IACHK, LDA_SON, LCB,

2984

* IW( J1 ), NELIM, NELIM, ETATASS,

2985

* COMPRESSCB,

2986

* .FALSE.

2987

* )

3016

& POSELT, LDAFS, NASS1,

3017

& IACHK, LDA_SON, LCB,

3018

& IW( J1 ), NELIM, NELIM, ETATASS,

3019

& COMPRESSCB,

3020

& .FALSE.

3021

& )

2988

3022

ENDIF

2989

3023

210 ISON = FRERE(STEP(ISON))

2990

3024

220 CONTINUE

2991

3025

ENDIF

2992

3026

IBROT = INODE

2993

APOSMAX = POSELT + NASS1*NASS1

3027

APOSMAX = POSELT + int(NASS1,8)*int(NASS1,8)

2994

3028

DO 260 IORG = 1, NUMORG

2995

3029

JK = PTRAIW(IBROT)

2996

3030

AINPUT = PTRARW(IBROT)

3001

3035

J3 = J2 + 1

3002

3036

J4 = J2 - INTARR(JJ)

3003

3037

IJROW = INTARR(J1)

3004

ICT12 = POSELT - LDAFS + IJROW - 1

3038

ICT12 = POSELT + int(IJROW - 1 - LDAFS, 8)

3005

3039

MAXARR = ZERO

3006

3040

CduplicatesCVD$ NODEPCHK

3007

3041

DO 240 JJ = J1, J2

3008

3042

IF (KEEP(219).NE.0) THEN

3009

3043

IF (INTARR(JJ).LE.NASS1) THEN

3010

APOS2 = ICT12 + INTARR(JJ) * LDAFS

3044

APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8)

3011

3045

A(APOS2) = A(APOS2) + DBLARR(AINPUT)

3012

3046

ELSEIF (KEEP(50).EQ.2) THEN

3013

3047

MAXARR = max(MAXARR,abs(DBLARR(AINPUT)))

3014

3048

ENDIF

3015

3049

ELSE

3016

3050

IF (INTARR(JJ).LE.NASS1) THEN

3017

APOS2 = ICT12 + INTARR(JJ) * LDAFS

3051

APOS2 = ICT12 + int(INTARR(JJ),8) * int(LDAFS,8)

3018

3052

A(APOS2) = A(APOS2) + DBLARR(AINPUT)

3019

3053

ENDIF

3020

3054

ENDIF

3021

3055

AINPUT = AINPUT + 1

3022

3056

240 CONTINUE

3023

3057

IF(KEEP(219).NE.0.AND.KEEP(50) .EQ. 2) THEN

3024

A(APOSMAX+IJROW-1) = MAXARR

3058

A(APOSMAX+int(IJROW-1,8)) = dble(MAXARR)

3025

3059

ENDIF

3026

3060

IF (J3 .GT. J4) GOTO 260

3027

ICT13 = POSELT + (IJROW - 1) * LDAFS

3061

ICT13 = POSELT + int(IJROW - 1,8) * int(LDAFS,8)

3028

3062

NBCOL = J4 - J3 + 1

3029

3063

CduplicatesCVD$ NODEPCHK

3030

3064

CduplicatesCVD$ NODEPCHK

3031

3065

DO JJ = 1, NBCOL

3032

JJ1 = ICT13 + INTARR(J3 + JJ - 1) - 1

3033

A(JJ1) = A(JJ1) + DBLARR(AINPUT + JJ - 1)

3066

JJ3 = ICT13 + int(INTARR(J3 + JJ - 1),8) - 1_8

3067

A(JJ3) = A(JJ3) + DBLARR(AINPUT + JJ - 1)

3034

3068

ENDDO

3035

3069

260 CONTINUE

3036

3070

PTRCOL = IOLDPS + HF + NFRONT

3049

3083

IF ( KEEP(50) .eq. 0 ) THEN

3050

3084

NBCOL = NFRONT

3051

3085

CALL DMUMPS_68( INODE,

3052

* NBPROCFILS(STEP(INODE)),

3053

* NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1,

3054

* IZERO, IDUMMY,

3055

* IW(PDEST), NFRONT, COMM, IERR)

3086

& NBPROCFILS(STEP(INODE)),

3087

& NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1,

3088

& IZERO, IDUMMY,

3089

& IW(PDEST), NFRONT, COMM, IERR)

3056

3090

ELSE

3057

3091

NBCOL = NASS1+SHIFT_INDEX+NBLIG

3058

3092

CALL DMUMPS_68( INODE,

3059

* NBPROCFILS(STEP(INODE)),

3060

* NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1,

3061

* NSLAVES-ISLAVE,

3062

* IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE),

3063

* IW(PDEST), NFRONT, COMM, IERR)

3093

& NBPROCFILS(STEP(INODE)),

3094

& NBLIG, IW(PTRROW), NBCOL, IW(PTRCOL), NASS1,

3095

& NSLAVES-ISLAVE,

3096

& IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)+ISLAVE),

3097

& IW(PDEST), NFRONT, COMM, IERR)

3064

3098

ENDIF

3065

3099

IF (IERR.EQ.-1) THEN

3066

3100

BLOCKING = .FALSE.

3067

3101

SET_IRECV = .TRUE.

3068

3102

MESSAGE_RECEIVED = .FALSE.

3069

3103

CALL DMUMPS_329( COMM_LOAD, ASS_IRECV,

3070

* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

3071

* MPI_ANY_SOURCE, MPI_ANY_TAG,

3072

* STATUS, BUFR, LBUFR,

3073

* LBUFR_BYTES,

3074

* PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,

3075

* LRLU, LRLUS, N, IW, LIW, A, LA,

3076

* PTRIST, PTLUST_S, PTRFAC,

3077

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

3078

* IERROR, COMM,

3079

* NBPROCFILS,

3080

* IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

3081

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3082

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

3083

* LPTRAR, NELT, IW, IW,

3084

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

3104

& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

3105

& MPI_ANY_SOURCE, MPI_ANY_TAG,

3106

& STATUS, BUFR, LBUFR,

3107

& LBUFR_BYTES,

3108

& PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,

3109

& LRLU, LRLUS, N, IW, LIW, A, LA,

3110

& PTRIST, PTLUST_S, PTRFAC,

3111

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

3112

& IERROR, COMM,

3113

& NBPROCFILS,

3114

& IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

3115

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3116

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

3117

& LPTRAR, NELT, IW, IW,

3118

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

3085

3119

IF ( IFLAG .LT. 0 ) GOTO 500

3086

3120

IF (MESSAGE_RECEIVED) THEN

3087

3121

IOLDPS = PTLUST_S(STEP(INODE))

3134

3168

IF (NSLSON.EQ.0) THEN

3135

3169

NSLSON = 1

3136

3170

PDEST1(1) = MUMPS_275(STEP(ISON),

3137

* PROCNODE_STEPS, SLAVEF)

3171

& PROCNODE_STEPS, SLAVEF)

3138

3172

IF (PDEST1(1).EQ.MYID) THEN

3139

3173

CALL DMUMPS_211( COMM_LOAD, ASS_IRECV,

3140

* BUFR, LBUFR, LBUFR_BYTES,

3141

* INODE, ISON, NSLAVES,

3142

* IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)),

3143

* NFRONT, NASS1, NFS4FATHER, NCBSON,

3144

* IW( PTRCOL ),

3145

* PROCNODE_STEPS,

3146

* SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,

3147

* LRLUS, N, IW,

3148

* LIW, A, LA,

3149

* PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP,

3150

* PIMASTER, PAMASTER, NSTK_S, COMP,

3151

* IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF,

3152

* NBFIN, ICNTL, KEEP,KEEP8, root,

3153

* OPASSW, OPELIW,

3154

* ITLOC, FILS, PTRARW, PTRAIW, INTARR, DBLARR,

3155

* ND, FRERE, LPTRAR, NELT, IW, IW,

3156

*

3157

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

3158

* )

3174

& BUFR, LBUFR, LBUFR_BYTES,

3175

& INODE, ISON, NSLAVES,

3176

& IW( PTLUST_S(STEP(INODE)) + 6 +KEEP(IXSZ)),

3177

& NFRONT, NASS1, NFS4FATHER, NCBSON,

3178

& IW( PTRCOL ),

3179

& PROCNODE_STEPS,

3180

& SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,

3181

& LRLUS, N, IW,

3182

& LIW, A, LA,

3183

& PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP,

3184

& PIMASTER, PAMASTER, NSTK_S, COMP,

3185

& IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF,

3186

& NBFIN, ICNTL, KEEP,KEEP8, root,

3187

& OPASSW, OPELIW,

3188

& ITLOC, FILS, PTRARW, PTRAIW, INTARR, DBLARR,

3189

& ND, FRERE, LPTRAR, NELT, IW, IW,

3190

&

3191

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

3192

& )

3159

3193

IF ( IFLAG .LT. 0 ) GOTO 500

3160

3194

ELSE

3161

3195

IERR = -1

3162

3196

DO WHILE (IERR.EQ.-1)

3163

3197

PTRCOL = PIMASTER(STEP(ISON))+HS+NROWS+NPIVS+NELIM

3164

3198

CALL DMUMPS_71(

3165

* INODE, NFRONT,NASS1,NFS4FATHER,

3166

* ISON, MYID,

3167

* NSLAVES, IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ) ),

3168

* IW(PTRCOL), NCBSON,

3169

* COMM, IERR, PDEST1, NSLSON, SLAVEF,

3170

* KEEP,KEEP8, STEP, N,

3171

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

3172

* )

3199

& INODE, NFRONT,NASS1,NFS4FATHER,

3200

& ISON, MYID,

3201

& NSLAVES, IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ) ),

3202

& IW(PTRCOL), NCBSON,

3203

& COMM, IERR, PDEST1, NSLSON, SLAVEF,

3204

& KEEP,KEEP8, STEP, N,

3205

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

3206

& )

3173

3207

IF (IERR.EQ.-1) THEN

3174

3208

BLOCKING = .FALSE.

3175

3209

SET_IRECV = .TRUE.

3176

3210

MESSAGE_RECEIVED = .FALSE.

3177

3211

CALL DMUMPS_329( COMM_LOAD, ASS_IRECV,

3178

* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

3179

* MPI_ANY_SOURCE, MPI_ANY_TAG,

3180

* STATUS, BUFR, LBUFR, LBUFR_BYTES,

3181

* PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,

3182

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

3183

* PTLUST_S, PTRFAC,

3184

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

3185

* IERROR, COMM,

3186

* NBPROCFILS,

3187

* IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

3188

* root,OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3189

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR,

3190

* NELT, IW, IW,

3191

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

3212

& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

3213

& MPI_ANY_SOURCE, MPI_ANY_TAG,

3214

& STATUS, BUFR, LBUFR, LBUFR_BYTES,

3215

& PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,

3216

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

3217

& PTLUST_S, PTRFAC,

3218

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

3219

& IERROR, COMM,

3220

& NBPROCFILS,

3221

& IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

3222

& root,OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3223

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE, LPTRAR,

3224

& NELT, IW, IW,

3225

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

3192

3226

IF ( IFLAG .LT. 0 ) GOTO 500

3193

3227

ENDIF

3194

3228

ENDDO

3207

3241

SHIFT_INDEX = FIRST_INDEX - 1

3208

3242

INDX = PTRCOL + SHIFT_INDEX

3209

3243

CALL DMUMPS_210( COMM_LOAD, ASS_IRECV,

3210

* BUFR, LBUFR, LBUFR_BYTES,

3211

* INODE, ISON, NSLAVES,

3212

* IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)),

3213

* NFRONT, NASS1,NFS4FATHER,

3214

* TROW_SIZE, IW( INDX ),

3215

* PROCNODE_STEPS,

3216

* SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,

3217

* LRLUS, N, IW,

3218

* LIW, A, LA,

3219

* PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP,

3220

* PIMASTER, PAMASTER, NSTK_S, COMP,

3221

* IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF,

3222

* NBFIN, ICNTL, KEEP,KEEP8, root,

3223

* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3224

* INTARR, DBLARR, ND, FRERE, LPTRAR, NELT, IW,

3225

* IW,

3226

*

3227

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

3228

* )

3244

& BUFR, LBUFR, LBUFR_BYTES,

3245

& INODE, ISON, NSLAVES,

3246

& IW( PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)),

3247

& NFRONT, NASS1,NFS4FATHER,

3248

& TROW_SIZE, IW( INDX ),

3249

& PROCNODE_STEPS,

3250

& SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,

3251

& LRLUS, N, IW,

3252

& LIW, A, LA,

3253

& PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP,

3254

& PIMASTER, PAMASTER, NSTK_S, COMP,

3255

& IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF,

3256

& NBFIN, ICNTL, KEEP,KEEP8, root,

3257

& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3258

& INTARR, DBLARR, ND, FRERE, LPTRAR, NELT, IW,

3259

& IW,

3260

&

3261

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

3262

& )

3229

3263

IF ( IFLAG .LT. 0 ) GOTO 500

3230

3264

EXIT

3231

3265

ENDIF

3236

3270

PTRCOL = PIMASTER(STEP(ISON)) + HS + NROWS + NPIVS + NELIM

3237

3271

PDEST = PIMASTER(STEP(ISON)) + 6 + KEEP(IXSZ)

3238

3272

CALL DMUMPS_71(

3239

* INODE, NFRONT,NASS1, NFS4FATHER,

3240

* ISON, MYID,

3241

* NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)),

3242

* IW(PTRCOL), NCBSON,

3243

* COMM, IERR, IW(PDEST), NSLSON, SLAVEF,

3244

* KEEP,KEEP8, STEP, N,

3245

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

3246

* )

3273

& INODE, NFRONT,NASS1, NFS4FATHER,

3274

& ISON, MYID,

3275

& NSLAVES, IW(PTLUST_S(STEP(INODE))+6+KEEP(IXSZ)),

3276

& IW(PTRCOL), NCBSON,

3277

& COMM, IERR, IW(PDEST), NSLSON, SLAVEF,

3278

& KEEP,KEEP8, STEP, N,

3279

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

3280

& )

3247

3281

IF (IERR.EQ.-1) THEN

3248

3282

BLOCKING = .FALSE.

3249

3283

SET_IRECV = .TRUE.

3250

3284

MESSAGE_RECEIVED = .FALSE.

3251

3285

CALL DMUMPS_329( COMM_LOAD, ASS_IRECV,

3252

* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

3253

* MPI_ANY_SOURCE, MPI_ANY_TAG,

3254

* STATUS, BUFR, LBUFR,

3255

* LBUFR_BYTES,

3256

* PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,

3257

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

3258

* PTLUST_S, PTRFAC,

3259

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

3260

* IERROR, COMM,

3261

* NBPROCFILS,

3262

* IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

3263

* root,OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3264

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

3265

* LPTRAR, NELT, IW, IW,

3266

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

3286

& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

3287

& MPI_ANY_SOURCE, MPI_ANY_TAG,

3288

& STATUS, BUFR, LBUFR,

3289

& LBUFR_BYTES,

3290

& PROCNODE_STEPS, POSFAC, IWPOS, IWPOSCB, IPTRLU,

3291

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

3292

& PTLUST_S, PTRFAC,

3293

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

3294

& IERROR, COMM,

3295

& NBPROCFILS,

3296

& IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

3297

& root,OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

3298

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

3299

& LPTRAR, NELT, IW, IW,

3300

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

3267

3301

IF ( IFLAG .LT. 0 ) GOTO 500

3268

3302

ENDIF

3269

3303

ENDDO

3278

3312

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

3279

3313

LP = ICNTL(1)

3280

3314

WRITE( LP, * )

3281

*' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING

3282

* DMUMPS_253'

3315

&' FAILURE IN INTEGER DYNAMIC ALLOCATION DURING

3316

& DMUMPS_253'

3283

3317

ENDIF

3284

3318

IFLAG = -13

3285

3319

IERROR = NUMSTK + 1

3299

3333

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

3300

3334

LP = ICNTL(1)

3301

3335

WRITE( LP, * )

3302

*' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_253'

3336

&' FAILURE IN INTEGER ALLOCATION DURING DMUMPS_253'

3303

3337

ENDIF

3304

3338

GOTO 490

3305

3339

280 CONTINUE

3306

3340

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

3307

3341

LP = ICNTL(1)

3308

3342

WRITE( LP, * )

3309

*' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_253'

3343

&' FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_253'

3310

3344

ENDIF

3311

3345

IFLAG = -9

3312

IERROR = LAELL - LRLUS

3346

CALL MUMPS_731(LAELL8-LRLUS, IERROR)

3313

3347

GOTO 490

3314

3348

290 CONTINUE

3315

3349

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

3316

3350

LP = ICNTL(1)

3317

3351

WRITE( LP, * )

3318

*' FAILURE, SEND BUFFER TOO SMALL (1) DURING DMUMPS_253'

3352

&' FAILURE, SEND BUFFER TOO SMALL (1) DURING DMUMPS_253'

3319

3353

ENDIF

3320

3354

IFLAG = -17

3321

3355

LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ)

3325

3359

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

3326

3360

LP = ICNTL(1)

3327

3361

WRITE( LP, * )

3328

*' FAILURE, RECV BUFFER TOO SMALL (1) DURING DMUMPS_253'

3362

&' FAILURE, RECV BUFFER TOO SMALL (1) DURING DMUMPS_253'

3329

3363

ENDIF

3330

3364

IFLAG = -20

3331

3365

LREQ = NCBSON + 6 + NSLSON+KEEP(IXSZ)

3335

3369

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

3336

3370

LP = ICNTL(1)

3337

3371

WRITE( LP, * )

3338

*' FAILURE, SEND BUFFER TOO SMALL (2) DURING DMUMPS_253'

3372

&' FAILURE, SEND BUFFER TOO SMALL (2) DURING DMUMPS_253'

3339

3373

ENDIF

3340

3374

IFLAG = -17

3341

3375

LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ)

3345

3379

IF ((ICNTL(1) .GT. 0) .AND. (ICNTL(4) .GE. 1)) THEN

3346

3380

LP = ICNTL(1)

3347

3381

WRITE( LP, * )

3348

*' FAILURE, RECV BUFFER TOO SMALL (2) DURING DMUMPS_253'

3382

&' FAILURE, RECV BUFFER TOO SMALL (2) DURING DMUMPS_253'

3349

3383

ENDIF

3350

3384

IFLAG = -17

3351

3385

LREQ = NBLIG + NBCOL + 4 + KEEP(IXSZ)

3355

3389

RETURN

3356

3390

END SUBROUTINE DMUMPS_253

3357

3391

SUBROUTINE DMUMPS_39(N, INODE, IW, LIW, A, LA,

3358

* ISON, NBROWS, NBCOLS, ROWLIST,

3359

* VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,

3360

* OPASSW, IWPOSCB, MYID, KEEP,KEEP8 )

3392

& ISON, NBROWS, NBCOLS, ROWLIST,

3393

& VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,

3394

& OPASSW, IWPOSCB, MYID, KEEP,KEEP8 )

3361

3395

USE DMUMPS_LOAD

3362

3396

IMPLICIT NONE

3363

3397

INTEGER KEEP(500)

3364

3398

INTEGER*8 KEEP8(150)

3365

INTEGER N,LIW,LA,MYID

3399

INTEGER(8) :: LA

3400

INTEGER N,LIW,MYID

3366

3401

INTEGER INODE,ISON, IWPOSCB

3367

3402

INTEGER NBROWS, NBCOLS

3368

INTEGER IW(LIW), STEP(N),

3369

* PIMASTER(KEEP(28)),

3370

* PTLUST_S(KEEP(28)), PTRAST(KEEP(28)),

3371

* ROWLIST(NBROWS)

3403

INTEGER(8) :: PTRAST(KEEP(28))

3404

INTEGER IW(LIW), STEP(N), PIMASTER(KEEP(28)),

3405

& PTLUST_S(KEEP(28)), ROWLIST(NBROWS)

3372

3406

DOUBLE PRECISION A(LA), VALSON(NBCOLS,NBROWS)

3373

3407

DOUBLE PRECISION OPASSW

3408

INTEGER(8) :: POSELT, POSEL1, APOS, JJ2

3374

3409

INTEGER HF,HS, NSLAVES, NFRONT, NASS1,

3375

* IOLDPS, POSELT, POSEL1, ISTCHK,

3376

* LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1,J2,J3, JJ,APOS,

3377

* JJ1,JJ2, ICT11, JPOS, SIZFI, SIZFR, NCOL, NROW,

3378

* NROWS, LDAFS_PERE, IBEG

3410

& IOLDPS, ISTCHK,

3411

& LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1,J2,J3, JJ,

3412

& JJ1, JPOS, SIZFI, NCOL, NROW,

3413

& NROWS, LDAFS_PERE, IBEG

3379

3414

INCLUDE 'mumps_headers.h'

3380

3415

LOGICAL SAME_PROC, FREE

3381

3416

INTRINSIC real

3394

3429

ENDIF

3395

3430

ENDIF

3396

3431

HF = 6 + NSLAVES + KEEP(IXSZ)

3397

POSEL1 = POSELT - LDAFS_PERE

3432

POSEL1 = POSELT - int(LDAFS_PERE,8)

3398

3433

ISTCHK = PIMASTER(STEP(ISON))

3399

3434

LSTK = IW(ISTCHK+KEEP(IXSZ))

3400

3435

NSLSON = IW(ISTCHK + 5+KEEP(IXSZ))

3413

3448

J1 = ISTCHK + NROWS + HS + NPIVS

3414

3449

IF (KEEP(50).EQ.0) THEN

3415

3450

DO 170 JJ = 1, NBROWS

3416

APOS = POSEL1 + ROWLIST(JJ) * LDAFS_PERE

3451

APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8)

3417

3452

DO 160 JJ1 = 1, NBCOLS

3418

JJ2 = APOS + IW(J1 + JJ1 - 1) - 1

3453

JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8)

3419

3454

A(JJ2) = A(JJ2) + VALSON(JJ1,JJ)

3420

3455

160 CONTINUE

3421

3456

170 CONTINUE

3422

3457

ELSE

3423

3458

DO JJ = 1, NBROWS

3424

3459

IF (ROWLIST(JJ).LE.NASS1) THEN

3425

APOS = POSEL1 + ROWLIST(JJ) - 1

3460

APOS = POSEL1 + int(ROWLIST(JJ) - 1,8)

3426

3461

DO JJ1 = 1, NELIM

3427

JJ2 = APOS + IW(J1 + JJ1 - 1)*LDAFS_PERE

3462

JJ2 = APOS + int(IW(J1+JJ1-1),8)*int(LDAFS_PERE,8)

3428

3463

A(JJ2) = A(JJ2) + VALSON(JJ1,JJ)

3429

3464

ENDDO

3430

3465

IBEG = NELIM+1

3431

3466

ELSE

3432

3467

IBEG = 1

3433

3468

ENDIF

3434

APOS = POSEL1 + ROWLIST(JJ) * LDAFS_PERE

3469

APOS = POSEL1 + int(ROWLIST(JJ),8) * int(LDAFS_PERE,8)

3435

3470

DO JJ1 = IBEG, NBCOLS

3436

3471

IF (ROWLIST(JJ).LT.IW(J1 + JJ1 - 1)) EXIT

3437

JJ2 = APOS + IW(J1 + JJ1 - 1) - 1

3472

JJ2 = APOS + int(IW(J1 + JJ1 - 1) - 1,8)

3438

3473

A(JJ2) = A(JJ2) + VALSON(JJ1,JJ)

3439

3474

ENDDO

3440

3475

ENDDO

3442

3477

RETURN

3443

3478

END SUBROUTINE DMUMPS_39

3444

3479

SUBROUTINE DMUMPS_539

3445

* (N, INODE, IW, LIW, A, LA,

3446

* NBROWS, NBCOLS,

3447

* OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

3448

* FILS, PTRARW, PTRAIW, INTARR, DBLARR,

3449

* ICNTL, KEEP,KEEP8, MYID)

3480

& (N, INODE, IW, LIW, A, LA,

3481

& NBROWS, NBCOLS,

3482

& OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

3483

& FILS, PTRARW, PTRAIW, INTARR, DBLARR,

3484

& ICNTL, KEEP,KEEP8, MYID)

3450

3485

IMPLICIT NONE

3451

INTEGER N,LIW,LA

3486

INTEGER N,LIW

3487

INTEGER(8) :: LA

3452

3488

INTEGER KEEP(500), ICNTL(40)

3453

3489

INTEGER*8 KEEP8(150)

3454

3490

INTEGER INODE, MYID

3455

3491

INTEGER NBROWS, NBCOLS

3492

INTEGER(8) :: PTRAST(KEEP(28))

3456

3493

INTEGER IW(LIW), ITLOC(N), STEP(N),

3457

* PTRIST(KEEP(28)),

3458

* PTRAST(KEEP(28)) , FILS(N), PTRARW(N), PTRAIW(N)

3494

& PTRIST(KEEP(28)), FILS(N), PTRARW(N), PTRAIW(N)

3459

3495

INTEGER INTARR(max(1,KEEP(14)))

3460

3496

DOUBLE PRECISION A(LA),

3461

* DBLARR(max(1,KEEP(13)))

3497

& DBLARR(max(1,KEEP(13)))

3462

3498

DOUBLE PRECISION OPASSW, OPELIW

3463

INTEGER IOLDPS, POSELT, NBCOLF, NBROWF, NSLAVES, HF,

3464

* K1,K2,K,I,J,POSEL1,APOS,JPOS,NASS,JJ,

3465

* IN,AINPUT,JK,J1,J2,IJROW,ICT12, ILOC

3499

INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,

3500

& K1,K2,K,I,J,JPOS,NASS,JJ,

3501

& IN,AINPUT,JK,J1,J2,IJROW, ILOC

3502

INTEGER(8) :: POSELT, ICT12, APOS

3466

3503

DOUBLE PRECISION ZERO

3467

3504

PARAMETER (ZERO=0.0D0)

3468

3505

INCLUDE 'mumps_headers.h'

3476

3513

IF (NASS.LT.0) THEN

3477

3514

NASS = -NASS

3478

3515

IW(IOLDPS+1+KEEP(IXSZ)) = NASS

3479

A(POSELT:POSELT+NBROWF*NBCOLF-1) = dble(ZERO)

3516

A(POSELT:POSELT+int(NBROWF,8)*int(NBCOLF,8)-1_8) =

3517

& dble(ZERO)

3480

3518

K1 = IOLDPS + HF

3481

3519

K2 = K1 + NBROWF - 1

3482

3520

JPOS = 1

3501

3539

J1 = JJ + 1

3502

3540

J2 = J1 + INTARR(JK)

3503

3541

IJROW = -ITLOC(INTARR(J1))

3504

ICT12 = POSELT - NBCOLF + IJROW - 1

3542

ICT12 = POSELT +int(- NBCOLF + IJROW - 1,8)

3505

3543

DO JJ= J1,J2

3506

3544

ILOC = ITLOC(INTARR(JJ))

3507

3545

IF (ILOC.GT.0) THEN

3508

APOS = ICT12 + ILOC*NBCOLF

3546

APOS = ICT12 + int(ILOC,8)*int(NBCOLF,8)

3509

3547

A(APOS) = A(APOS) + DBLARR(AINPUT)

3510

3548

ENDIF

3511

3549

AINPUT = AINPUT + 1

3532

3570

RETURN

3533

3571

END SUBROUTINE DMUMPS_539

3534

3572

SUBROUTINE DMUMPS_531

3535

* (N, INODE, IW, LIW, NBROWS, STEP, PTRIST, ITLOC, KEEP,KEEP8)

3573

& (N, INODE, IW, LIW, NBROWS, STEP, PTRIST, ITLOC, KEEP,KEEP8)

3536

3574

IMPLICIT NONE

3537

3575

INTEGER N, LIW

3538

3576

INTEGER KEEP(500)

3540

3578

INTEGER INODE, MYID

3541

3579

INTEGER NBROWS

3542

3580

INTEGER IW(LIW), ITLOC(N), STEP(N),

3543

* PTRIST(KEEP(28))

3581

& PTRIST(KEEP(28))

3544

3582

INCLUDE 'mumps_headers.h'

3545

3583

INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,

3546

* K1,K2,K,J

3584

& K1,K2,K,J

3547

3585

IOLDPS = PTRIST(STEP(INODE))

3548

3586

NBCOLF = IW(IOLDPS+KEEP(IXSZ))

3549

3587

NBROWF = IW(IOLDPS+2+KEEP(IXSZ))

3560

3598

RETURN

3561

3599

END SUBROUTINE DMUMPS_531

3562

3600

SUBROUTINE DMUMPS_40(N, INODE, IW, LIW, A, LA,

3563

* NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON,

3564

* OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

3565

* FILS,

3566

* ICNTL, KEEP,KEEP8, MYID)

3601

& NBROWS, NBCOLS, ROWLIST, COLLIST, VALSON,

3602

& OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

3603

& FILS,

3604

& ICNTL, KEEP,KEEP8, MYID)

3567

3605

IMPLICIT NONE

3568

INTEGER N,LIW,LA

3606

INTEGER N,LIW

3607

INTEGER(8) :: LA

3569

3608

INTEGER KEEP(500), ICNTL(40)

3570

3609

INTEGER*8 KEEP8(150)

3571

3610

INTEGER INODE, MYID

3572

3611

INTEGER NBROWS, NBCOLS

3573

3612

INTEGER ROWLIST(NBROWS), COLLIST(NBCOLS)

3574

3613

INTEGER IW(LIW), ITLOC(N), STEP(N),

3575

* PTRIST(KEEP(28)),

3576

* PTRAST(KEEP(28)) , FILS(N)

3614

& PTRIST(KEEP(28)), FILS(N)

3615

INTEGER(8) :: PTRAST(KEEP(28))

3577

3616

DOUBLE PRECISION A(LA), VALSON(NBCOLS,NBROWS)

3578

3617

DOUBLE PRECISION OPASSW, OPELIW

3579

INTEGER IOLDPS, POSELT, NBCOLF, NBROWF, NSLAVES, HF,

3580

* K1,K2,K,I,J,POSEL1,APOS,JPOS,NASS,JJ,

3581

* IN,AINPUT,JK,J1,J2,IJROW,ICT12, ILOC

3618

INTEGER(8) :: POSEL1, POSELT, APOS, ICT12, K8

3619

INTEGER IOLDPS, NBCOLF, NBROWF, NSLAVES, HF,

3620

& I,J,JPOS,NASS,JJ,

3621

& IN,AINPUT,JK,J1,J2,IJROW,ILOC

3582

3622

DOUBLE PRECISION ZERO

3583

3623

PARAMETER (ZERO=0.0D0)

3584

3624

INCLUDE 'mumps_headers.h'

3598

3638

NSLAVES = IW(IOLDPS+5+KEEP(IXSZ))

3599

3639

HF = 6 + NSLAVES+KEEP(IXSZ)

3600

3640

IF (NBROWS.GT.0) THEN

3601

POSEL1 = POSELT - NBCOLF

3641

POSEL1 = POSELT - int(NBCOLF,8)

3602

3642

IF (KEEP(50).EQ.0) THEN

3603

3643

DO I=1,NBROWS

3604

APOS = POSEL1 + ROWLIST(I) * NBCOLF

3644

APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8)

3605

3645

DO J=1,NBCOLS

3606

K = APOS + ITLOC(COLLIST(J)) - 1

3607

A(K) = A(K) + VALSON(J,I)

3646

K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8

3647

A(K8) = A(K8) + VALSON(J,I)

3608

3648

ENDDO

3609

3649

ENDDO

3610

3650

ELSE

3611

3651

DO I=1,NBROWS

3612

APOS = POSEL1 + ROWLIST(I) * NBCOLF

3652

APOS = POSEL1 + int(ROWLIST(I),8) * int(NBCOLF,8)

3613

3653

DO J=1,NBCOLS

3614

3654

IF (ITLOC(COLLIST(J)) .EQ. 0) EXIT

3615

K = APOS + ITLOC(COLLIST(J)) - 1

3616

A(K) = A(K) + VALSON(J,I)

3655

K8 = APOS + int(ITLOC(COLLIST(J)),8) - 1_8

3656

A(K8) = A(K8) + VALSON(J,I)

3617

3657

ENDDO

3618

3658

ENDDO

3619

3659

ENDIF

3623

3663

RETURN

3624

3664

END SUBROUTINE DMUMPS_40

3625

3665

SUBROUTINE DMUMPS_178( A, LA,

3626

* IAFATH, NFRONT, NASS1,

3627

* IACB, NCOLS, LCB,

3628

* IW, NROWS, NELIM, ETATASS,

3629

* CB_IS_COMPRESSED, IS_INPLACE

3630

* )

3666

& IAFATH, NFRONT, NASS1,

3667

& IACB, NCOLS, LCB,

3668

& IW, NROWS, NELIM, ETATASS,

3669

& CB_IS_COMPRESSED, IS_INPLACE

3670

& )

3631

3671

IMPLICIT NONE

3632

INTEGER NFRONT, NASS1, LA

3672

INTEGER NFRONT, NASS1

3673

INTEGER(8) :: LA

3633

3674

INTEGER NCOLS, NROWS, NELIM

3634

INTEGER LCB

3675

INTEGER(8) :: LCB

3635

3676

DOUBLE PRECISION A( LA )

3636

INTEGER IAFATH, IACB

3677

INTEGER(8) :: IAFATH, IACB

3637

3678

INTEGER IW( NCOLS )

3638

3679

INTEGER ETATASS

3639

3680

DOUBLE PRECISION ZERO

3640

3681

LOGICAL CB_IS_COMPRESSED, IS_INPLACE

3641

3682

PARAMETER(ZERO=0.0D0)

3642

3683

LOGICAL RESET_TO_ZERO, RISK_OF_SAME_POS,

3643

* RISK_OF_SAME_POS_THIS_LINE

3684

& RISK_OF_SAME_POS_THIS_LINE

3644

3685

INTEGER I, J

3645

INTEGER APOS, POSELT

3646

INTEGER IPOSCB, IBEGCBROW, IENDFRONT

3686

INTEGER(8) :: APOS, POSELT

3687

INTEGER(8) :: IPOSCB, IBEGCBROW, IENDFRONT

3688

IENDFRONT = IAFATH+int(NFRONT,8)*int(NFRONT,8)-1_8

3647

3689

IF ( IS_INPLACE ) THEN

3648

IPOSCB=1

3649

RESET_TO_ZERO = IACB .LT. IAFATH + NFRONT * NFRONT

3650

RISK_OF_SAME_POS = IACB + LCB .EQ. IAFATH + NFRONT * NFRONT

3690

IPOSCB=1_8

3691

RESET_TO_ZERO = IACB .LT. IENDFRONT + 1_8

3692

RISK_OF_SAME_POS = IACB + LCB .EQ. IENDFRONT + 1_8

3651

3693

RISK_OF_SAME_POS_THIS_LINE = .FALSE.

3652

3694

DO I=1, NROWS

3653

POSELT = (IW(I)-1) * NFRONT

3695

POSELT = int(IW(I)-1,8) * int(NFRONT,8)

3654

3696

IF (.NOT. CB_IS_COMPRESSED ) THEN

3655

IPOSCB = 1 + (I - 1) * NCOLS

3656

IF (IACB+IPOSCB-1 .GE. IAFATH + NFRONT *NFRONT) THEN

3697

IPOSCB = 1_8 + int(I - 1,8) * int(NCOLS,8)

3698

IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN

3657

3699

RESET_TO_ZERO = .FALSE.

3658

3700

ENDIF

3659

3701

ENDIF

3660

3702

IF ( RISK_OF_SAME_POS ) THEN

3661

3703

IF (I.EQ.NROWS .OR. .NOT. CB_IS_COMPRESSED) THEN

3662

IF ( IAFATH + POSELT + IW(I)-1 .EQ.

3663

* IACB+IPOSCB+I-1-1) THEN

3704

IF ( IAFATH + POSELT + int(IW(I)-1,8) .EQ.

3705

& IACB+IPOSCB+int(I-1-1,8)) THEN

3664

3706

RISK_OF_SAME_POS_THIS_LINE = .TRUE.

3665

3707

ENDIF

3666

3708

ENDIF

3668

3710

IF (RESET_TO_ZERO) THEN

3669

3711

IF ( RISK_OF_SAME_POS_THIS_LINE ) THEN

3670

3712

DO J=1, I

3671

APOS = POSELT + IW( J )

3672

IF (IAFATH + APOS - 1.NE. IACB+IPOSCB-1) THEN

3673

A(IAFATH+ APOS -1) = A(IACB+IPOSCB-1)

3674

A(IACB+IPOSCB-1) = dble(ZERO)

3713

APOS = POSELT + int(IW( J ),8)

3714

IF (IAFATH + APOS - 1_8.NE. IACB+IPOSCB-1_8) THEN

3715

A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)

3716

A(IACB+IPOSCB-1_8) = dble(ZERO)

3675

3717

ENDIF

3676

IPOSCB = IPOSCB + 1

3718

IPOSCB = IPOSCB + 1_8

3677

3719

ENDDO

3678

3720

ELSE

3679

3721

DO J=1, I

3680

APOS = POSELT + IW( J )

3681

A(IAFATH+ APOS -1) = A(IACB+IPOSCB-1)

3682

A(IACB+IPOSCB-1)=dble(ZERO)

3683

IPOSCB = IPOSCB + 1

3722

APOS = POSELT + int(IW( J ),8)

3723

A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)

3724

A(IACB+IPOSCB-1_8)=dble(ZERO)

3725

IPOSCB = IPOSCB + 1_8

3684

3726

ENDDO

3685

3727

ENDIF

3686

3728

ELSE

3687

3729

DO J=1, I

3688

APOS = POSELT + IW( J )

3689

A(IAFATH+ APOS -1) = A(IACB+IPOSCB-1)

3690

IPOSCB = IPOSCB + 1

3730

APOS = POSELT + int(IW( J ),8)

3731

A(IAFATH+ APOS -1_8) = A(IACB+IPOSCB-1_8)

3732

IPOSCB = IPOSCB + 1_8

3691

3733

ENDDO

3692

3734

ENDIF

3693

3735

IF (.NOT. CB_IS_COMPRESSED ) THEN

3694

IBEGCBROW = IACB+IPOSCB-1

3695

IENDFRONT = IAFATH+NFRONT*NFRONT-1

3736

IBEGCBROW = IACB+IPOSCB-1_8

3696

3737

IF ( IBEGCBROW .LE. IENDFRONT ) THEN

3697

A(IBEGCBROW:IBEGCBROW+NCOLS-I-1)=dble(ZERO)

3738

A(IBEGCBROW:IBEGCBROW+int(NCOLS-I,8)-1_8)=dble(ZERO)

3698

3739

ENDIF

3699

3740

ENDIF

3700

IF (IACB+IPOSCB-1 .GE. IAFATH + NFRONT *NFRONT) THEN

3741

IF (IACB+IPOSCB-1_8 .GE. IENDFRONT + 1_8) THEN

3701

3742

RESET_TO_ZERO = .FALSE.

3702

3743

ENDIF

3703

3744

ENDDO

3704

3745

RETURN

3705

3746

ENDIF

3706

3747

IF ((ETATASS.EQ.0) .OR. (ETATASS.EQ.1)) THEN

3707

IPOSCB = 1

3748

IPOSCB = 1_8

3708

3749

DO I = 1, NELIM

3709

POSELT = ( IW( I ) - 1 ) * NFRONT

3750

POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)

3710

3751

IF (.NOT. CB_IS_COMPRESSED) THEN

3711

IPOSCB = 1 + ( I - 1 ) * NCOLS

3752

IPOSCB = 1_8 + int( I - 1, 8 ) * int(NCOLS,8)

3712

3753

ENDIF

3713

3754

DO J = 1, I

3714

APOS = POSELT + IW( J )

3715

A(IAFATH+ APOS -1) = A(IAFATH+ APOS -1) + A(IACB+IPOSCB-1)

3716

IPOSCB = IPOSCB + 1

3755

APOS = POSELT + int(IW( J ),8)

3756

A(IAFATH+ APOS -1_8) = A(IAFATH+ APOS -1_8)

3757

& + A(IACB+IPOSCB-1_8)

3758

IPOSCB = IPOSCB + 1_8

3717

3759

END DO

3718

3760

END DO

3719

3761

ENDIF

3720

3762

IF ((ETATASS.EQ.0).OR.(ETATASS.EQ.1)) THEN

3721

3763

DO I = NELIM + 1, NROWS

3722

3764

IF (CB_IS_COMPRESSED) THEN

3723

IPOSCB = (I*(I-1))/2 + 1

3765

IPOSCB = (int(I,8) * int(I-1,8)) / 2_8 + 1_8

3724

3766

ELSE

3725

IPOSCB = (I-1) * NCOLS + 1

3767

IPOSCB = int(I-1,8) * int(NCOLS,8) + 1_8

3726

3768

ENDIF

3727

POSELT = IW( I )

3728

IF (POSELT.LE.NASS1 .AND. .NOT. IS_INPLACE) THEN

3769

POSELT = int(IW( I ),8)

3770

IF (POSELT.LE. int(NASS1,8) .AND. .NOT. IS_INPLACE) THEN

3729

3771

DO J = 1, NELIM

3730

APOS = POSELT + ( IW( J ) - 1 ) * NFRONT

3731

A(IAFATH+APOS-1) = A(IAFATH+APOS-1) +

3732

* A(IACB+IPOSCB-1)

3733

IPOSCB = IPOSCB + 1

3772

APOS = POSELT + int( IW( J ) - 1, 8 ) * int(NFRONT,8)

3773

A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8) +

3774

& A(IACB+IPOSCB-1_8)

3775

IPOSCB = IPOSCB + 1_8

3734

3776

END DO

3735

3777

ELSE

3736

POSELT = ( IW( I ) - 1 ) * NFRONT

3778

POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)

3737

3779

DO J = 1, NELIM

3738

APOS = POSELT + IW( J )

3739

A(IAFATH+APOS-1) = A(IAFATH+APOS-1) + A(IACB+IPOSCB-1)

3740

IPOSCB = IPOSCB + 1

3780

APOS = POSELT + int(IW( J ), 8)

3781

A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)

3782

& + A(IACB+IPOSCB-1_8)

3783

IPOSCB = IPOSCB + 1_8

3741

3784

END DO

3742

3785

ENDIF

3743

3786

IF (ETATASS.EQ.1) THEN

3744

POSELT = ( IW( I ) - 1 ) * NFRONT

3787

POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)

3745

3788

DO J = NELIM + 1, I

3746

3789

IF (IW(J).GT.NASS1) EXIT

3747

APOS = POSELT + IW( J )

3748

A(IAFATH+APOS-1) = A(IAFATH+APOS-1) + A(IACB+IPOSCB-1)

3749

IPOSCB = IPOSCB +1

3790

APOS = POSELT + int(IW( J ), 8)

3791

A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)

3792

& + A(IACB+IPOSCB-1_8)

3793

IPOSCB = IPOSCB +1_8

3750

3794

END DO

3751

3795

ELSE

3752

POSELT = ( IW( I ) - 1 ) * NFRONT

3796

POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)

3753

3797

DO J = NELIM + 1, I

3754

APOS = POSELT + IW( J )

3755

A(IAFATH+APOS-1) = A(IAFATH+APOS-1) + A(IACB+IPOSCB-1)

3756

IPOSCB = IPOSCB +1

3798

APOS = POSELT + int(IW( J ), 8)

3799

A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)

3800

& + A(IACB+IPOSCB-1_8)

3801

IPOSCB = IPOSCB + 1_8

3757

3802

END DO

3758

3803

ENDIF

3759

3804

END DO

3760

3805

ELSE

3761

3806

DO I= NROWS, NELIM+1, -1

3762

3807

IF (CB_IS_COMPRESSED) THEN

3763

IPOSCB = (I*(I+1))/2

3808

IPOSCB = (int(I,8)*int(I+1,8))/2_8

3764

3809

ELSE

3765

IPOSCB = (I-1) *NCOLS + I

3810

IPOSCB = int(I-1,8) * int(NCOLS,8) + int(I,8)

3766

3811

ENDIF

3767

POSELT = IW( I )

3768

IF (POSELT.LE.NASS1) EXIT

3769

POSELT = ( IW( I ) - 1 ) * NFRONT

3812

POSELT = int(IW( I ),8)

3813

IF (POSELT.LE.int(NASS1,8)) EXIT

3814

POSELT = int( IW( I ) - 1, 8 ) * int(NFRONT, 8)

3770

3815

DO J=I,NELIM+1, -1

3771

3816

IF (IW(J).LE.NASS1) EXIT

3772

APOS = POSELT + IW( J )

3773

A(IAFATH+APOS-1)=A(IAFATH+APOS-1)+A(IACB+IPOSCB-1)

3774

IPOSCB = IPOSCB -1

3817

APOS = POSELT + int(IW( J ), 8)

3818

A(IAFATH+APOS-1_8) = A(IAFATH+APOS-1_8)

3819

& + A(IACB+IPOSCB-1_8)

3820

IPOSCB = IPOSCB - 1_8

3775

3821

ENDDO

3776

3822

ENDDO

3777

3823

ENDIF

3778

3824

RETURN

3779

3825

END SUBROUTINE DMUMPS_178

3780

3826

SUBROUTINE DMUMPS_530(N, ISON, INODE, IWPOSCB,

3781

* PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8)

3827

& PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8)

3782

3828

IMPLICIT NONE

3783

3829

INTEGER N, ISON, INODE, IWPOSCB

3784

3830

INTEGER KEEP(500), STEP(N)

3833

3879

RETURN

3834

3880

END SUBROUTINE DMUMPS_530

3835

3881

SUBROUTINE DMUMPS_619(

3836

* N, INODE, IW, LIW, A, LA,

3837

* ISON, NBCOLS,

3838

* VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,

3839

* OPASSW, IWPOSCB,MYID, KEEP,KEEP8 )

3882

& N, INODE, IW, LIW, A, LA,

3883

& ISON, NBCOLS,

3884

& VALSON, PTLUST_S, PTRAST, STEP, PIMASTER,

3885

& OPASSW, IWPOSCB,MYID, KEEP,KEEP8 )

3840

3886

USE DMUMPS_LOAD

3841

3887

IMPLICIT NONE

3842

3888

INTEGER KEEP(500)

3843

3889

INTEGER*8 KEEP8(150)

3844

INTEGER N,LIW,LA,MYID

3890

INTEGER(8) :: LA

3891

INTEGER N,LIW,MYID

3845

3892

INTEGER INODE,ISON,IWPOSCB

3846

3893

INTEGER NBCOLS

3847

3894

INTEGER IW(LIW), STEP(N),

3848

* PIMASTER(KEEP(28)),

3849

* PTLUST_S(KEEP(28)), PTRAST(KEEP(28))

3895

& PIMASTER(KEEP(28)),

3896

& PTLUST_S(KEEP(28))

3897

INTEGER(8) PTRAST(KEEP(28))

3850

3898

DOUBLE PRECISION A(LA)

3851

3899

DOUBLE PRECISION VALSON(NBCOLS)

3852

3900

DOUBLE PRECISION OPASSW

3853

3901

INTEGER HF,HS, NSLAVES, NASS1,

3854

* IOLDPS, POSELT, ISTCHK,

3855

* LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1,APOS,

3856

* JJ1,JJ2, JPOS, NROWS

3902

& IOLDPS, ISTCHK,

3903

& LSTK, NSLSON,NELIM,NPIVS,NCOLS, J1,

3904

& JJ1,JPOS, NROWS

3905

INTEGER(8) POSELT, APOS, JJ2

3857

3906

INCLUDE 'mumps_headers.h'

3858

3907

LOGICAL SAME_PROC, FREE

3859

3908

INTRINSIC real

3877

3926

NROWS = IW(ISTCHK+2 + KEEP(IXSZ))

3878

3927

ENDIF

3879

3928

J1 = ISTCHK + NROWS + HS + NPIVS

3880

APOS = POSELT + NASS1**2 -1

3929

APOS = POSELT + int(NASS1,8)*int(NASS1,8) - 1_8

3881

3930

DO JJ1 = 1, NBCOLS

3882

JJ2 = APOS+IW(J1 + JJ1 - 1)

3883

IF(abs(A(JJ2)) .LT. VALSON(JJ1)) A(JJ2) = VALSON(JJ1)

3931

JJ2 = APOS+int(IW(J1 + JJ1 - 1),8)

3932

IF(abs(A(JJ2)) .LT. VALSON(JJ1))

3933

& A(JJ2) = dble(VALSON(JJ1))

3884

3934

ENDDO

3885

3935

RETURN

3886

3936

END SUBROUTINE DMUMPS_619

3887

3937

RECURSIVE SUBROUTINE DMUMPS_264(

3888

* COMM_LOAD, ASS_IRECV,

3889

* BUFR, LBUFR,

3890

* LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,

3891

* SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

3892

* A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

3893

* COMP, STEP, PIMASTER, PAMASTER, POSFAC,

3894

* MYID, COMM, IFLAG, IERROR, NBFIN,

3895

*

3896

* PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

3897

* PTRARW, PTRAIW, INTARR, DBLARR,

3898

* ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS,

3899

* LPTRAR, NELT, FRTPTR, FRTELT,

3900

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

3901

* )

3938

& COMM_LOAD, ASS_IRECV,

3939

& BUFR, LBUFR,

3940

& LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,

3941

& SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

3942

& A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

3943

& COMP, STEP, PIMASTER, PAMASTER, POSFAC,

3944

& MYID, COMM, IFLAG, IERROR, NBFIN,

3945

&

3946

& PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

3947

& PTRARW, PTRAIW, INTARR, DBLARR,

3948

& ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE_STEPS,

3949

& LPTRAR, NELT, FRTPTR, FRTELT,

3950

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

3951

& )

3902

3952

USE DMUMPS_OOC

3903

3953

USE DMUMPS_LOAD

3904

3954

IMPLICIT NONE

3910

3960

INTEGER LBUFR, LBUFR_BYTES

3911

3961

INTEGER COMM_LOAD, ASS_IRECV

3912

3962

INTEGER BUFR( LBUFR )

3913

INTEGER N, SLAVEF, IWPOS, IWPOSCB, IPTRLU,

3914

& LRLU, LRLUS, LIW, LA

3963

INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW

3964

INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA

3965

INTEGER(8) :: POSFAC

3915

3966

INTEGER COMP

3916

INTEGER IFLAG, IERROR, POSFAC, NBFIN, MSGSOU

3967

INTEGER IFLAG, IERROR, NBFIN, MSGSOU

3917

3968

INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)),

3918

* PTRAST(KEEP(28)),

3919

* NSTK_S(KEEP(28))

3969

& NSTK_S(KEEP(28))

3970

INTEGER(8) :: PAMASTER(KEEP(28))

3971

INTEGER(8) :: PTRAST(KEEP(28))

3972

INTEGER(8) :: PTRFAC(KEEP(28))

3920

3973

INTEGER NBPROCFILS( KEEP(28) ), STEP(N),

3921

* PIMASTER(KEEP(28)),

3922

* PAMASTER(KEEP(28))

3974

& PIMASTER(KEEP(28))

3923

3975

INTEGER IW( LIW )

3924

3976

DOUBLE PRECISION A( LA )

3925

3977

INTEGER COMM, MYID

3926

3978

INTEGER NELT, LPTRAR

3927

3979

INTEGER FRTPTR( N+1 ), FRTELT( NELT )

3928

INTEGER PTLUST_S(KEEP(28)), PTRFAC(KEEP(28)),

3929

* ITLOC(N), FILS(N), ND(KEEP(28))

3980

INTEGER PTLUST_S(KEEP(28)),

3981

& ITLOC(N), FILS(N), ND(KEEP(28))

3930

3982

INTEGER PTRAIW( LPTRAR ), PTRARW( LPTRAR )

3931

3983

INTEGER FRERE_STEPS(KEEP(28))

3932

3984

INTEGER INTARR( max(1,KEEP(14)) )

3936

3988

INTEGER LEAF, LPOOL

3937

3989

INTEGER IPOOL( LPOOL )

3938

3990

INTEGER ISTEP_TO_INIV2(KEEP(71)),

3939

* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

3991

& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

3940

3992

INCLUDE 'mpif.h'

3941

3993

INCLUDE 'mumps_tags.h'

3942

3994

INTEGER STATUS( MPI_STATUS_SIZE )

3943

3995

INTEGER INODE, POSITION, NPIV, IERR, LP

3944

INTEGER LAELL, NCOL, POSBLOCFACTO, NROW

3945

INTEGER MEM_GAIN

3946

INTEGER IOLDPS, POSELT, LCONT1, NASS1, NROW1, NCOL1, NPIV1

3996

INTEGER NCOL, NROW

3997

INTEGER(8) :: POSBLOCFACTO

3998

INTEGER(8) :: LAELL

3999

INTEGER(8) :: MEM_GAIN

4000

INTEGER(8) :: POSELT

4001

INTEGER IOLDPS, LCONT1, NASS1, NROW1, NCOL1, NPIV1

3947

4002

INTEGER NSLAV1, HS, ISW

3948

INTEGER ICT11, LPOS, LPOS1, LPOS2

3949

INTEGER I, IPOS, KPOS, IPIV, FPERE

4003

INTEGER (8) :: LPOS, LPOS1, LPOS2, IPOS, KPOS

4004

INTEGER ICT11

4005

INTEGER I, IPIV, FPERE

3950

4006

INTEGER LCONT,NELIM,NASS, LDA, NCOL_TO_SEND,

3951

* SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON, SHIFT_VAL_SON

4007

& SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON

4008

INTEGER(8) :: SHIFT_VAL_SON

3952

4009

INTEGER ITYPE2

3953

4010

PARAMETER(ITYPE2=2)

3954

4011

LOGICAL LASTBL

3955

4012

LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED

3956

4013

DOUBLE PRECISION ONE,ALPHA

3957

PARAMETER (ONE=1.0D0, ALPHA=-1.0D0)

3958

INTEGER LIWFAC, LAFAC, STRAT, NextPivDummy

4014

PARAMETER (ONE = 1.0D0, ALPHA=-1.0D0)

4015

INTEGER(8) :: LAFAC

4016

INTEGER LIWFAC, STRAT, NextPivDummy

3959

4017

TYPE(IO_BLOCK) :: MonBloc

4018

LOGICAL LAST_CALL

3960

4019

INTEGER MUMPS_275

3961

4020

EXTERNAL MUMPS_275

3962

4021

FPERE = -1

3963

4022

POSITION = 0

3964

4023

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1,

3965

* MPI_INTEGER, COMM, IERR )

4024

& MPI_INTEGER, COMM, IERR )

3966

4025

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NPIV, 1,

3967

* MPI_INTEGER, COMM, IERR )

4026

& MPI_INTEGER, COMM, IERR )

3968

4027

LASTBL = (NPIV.LE.0)

3969

4028

IF (LASTBL) THEN

3970

4029

NPIV = -NPIV

3971

4030

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, FPERE, 1,

3972

* MPI_INTEGER, COMM, IERR )

4031

& MPI_INTEGER, COMM, IERR )

3973

4032

ENDIF

3974

4033

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NCOL, 1,

3975

* MPI_INTEGER, COMM, IERR )

3976

LAELL = NPIV * NCOL

4034

& MPI_INTEGER, COMM, IERR )

4035

LAELL = int(NPIV,8) * int(NCOL,8)

3977

4036

IF ( LRLU .LT. LAELL .OR. IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN

3978

4037

IF ( LRLUS .LT. LAELL ) THEN

4038

IF (LAELL - LRLUS .GT. int(huge(IERROR),8)) THEN

4039

write(*,*) "I8 OVERFLOW, LAELL-LRLUS=",LAELL-LRLUS

4040

CALL MUMPS_ABORT()

4041

ENDIF

3979

4042

IFLAG = -9

3980

IERROR = LAELL - LRLU

4043

IERROR = int(LAELL - LRLUS,kind(IERROR))

3981

4044

IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN

3982

4045

LP=ICNTL(1)

3983

4046

WRITE(LP,*)

3984

*" FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_264"

4047

&" FAILURE, WORKSPACE TOO SMALL DURING DMUMPS_264"

3985

4048

ENDIF

3986

4049

GOTO 700

3987

4050

END IF

3988

4051

CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA,

3989

* LRLU, IPTRLU,

3990

* IWPOS, IWPOSCB, PTRIST, PTRAST,

3991

* STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

3992

* KEEP(IXSZ))

4052

& LRLU, IPTRLU,

4053

& IWPOS, IWPOSCB, PTRIST, PTRAST,

4054

& STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

4055

& KEEP(IXSZ))

3993

4056

COMP = COMP+1

3994

4057

IF ( LRLU .NE. LRLUS ) THEN

3995

4058

WRITE(*,*) 'PB compress ass..blocfacto: LRLU,LRLUS='

3996

* ,LRLU,LRLUS

4059

& ,LRLU,LRLUS

3997

4060

IFLAG = -9

3998

IERROR = LAELL -LRLU

4061

CALL MUMPS_731( LAELL-LRLUS, IERROR )

4062

IF (LAELL - LRLUS .GT. int(huge(IERROR),8)) THEN

4063

write(*,*) "I8 OVERFLOW, LAELL-LRLUS=",LAELL-LRLUS

4064

CALL MUMPS_ABORT()

4065

ENDIF

4066

IERROR = int(LAELL - LRLUS,kind(IERROR))

3999

4067

GOTO 700

4000

4068

END IF

4001

4069

IF ( IWPOS + NPIV - 1 .GT. IWPOSCB ) THEN

4002

4070

IF (ICNTL(1).GT.0 .AND. ICNTL(4).GE.1) THEN

4003

4071

LP=ICNTL(1)

4004

4072

WRITE(LP,*)

4005

*" FAILURE IN INTEGER ALLOCATION DURING DMUMPS_264"

4073

&" FAILURE IN INTEGER ALLOCATION DURING DMUMPS_264"

4006

4074

ENDIF

4007

4075

IFLAG = -8

4008

4076

IERROR = IWPOS + NPIV - 1 - IWPOSCB

4011

4079

END IF

4012

4080

LRLU = LRLU - LAELL

4013

4081

LRLUS = LRLUS - LAELL

4014

KEEP(67) = min(LRLUS, KEEP(67))

4082

KEEP8(67) = min(LRLUS, KEEP8(67))

4015

4083

POSBLOCFACTO = POSFAC

4016

4084

POSFAC = POSFAC + LAELL

4017

4085

CALL DMUMPS_471(.FALSE., .FALSE.,

4018

* LA-LRLUS,0,LAELL,KEEP,KEEP8,LRLU)

4086

& LA-LRLUS,0_8,LAELL,KEEP,KEEP8,LRLU)

4019

4087

IPIV = IWPOS

4020

4088

IWPOS = IWPOS + NPIV

4021

4089

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4022

* IW( IPIV ), NPIV,

4023

* MPI_INTEGER, COMM, IERR )

4090

& IW( IPIV ), NPIV,

4091

& MPI_INTEGER, COMM, IERR )

4024

4092

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4025

* A(POSBLOCFACTO), NPIV*NCOL,

4026

* MPI_DOUBLE_PRECISION,

4027

* COMM, IERR )

4093

& A(POSBLOCFACTO), NPIV*NCOL,

4094

& MPI_DOUBLE_PRECISION,

4095

& COMM, IERR )

4028

4096

IF (PTRIST(STEP( INODE )) .EQ. 0) THEN

4029

MSGSOU = MUMPS_275( STEP(INODE), PROCNODE_STEPS,

4030

* SLAVEF )

4031

WRITE(*,*) MYID,

4032

* ': Internal ERROR 1 in DMUMPS_264',

4033

* ' INODE =', INODE,

4034

* ' MAITRE_DESC_BANDE not yet received from ', MSGSOU

4035

CALL MUMPS_ABORT()

4097

DO WHILE ( PTRIST(STEP(INODE)) .EQ. 0 )

4098

BLOCKING = .TRUE.

4099

SET_IRECV= .FALSE.

4100

MESSAGE_RECEIVED = .FALSE.

4101

CALL DMUMPS_329( COMM_LOAD,

4102

& ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

4103

& MSGSOU, MAITRE_DESC_BANDE,

4104

& STATUS,

4105

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4106

& IWPOS, IWPOSCB, IPTRLU,

4107

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

4108

& PTLUST_S, PTRFAC,

4109

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4110

& IFLAG, IERROR, COMM,

4111

& NBPROCFILS,

4112

& IPOOL, LPOOL, LEAF,

4113

& NBFIN, MYID, SLAVEF,

4114

&

4115

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4116

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS,

4117

& LPTRAR, NELT, FRTPTR, FRTELT,

4118

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.

4119

& )

4120

IF ( IFLAG .LT. 0 ) GOTO 600

4121

END DO

4036

4122

ENDIF

4037

4123

DO WHILE ( NBPROCFILS( STEP(INODE)) .NE. 0 )

4038

4124

BLOCKING = .TRUE.

4039

4125

SET_IRECV = .FALSE.

4040

4126

MESSAGE_RECEIVED = .FALSE.

4041

4127

CALL DMUMPS_329( COMM_LOAD,

4042

* ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

4043

* MPI_ANY_SOURCE, CONTRIB_TYPE2,

4044

* STATUS,

4045

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4046

* IWPOS, IWPOSCB, IPTRLU,

4047

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

4048

* PTLUST_S, PTRFAC,

4049

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4050

* IFLAG, IERROR, COMM,

4051

* NBPROCFILS,

4052

* IPOOL, LPOOL, LEAF,

4053

* NBFIN, MYID, SLAVEF,

4054

*

4055

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4056

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS,

4057

* LPTRAR, NELT, FRTPTR, FRTELT,

4058

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

4128

& ASS_IRECV, BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

4129

& MPI_ANY_SOURCE, CONTRIB_TYPE2,

4130

& STATUS,

4131

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4132

& IWPOS, IWPOSCB, IPTRLU,

4133

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

4134

& PTLUST_S, PTRFAC,

4135

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4136

& IFLAG, IERROR, COMM,

4137

& NBPROCFILS,

4138

& IPOOL, LPOOL, LEAF,

4139

& NBFIN, MYID, SLAVEF,

4140

&

4141

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4142

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS,

4143

& LPTRAR, NELT, FRTPTR, FRTELT,

4144

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

4059

4145

IF ( IFLAG .LT. 0 ) GOTO 600

4060

4146

END DO

4061

4147

SET_IRECV = .TRUE.

4062

4148

BLOCKING = .FALSE.

4063

4149

MESSAGE_RECEIVED = .TRUE.

4064

4150

CALL DMUMPS_329( COMM_LOAD, ASS_IRECV,

4065

* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

4066

* MPI_ANY_SOURCE, MPI_ANY_TAG,

4067

* STATUS,

4068

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4069

* IWPOS, IWPOSCB, IPTRLU,

4070

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

4071

* PTLUST_S, PTRFAC,

4072

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4073

* IFLAG, IERROR, COMM,

4074

* NBPROCFILS,

4075

* IPOOL, LPOOL, LEAF,

4076

* NBFIN, MYID, SLAVEF,

4077

*

4078

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4079

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS,

4080

* LPTRAR, NELT, FRTPTR, FRTELT,

4081

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

4151

& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

4152

& MPI_ANY_SOURCE, MPI_ANY_TAG,

4153

& STATUS,

4154

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4155

& IWPOS, IWPOSCB, IPTRLU,

4156

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

4157

& PTLUST_S, PTRFAC,

4158

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4159

& IFLAG, IERROR, COMM,

4160

& NBPROCFILS,

4161

& IPOOL, LPOOL, LEAF,

4162

& NBFIN, MYID, SLAVEF,

4163

&

4164

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4165

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS,

4166

& LPTRAR, NELT, FRTPTR, FRTELT,

4167

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

4082

4168

IOLDPS = PTRIST(STEP(INODE))

4083

4169

POSELT = PTRAST(STEP(INODE))

4084

4170

LCONT1 = IW( IOLDPS +KEEP(IXSZ))

4088

4174

NSLAV1 = IW( IOLDPS + 5 +KEEP(IXSZ))

4089

4175

HS = 6 + NSLAV1 + KEEP(IXSZ)

4090

4176

NCOL1 = LCONT1 + NPIV1

4091

IF (NPIV.EQ.0) GOTO 200

4092

ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1

4093

DO 100 I = 1, NPIV

4094

IF (IW(IPIV+I-1).EQ.I) GOTO 100

4095

ISW = IW(ICT11+I)

4096

IW(ICT11+I) = IW(ICT11+IW(IPIV+I-1))

4097

IW(ICT11+IW(IPIV+I-1)) = ISW

4098

IPOS = POSELT + NPIV1 + I - 1

4099

KPOS = POSELT + NPIV1 + IW(IPIV+I-1) - 1

4100

CALL DSWAP(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1)

4101

100 CONTINUE

4102

LPOS2 = POSELT + NPIV1

4103

CALL DTRSM('L','L','N','N',NPIV, NROW1, ONE,

4104

* A(POSBLOCFACTO), NCOL, A(LPOS2), NCOL1)

4105

LPOS1 = POSBLOCFACTO+NPIV

4106

LPOS = LPOS2 + NPIV

4177

IF (NPIV.GT.0) THEN

4178

ICT11 = IOLDPS+HS+NROW1+NPIV1 - 1

4179

DO I = 1, NPIV

4180

IF (IW(IPIV+I-1).EQ.I) CYCLE

4181

ISW = IW(ICT11+I)

4182

IW(ICT11+I) = IW(ICT11+IW(IPIV+I-1))

4183

IW(ICT11+IW(IPIV+I-1)) = ISW

4184

IPOS = POSELT + int(NPIV1 + I - 1,8)

4185

KPOS = POSELT + int(NPIV1 + IW(IPIV+I-1) - 1,8)

4186

CALL DSWAP(NROW1, A(IPOS), NCOL1, A(KPOS), NCOL1)

4187

ENDDO

4188

LPOS2 = POSELT + int(NPIV1,8)

4189

CALL DTRSM('L','L','N','N',NPIV, NROW1, ONE,

4190

& A(POSBLOCFACTO), NCOL, A(LPOS2), NCOL1)

4191

LPOS1 = POSBLOCFACTO+int(NPIV,8)

4192

LPOS = LPOS2 + int(NPIV,8)

4193

ENDIF

4107

4194

IF (KEEP(201).eq.1) THEN

4108

4195

MonBloc%INODE = INODE

4109

4196

MonBloc%MASTER = .FALSE.

4117

4204

STRAT = STRAT_TRY_WRITE

4118

4205

NextPivDummy = -8888

4119

4206

LIWFAC = IW(IOLDPS+XXI)

4120

LAFAC = IW(IOLDPS+XXR)

4207

CALL MUMPS_729(LAFAC, IW(IOLDPS+XXR))

4208

LAST_CALL = .FALSE.

4121

4209

CALL DMUMPS_688( STRAT, TYPEF_L, A(POSELT),

4122

4210

& LAFAC, MonBloc, NextPivDummy, NextPivDummy,

4123

& IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG)

4124

ENDIF

4125

CALL DGEMM('N','N', NCOL-NPIV,NROW1,NPIV,

4126

* ALPHA,A(LPOS1),NCOL,

4127

* A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1)

4211

& IW(IOLDPS), LIWFAC, MYID, KEEP8(31), IFLAG,LAST_CALL)

4212

ENDIF

4213

IF ( NPIV .GT. 0 ) THEN

4214

CALL DGEMM('N','N', NCOL-NPIV,NROW1,NPIV,

4215

& ALPHA,A(LPOS1),NCOL,

4216

& A(LPOS2),NCOL1,ONE, A(LPOS),NCOL1)

4217

ENDIF

4128

4218

200 CONTINUE

4129

4219

IW(IOLDPS+KEEP(IXSZ) ) = IW(IOLDPS+KEEP(IXSZ) ) - NPIV

4130

4220

IW(IOLDPS + 3+KEEP(IXSZ) ) = IW(IOLDPS+3+KEEP(IXSZ) ) + NPIV

4138

4228

LRLUS = LRLUS + LAELL

4139

4229

POSFAC = POSFAC - LAELL

4140

4230

CALL DMUMPS_471(.FALSE.,.FALSE.,

4141

* LA-LRLUS,0,-LAELL,KEEP,KEEP8,LRLU)

4231

& LA-LRLUS,0_8,-LAELL,KEEP,KEEP8,LRLU)

4142

4232

IWPOS = IWPOS - NPIV

4143

4233

FLOP1 = dble( NPIV1*NROW1 ) +

4144

* dble(NROW1*NPIV1)*dble(2*NCOL1-NPIV1-1)

4145

* -

4146

* dble((NPIV1+NPIV)*NROW1 ) -

4147

* dble(NROW1*(NPIV1+NPIV))*dble(2*NCOL1-NPIV1-NPIV-1)

4234

& dble(NROW1*NPIV1)*dble(2*NCOL1-NPIV1-1)

4235

& -

4236

& dble((NPIV1+NPIV)*NROW1 ) -

4237

& dble(NROW1*(NPIV1+NPIV))*dble(2*NCOL1-NPIV1-NPIV-1)

4148

4238

CALL DMUMPS_190( 1, .FALSE., FLOP1, KEEP,KEEP8 )

4149

4239

IF (LASTBL) THEN

4150

4240

IW(IOLDPS+XXS)=S_ALL

4151

4241

IF (KEEP(214).EQ.1) THEN

4152

4242

CALL DMUMPS_314( N, INODE,

4153

* PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,

4154

* LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,

4155

* IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, ITLOC,

4156

* IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2

4157

$ )

4243

& PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,

4244

& LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,

4245

& IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, ITLOC,

4246

& IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2

4247

& )

4158

4248

IF (KEEP(38).NE.FPERE) THEN

4159

4249

IW(PTRIST(STEP(INODE))+XXS)=S_NOLCBNOCONTIG

4160

4250

IF (KEEP(216).NE.3) THEN

4161

MEM_GAIN=IW( PTRIST(STEP( INODE )) + 2 + KEEP(IXSZ) )*

4162

* IW( PTRIST(STEP( INODE )) + 3 + KEEP(IXSZ) )

4251

MEM_GAIN=int(IW(PTRIST(STEP(INODE))+2+KEEP(IXSZ)),8)*

4252

& int(IW(PTRIST(STEP(INODE))+3+KEEP(IXSZ)),8)

4163

4253

LRLUS = LRLUS+MEM_GAIN

4164

4254

CALL DMUMPS_471(.FALSE.,.FALSE.,

4165

* LA-LRLUS,0,-MEM_GAIN,KEEP,KEEP8,LRLU)

4255

& LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU)

4166

4256

ENDIF

4167

4257

ENDIF

4168

4258

IF (KEEP(216).EQ.2) THEN

4169

4259

IF (KEEP(38).NE.FPERE) THEN

4170

4260

CALL DMUMPS_627(A,LA,PTRAST(STEP(INODE)),

4171

* IW( PTRIST(STEP( INODE )) + 2 + KEEP(IXSZ) ),

4172

* IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),

4173

* IW( PTRIST(STEP( INODE )) + 3 + KEEP(IXSZ) )+

4174

* IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),0,

4175

* IW( PTRIST(STEP( INODE )) + XXS ),0)

4261

& IW( PTRIST(STEP( INODE )) + 2 + KEEP(IXSZ) ),

4262

& IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),

4263

& IW( PTRIST(STEP( INODE )) + 3 + KEEP(IXSZ) )+

4264

& IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),0,

4265

& IW( PTRIST(STEP( INODE )) + XXS ),0_8)

4176

4266

IW(PTRIST(STEP(INODE))+XXS)=S_NOLCBCONTIG

4177

4267

ENDIF

4178

4268

ENDIF

4188

4278

NCOL_TO_SEND = LCONT-NELIM

4189

4279

SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ)

4190

4280

SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS

4191

SHIFT_VAL_SON = NASS

4281

SHIFT_VAL_SON = int(NASS,8)

4192

4282

LDA = LCONT + NPIV

4193

4283

IF (IW(IOLDPS+6+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN

4194

4284

IW(IOLDPS+6+KEEP(IXSZ)) = S_REC_CONTSTATIC

4195

4285

ELSE

4196

4286

ENDIF

4197

4287

CALL DMUMPS_80(

4198

* COMM_LOAD, ASS_IRECV,

4199

* N, INODE, FPERE,

4200

* PTRIST, PTRAST,

4201

* root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,

4202

* SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA,

4203

* ROOT_CONT_STATIC, MYID, COMM,

4204

*

4205

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4206

* IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,

4207

* PTRIST, PTLUST_S, PTRFAC,

4208

* PTRAST, STEP, PIMASTER, PAMASTER,

4209

* NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,

4210

* IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,

4211

* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4212

* INTARR, DBLARR, ICNTL, KEEP,KEEP8,

4213

* .FALSE., ND, FRERE_STEPS,

4214

* LPTRAR, NELT, FRTPTR, FRTELT,

4215

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4288

& COMM_LOAD, ASS_IRECV,

4289

& N, INODE, FPERE,

4290

& PTRIST, PTRAST,

4291

& root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,

4292

& SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA,

4293

& ROOT_CONT_STATIC, MYID, COMM,

4294

&

4295

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4296

& IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,

4297

& PTRIST, PTLUST_S, PTRFAC,

4298

& PTRAST, STEP, PIMASTER, PAMASTER,

4299

& NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,

4300

& IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,

4301

& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4302

& INTARR, DBLARR, ICNTL, KEEP,KEEP8,

4303

& .FALSE., ND, FRERE_STEPS,

4304

& LPTRAR, NELT, FRTPTR, FRTELT,

4305

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4216

4306

IF ( IFLAG < 0 ) GOTO 600

4217

4307

IF (NELIM.EQ.0) THEN

4218

4308

IF (KEEP(214).EQ.2) THEN

4219

4309

CALL DMUMPS_314( N, INODE,

4220

* PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,

4221

* LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,

4222

* IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, ITLOC,

4223

* IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2

4224

$ )

4310

& PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,

4311

& LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,

4312

& IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER, ITLOC,

4313

& IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8, ITYPE2

4314

& )

4225

4315

ENDIF

4226

4316

CALL DMUMPS_626( N, INODE,

4227

* PTRIST, PTRAST, IW, LIW, A, LA,

4228

* LRLU, LRLUS, IWPOSCB,

4229

* IPTRLU, STEP,

4230

* MYID, KEEP

4231

$ )

4317

& PTRIST, PTRAST, IW, LIW, A, LA,

4318

& LRLU, LRLUS, IWPOSCB,

4319

& IPTRLU, STEP,

4320

& MYID, KEEP

4321

& )

4232

4322

ELSE

4233

4323

IOLDPS = PTRIST(STEP(INODE))

4234

4324

IF (IW(IOLDPS+6+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN

4235

4325

CALL DMUMPS_626( N, INODE, PTRIST, PTRAST, IW, LIW,

4236

* A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,

4237

* MYID, KEEP

4238

$ )

4326

& A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,

4327

& MYID, KEEP

4328

& )

4239

4329

ELSE

4240

4330

IW(IOLDPS+6+KEEP(IXSZ)) = S_ROOTBAND_INIT

4241

4331

IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN

4242

4332

IW(PTRIST(STEP(INODE))+XXS)=S_NOLCBNOCONTIG38

4243

4333

CALL DMUMPS_628( IW(PTRIST(STEP(INODE))),

4244

* LIW-PTRIST(STEP(INODE))+1,

4245

* MEM_GAIN, KEEP(IXSZ) )

4334

& LIW-PTRIST(STEP(INODE))+1,

4335

& MEM_GAIN, KEEP(IXSZ) )

4246

4336

LRLUS = LRLUS + MEM_GAIN

4247

4337

CALL DMUMPS_471(.FALSE.,.FALSE.,

4248

* LA-LRLUS,0,-MEM_GAIN,KEEP,KEEP8,LRLU)

4338

& LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLU)

4249

4339

IF (KEEP(216).EQ.2) THEN

4250

4340

CALL DMUMPS_627(A,LA,PTRAST(STEP(INODE)),

4251

* IW( PTRIST(STEP( INODE )) + 2 + KEEP(IXSZ) ),

4252

* IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),

4253

* IW( PTRIST(STEP( INODE )) + 3 + KEEP(IXSZ) )+

4254

* IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),

4255

* IW( PTRIST(STEP( INODE )) + 4 + KEEP(IXSZ) ) -

4256

* IW( PTRIST(STEP( INODE )) + 3 + KEEP(IXSZ) ),

4257

* IW( PTRIST(STEP( INODE )) + XXS ),0)

4341

& IW( PTRIST(STEP( INODE )) + 2 + KEEP(IXSZ) ),

4342

& IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),

4343

& IW( PTRIST(STEP( INODE )) + 3 + KEEP(IXSZ) )+

4344

& IW( PTRIST(STEP( INODE )) + KEEP(IXSZ) ),

4345

& IW( PTRIST(STEP( INODE )) + 4 + KEEP(IXSZ) ) -

4346

& IW( PTRIST(STEP( INODE )) + 3 + KEEP(IXSZ) ),

4347

& IW( PTRIST(STEP( INODE )) + XXS ),0_8)

4258

4348

IW(PTRIST(STEP(INODE))+XXS)=S_NOLCBCONTIG38

4259

4349

ENDIF

4260

4350

ENDIF

4268

4358

RETURN

4269

4359

END SUBROUTINE DMUMPS_264

4270

4360

SUBROUTINE DMUMPS_699( COMM_LOAD, ASS_IRECV,

4271

* MSGLEN, BUFR, LBUFR,

4272

* LBUFR_BYTES, PROCNODE_STEPS,

4273

* SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC,

4274

* N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC, PTRAST,

4275

* STEP, PIMASTER, PAMASTER, NBPROCFILS,

4276

* COMP, root, OPASSW, OPELIW, ITLOC, NSTK_S,

4277

* FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN,

4278

* MYID, COMM, ICNTL, KEEP,KEEP8, IFLAG, IERROR,

4279

* IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, LPTRAR, NELT,

4280

* FRTPTR, FRTELT,

4281

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4361

& MSGLEN, BUFR, LBUFR,

4362

& LBUFR_BYTES, PROCNODE_STEPS,

4363

& SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC,

4364

& N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC, PTRAST,

4365

& STEP, PIMASTER, PAMASTER, NBPROCFILS,

4366

& COMP, root, OPASSW, OPELIW, ITLOC, NSTK_S,

4367

& FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN,

4368

& MYID, COMM, ICNTL, KEEP,KEEP8, IFLAG, IERROR,

4369

& IPOOL, LPOOL, LEAF, ND, FRERE_STEPS, LPTRAR, NELT,

4370

& FRTPTR, FRTELT,

4371

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4282

4372

USE DMUMPS_LOAD

4283

4373

USE DMUMPS_COMM_BUFFER

4284

4374

IMPLICIT NONE

4289

4379

INTEGER LBUFR, LBUFR_BYTES

4290

4380

INTEGER COMM_LOAD, ASS_IRECV, MSGLEN

4291

4381

INTEGER BUFR( LBUFR )

4292

INTEGER N, SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, LIW, LA

4293

INTEGER POSFAC, NBFIN

4382

INTEGER(8) :: LRLU, IPTRLU, LRLUS, LA, POSFAC

4383

INTEGER N, SLAVEF, IWPOS, IWPOSCB, LIW

4384

INTEGER NBFIN

4294

4385

INTEGER COMP

4295

4386

INTEGER NELT, LPTRAR

4296

INTEGER PROCNODE_STEPS( KEEP(28) ), PTRIST(KEEP(28)),

4297

* PTRAST(KEEP(28))

4298

INTEGER STEP(N),

4299

* PIMASTER(KEEP(28)),

4300

* PAMASTER(KEEP(28))

4301

INTEGER PTLUST_S( KEEP(28) ), PTRFAC(KEEP(28))

4387

INTEGER PROCNODE_STEPS( KEEP(28) ), PTRIST(KEEP(28))

4388

INTEGER(8) :: PTRAST(KEEP(28)), PAMASTER(KEEP(28))

4389

INTEGER(8) :: PTRFAC(KEEP(28))

4390

INTEGER STEP(N), PIMASTER(KEEP(28))

4391

INTEGER PTLUST_S( KEEP(28) )

4302

4392

INTEGER NBPROCFILS( KEEP(28) )

4303

4393

INTEGER IW( LIW )

4304

4394

DOUBLE PRECISION A( LA )

4313

4403

INTEGER IPOOL( LPOOL )

4314

4404

INTEGER FRTPTR(N+1), FRTELT( NELT )

4315

4405

INTEGER ISTEP_TO_INIV2(KEEP(71)),

4316

* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

4406

& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

4317

4407

INTEGER NFS4FATHER

4318

4408

LOGICAL COMPUTE_MAX

4319

4409

INCLUDE 'mumps_headers.h'

4325

4415

INTEGER IERR

4326

4416

INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET

4327

4417

INTEGER I, INODE, ISON, POSITION, NBROW, LROW, IROW, INDCOL

4328

INTEGER LREQI, LREQA

4329

INTEGER POSCONTRIB, ROW_LENGTH

4418

INTEGER LREQI

4419

INTEGER(8) :: LREQA, POSCONTRIB

4420

INTEGER ROW_LENGTH

4330

4421

INTEGER MASTER

4331

4422

INTEGER ISTCHK

4332

4423

LOGICAL SAME_PROC

4335

4426

INTEGER ISHIFT_BUFR, LBUFR_LOC, LBUFR_BYTES_LOC

4336

4427

POSITION = 0

4337

4428

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, INODE, 1,

4338

* MPI_INTEGER, COMM, IERR )

4429

& MPI_INTEGER, COMM, IERR )

4339

4430

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, ISON, 1,

4340

* MPI_INTEGER, COMM, IERR )

4431

& MPI_INTEGER, COMM, IERR )

4341

4432

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBROW, 1,

4342

* MPI_INTEGER, COMM, IERR )

4433

& MPI_INTEGER, COMM, IERR )

4343

4434

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, LROW, 1,

4344

* MPI_INTEGER, COMM, IERR )

4345

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4346

* NBROWS_ALREADY_SENT, 1,

4347

* MPI_INTEGER, COMM, IERR )

4348

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4349

* NBROWS_PACKET, 1,

4350

* MPI_INTEGER, COMM, IERR )

4435

& MPI_INTEGER, COMM, IERR )

4436

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4437

& NBROWS_ALREADY_SENT, 1,

4438

& MPI_INTEGER, COMM, IERR )

4439

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4440

& NBROWS_PACKET, 1,

4441

& MPI_INTEGER, COMM, IERR )

4351

4442

MASTER = MUMPS_275(STEP(INODE),PROCNODE_STEPS,SLAVEF)

4352

4443

SLAVE_NODE = MASTER .NE. MYID

4353

4444

IF (SLAVE_NODE .AND. PTRIST(STEP(INODE)) ==0) THEN

4360

4451

SET_IRECV = .FALSE.

4361

4452

MESSAGE_RECEIVED = .FALSE.

4362

4453

CALL DMUMPS_329( COMM_LOAD, ASS_IRECV,

4363

* BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

4364

* MASTER, MAITRE_DESC_BANDE,

4365

* STATUS,

4366

* BUFR(ISHIFT_BUFR), LBUFR_LOC, LBUFR_BYTES_LOC,

4367

* PROCNODE_STEPS, POSFAC,

4368

* IWPOS, IWPOSCB, IPTRLU,

4369

* LRLU, LRLUS, N, IW, LIW, A, LA,

4370

* PTRIST, PTLUST_S, PTRFAC,

4371

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4372

* IFLAG, IERROR, COMM,

4373

* NBPROCFILS, IPOOL, LPOOL, LEAF,

4374

* NBFIN, MYID, SLAVEF,

4375

*

4376

* root, OPASSW, OPELIW, ITLOC, FILS,

4377

* PTRARW, PTRAIW,

4378

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS,

4379

* LPTRAR, NELT, FRTPTR, FRTELT,

4380

* ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

4454

& BLOCKING, SET_IRECV, MESSAGE_RECEIVED,

4455

& MASTER, MAITRE_DESC_BANDE,

4456

& STATUS,

4457

& BUFR(ISHIFT_BUFR), LBUFR_LOC, LBUFR_BYTES_LOC,

4458

& PROCNODE_STEPS, POSFAC,

4459

& IWPOS, IWPOSCB, IPTRLU,

4460

& LRLU, LRLUS, N, IW, LIW, A, LA,

4461

& PTRIST, PTLUST_S, PTRFAC,

4462

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4463

& IFLAG, IERROR, COMM,

4464

& NBPROCFILS, IPOOL, LPOOL, LEAF,

4465

& NBFIN, MYID, SLAVEF,

4466

&

4467

& root, OPASSW, OPELIW, ITLOC, FILS,

4468

& PTRARW, PTRAIW,

4469

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE_STEPS,

4470

& LPTRAR, NELT, FRTPTR, FRTELT,

4471

& ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE. )

4381

4472

IF (IFLAG.LT.0) RETURN

4382

4473

END DO

4383

4474

ENDIF

4386

4477

ELSE

4387

4478

LREQI = NBROWS_PACKET

4388

4479

END IF

4389

LREQA = LROW

4480

LREQA = int(LROW,8)

4390

4481

IF ( LRLU .LT. LREQA .OR. IWPOS + LREQI

4391

$ - 1 .GT. IWPOSCB ) THEN

4482

& - 1 .GT. IWPOSCB ) THEN

4392

4483

IF ( LRLUS .LT. LREQA ) THEN

4393

4484

IFLAG = -9

4394

IERROR = LREQA - LRLUS

4485

CALL MUMPS_731( LREQA - LRLUS, IERROR )

4395

4486

CALL DMUMPS_44( MYID, SLAVEF, COMM )

4396

4487

RETURN

4397

4488

END IF

4398

4489

CALL DMUMPS_94(N, KEEP(28), IW, LIW, A, LA,

4399

* LRLU, IPTRLU,

4400

* IWPOS, IWPOSCB, PTRIST, PTRAST,

4401

* STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

4402

* KEEP(IXSZ))

4490

& LRLU, IPTRLU,

4491

& IWPOS, IWPOSCB, PTRIST, PTRAST,

4492

& STEP, PIMASTER, PAMASTER, ITLOC,KEEP(216),LRLUS,

4493

& KEEP(IXSZ))

4403

4494

COMP = COMP+1

4404

4495

IF ( LRLU .NE. LRLUS ) THEN

4405

4496

WRITE(*,*) 'PB compress ass..process_contrib'

4406

4497

WRITE(*,*) 'LRLU,LRLUS=',LRLU,LRLUS

4407

4498

IFLAG = -9

4408

IERROR = LREQA - LRLUS

4499

CALL MUMPS_731( LREQA - LRLUS, IERROR )

4409

4500

CALL DMUMPS_44( MYID, SLAVEF, COMM )

4410

4501

RETURN

4411

4502

END IF

4420

4511

LRLUS = LRLUS - LREQA

4421

4512

POSCONTRIB = POSFAC

4422

4513

POSFAC = POSFAC + LREQA

4423

KEEP(67) = min(LRLUS, KEEP(67))

4514

KEEP8(67) = min(LRLUS, KEEP8(67))

4424

4515

CALL DMUMPS_471(.FALSE.,.FALSE.,

4425

* LA-LRLUS,0,LREQA,KEEP,KEEP8,LRLU)

4516

& LA-LRLUS,0_8,LREQA,KEEP,KEEP8,LRLU)

4426

4517

IF ( SLAVE_NODE ) THEN

4427

4518

IROW = IWPOS

4428

4519

INDCOL = IWPOS + NBROWS_PACKET

4433

4524

IWPOS = IWPOS + LREQI

4434

4525

IF ( SLAVE_NODE ) THEN

4435

4526

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4436

* IW( INDCOL ), LROW, MPI_INTEGER,

4437

* COMM, IERR )

4527

& IW( INDCOL ), LROW, MPI_INTEGER,

4528

& COMM, IERR )

4438

4529

END IF

4439

4530

DO I = 1, NBROWS_PACKET

4440

4531

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4441

* IW( IROW + I - 1 ), 1, MPI_INTEGER,

4442

* COMM, IERR )

4532

& IW( IROW + I - 1 ), 1, MPI_INTEGER,

4533

& COMM, IERR )

4443

4534

END DO

4444

4535

IF ( SLAVE_NODE ) THEN

4445

4536

IF ( NBROWS_ALREADY_SENT + NBROWS_PACKET == NBROW ) THEN

4447

4538

ENDIF

4448

4539

IF ( KEEP(55) .eq. 0 ) THEN

4449

4540

CALL DMUMPS_539

4450

* (N, INODE, IW, LIW, A, LA,

4451

* NBROW, LROW,

4452

* OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

4453

* FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,

4454

$ KEEP,KEEP8, MYID )

4541

& (N, INODE, IW, LIW, A, LA,

4542

& NBROW, LROW,

4543

& OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

4544

& FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,

4545

& KEEP,KEEP8, MYID )

4455

4546

ELSE

4456

4547

CALL DMUMPS_123(

4457

* NELT, FRTPTR, FRTELT,

4458

* N, INODE, IW, LIW, A, LA,

4459

* NBROW, LROW,

4460

* OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

4461

* FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,

4462

$ KEEP,KEEP8, MYID )

4548

& NELT, FRTPTR, FRTELT,

4549

& N, INODE, IW, LIW, A, LA,

4550

& NBROW, LROW,

4551

& OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

4552

& FILS, PTRARW, PTRAIW, INTARR, DBLARR, ICNTL,

4553

& KEEP,KEEP8, MYID )

4463

4554

ENDIF

4464

4555

DO I=1,NBROWS_PACKET

4465

4556

IF(KEEP(50).NE.0)THEN

4466

4557

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4467

* ROW_LENGTH,

4468

* 1,

4469

* MPI_INTEGER,

4470

* COMM, IERR )

4558

& ROW_LENGTH,

4559

& 1,

4560

& MPI_INTEGER,

4561

& COMM, IERR )

4471

4562

ELSE

4472

4563

ROW_LENGTH=LROW

4473

4564

ENDIF

4474

4565

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4475

* A(POSCONTRIB),

4476

* ROW_LENGTH,

4477

* MPI_DOUBLE_PRECISION,

4478

* COMM, IERR )

4566

& A(POSCONTRIB),

4567

& ROW_LENGTH,

4568

& MPI_DOUBLE_PRECISION,

4569

& COMM, IERR )

4479

4570

CALL DMUMPS_40(N, INODE, IW, LIW, A, LA,

4480

* 1, ROW_LENGTH, IW( IROW+I-1 ),IW(INDCOL),

4481

* A(POSCONTRIB),

4482

* OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

4483

* FILS, ICNTL, KEEP,KEEP8, MYID )

4571

& 1, ROW_LENGTH, IW( IROW+I-1 ),IW(INDCOL),

4572

& A(POSCONTRIB),

4573

& OPASSW, OPELIW, STEP, PTRIST, PTRAST, ITLOC,

4574

& FILS, ICNTL, KEEP,KEEP8, MYID )

4484

4575

ENDDO

4485

4576

CALL DMUMPS_531

4486

* (N, INODE, IW, LIW,

4487

* NBROWS_PACKET, STEP, PTRIST, ITLOC, KEEP,KEEP8)

4577

& (N, INODE, IW, LIW,

4578

& NBROWS_PACKET, STEP, PTRIST, ITLOC, KEEP,KEEP8)

4488

4579

ELSE

4489

4580

DO I=1,NBROWS_PACKET

4490

4581

IF(KEEP(50).NE.0)THEN

4491

4582

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4492

* ROW_LENGTH,

4493

* 1,

4494

* MPI_INTEGER,

4495

* COMM, IERR )

4583

& ROW_LENGTH,

4584

& 1,

4585

& MPI_INTEGER,

4586

& COMM, IERR )

4496

4587

ELSE

4497

4588

ROW_LENGTH=LROW

4498

4589

ENDIF

4499

4590

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4500

* A(POSCONTRIB),

4501

* ROW_LENGTH,

4502

* MPI_DOUBLE_PRECISION,

4503

* COMM, IERR )

4591

& A(POSCONTRIB),

4592

& ROW_LENGTH,

4593

& MPI_DOUBLE_PRECISION,

4594

& COMM, IERR )

4504

4595

CALL DMUMPS_39(N, INODE, IW, LIW, A, LA,

4505

* ISON, 1, ROW_LENGTH, IW( IROW +I-1 ),

4506

* A(POSCONTRIB), PTLUST_S, PTRAST,

4507

* STEP, PIMASTER, OPASSW,

4508

* IWPOSCB, MYID, KEEP,KEEP8)

4596

& ISON, 1, ROW_LENGTH, IW( IROW +I-1 ),

4597

& A(POSCONTRIB), PTLUST_S, PTRAST,

4598

& STEP, PIMASTER, OPASSW,

4599

& IWPOSCB, MYID, KEEP,KEEP8)

4509

4600

ENDDO

4510

4601

IF (NBROWS_ALREADY_SENT .EQ. 0) THEN

4511

4602

IF (KEEP(219).NE.0) THEN

4512

4603

IF(KEEP(50) .EQ. 2) THEN

4513

4604

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4514

* NFS4FATHER,

4515

* 1,

4516

* MPI_INTEGER,

4517

* COMM, IERR )

4605

& NFS4FATHER,

4606

& 1,

4607

& MPI_INTEGER,

4608

& COMM, IERR )

4518

4609

IF(NFS4FATHER .GT. 0) THEN

4519

4610

CALL DMUMPS_617(NFS4FATHER,IERR)

4520

4611

IF (IERR .NE. 0) THEN

4524

4615

RETURN

4525

4616

ENDIF

4526

4617

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION,

4527

* BUF_MAX_ARRAY,

4528

* NFS4FATHER,

4529

* MPI_DOUBLE_PRECISION,

4530

* COMM, IERR )

4618

& BUF_MAX_ARRAY,

4619

& NFS4FATHER,

4620

& MPI_DOUBLE_PRECISION,

4621

& COMM, IERR )

4531

4622

CALL DMUMPS_619(N, INODE, IW, LIW, A, LA,

4532

* ISON, NFS4FATHER,

4533

* BUF_MAX_ARRAY, PTLUST_S, PTRAST,

4534

* STEP, PIMASTER, OPASSW,

4535

* IWPOSCB, MYID, KEEP,KEEP8)

4623

& ISON, NFS4FATHER,

4624

& BUF_MAX_ARRAY, PTLUST_S, PTRAST,

4625

& STEP, PIMASTER, OPASSW,

4626

& IWPOSCB, MYID, KEEP,KEEP8)

4536

4627

ENDIF

4537

4628

ENDIF

4538

4629

ENDIF

4545

4636

SAME_PROC= ISTCHK .LT. IWPOSCB

4546

4637

IF (SAME_PROC) THEN

4547

4638

CALL DMUMPS_530(N, ISON, INODE, IWPOSCB,

4548

* PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8)

4639

& PIMASTER, PTLUST_S, IW, LIW, STEP, KEEP,KEEP8)

4549

4640

ENDIF

4550

4641

IF (SAME_PROC) THEN

4551

4642

ISTCHK = PTRIST(STEP(ISON))

4554

4645

PIMASTER(STEP( ISON )) = -99999999

4555

4646

ENDIF

4556

4647

CALL DMUMPS_152(.FALSE., MYID, N, ISTCHK,

4557

* PAMASTER(STEP(ISON)),

4558

* IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB,

4559

* LA, KEEP,KEEP8, .FALSE.

4560

* )

4648

& PAMASTER(STEP(ISON)),

4649

& IW, LIW, LRLU, LRLUS, IPTRLU, IWPOSCB,

4650

& LA, KEEP,KEEP8, .FALSE.

4651

& )

4561

4652

ENDIF

4562

4653

IF ( NBPROCFILS(STEP(INODE)) .EQ. 0 ) THEN

4563

4654

CALL DMUMPS_507( N, IPOOL, LPOOL,

4564

* PROCNODE_STEPS,

4565

* SLAVEF, KEEP(28), KEEP(76), KEEP(80),

4566

* KEEP(47), STEP, INODE+N )

4655

& PROCNODE_STEPS,

4656

& SLAVEF, KEEP(28), KEEP(76), KEEP(80),

4657

& KEEP(47), STEP, INODE+N )

4567

4658

IF (KEEP(47) .GE. 3) THEN

4568

4659

CALL DMUMPS_500(

4569

$ IPOOL, LPOOL,

4570

* PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,

4571

* MYID, STEP, N, ND, FILS )

4660

& IPOOL, LPOOL,

4661

& PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,

4662

& MYID, STEP, N, ND, FILS )

4572

4663

ENDIF

4573

4664

ENDIF

4574

4665

ENDIF

4578

4669

LRLUS = LRLUS + LREQA

4579

4670

POSFAC = POSFAC - LREQA

4580

4671

CALL DMUMPS_471(.FALSE.,.FALSE.,

4581

* LA-LRLUS,0,-LREQA,KEEP,KEEP8,LRLU)

4672

& LA-LRLUS,0_8,-LREQA,KEEP,KEEP8,LRLU)

4582

4673

RETURN

4583

4674

END SUBROUTINE DMUMPS_699

4584

4675

SUBROUTINE DMUMPS_143( N, INODE, IW, LIW, A, LA,

4585

* IOLDPS, POSELT, IFLAG, UU, NOFFW,

4586

* NPVW,

4587

* KEEP,KEEP8, STEP,

4588

* PROCNODE_STEPS, MYID, SLAVEF, SEUIL,

4589

* AVOID_DELAYED, ETATASS,

4590

* DKEEP,PIVNUL_LIST,LPN_LIST,

4591

* IWPOS )

4676

& IOLDPS, POSELT, IFLAG, UU, NOFFW,

4677

& NPVW,

4678

& KEEP,KEEP8, STEP,

4679

& PROCNODE_STEPS, MYID, SLAVEF, SEUIL,

4680

& AVOID_DELAYED, ETATASS,

4681

& DKEEP,PIVNUL_LIST,LPN_LIST,

4682

& IWPOS )

4592

4683

USE DMUMPS_OOC

4593

4684

IMPLICIT NONE

4594

INTEGER N, INODE, LIW, LA, IFLAG, NOFFW, NPVW

4685

INTEGER(8) :: LA, POSELT

4686

INTEGER N, INODE, LIW, IFLAG, NOFFW, NPVW

4595

4687

INTEGER IW( LIW )

4596

4688

DOUBLE PRECISION A( LA )

4597

INTEGER MYID, SLAVEF, IOLDPS, POSELT

4689

INTEGER MYID, SLAVEF, IOLDPS

4598

4690

INTEGER KEEP( 500 )

4599

4691

INTEGER*8 KEEP8(150)

4600

4692

INTEGER PROCNODE_STEPS( KEEP(28) ), STEP(N)

4607

4699

INTEGER INOPV, IFINB, NFRONT, NPIV, IBEG_BLOCK

4608

4700

INTEGER NASS, NEL1, NPIVB, NPIVE, NBOLKJ, NBTLKJ

4609

4701

DOUBLE PRECISION UUTEMP

4610

INTEGER LAFAC, LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten,

4702

INTEGER(8) :: LAFAC

4703

INTEGER LIWFAC, STRAT, TYPEFile, LNextPiv2beWritten,

4611

4704

& UNextPiv2beWritten, IFLAG_OOC,

4612

4705

& PP_FIRST2SWAP_L, PP_FIRST2SWAP_U,

4613

4706

& PP_LastPIVRPTRFilled_L,

4614

4707

& PP_LastPIVRPTRFilled_U

4615

4708

TYPE(IO_BLOCK) :: MonBloc

4709

LOGICAL LAST_CALL

4616

4710

INCLUDE 'mumps_headers.h'

4617

4711

EXTERNAL MUMPS_330, DMUMPS_221, DMUMPS_233,

4618

* DMUMPS_229,

4619

* DMUMPS_225, DMUMPS_232, DMUMPS_231,

4620

* DMUMPS_220,

4621

* DMUMPS_228, DMUMPS_236

4712

& DMUMPS_229,

4713

& DMUMPS_225, DMUMPS_232, DMUMPS_231,

4714

& DMUMPS_220,

4715

& DMUMPS_228, DMUMPS_236

4622

4716

INTEGER MUMPS_330

4623

4717

LOGICAL STATICMODE

4624

4718

DOUBLE PRECISION SEUIL_LOC

4646

4740

ENDIF

4647

4741

NBTLKJ = NBOLKJ

4648

4742

IF (KEEP(201).EQ.1) THEN

4649

LAFAC = IW(IOLDPS+XXR)

4743

CALL MUMPS_729(LAFAC,IW(IOLDPS+XXR))

4650

4744

LIWFAC = IW(IOLDPS+XXI)

4651

4745

TYPEFile = TYPEF_BOTH_LU

4652

4746

LNextPiv2beWritten = 1

4669

4763

ENDIF

4670

4764

50 CONTINUE

4671

4765

CALL DMUMPS_221(NFRONT,NASS,N,INODE,IW,LIW,A,LA,INOPV,NOFFW,

4672

* IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8,

4673

* DKEEP(1),PIVNUL_LIST(1),LPN_LIST,

4674

* PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L,

4675

* PP_LastPIVRPTRFilled_L,

4676

* PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U,

4677

* PP_LastPIVRPTRFilled_U)

4766

& IFLAG,IOLDPS,POSELT,UU,SEUIL_LOC,KEEP,KEEP8,

4767

& DKEEP(1),PIVNUL_LIST(1),LPN_LIST,

4768

& PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L,

4769

& PP_LastPIVRPTRFilled_L,

4770

& PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U,

4771

& PP_LastPIVRPTRFilled_U)

4678

4772

IF (IFLAG.LT.0) GOTO 500

4679

4773

IF (INOPV.EQ.1) THEN

4680

4774

IF(STATICMODE) THEN

4685

4779

ENDIF

4686

4780

IF (INOPV.EQ.2) THEN

4687

4781

CALL DMUMPS_233(IBEG_BLOCK,

4688

* NFRONT,NASS,N,INODE,IW,LIW,A,LA,

4689

* IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP(IXSZ))

4782

& NFRONT,NASS,N,INODE,IW,LIW,A,LA,

4783

& IOLDPS,POSELT,NBOLKJ, NBTLKJ,KEEP(4),KEEP(IXSZ))

4690

4784

GOTO 50

4691

4785

ENDIF

4692

4786

NPVW = NPVW + 1

4693

4787

IF (NASS.LE.1) THEN

4694

4788

CALL DMUMPS_229(NFRONT,N,INODE,IW,LIW,A,LA,

4695

* IOLDPS,POSELT,KEEP(IXSZ))

4789

& IOLDPS,POSELT,KEEP(IXSZ))

4696

4790

IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1

4697

4791

GO TO 500

4698

4792

ENDIF

4699

4793

CALL DMUMPS_225(IBEG_BLOCK,NFRONT, NASS, N,INODE,IW,LIW,A,LA,

4700

* IOLDPS,POSELT,IFINB,

4701

* NBTLKJ,KEEP(4),KEEP(IXSZ))

4794

& IOLDPS,POSELT,IFINB,

4795

& NBTLKJ,KEEP(4),KEEP(IXSZ))

4702

4796

IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1

4703

4797

IF (IFINB.EQ.0) GOTO 50

4704

4798

IF (KEEP(201).EQ.1) THEN

4705

4799

MonBloc%LastPiv= IW(IOLDPS+1+KEEP(IXSZ))

4706

4800

STRAT = STRAT_TRY_WRITE

4707

4801

TYPEFile = TYPEF_U

4802

LAST_CALL = .FALSE.

4708

4803

CALL DMUMPS_688

4709

4804

& ( STRAT, TYPEFile,

4710

4805

& A(POSELT), LAFAC, MonBloc,

4711

4806

& LNextPiv2beWritten, UNextPiv2beWritten,

4712

4807

& IW(IOLDPS), LIWFAC,

4713

& MYID, KEEP8(31), IFLAG_OOC )

4808

& MYID, KEEP8(31), IFLAG_OOC,LAST_CALL )

4714

4809

IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC

4715

4810

ENDIF

4716

4811

IF (IFINB.EQ.(-1)) GOTO 80

4717

4812

NPIV = IW(IOLDPS+1+KEEP(IXSZ))

4718

4813

NEL1 = NASS - NPIV

4719

4814

CALL DMUMPS_232(A,LA,

4720

* NFRONT,NPIV,NASS,POSELT,NBTLKJ)

4815

& NFRONT,NPIV,NASS,POSELT,NBTLKJ)

4721

4816

GO TO 50

4722

4817

80 CONTINUE

4723

4818

NPIV = IW(IOLDPS+1+KEEP(IXSZ))

4739

4834

ENDIF

4740

4835

110 CONTINUE

4741

4836

IF (MUMPS_330(STEP(INODE),PROCNODE_STEPS,SLAVEF)

4742

* .EQ.1) THEN

4837

& .EQ.1) THEN

4743

4838

NPIV = IW(IOLDPS+1+KEEP(IXSZ))

4744

4839

IBEG_BLOCK = NPIV

4745

4840

IF (NASS.EQ.NPIV) GOTO 500

4746

4841

120 CALL DMUMPS_220(NFRONT,NASS,N,INODE,IW,LIW,A,LA,

4747

* INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,

4748

* KEEP,

4749

* PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L,

4750

* PP_LastPIVRPTRFilled_L,

4751

* PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U,

4752

* PP_LastPIVRPTRFilled_U)

4842

& INOPV,NOFFW,IOLDPS,POSELT,UU,SEUIL,

4843

& KEEP,

4844

& PP_FIRST2SWAP_L, MonBloc%LastPanelWritten_L,

4845

& PP_LastPIVRPTRFilled_L,

4846

& PP_FIRST2SWAP_U, MonBloc%LastPanelWritten_U,

4847

& PP_LastPIVRPTRFilled_U)

4753

4848

IF (INOPV.NE.1) THEN

4754

4849

NPVW = NPVW + 1

4755

4850

CALL DMUMPS_228(NFRONT,NASS,N,INODE,IW,LIW,A,LA,

4756

* IOLDPS,POSELT,IFINB,KEEP(IXSZ))

4851

& IOLDPS,POSELT,IFINB,KEEP(IXSZ))

4757

4852

IW(IOLDPS+1+KEEP(IXSZ)) = IW(IOLDPS+1+KEEP(IXSZ)) + 1

4758

4853

IF (IFINB.EQ.0) GOTO 120

4759

4854

ENDIF

4763

4858

NEL1 = NFRONT - NASS

4764

4859

IF ((NPIVE.LE.0).OR.(NEL1.EQ.0)) GO TO 500

4765

4860

CALL DMUMPS_236(A,LA,NPIVB,

4766

* NFRONT,NPIV,NASS,POSELT)

4861

& NFRONT,NPIV,NASS,POSELT)

4767

4862

ENDIF

4768

4863

500 CONTINUE

4769

4864

IF (KEEP(201).EQ.1) THEN

4771

4866

MonBloc%Last = .TRUE.

4772

4867

MonBloc%LastPiv = IW(IOLDPS+1+KEEP(IXSZ))

4773

4868

TYPEFile = TYPEF_BOTH_LU

4869

LAST_CALL = .TRUE.

4774

4870

CALL DMUMPS_688

4775

4871

& ( STRAT, TYPEFile,

4776

4872

& A(POSELT), LAFAC, MonBloc,

4777

4873

& LNextPiv2beWritten, UNextPiv2beWritten,

4778

4874

& IW(IOLDPS), LIWFAC,

4779

& MYID, KEEP8(31), IFLAG_OOC )

4875

& MYID, KEEP8(31), IFLAG_OOC, LAST_CALL )

4780

4876

IF (IFLAG_OOC < 0 ) IFLAG=IFLAG_OOC

4781

4877

CALL DMUMPS_644(IWPOS,

4782

4878

& IOLDPS, IW, LIW, MonBloc , NFRONT, KEEP)

4784

4880

RETURN

4785

4881

END SUBROUTINE DMUMPS_143

4786

4882

RECURSIVE SUBROUTINE DMUMPS_322(

4787

* COMM_LOAD, ASS_IRECV,

4788

* MSGSOU, MSGTAG, MSGLEN,

4789

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4790

* IWPOS, IWPOSCB, IPTRLU,

4791

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

4792

* PTLUST_S, PTRFAC,

4793

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4794

* IFLAG, IERROR, COMM,

4795

* NBPROCFILS,

4796

* IPOOL, LPOOL, LEAF,

4797

* NBFIN, MYID, SLAVEF,

4798

*

4799

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4800

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

4801

* LPTRAR, NELT, FRTPTR, FRTELT,

4802

*

4803

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

4804

* )

4883

& COMM_LOAD, ASS_IRECV,

4884

& MSGSOU, MSGTAG, MSGLEN,

4885

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

4886

& IWPOS, IWPOSCB, IPTRLU,

4887

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

4888

& PTLUST_S, PTRFAC,

4889

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4890

& IFLAG, IERROR, COMM,

4891

& NBPROCFILS,

4892

& IPOOL, LPOOL, LEAF,

4893

& NBFIN, MYID, SLAVEF,

4894

&

4895

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

4896

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

4897

& LPTRAR, NELT, FRTPTR, FRTELT,

4898

&

4899

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

4900

& )

4805

4901

USE DMUMPS_LOAD

4806

4902

IMPLICIT NONE

4807

4903

INCLUDE 'dmumps_root.h'

4812

4908

INTEGER BUFR( LBUFR )

4813

4909

INTEGER KEEP(500), ICNTL( 40 )

4814

4910

INTEGER*8 KEEP8(150)

4815

INTEGER POSFAC,IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS

4816

INTEGER N, LIW, LA

4911

INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA

4912

INTEGER IWPOS, IWPOSCB

4913

INTEGER N, LIW

4817

4914

INTEGER IW( LIW )

4818

4915

DOUBLE PRECISION A( LA )

4819

INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)), PTRFAC(KEEP(28)),

4820

*PTRAST(KEEP(28))

4821

INTEGER STEP(N),

4822

* PIMASTER(KEEP(28)),

4823

* PAMASTER(KEEP(28))

4916

INTEGER(8) :: PTRFAC(KEEP(28))

4917

INTEGER(8) :: PTRAST(KEEP(28))

4918

INTEGER(8) :: PAMASTER(KEEP(28))

4919

INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))

4920

INTEGER STEP(N), PIMASTER(KEEP(28))

4824

4921

INTEGER COMP

4825

4922

INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )

4826

4923

INTEGER NBPROCFILS( KEEP(28) )

4836

4933

INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR )

4837

4934

INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )

4838

4935

INTEGER ISTEP_TO_INIV2(KEEP(71)),

4839

* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

4936

& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

4840

4937

INTEGER INTARR( max(1,KEEP(14)) )

4841

4938

DOUBLE PRECISION DBLARR( max(1,KEEP(13)) )

4842

4939

INTEGER INIV2, ISHIFT, IBEG

4847

4944

INTEGER TMP( 2 )

4848

4945

INTEGER NBRECU, POSITION, INODE, ISON, IROOT

4849

4946

INTEGER NSLAVES_PERE, NFRONT_PERE, NASS_PERE,

4850

* LASTBL_PERE, LMAP, FPERE, NELIM,

4851

* HDMAPLIG,NFS4FATHER,

4852

* TOT_ROOT_SIZE, TOT_CONT_TO_RECV

4947

& LASTBL_PERE, LMAP, FPERE, NELIM,

4948

& HDMAPLIG,NFS4FATHER,

4949

& TOT_ROOT_SIZE, TOT_CONT_TO_RECV

4853

4950

DOUBLE PRECISION FLOP1

4854

4951

INCLUDE 'mumps_tags.h'

4855

4952

INCLUDE 'mpif.h'

4862

4959

IF ( MSGTAG .EQ. RACINE ) THEN

4863

4960

POSITION = 0

4864

4961

CALL MPI_UNPACK( BUFR, LBUFR_BYTES, POSITION, NBRECU,

4865

* 1, MPI_INTEGER, COMM, IERR)

4962

& 1, MPI_INTEGER, COMM, IERR)

4866

4963

NBRECU = BUFR( 1 )

4867

4964

NBFIN = NBFIN - NBRECU

4868

4965

ELSEIF ( MSGTAG .EQ. NOEUD ) THEN

4869

4966

CALL DMUMPS_269( MYID,KEEP,KEEP8,

4870

* BUFR, LBUFR, LBUFR_BYTES,

4871

* IWPOS, IWPOSCB, IPTRLU,

4872

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, PTRAST,

4873

* STEP, PIMASTER, PAMASTER,

4874

* NSTK_S, COMP, FPERE, FLAG, IFLAG, IERROR, COMM, ITLOC )

4967

& BUFR, LBUFR, LBUFR_BYTES,

4968

& IWPOS, IWPOSCB, IPTRLU,

4969

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST, PTRAST,

4970

& STEP, PIMASTER, PAMASTER,

4971

& NSTK_S, COMP, FPERE, FLAG, IFLAG, IERROR, COMM, ITLOC )

4875

4972

SUBNAME="DMUMPS_269"

4876

4973

IF ( IFLAG .LT. 0 ) GO TO 500

4877

4974

IF ( FLAG ) THEN

4878

4975

CALL DMUMPS_507(N, IPOOL, LPOOL,

4879

* PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76),

4880

* KEEP(80), KEEP(47), STEP, FPERE )

4976

& PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76),

4977

& KEEP(80), KEEP(47), STEP, FPERE )

4881

4978

IF (KEEP(47) .GE. 3) THEN

4882

4979

CALL DMUMPS_500(

4883

$ IPOOL, LPOOL,

4884

* PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,

4885

* MYID, STEP, N, ND, FILS )

4980

& IPOOL, LPOOL,

4981

& PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,

4982

& MYID, STEP, N, ND, FILS )

4886

4983

ENDIF

4887

4984

CALL MUMPS_137( FPERE, N,

4888

* PROCNODE_STEPS,SLAVEF,

4985

& PROCNODE_STEPS,SLAVEF,

4889

4986

& ND, FILS, FRERE, STEP, PIMASTER,

4890

* KEEP(28), KEEP(50), FLOP1,

4987

& KEEP(28), KEEP(50), FLOP1,

4891

4988

& IW, LIW, KEEP(IXSZ) )

4892

4989

IF (FPERE.NE.KEEP(20))

4893

* CALL DMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8)

4990

& CALL DMUMPS_190(1,.FALSE.,FLOP1,KEEP,KEEP8)

4894

4991

ENDIF

4895

4992

ELSEIF ( MSGTAG .EQ. END_NIV2_LDLT ) THEN

4896

4993

INODE = BUFR( 1 )

4897

4994

CALL DMUMPS_507(N, IPOOL, LPOOL,

4898

* PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76),

4899

* KEEP(80), KEEP(47),

4900

* STEP, -INODE )

4995

& PROCNODE_STEPS, SLAVEF, KEEP(28), KEEP(76),

4996

& KEEP(80), KEEP(47),

4997

& STEP, -INODE )

4901

4998

IF (KEEP(47) .GE. 3) THEN

4902

4999

CALL DMUMPS_500(

4903

$ IPOOL, LPOOL,

4904

* PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,

4905

* MYID, STEP, N, ND, FILS )

5000

& IPOOL, LPOOL,

5001

& PROCNODE_STEPS, KEEP,KEEP8, SLAVEF, COMM_LOAD,

5002

& MYID, STEP, N, ND, FILS )

4906

5003

ENDIF

4907

5004

ELSEIF ( MSGTAG .EQ. TERREUR ) THEN

4908

5005

IFLAG = -001

4910

5007

GOTO 100

4911

5008

ELSEIF ( MSGTAG .EQ. MAITRE_DESC_BANDE ) THEN

4912

5009

CALL DMUMPS_266( MYID,BUFR, LBUFR,

4913

* LBUFR_BYTES, IWPOS,

4914

* IWPOSCB,

4915

* IPTRLU, LRLU, LRLUS, NBPROCFILS,

4916

* N, IW, LIW, A, LA,

4917

* PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,

4918

* KEEP,KEEP8, ITLOC,

4919

* IFLAG, IERROR )

5010

& LBUFR_BYTES, IWPOS,

5011

& IWPOSCB,

5012

& IPTRLU, LRLU, LRLUS, NBPROCFILS,

5013

& N, IW, LIW, A, LA,

5014

& PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, COMP,

5015

& KEEP,KEEP8, ITLOC,

5016

& IFLAG, IERROR )

4920

5017

SUBNAME="DMUMPS_266"

4921

5018

IF ( IFLAG .LT. 0 ) GO to 500

4922

5019

ELSEIF ( MSGTAG .EQ. MAITRE2 ) THEN

4923

5020

CALL DMUMPS_268(MYID,BUFR, LBUFR, LBUFR_BYTES,

4924

* PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB,

4925

* IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,

4926

* PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

4927

* IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS,

4928

* IPOOL, LPOOL, LEAF,

4929

* KEEP,KEEP8, ND, FILS, FRERE, ITLOC,

4930

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5021

& PROCNODE_STEPS, SLAVEF, IWPOS, IWPOSCB,

5022

& IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,

5023

& PTRIST, PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5024

& IFLAG, IERROR, COMM, COMM_LOAD, NBPROCFILS,

5025

& IPOOL, LPOOL, LEAF,

5026

& KEEP,KEEP8, ND, FILS, FRERE, ITLOC,

5027

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4931

5028

SUBNAME="DMUMPS_268"

4932

5029

IF ( IFLAG .LT. 0 ) GO to 500

4933

5030

ELSEIF ( MSGTAG .EQ. BLOC_FACTO ) THEN

4934

5031

CALL DMUMPS_264( COMM_LOAD, ASS_IRECV,

4935

* BUFR, LBUFR, LBUFR_BYTES,

4936

* PROCNODE_STEPS, MSGSOU,

4937

* SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

4938

* A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

4939

* COMP, STEP, PIMASTER, PAMASTER, POSFAC,

4940

* MYID, COMM , IFLAG, IERROR, NBFIN,

4941

*

4942

* PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

4943

* PTRARW, PTRAIW, INTARR, DBLARR,

4944

* ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE,

4945

* LPTRAR, NELT, FRTPTR, FRTELT,

4946

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5032

& BUFR, LBUFR, LBUFR_BYTES,

5033

& PROCNODE_STEPS, MSGSOU,

5034

& SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

5035

& A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

5036

& COMP, STEP, PIMASTER, PAMASTER, POSFAC,

5037

& MYID, COMM , IFLAG, IERROR, NBFIN,

5038

&

5039

& PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

5040

& PTRARW, PTRAIW, INTARR, DBLARR,

5041

& ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE,

5042

& LPTRAR, NELT, FRTPTR, FRTELT,

5043

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4947

5044

ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM_SLAVE ) THEN

4948

5045

CALL DMUMPS_263( COMM_LOAD, ASS_IRECV,

4949

* BUFR, LBUFR,

4950

* LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,

4951

* SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

4952

* A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

4953

* COMP, STEP, PIMASTER, PAMASTER, POSFAC,

4954

* MYID, COMM, IFLAG, IERROR, NBFIN,

4955

*

4956

* PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

4957

* PTRARW, PTRAIW, INTARR, DBLARR,

4958

* ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE,

4959

* LPTRAR, NELT, FRTPTR, FRTELT,

4960

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5046

& BUFR, LBUFR,

5047

& LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,

5048

& SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

5049

& A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

5050

& COMP, STEP, PIMASTER, PAMASTER, POSFAC,

5051

& MYID, COMM, IFLAG, IERROR, NBFIN,

5052

&

5053

& PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

5054

& PTRARW, PTRAIW, INTARR, DBLARR,

5055

& ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE,

5056

& LPTRAR, NELT, FRTPTR, FRTELT,

5057

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4961

5058

ELSEIF ( MSGTAG .EQ. BLOC_FACTO_SYM ) THEN

4962

5059

CALL DMUMPS_274( COMM_LOAD, ASS_IRECV,

4963

* BUFR, LBUFR,

4964

* LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,

4965

* SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

4966

* A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

4967

* COMP, STEP, PIMASTER, PAMASTER, POSFAC,

4968

* MYID, COMM, IFLAG, IERROR, NBFIN,

4969

*

4970

* PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

4971

* PTRARW, PTRAIW, INTARR, DBLARR,

4972

* ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE,

4973

* LPTRAR, NELT, FRTPTR, FRTELT,

4974

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5060

& BUFR, LBUFR,

5061

& LBUFR_BYTES, PROCNODE_STEPS, MSGSOU,

5062

& SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, N, IW, LIW,

5063

& A, LA, PTRIST, PTRAST, NSTK_S, NBPROCFILS,

5064

& COMP, STEP, PIMASTER, PAMASTER, POSFAC,

5065

& MYID, COMM, IFLAG, IERROR, NBFIN,

5066

&

5067

& PTLUST_S, PTRFAC, root, OPASSW, OPELIW, ITLOC, FILS,

5068

& PTRARW, PTRAIW, INTARR, DBLARR,

5069

& ICNTL, KEEP,KEEP8, IPOOL, LPOOL, LEAF, ND, FRERE,

5070

& LPTRAR, NELT, FRTPTR, FRTELT,

5071

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4975

5072

ELSEIF ( MSGTAG .EQ. CONTRIB_TYPE2 ) THEN

4976

5073

CALL DMUMPS_699( COMM_LOAD, ASS_IRECV,

4977

* MSGLEN, BUFR, LBUFR,

4978

* LBUFR_BYTES, PROCNODE_STEPS,

4979

* SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC,

4980

* N, IW, LIW, A, LA, PTRIST,

4981

* PTLUST_S, PTRFAC, PTRAST,

4982

* STEP, PIMASTER, PAMASTER, NBPROCFILS, COMP, root,

4983

* OPASSW, OPELIW, ITLOC, NSTK_S,

4984

* FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM,

4985

* ICNTL, KEEP,KEEP8, IFLAG, IERROR, IPOOL, LPOOL, LEAF,

4986

* ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,

4987

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5074

& MSGLEN, BUFR, LBUFR,

5075

& LBUFR_BYTES, PROCNODE_STEPS,

5076

& SLAVEF, IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, POSFAC,

5077

& N, IW, LIW, A, LA, PTRIST,

5078

& PTLUST_S, PTRFAC, PTRAST,

5079

& STEP, PIMASTER, PAMASTER, NBPROCFILS, COMP, root,

5080

& OPASSW, OPELIW, ITLOC, NSTK_S,

5081

& FILS, PTRARW, PTRAIW, INTARR, DBLARR, NBFIN, MYID, COMM,

5082

& ICNTL, KEEP,KEEP8, IFLAG, IERROR, IPOOL, LPOOL, LEAF,

5083

& ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,

5084

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

4988

5085

IF ( IFLAG .LT. 0 ) GO TO 100

4989

5086

ELSEIF ( MSGTAG .EQ. MAPLIG ) THEN

4990

5087

HDMAPLIG = 7

4999

5096

INIV2 = ISTEP_TO_INIV2 ( STEP(INODE) )

5000

5097

ISHIFT = NSLAVES_PERE+1

5001

5098

TAB_POS_IN_PERE(1:NSLAVES_PERE+1, INIV2) =

5002

* BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE)

5099

& BUFR(HDMAPLIG+1:HDMAPLIG+1+NSLAVES_PERE)

5003

5100

TAB_POS_IN_PERE(SLAVEF+2, INIV2) = NSLAVES_PERE

5004

5101

ELSE

5005

5102

ISHIFT = 0

5006

5103

ENDIF

5007

5104

IBEG = HDMAPLIG+1+ISHIFT

5008

5105

CALL DMUMPS_210( COMM_LOAD, ASS_IRECV,

5009

* BUFR, LBUFR, LBUFR_BYTES,

5010

* INODE, ISON, NSLAVES_PERE,

5011

* BUFR(IBEG),

5012

* NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP,

5013

* BUFR(IBEG+NSLAVES_PERE),

5014

* PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB,

5015

* IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,

5016

* PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,

5017

* NSTK_S, COMP,

5018

* IFLAG, IERROR, MYID, COMM, NBPROCFILS,

5019

* IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root,

5020

* OPASSW, OPELIW,

5021

* ITLOC, FILS, PTRARW, PTRAIW, INTARR, DBLARR,

5022

* ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,

5023

*

5024

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

5025

* )

5106

& BUFR, LBUFR, LBUFR_BYTES,

5107

& INODE, ISON, NSLAVES_PERE,

5108

& BUFR(IBEG),

5109

& NFRONT_PERE, NASS_PERE, NFS4FATHER,LMAP,

5110

& BUFR(IBEG+NSLAVES_PERE),

5111

& PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB,

5112

& IPTRLU, LRLU, LRLUS, N, IW, LIW, A, LA,

5113

& PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,

5114

& NSTK_S, COMP,

5115

& IFLAG, IERROR, MYID, COMM, NBPROCFILS,

5116

& IPOOL, LPOOL, LEAF, NBFIN, ICNTL, KEEP,KEEP8, root,

5117

& OPASSW, OPELIW,

5118

& ITLOC, FILS, PTRARW, PTRAIW, INTARR, DBLARR,

5119

& ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,

5120

&

5121

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

5122

& )

5026

5123

IF ( IFLAG .LT. 0 ) GO TO 100

5027

ELSE IF ( MSGTAG .EQ. FACTOR ) THEN

5028

CALL DMUMPS_267( BUFR, LBUFR, LBUFR_BYTES,

5029

* N, MSGSOU, MYID,

5030

* STEP, PTLUST_S, KEEP(10), KEEP(28),

5031

* SLAVEF, IW, LIW, A, LA, COMM, KEEP(IXSZ) )

5032

5124

ELSE IF ( MSGTAG .EQ. ROOT_CONT_STATIC ) THEN

5033

5125

CALL DMUMPS_700(

5034

* BUFR, LBUFR, LBUFR_BYTES,

5035

* root, N, IW, LIW, A, LA, NBPROCFILS,

5036

* LRLU, IPTRLU, IWPOS, IWPOSCB,

5037

* PTRIST, PTLUST_S, PTRFAC, PTRAST,

5038

* STEP, PIMASTER, PAMASTER,

5039

* COMP, LRLUS, IPOOL, LPOOL, LEAF,

5040

* FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,

5041

* KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, ITLOC,

5042

* ND, PROCNODE_STEPS, SLAVEF)

5126

& BUFR, LBUFR, LBUFR_BYTES,

5127

& root, N, IW, LIW, A, LA, NBPROCFILS,

5128

& LRLU, IPTRLU, IWPOS, IWPOSCB,

5129

& PTRIST, PTLUST_S, PTRFAC, PTRAST,

5130

& STEP, PIMASTER, PAMASTER,

5131

& COMP, LRLUS, IPOOL, LPOOL, LEAF,

5132

& FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,

5133

& KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, ITLOC,

5134

& ND, PROCNODE_STEPS, SLAVEF)

5043

5135

SUBNAME="DMUMPS_700"

5044

5136

IF ( IFLAG .LT. 0 ) GO TO 500

5045

5137

ELSE IF ( MSGTAG .EQ. ROOT_NON_ELIM_CB ) THEN

5046

5138

IROOT = KEEP( 38 )

5047

5139

MSGSOU = MUMPS_275( STEP(IROOT), PROCNODE_STEPS,

5048

* SLAVEF )

5140

& SLAVEF )

5049

5141

IF ( PTLUST_S( STEP(IROOT)) .EQ. 0 ) THEN

5050

5142

CALL MPI_RECV( TMP, 2 * KEEP(34), MPI_PACKED,

5051

* MSGSOU, ROOT_2SLAVE,

5052

* COMM, STATUS, IERR )

5143

& MSGSOU, ROOT_2SLAVE,

5144

& COMM, STATUS, IERR )

5053

5145

CALL DMUMPS_270( TMP( 1 ), TMP( 2 ),

5054

* root,

5055

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5056

* IWPOS, IWPOSCB, IPTRLU,

5057

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5058

* PTLUST_S, PTRFAC,

5059

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5060

* IFLAG, IERROR, COMM, COMM_LOAD,

5061

* NBPROCFILS,

5062

* IPOOL, LPOOL, LEAF,

5063

* NBFIN, MYID, SLAVEF,

5064

*

5065

* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5066

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND )

5146

& root,

5147

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5148

& IWPOS, IWPOSCB, IPTRLU,

5149

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5150

& PTLUST_S, PTRFAC,

5151

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5152

& IFLAG, IERROR, COMM, COMM_LOAD,

5153

& NBPROCFILS,

5154

& IPOOL, LPOOL, LEAF,

5155

& NBFIN, MYID, SLAVEF,

5156

&

5157

& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5158

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND )

5067

5159

SUBNAME="DMUMPS_270"

5068

5160

IF ( IFLAG .LT. 0 ) GOTO 500

5069

5161

END IF

5070

5162

CALL DMUMPS_700(

5071

* BUFR, LBUFR, LBUFR_BYTES,

5072

* root, N, IW, LIW, A, LA, NBPROCFILS,

5073

* LRLU, IPTRLU, IWPOS, IWPOSCB,

5074

* PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,

5075

* COMP, LRLUS, IPOOL, LPOOL, LEAF,

5076

* FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,

5077

* KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, ITLOC,

5078

* ND, PROCNODE_STEPS, SLAVEF )

5163

& BUFR, LBUFR, LBUFR_BYTES,

5164

& root, N, IW, LIW, A, LA, NBPROCFILS,

5165

& LRLU, IPTRLU, IWPOS, IWPOSCB,

5166

& PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER, PAMASTER,

5167

& COMP, LRLUS, IPOOL, LPOOL, LEAF,

5168

& FILS, MYID, PTRAIW, PTRARW, INTARR, DBLARR,

5169

& KEEP,KEEP8, IFLAG, IERROR, COMM, COMM_LOAD, ITLOC,

5170

& ND, PROCNODE_STEPS, SLAVEF )

5079

5171

SUBNAME="DMUMPS_700"

5080

5172

IF ( IFLAG .LT. 0 ) GO TO 500

5081

5173

ELSE IF ( MSGTAG .EQ. ROOT_2SON ) THEN

5082

5174

ISON = BUFR( 1 )

5083

5175

NELIM = BUFR( 2 )

5084

5176

CALL DMUMPS_271( COMM_LOAD, ASS_IRECV,

5085

* ISON, NELIM, root,

5086

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5087

* IWPOS, IWPOSCB, IPTRLU,

5088

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5089

* PTLUST_S, PTRFAC,

5090

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5091

* IFLAG, IERROR, COMM,

5092

* NBPROCFILS,

5093

* IPOOL, LPOOL, LEAF,

5094

* NBFIN, MYID, SLAVEF,

5095

*

5096

* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5097

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5098

* LPTRAR, NELT, FRTPTR, FRTELT,

5099

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5177

& ISON, NELIM, root,

5178

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5179

& IWPOS, IWPOSCB, IPTRLU,

5180

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5181

& PTLUST_S, PTRFAC,

5182

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5183

& IFLAG, IERROR, COMM,

5184

& NBPROCFILS,

5185

& IPOOL, LPOOL, LEAF,

5186

& NBFIN, MYID, SLAVEF,

5187

&

5188

& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5189

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5190

& LPTRAR, NELT, FRTPTR, FRTELT,

5191

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5100

5192

IF ( IFLAG .LT. 0 ) GO TO 100

5101

5193

IF (MYID.NE.MUMPS_275(STEP(ISON),

5102

* PROCNODE_STEPS, SLAVEF)) THEN

5194

& PROCNODE_STEPS, SLAVEF)) THEN

5103

5195

IF (KEEP(50).EQ.0) THEN

5104

5196

IF (IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)).EQ.

5105

5197

& S_REC_CONTSTATIC) THEN

5106

5198

IW(PTRIST(STEP(ISON))+6+KEEP(IXSZ)) = S_ROOT2SON_CALLED

5107

5199

ELSE

5108

5200

CALL DMUMPS_626( N, ISON, PTRIST, PTRAST,

5109

* IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB,

5110

* IPTRLU, STEP, MYID, KEEP

5111

* )

5201

& IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB,

5202

& IPTRLU, STEP, MYID, KEEP

5203

& )

5112

5204

ENDIF

5113

5205

ELSE

5114

5206

IF (IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)).EQ.

5116

5208

IW(PTRIST(STEP(ISON))+8+KEEP(IXSZ)) = S_ROOT2SON_CALLED

5117

5209

ELSE

5118

5210

CALL DMUMPS_626( N, ISON, PTRIST, PTRAST,

5119

* IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB,

5120

* IPTRLU, STEP, MYID, KEEP

5121

* )

5211

& IW, LIW, A, LA, LRLU, LRLUS, IWPOSCB,

5212

& IPTRLU, STEP, MYID, KEEP

5213

& )

5122

5214

ENDIF

5123

5215

ENDIF

5124

5216

ENDIF

5126

5218

TOT_ROOT_SIZE = BUFR( 1 )

5127

5219

TOT_CONT_TO_RECV = BUFR( 2 )

5128

5220

CALL DMUMPS_270( TOT_ROOT_SIZE,

5129

* TOT_CONT_TO_RECV, root,

5130

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5131

* IWPOS, IWPOSCB, IPTRLU,

5132

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5133

* PTLUST_S, PTRFAC,

5134

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5135

* IFLAG, IERROR, COMM, COMM_LOAD,

5136

* NBPROCFILS,

5137

* IPOOL, LPOOL, LEAF,

5138

* NBFIN, MYID, SLAVEF,

5139

*

5140

* OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5141

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND )

5221

& TOT_CONT_TO_RECV, root,

5222

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5223

& IWPOS, IWPOSCB, IPTRLU,

5224

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5225

& PTLUST_S, PTRFAC,

5226

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5227

& IFLAG, IERROR, COMM, COMM_LOAD,

5228

& NBPROCFILS,

5229

& IPOOL, LPOOL, LEAF,

5230

& NBFIN, MYID, SLAVEF,

5231

&

5232

& OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5233

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND )

5142

5234

IF ( IFLAG .LT. 0 ) GO TO 100

5143

5235

ELSE IF ( MSGTAG .EQ. ROOT_NELIM_INDICES ) THEN

5144

5236

ISON = BUFR( 1 )

5145

5237

NELIM = BUFR( 2 )

5146

5238

NSLAVES_PERE = BUFR( 3 )

5147

5239

CALL DMUMPS_273( root,

5148

* ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)),

5149

* BUFR(4+2*BUFR(2)),

5150

*

5151

* PROCNODE_STEPS,

5152

* IWPOS, IWPOSCB, IPTRLU,

5153

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5154

* PTLUST_S, PTRFAC,

5155

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, ITLOC, COMP,

5156

* IFLAG, IERROR,

5157

* IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8,

5158

* COMM, COMM_LOAD, FILS, ND)

5240

& ISON, NELIM, NSLAVES_PERE, BUFR(4), BUFR(4+BUFR(2)),

5241

& BUFR(4+2*BUFR(2)),

5242

&

5243

& PROCNODE_STEPS,

5244

& IWPOS, IWPOSCB, IPTRLU,

5245

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5246

& PTLUST_S, PTRFAC,

5247

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, ITLOC, COMP,

5248

& IFLAG, IERROR,

5249

& IPOOL, LPOOL, LEAF, MYID, SLAVEF, KEEP,KEEP8,

5250

& COMM, COMM_LOAD, FILS, ND)

5159

5251

SUBNAME="DMUMPS_273"

5160

5252

IF ( IFLAG .LT. 0 ) GO TO 500

5161

5253

ELSE IF ( MSGTAG .EQ. UPDATE_LOAD ) THEN

5164

5256

ELSE IF ( MSGTAG .EQ. TAG_DUMMY ) THEN

5165

5257

ELSE

5166

5258

IF ( LP > 0 )

5167

* WRITE(LP,*) MYID,

5168

*': Internal error, routine DMUMPS_322.',MSGTAG

5259

& WRITE(LP,*) MYID,

5260

&': Internal error, routine DMUMPS_322.',MSGTAG

5169

5261

IFLAG = -100

5170

5262

IERROR= MSGTAG

5171

5263

GOTO 500

5189

5281

RETURN

5190

5282

END SUBROUTINE DMUMPS_322

5191

5283

RECURSIVE SUBROUTINE DMUMPS_280(

5192

* COMM_LOAD, ASS_IRECV,

5193

* STATUS,

5194

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5195

* IWPOS, IWPOSCB, IPTRLU,

5196

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5197

* PTLUST_S, PTRFAC,

5198

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5199

* IFLAG, IERROR, COMM,

5200

* NBPROCFILS,

5201

* IPOOL, LPOOL, LEAF,

5202

* NBFIN, MYID, SLAVEF,

5203

*

5204

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5205

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5206

* LPTRAR, NELT, FRTPTR, FRTELT ,

5207

*

5208

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

5209

* )

5284

& COMM_LOAD, ASS_IRECV,

5285

& STATUS,

5286

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5287

& IWPOS, IWPOSCB, IPTRLU,

5288

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5289

& PTLUST_S, PTRFAC,

5290

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5291

& IFLAG, IERROR, COMM,

5292

& NBPROCFILS,

5293

& IPOOL, LPOOL, LEAF,

5294

& NBFIN, MYID, SLAVEF,

5295

&

5296

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5297

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5298

& LPTRAR, NELT, FRTPTR, FRTELT ,

5299

&

5300

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

5301

& )

5210

5302

IMPLICIT NONE

5211

5303

INCLUDE 'dmumps_root.h'

5212

5304

INCLUDE 'mpif.h'

5218

5310

INTEGER COMM_LOAD, ASS_IRECV

5219

5311

INTEGER LBUFR, LBUFR_BYTES

5220

5312

INTEGER BUFR( LBUFR )

5221

INTEGER POSFAC,IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS

5222

INTEGER N, LIW, LA

5313

INTEGER(8) :: POSFAC, LA, IPTRLU, LRLU, LRLUS

5314

INTEGER IWPOS, IWPOSCB

5315

INTEGER N, LIW

5223

5316

INTEGER IW( LIW )

5224

5317

DOUBLE PRECISION A( LA )

5318

INTEGER(8) :: PTRFAC(KEEP(28))

5319

INTEGER(8) :: PTRAST(KEEP(28))

5320

INTEGER(8) :: PAMASTER(KEEP(28))

5225

5321

INTEGER PTRIST( KEEP(28) ),

5226

& PTLUST_S(KEEP(28)), PTRFAC(KEEP(28)), PTRAST(KEEP(28))

5227

INTEGER STEP(N),

5228

* PIMASTER(KEEP(28)),

5229

* PAMASTER(KEEP(28))

5322

& PTLUST_S(KEEP(28))

5323

INTEGER STEP(N), PIMASTER(KEEP(28))

5230

5324

INTEGER COMP

5231

5325

INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )

5232

5326

INTEGER NBPROCFILS( KEEP(28) )

5241

5335

INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR )

5242

5336

INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )

5243

5337

INTEGER ISTEP_TO_INIV2(KEEP(71)),

5244

* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

5338

& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

5245

5339

INTEGER INTARR( max(1,KEEP(14)) )

5246

5340

DOUBLE PRECISION DBLARR( max(1,KEEP(13)) )

5247

5341

INTEGER MSGSOU, MSGTAG, MSGLEN, IERR

5253

5347

IFLAG = -20

5254

5348

IERROR = MSGLEN

5255

5349

WRITE(*,*) ' RECEPTION BUF TOO SMALL, Msgtag/len=',

5256

* MSGTAG,MSGLEN

5350

& MSGTAG,MSGLEN

5257

5351

CALL DMUMPS_44( MYID, SLAVEF, COMM )

5258

5352

RETURN

5259

5353

ENDIF

5260

5354

CALL MPI_RECV( BUFR, LBUFR_BYTES, MPI_PACKED, MSGSOU,

5261

* MSGTAG,

5262

* COMM, STATUS, IERR )

5355

& MSGTAG,

5356

& COMM, STATUS, IERR )

5263

5357

CALL DMUMPS_322(

5264

* COMM_LOAD, ASS_IRECV,

5265

* MSGSOU, MSGTAG, MSGLEN, BUFR, LBUFR,

5266

* LBUFR_BYTES,

5267

* PROCNODE_STEPS, POSFAC,

5268

* IWPOS, IWPOSCB, IPTRLU,

5269

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5270

* PTLUST_S, PTRFAC,

5271

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

5272

* IERROR, COMM,

5273

* NBPROCFILS,

5274

* IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

5275

*

5276

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5277

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5278

* LPTRAR, NELT, FRTPTR, FRTELT,

5279

*

5280

* ISTEP_TO_INIV2, TAB_POS_IN_PERE

5281

* )

5358

& COMM_LOAD, ASS_IRECV,

5359

& MSGSOU, MSGTAG, MSGLEN, BUFR, LBUFR,

5360

& LBUFR_BYTES,

5361

& PROCNODE_STEPS, POSFAC,

5362

& IWPOS, IWPOSCB, IPTRLU,

5363

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5364

& PTLUST_S, PTRFAC,

5365

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

5366

& IERROR, COMM,

5367

& NBPROCFILS,

5368

& IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

5369

&

5370

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5371

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5372

& LPTRAR, NELT, FRTPTR, FRTELT,

5373

&

5374

& ISTEP_TO_INIV2, TAB_POS_IN_PERE

5375

& )

5282

5376

RETURN

5283

5377

END SUBROUTINE DMUMPS_280

5284

5378

RECURSIVE SUBROUTINE DMUMPS_329(

5285

* COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV,

5286

* MESSAGE_RECEIVED, MSGSOU, MSGTAG,

5287

* STATUS,

5288

* BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5289

* IWPOS, IWPOSCB, IPTRLU,

5290

* LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5291

* PTLUST_S, PTRFAC,

5292

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5293

* IFLAG, IERROR, COMM,

5294

* NBPROCFILS,

5295

* IPOOL, LPOOL, LEAF,

5296

* NBFIN, MYID, SLAVEF,

5297

*

5298

* root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5299

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5300

* LPTRAR, NELT, FRTPTR, FRTELT,

5301

*

5302

* ISTEP_TO_INIV2, TAB_POS_IN_PERE,

5303

* STACK_RIGHT_AUTHORIZED

5304

* )

5379

& COMM_LOAD, ASS_IRECV, BLOCKING, SET_IRECV,

5380

& MESSAGE_RECEIVED, MSGSOU, MSGTAG,

5381

& STATUS,

5382

& BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,

5383

& IWPOS, IWPOSCB, IPTRLU,

5384

& LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,

5385

& PTLUST_S, PTRFAC,

5386

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,

5387

& IFLAG, IERROR, COMM,

5388

& NBPROCFILS,

5389

& IPOOL, LPOOL, LEAF,

5390

& NBFIN, MYID, SLAVEF,

5391

&

5392

& root, OPASSW, OPELIW, ITLOC, FILS, PTRARW, PTRAIW,

5393

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5394

& LPTRAR, NELT, FRTPTR, FRTELT,

5395

&

5396

& ISTEP_TO_INIV2, TAB_POS_IN_PERE,

5397

& STACK_RIGHT_AUTHORIZED

5398

& )

5305

5399

USE DMUMPS_LOAD

5306

5400

IMPLICIT NONE

5307

5401

INCLUDE 'dmumps_root.h'

5318

5412

INTEGER LBUFR, LBUFR_BYTES

5319

5413

INTEGER COMM_LOAD, ASS_IRECV

5320

5414

INTEGER BUFR( LBUFR )

5321

INTEGER POSFAC,IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS

5322

INTEGER N, LIW, LA

5415

INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS

5416

INTEGER IWPOS, IWPOSCB

5417

INTEGER N, LIW

5323

5418

INTEGER IW( LIW )

5324

5419

DOUBLE PRECISION A( LA )

5420

INTEGER(8) :: PTRAST(KEEP(28))

5421

INTEGER(8) :: PTRFAC(KEEP(28))

5422

INTEGER(8) :: PAMASTER(KEEP(28))

5325

5423

INTEGER PTRIST( KEEP(28) ),

5326

& PTLUST_S(KEEP(28)), PTRFAC(KEEP(28)), PTRAST(KEEP(28))

5424

& PTLUST_S(KEEP(28))

5327

5425

INTEGER STEP(N),

5328

* PIMASTER(KEEP(28)),

5329

* PAMASTER(KEEP(28))

5426

& PIMASTER(KEEP(28))

5330

5427

INTEGER COMP

5331

5428

INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )

5332

5429

INTEGER NBPROCFILS( KEEP(28) )

5341

5438

INTEGER PTRARW( LPTRAR ), PTRAIW( LPTRAR )

5342

5439

INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )

5343

5440

INTEGER ISTEP_TO_INIV2(KEEP(71)),

5344

* TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

5441

& TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))

5345

5442

INTEGER INTARR( max(1,KEEP(14)) )

5346

5443

DOUBLE PRECISION DBLARR( max(1,KEEP(13)) )

5347

5444

LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED

5366

5463

RIGHT_MESS = .TRUE.

5367

5464

IF (BLOCKING) THEN

5368

5465

CALL MPI_WAIT(ASS_IRECV,

5369

* STATUS, IERR)

5466

& STATUS, IERR)

5370

5467

FLAG = .TRUE.

5371

5468

IF ( ( (MSGSOU.NE.MPI_ANY_SOURCE) .OR.

5372

* (MSGTAG.NE.MPI_ANY_TAG) ) ) THEN

5469

& (MSGTAG.NE.MPI_ANY_TAG) ) ) THEN

5373

5470

IF ( MSGSOU.NE.MPI_ANY_SOURCE) THEN

5374

5471

RIGHT_MESS = MSGSOU.EQ.STATUS(MPI_SOURCE)

5375

5472

ENDIF

5379

5476

ENDIF

5380

5477

IF (.NOT.RIGHT_MESS) THEN

5381

5478

CALL MPI_PROBE(MSGSOU,MSGTAG,

5382

* COMM, STATUS_BIS, IERR)

5479

& COMM, STATUS_BIS, IERR)

5383

5480

ENDIF

5384

5481

ENDIF

5385

5482

ELSE

5386

5483

CALL MPI_TEST(ASS_IRECV,

5387

* FLAG, STATUS, IERR)

5484

& FLAG, STATUS, IERR)

5388

5485

ENDIF

5389

5486

IF (IERR.LT.0) THEN

5390

5487

IFLAG = -20

5401

5498

CALL MPI_GET_COUNT( STATUS, MPI_PACKED, MSGLEN_LOC, IERR )

5402

5499

IF (.NOT.RIGHT_MESS) RECURS = RECURS + 10

5403

5500

CALL DMUMPS_322( COMM_LOAD, ASS_IRECV,

5404

* MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC, BUFR, LBUFR,

5405

* LBUFR_BYTES,

5406

* PROCNODE_STEPS, POSFAC,

5407

* IWPOS, IWPOSCB, IPTRLU,

5408

* LRLU, LRLUS, N, IW, LIW, A, LA,

5409

* PTRIST, PTLUST_S, PTRFAC,

5410

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

5411

* IERROR, COMM,

5412

* NBPROCFILS,

5413

* IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

5414

*

5415

* root, OPASSW, OPELIW, ITLOC, FILS,

5416

* PTRARW, PTRAIW,

5417

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5418

* LPTRAR, NELT, FRTPTR, FRTELT,

5419

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5501

& MSGSOU_LOC, MSGTAG_LOC, MSGLEN_LOC, BUFR, LBUFR,

5502

& LBUFR_BYTES,

5503

& PROCNODE_STEPS, POSFAC,

5504

& IWPOS, IWPOSCB, IPTRLU,

5505

& LRLU, LRLUS, N, IW, LIW, A, LA,

5506

& PTRIST, PTLUST_S, PTRFAC,

5507

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

5508

& IERROR, COMM,

5509

& NBPROCFILS,

5510

& IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

5511

&

5512

& root, OPASSW, OPELIW, ITLOC, FILS,

5513

& PTRARW, PTRAIW,

5514

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5515

& LPTRAR, NELT, FRTPTR, FRTELT,

5516

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5420

5517

IF (.NOT.RIGHT_MESS) RECURS = RECURS - 10

5421

5518

IF ( IFLAG .LT. 0 ) RETURN

5422

5519

IF (.NOT.RIGHT_MESS) THEN

5423

5520

IF (ASS_IRECV .NE. MPI_REQUEST_NULL) THEN

5424

stop

5521

CALL MUMPS_ABORT()

5425

5522

ENDIF

5426

5523

CALL MPI_IPROBE(MSGSOU,MSGTAG,

5427

* COMM, FLAGbis, STATUS, IERR)

5524

& COMM, FLAGbis, STATUS, IERR)

5428

5525

IF (FLAGbis) THEN

5429

5526

MSGSOU_LOC = STATUS( MPI_SOURCE )

5430

5527

MSGTAG_LOC = STATUS( MPI_TAG )

5431

5528

CALL DMUMPS_280( COMM_LOAD, ASS_IRECV,

5432

* STATUS, BUFR, LBUFR,

5433

* LBUFR_BYTES,

5434

* PROCNODE_STEPS, POSFAC,

5435

* IWPOS, IWPOSCB, IPTRLU,

5436

* LRLU, LRLUS, N, IW, LIW, A, LA,

5437

* PTRIST, PTLUST_S, PTRFAC,

5438

* PTRAST, STEP, PIMASTER, PAMASTER,

5439

* NSTK_S, COMP, IFLAG,

5440

* IERROR, COMM,

5441

* NBPROCFILS,

5442

* IPOOL, LPOOL, LEAF,

5443

* NBFIN, MYID, SLAVEF,

5444

*

5445

* root, OPASSW, OPELIW, ITLOC,

5446

* FILS, PTRARW, PTRAIW,

5447

* INTARR, DBLARR, ICNTL,

5448

* KEEP,KEEP8, ND, FRERE,

5449

* LPTRAR, NELT, FRTPTR, FRTELT,

5450

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5529

& STATUS, BUFR, LBUFR,

5530

& LBUFR_BYTES,

5531

& PROCNODE_STEPS, POSFAC,

5532

& IWPOS, IWPOSCB, IPTRLU,

5533

& LRLU, LRLUS, N, IW, LIW, A, LA,

5534

& PTRIST, PTLUST_S, PTRFAC,

5535

& PTRAST, STEP, PIMASTER, PAMASTER,

5536

& NSTK_S, COMP, IFLAG,

5537

& IERROR, COMM,

5538

& NBPROCFILS,

5539

& IPOOL, LPOOL, LEAF,

5540

& NBFIN, MYID, SLAVEF,

5541

&

5542

& root, OPASSW, OPELIW, ITLOC,

5543

& FILS, PTRARW, PTRAIW,

5544

& INTARR, DBLARR, ICNTL,

5545

& KEEP,KEEP8, ND, FRERE,

5546

& LPTRAR, NELT, FRTPTR, FRTELT,

5547

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5451

5548

IF ( IFLAG .LT. 0 ) RETURN

5452

5549

ENDIF

5453

5550

ENDIF

5455

5552

ELSE

5456

5553

IF (BLOCKING) THEN

5457

5554

CALL MPI_PROBE(MSGSOU,MSGTAG,

5458

* COMM, STATUS, IERR)

5555

& COMM, STATUS, IERR)

5459

5556

FLAG = .TRUE.

5460

5557

ELSE

5461

5558

CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG,

5462

* COMM, FLAG, STATUS, IERR)

5559

& COMM, FLAG, STATUS, IERR)

5463

5560

ENDIF

5464

5561

IF (FLAG) THEN

5465

5562

MSGSOU_LOC = STATUS( MPI_SOURCE )

5466

5563

MSGTAG_LOC = STATUS( MPI_TAG )

5467

5564

MESSAGE_RECEIVED = .TRUE.

5468

5565

CALL DMUMPS_280( COMM_LOAD, ASS_IRECV,

5469

* STATUS, BUFR, LBUFR,

5470

* LBUFR_BYTES,

5471

* PROCNODE_STEPS, POSFAC,

5472

* IWPOS, IWPOSCB, IPTRLU,

5473

* LRLU, LRLUS, N, IW, LIW, A, LA,

5474

* PTRIST, PTLUST_S, PTRFAC,

5475

* PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

5476

* IERROR, COMM,

5477

* NBPROCFILS,

5478

* IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

5479

*

5480

* root, OPASSW, OPELIW, ITLOC,

5481

* FILS, PTRARW, PTRAIW,

5482

* INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5483

* LPTRAR, NELT, FRTPTR, FRTELT,

5484

* ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5566

& STATUS, BUFR, LBUFR,

5567

& LBUFR_BYTES,

5568

& PROCNODE_STEPS, POSFAC,

5569

& IWPOS, IWPOSCB, IPTRLU,

5570

& LRLU, LRLUS, N, IW, LIW, A, LA,

5571

& PTRIST, PTLUST_S, PTRFAC,

5572

& PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP, IFLAG,

5573

& IERROR, COMM,

5574

& NBPROCFILS,

5575

& IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,

5576

&

5577

& root, OPASSW, OPELIW, ITLOC,

5578

& FILS, PTRARW, PTRAIW,

5579

& INTARR, DBLARR, ICNTL, KEEP,KEEP8, ND, FRERE,

5580

& LPTRAR, NELT, FRTPTR, FRTELT,

5581

& ISTEP_TO_INIV2, TAB_POS_IN_PERE )

5485

5582

IF ( IFLAG .LT. 0 ) RETURN

5486

5583

ENDIF

5487

5584

ENDIF

5490

5587

IF ( NBFIN .EQ. 0 ) RETURN

5491

5588

IF ( RECURS .GT. 3 ) RETURN

5492

5589

IF ( KEEP(36).EQ.1 .AND. SET_IRECV .AND.

5493

* (ASS_IRECV.EQ.MPI_REQUEST_NULL) .AND.

5494

* MESSAGE_RECEIVED ) THEN

5590

& (ASS_IRECV.EQ.MPI_REQUEST_NULL) .AND.

5591

& MESSAGE_RECEIVED ) THEN

5495

5592

CALL MPI_IRECV ( BUFR(1),

5496

* LBUFR_BYTES, MPI_PACKED, MPI_ANY_SOURCE,

5497

* MPI_ANY_TAG, COMM,

5498

* ASS_IRECV, IERR )

5593

& LBUFR_BYTES, MPI_PACKED, MPI_ANY_SOURCE,

5594

& MPI_ANY_TAG, COMM,

5595

& ASS_IRECV, IERR )

5499

5596

ENDIF

5500

5597

RETURN

5501

5598

END SUBROUTINE DMUMPS_329

5502

5599

SUBROUTINE DMUMPS_255( INFO1,

5503

* ASS_IRECV,

5504

* BUFR, LBUFR, LBUFR_BYTES,

5505

* COMM,

5506

* MYID, SLAVEF)

5600

& ASS_IRECV,

5601

& BUFR, LBUFR, LBUFR_BYTES,

5602

& COMM,

5603

& MYID, SLAVEF)

5507

5604

USE DMUMPS_COMM_BUFFER

5508

5605

IMPLICIT NONE

5509

5606

INCLUDE 'mpif.h'

5523

5620

NO_ACTIVE_IRECV=.TRUE.

5524

5621

ELSE

5525

5622

CALL MPI_TEST(ASS_IRECV, NO_ACTIVE_IRECV,

5526

* STATUS, IERR)

5623

& STATUS, IERR)

5527

5624

ENDIF

5528

5625

CALL MPI_BARRIER(COMM,IERR)

5529

5626

DUMMY = 1

5530

5627

DEST = mod(MYID+1, SLAVEF)

5531

5628

CALL DMUMPS_62

5532

* (DUMMY, DEST, TAG_DUMMY, COMM, IERR)

5629

& (DUMMY, DEST, TAG_DUMMY, COMM, IERR)

5533

5630

IF (NO_ACTIVE_IRECV) THEN

5534

5631

CALL MPI_RECV( BUFR, LBUFR,

5535

* MPI_INTEGER, MPI_ANY_SOURCE,

5536

* TAG_DUMMY, COMM, STATUS, IERR )

5632

& MPI_INTEGER, MPI_ANY_SOURCE,

5633

& TAG_DUMMY, COMM, STATUS, IERR )

5537

5634

ELSE

5538

5635

CALL MPI_WAIT(ASS_IRECV,

5539

* STATUS, IERR)

5636

& STATUS, IERR)

5540

5637

ENDIF

5541

5638

RETURN

5542

5639

END SUBROUTINE DMUMPS_255

5543

5640

SUBROUTINE DMUMPS_180(

5544

* INFO1, BUFR, LBUFR, LBUFR_BYTES,

5545

* COMM_NODES, COMM_LOAD, SLAVEF, MP )

5641

& INFO1, BUFR, LBUFR, LBUFR_BYTES,

5642

& COMM_NODES, COMM_LOAD, SLAVEF, MP )

5546

5643

USE DMUMPS_COMM_BUFFER

5547

5644

IMPLICIT NONE

5548

5645

INCLUDE 'mpif.h'

5562

5659

DO WHILE ( FLAG )

5563

5660

COMM_EFF = COMM_NODES

5564

5661

CALL MPI_IPROBE(MPI_ANY_SOURCE,MPI_ANY_TAG,

5565

* COMM_NODES, FLAG, STATUS, IERR)

5662

& COMM_NODES, FLAG, STATUS, IERR)

5566

5663

IF ( .NOT. FLAG ) THEN

5567

5664

COMM_EFF = COMM_LOAD

5568

5665

CALL MPI_IPROBE( MPI_ANY_SOURCE, MPI_ANY_TAG,

5569

* COMM_LOAD, FLAG, STATUS, IERR)

5666

& COMM_LOAD, FLAG, STATUS, IERR)

5570

5667

END IF

5571

5668

IF (FLAG) THEN

5572

5669

MSGSOU_LOC = STATUS( MPI_SOURCE )

5573

5670

MSGTAG_LOC = STATUS( MPI_TAG )

5574

5671

CALL MPI_RECV( BUFR, LBUFR_BYTES,

5575

* MPI_PACKED, MSGSOU_LOC,

5576

* MSGTAG_LOC, COMM_EFF, STATUS, IERR )

5672

& MPI_PACKED, MSGSOU_LOC,

5673

& MSGTAG_LOC, COMM_EFF, STATUS, IERR )

5577

5674

ENDIF

5578

5675

END DO

5579

5676

IF (BUFFERS_EMPTY_ON_ALL_PROCS) THEN

5586

5683

IBUF_EMPTY = 1

5587

5684

ENDIF

5588

5685

CALL MPI_ALLREDUCE(IBUF_EMPTY,

5589

* IBUF_EMPTY_ON_ALL_PROCS,

5590

* 1, MPI_INTEGER, MPI_MAX,

5591

* COMM_NODES, IERR)

5686

& IBUF_EMPTY_ON_ALL_PROCS,

5687

& 1, MPI_INTEGER, MPI_MAX,

5688

& COMM_NODES, IERR)

5592

5689

IF ( IBUF_EMPTY_ON_ALL_PROCS == 0) THEN

5593

5690

BUFFERS_EMPTY_ON_ALL_PROCS = .TRUE.

5594

5691

ELSE

5596

5693

ENDIF

5597

5694

GOTO 10

5598

5695

END SUBROUTINE DMUMPS_180

5599

INTEGER FUNCTION DMUMPS_OOC_GET_PANEL_SIZE

5600

* ( HBUF_SIZE, NNMAX, K227, K50 )

5696

INTEGER FUNCTION DMUMPS_748

5697

& ( HBUF_SIZE, NNMAX, K227, K50 )

5601

5698

IMPLICIT NONE

5602

INTEGER, INTENT(IN) :: NNMAX, K227, K50, HBUF_SIZE

5699

INTEGER, INTENT(IN) :: NNMAX, K227, K50

5700

INTEGER(8), INTENT(IN) :: HBUF_SIZE

5603

5701

INTEGER K227_LOC

5702

INTEGER NBCOL_MAX

5604

5703

INTEGER EFFECTIVE_SIZE

5704

NBCOL_MAX=int(HBUF_SIZE / int(NNMAX,8))

5605

5705

K227_LOC = abs(K227)

5606

5706

IF (K50.EQ.2) THEN

5607

5707

K227_LOC=max(K227_LOC,2)

5608

EFFECTIVE_SIZE = min((HBUF_SIZE/NNMAX)-1, (K227_LOC-1))

5708

EFFECTIVE_SIZE = min(NBCOL_MAX-1, K227_LOC-1)

5609

5709

ELSE

5610

EFFECTIVE_SIZE = min(HBUF_SIZE/NNMAX, K227_LOC)

5710

EFFECTIVE_SIZE = min(NBCOL_MAX, K227_LOC)

5611

5711

ENDIF

5612

IF (EFFECTIVE_SIZE.EQ.0) THEN

5712

IF (EFFECTIVE_SIZE.LE.0) THEN

5613

5713

write(6,*) 'Internal buffers too small to store ',

5614

5714

& ' ONE col/row of size', NNMAX

5615

5715

CALL MUMPS_ABORT()

5616

5716

ENDIF

5617

DMUMPS_OOC_GET_PANEL_SIZE = EFFECTIVE_SIZE

5717

DMUMPS_748 = EFFECTIVE_SIZE

5618

5718

RETURN

5619

END FUNCTION DMUMPS_OOC_GET_PANEL_SIZE

5719

END FUNCTION DMUMPS_748

5620

5720

SUBROUTINE DMUMPS_698( IPIV, LPIV, ISHIFT,

5621

* THE_PANEL, NBROW, NBCOL, KbeforePanel )

5721

& THE_PANEL, NBROW, NBCOL, KbeforePanel )

5622

5722

IMPLICIT NONE

5623

5723

INTEGER LPIV, ISHIFT, NBROW, NBCOL, KbeforePanel

5624

5724

INTEGER IPIV(LPIV)

5628

5728

IPERM=IPIV(I)

5629

5729

IF ( I+ISHIFT.NE.IPERM) THEN

5630

5730

CALL DSWAP(NBCOL,

5631

* THE_PANEL(I+ISHIFT-KbeforePanel,1), NBROW,

5632

* THE_PANEL(IPERM-KbeforePanel,1), NBROW)

5731

& THE_PANEL(I+ISHIFT-KbeforePanel,1), NBROW,

5732

& THE_PANEL(IPERM-KbeforePanel,1), NBROW)

5633

5733

ENDIF

5634

5734

END DO

5635

5735

RETURN

5636

5736

END SUBROUTINE DMUMPS_698

5637

5737

SUBROUTINE DMUMPS_667(TYPEF,

5638

* NBPANELS,

5639

* I_PIVPTR, I_PIV, IPOS, IW, LIW)

5738

& NBPANELS,

5739

& I_PIVPTR, I_PIV, IPOS, IW, LIW)

5640

5740

IMPLICIT NONE

5641

5741

INCLUDE 'mumps_headers.h'

5642

5742

INTEGER, intent(out) :: NBPANELS, I_PIVPTR, I_PIV

5658

5758

RETURN

5659

5759

END SUBROUTINE DMUMPS_667

5660

5760

SUBROUTINE DMUMPS_691(K50,NBPANELS_L,NBPANELS_U,

5661

* NASS, IPOS, IW, LIW )

5761

& NASS, IPOS, IW, LIW )

5662

5762

IMPLICIT NONE

5663

5763

INTEGER K50

5664

5764

INTEGER IPOS, NASS, NBPANELS_L, NBPANELS_U, LIW

5684

5784

IMPLICIT NONE

5685

5785

INCLUDE 'mumps_headers.h'

5686

5786

INTEGER, INTENT(IN) :: IOLDPS, LIW, NFRONT,

5687

* KEEP(500)

5787

& KEEP(500)

5688

5788

INTEGER, INTENT(INOUT) :: IWPOS, IW(LIW)

5689

5789

TYPE(IO_BLOCK), INTENT(IN):: MonBloc

5690

5790

INTEGER :: LREQ_OOC

5691

5791

INTEGER :: NBPANELS_L,I_PIVRPTR_L, I_PIVR_L, NBPANELS_U,

5692

* I_PIVRPTR_U, I_PIVR_U, XSIZE, IBEGOOC

5792

& I_PIVRPTR_U, I_PIVR_U, XSIZE, IBEGOOC

5693

5793

LOGICAL FREESPACE

5694

5794

IF (KEEP(50).EQ.1) RETURN

5695

5795

IF ((IOLDPS+IW(IOLDPS+XXI)).NE.IWPOS) RETURN

5696

5796

XSIZE = KEEP(IXSZ)

5697

5797

IBEGOOC = IOLDPS+2*NFRONT+6+IW(IOLDPS+5+XSIZE)+XSIZE

5698

5798

CALL DMUMPS_667(TYPEF_L, NBPANELS_L,

5699

* I_PIVRPTR_L, I_PIVR_L,

5700

* IBEGOOC, IW, LIW)

5799

& I_PIVRPTR_L, I_PIVR_L,

5800

& IBEGOOC, IW, LIW)

5701

5801

FREESPACE =

5702

5802

& (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_L)-1))

5703

5803

IF (KEEP(50).EQ.0) THEN

5704

5804

CALL DMUMPS_667(TYPEF_U, NBPANELS_U,

5705

* I_PIVRPTR_U, I_PIVR_U,

5706

* IBEGOOC, IW, LIW)

5805

& I_PIVRPTR_U, I_PIVR_U,

5806

& IBEGOOC, IW, LIW)

5707

5807

FREESPACE = FREESPACE .AND.

5708

5808

& (MonBloc%LastPiv.EQ.(IW(I_PIVRPTR_U)-1))

5709

5809

ENDIF

5715

5815

RETURN

5716

5816

END SUBROUTINE DMUMPS_644

5717

5817

SUBROUTINE DMUMPS_684(K50, NBROW_L, NBCOL_U, NASS,

5718

* NBPANELS_L, NBPANELS_U, LREQ)

5818

& NBPANELS_L, NBPANELS_U, LREQ)

5719

5819

USE DMUMPS_OOC

5720

5820

IMPLICIT NONE

5721

5821

INTEGER, intent(IN) :: K50, NBROW_L, NBCOL_U, NASS

5726

5826

LREQ = 0

5727

5827

RETURN

5728

5828

ENDIF

5729

NBPANELS_L = (NASS / DMUMPS_OOC_PANEL_SIZE(NBROW_L))+1

5829

NBPANELS_L = (NASS / DMUMPS_690(NBROW_L))+1

5730

5830

LREQ = 1

5731

* + 1

5732

* + NASS

5733

* + NBPANELS_L

5831

& + 1

5832

& + NASS

5833

& + NBPANELS_L

5734

5834

IF (K50.eq.0) THEN

5735

NBPANELS_U = (NASS / DMUMPS_OOC_PANEL_SIZE(NBCOL_U) ) +1

5835

NBPANELS_U = (NASS / DMUMPS_690(NBCOL_U) ) +1

5736

5836

LREQ = LREQ + 1

5737

* + NASS

5738

* + NBPANELS_U

5837

& + NASS

5838

& + NBPANELS_U

5739

5839

ENDIF

5740

5840

RETURN

5741

5841

END SUBROUTINE DMUMPS_684

5842

SUBROUTINE DMUMPS_755

5843

& (IW_LOCATION, MUST_BE_PERMUTED)

5844

IMPLICIT NONE

5845

INTEGER, INTENT(IN) :: IW_LOCATION

5846

LOGICAL, INTENT(INOUT) :: MUST_BE_PERMUTED

5847

IF (IW_LOCATION .EQ. -7777) THEN

5848

MUST_BE_PERMUTED = .FALSE.

5849

ENDIF

5850

RETURN

5851

END SUBROUTINE DMUMPS_755