1C 2C This file is part of MUMPS 5.1.2, released 3C on Mon Oct 2 07:37:01 UTC 2017 4C 5C 6C Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria, 7C University of Bordeaux. 8C 9C This version of MUMPS is provided to you free of charge. It is 10C released under the CeCILL-C license: 11C http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html 12C 13 SUBROUTINE CMUMPS_FAC_B(N, NSTEPS, 14 & A, LA, IW, LIW, SYM_PERM, NA, LNA, 15 & NE_STEPS, NFSIZ, FILS, 16 & STEP, FRERE, DAD, CAND, 17 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 18 & PTRAR, LDPTRAR, 19 & PTRIST, PTLUST_S, PTRFAC, IW1, IW2, ITLOC, RHS_MUMPS, 20 & POOL, LPOOL, 21 & CNTL1, ICNTL, INFO, RINFO, KEEP,KEEP8,PROCNODE_STEPS, 22 & SLAVEF, 23 & COMM_NODES, MYID, MYID_NODES, 24 & BUFR,LBUFR,LBUFR_BYTES,INTARR,DBLARR, 25 & root, NELT, FRTPTR, FRTELT, COMM_LOAD, 26 & ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, 27 & MEM_DISTRIB, 28 & DKEEP,PIVNUL_LIST,LPN_LIST 29 & ,LRGROUPS 30 & ) 31 USE CMUMPS_LOAD 32 USE CMUMPS_FAC_PAR_M 33 IMPLICIT NONE 34 INCLUDE 'mpif.h' 35 INCLUDE 'cmumps_root.h' 36 TYPE (CMUMPS_ROOT_STRUC) :: root 37 INTEGER(8) :: LA 38 INTEGER N,NSTEPS,LIW,LPOOL,SLAVEF,COMM_NODES 39 INTEGER MYID, MYID_NODES,LNA 40 COMPLEX A(LA) 41 REAL RINFO(40) 42 INTEGER LBUFR, LBUFR_BYTES 43 INTEGER, DIMENSION(0:SLAVEF - 1) :: MEM_DISTRIB 44 INTEGER BUFR( LBUFR ) 45 INTEGER NELT, LDPTRAR 46 INTEGER FRTPTR(*), FRTELT(*) 47 INTEGER LRGROUPS(N) 48 REAL CNTL1 49 INTEGER ICNTL(40) 50 INTEGER INFO(40), KEEP(500) 51 INTEGER(8) KEEP8(150) 52 INTEGER IW(LIW), SYM_PERM(N), NA(LNA), 53 & NE_STEPS(KEEP(28)), FILS(N), 54 & FRERE(KEEP(28)), NFSIZ(KEEP(28)), 55 & DAD(KEEP(28)) 56 INTEGER CAND(SLAVEF+1, max(1,KEEP(56))) 57 INTEGER STEP(N) 58 INTEGER(8), INTENT(IN) :: PTRAR(LDPTRAR,2) 59 INTEGER(8) :: PTRFAC(KEEP(28)) 60 INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28)) 61 INTEGER IW1(3*KEEP(28)), ITLOC(N+KEEP(253)), POOL(LPOOL) 62 COMPLEX :: RHS_MUMPS(KEEP(255)) 63 INTEGER(8) :: IW2(2*KEEP(28)) 64 INTEGER PROCNODE_STEPS(KEEP(28)) 65 INTEGER COMM_LOAD, ASS_IRECV 66 INTEGER ISTEP_TO_INIV2(KEEP(71)), 67 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56))) 68 COMPLEX DBLARR(KEEP8(26)) 69 INTEGER INTARR(KEEP8(27)) 70 REAL SEUIL, SEUIL_LDLT_NIV2 71 INTEGER LPN_LIST 72 INTEGER PIVNUL_LIST(LPN_LIST) 73 REAL DKEEP(230) 74 INTEGER MUMPS_PROCNODE 75 EXTERNAL MUMPS_PROCNODE 76 REAL UULOC 77 INTEGER LP, MPRINT 78 INTEGER NSTK,PTRAST, NBPROCFILS 79 INTEGER PIMASTER, PAMASTER 80 LOGICAL PROK 81 REAL ZERO, ONE 82 DATA ZERO /0.0E0/ 83 DATA ONE /1.0E0/ 84 INTRINSIC int,real,log 85 INTEGER IERR 86 INTEGER NTOTPV, NTOTPVTOT, NMAXNPIV 87 INTEGER(8) :: POSFAC, LRLU, IPTRLU, LRLUS 88 INTEGER IWPOS, LEAF, NBROOT, NROOT 89 KEEP(41)=0 90 KEEP(42)=0 91 NSTEPS = 0 92 LP = ICNTL(1) 93 MPRINT = ICNTL(2) 94 PROK = ((MPRINT.GT.0).AND.(ICNTL(4).GE.2)) 95 UULOC = CNTL1 96 IF (UULOC.GT.ONE) UULOC=ONE 97 IF (UULOC.LT.ZERO) UULOC=ZERO 98 IF (KEEP(50).NE.0.AND.UULOC.GT.0.5E0) THEN 99 UULOC = 0.5E0 100 ENDIF 101 PIMASTER = 1 102 NSTK = PIMASTER + KEEP(28) 103 NBPROCFILS = NSTK + KEEP(28) 104 PTRAST = 1 105 PAMASTER = 1 + KEEP(28) 106 IF (KEEP(4).LE.0) KEEP(4)=32 107 IF (KEEP(5).LE.0) KEEP(5)=16 108 IF (KEEP(5).GT.KEEP(4)) KEEP(5) = KEEP(4) 109 IF (KEEP(6).LE.0) KEEP(6)=24 110 IF (KEEP(3).LE.KEEP(4)) KEEP(3)=KEEP(4)*2 111 IF (KEEP(6).GT.KEEP(3)) KEEP(6) = KEEP(3) 112 POSFAC = 1_8 113 IWPOS = 1 114 LRLU = LA 115 LRLUS = LRLU 116 KEEP8(67) = LRLUS 117 KEEP8(68) = LRLUS 118 KEEP8(69) = LRLUS 119 KEEP8(70) = LRLUS 120 KEEP8(71) = LRLUS 121 IPTRLU = LRLU 122 NTOTPV = 0 123 NMAXNPIV = 0 124 IW1(NSTK:NSTK+KEEP(28)-1) = NE_STEPS(1:KEEP(28)) 125 CALL MUMPS_INIT_NROOT_DIST(N, NBROOT, NROOT, 126 & MYID_NODES, 127 & SLAVEF, NA, LNA, 128 & KEEP, STEP, 129 & PROCNODE_STEPS) 130 CALL MUMPS_INIT_POOL_DIST(N, LEAF, 131 & MYID_NODES, 132 & SLAVEF, NA, LNA, 133 & KEEP,KEEP8, STEP, 134 & PROCNODE_STEPS, 135 & POOL, LPOOL) 136 CALL CMUMPS_INIT_POOL_LAST3(POOL, LPOOL, LEAF) 137 CALL CMUMPS_LOAD_INIT_SBTR_STRUCT(POOL, LPOOL,KEEP,KEEP8) 138 IF ( KEEP( 38 ) .NE. 0 ) THEN 139 NBROOT = NBROOT + root%NPROW * root%NPCOL - 1 140 END IF 141 IF ( root%yes ) THEN 142 IF ( MUMPS_PROCNODE( PROCNODE_STEPS(STEP(KEEP(38))), SLAVEF ) 143 & .NE. MYID_NODES ) THEN 144 NROOT = NROOT + 1 145 END IF 146 END IF 147 CALL CMUMPS_FAC_PAR(N,IW,LIW,A,LA,IW1(NSTK),IW1(NBPROCFILS), 148 & NFSIZ,FILS,STEP,FRERE, DAD, CAND, 149 & ISTEP_TO_INIV2, TAB_POS_IN_PERE, 150 & INFO(11), NTOTPV, NMAXNPIV, PTRIST,IW2(PTRAST), 151 & IW1(PIMASTER), IW2(PAMASTER), PTRAR(1,2), 152 & PTRAR(1,1), 153 & ITLOC, RHS_MUMPS, 154 & POOL, LPOOL, 155 & RINFO, POSFAC,IWPOS,LRLU,IPTRLU, 156 & LRLUS, LEAF, NROOT, NBROOT, 157 & UULOC,ICNTL,PTLUST_S,PTRFAC,NSTEPS,INFO, 158 & KEEP,KEEP8, 159 & PROCNODE_STEPS,SLAVEF,MYID,COMM_NODES, 160 & MYID_NODES, BUFR,LBUFR, LBUFR_BYTES, 161 & INTARR, DBLARR, root, SYM_PERM, 162 & NELT, FRTPTR, FRTELT, LDPTRAR, 163 & COMM_LOAD, ASS_IRECV, SEUIL, SEUIL_LDLT_NIV2, 164 & MEM_DISTRIB,NE_STEPS, 165 & DKEEP(1),PIVNUL_LIST(1),LPN_LIST 166 & ,LRGROUPS(1) 167 & ) 168 POSFAC = POSFAC -1_8 169 IWPOS = IWPOS -1 170 IF (KEEP(201).LE.0) THEN 171 IF (KEEP(201) .EQ. -1 .AND. INFO(1) .LT. 0) THEN 172 POSFAC = 0_8 173 ENDIF 174 KEEP8(31) = POSFAC 175 ENDIF 176 KEEP(32) = IWPOS 177 CALL MUMPS_SETI8TOI4(KEEP8(31), INFO(9)) 178 INFO(10) = KEEP(32) 179 KEEP8(67) = LA - KEEP8(67) 180 KEEP8(68) = LA - KEEP8(68) 181 KEEP8(69) = LA - KEEP8(69) 182 KEEP(89) = NTOTPV 183 KEEP(246) = NMAXNPIV 184 INFO(23) = KEEP(89) 185 CALL MPI_ALLREDUCE(NTOTPV, NTOTPVTOT, 1, MPI_INTEGER, MPI_SUM, 186 & COMM_NODES, IERR) 187 IF ( ( (INFO(1).EQ.-10 .OR. INFO(1).EQ.-40) 188 & .AND. (NTOTPVTOT.EQ.N) ) 189 & .OR. ( NTOTPVTOT.GT.N ) ) THEN 190 write(*,*) ' Error 1 in mc51d NTOTPVTOT=', NTOTPVTOT,N 191 CALL MUMPS_ABORT() 192 ENDIF 193 IF ( (KEEP(19).NE.0 ) .AND. (NTOTPVTOT.NE.N) .AND. 194 & (INFO(1).GE.0) ) THEN 195 write(*,*) ' Error 2 in mc51d NTOTPVTOT=', NTOTPVTOT 196 CALL MUMPS_ABORT() 197 ENDIF 198 IF ( (INFO(1) .GE. 0 ) 199 & .AND. (NTOTPVTOT.NE.N) ) THEN 200 INFO(1) = -10 201 INFO(2) = NTOTPVTOT 202 ENDIF 203 IF (PROK) THEN 204 WRITE (MPRINT,99980) INFO(1), INFO(2), 205 & KEEP(28), KEEP8(31), INFO(10), INFO(11) 206 IF(KEEP(50) .EQ. 0) THEN 207 WRITE(MPRINT,99982) INFO(12) 208 ENDIF 209 WRITE (MPRINT, 99986) 210 & INFO(13), INFO(14), INFO(25), RINFO(2), RINFO(3) 211 ENDIF 212 RETURN 21399980 FORMAT (/' LEAVING FACTORIZATION PHASE WITH ...'/ 214 & ' INFO (1) =',I15/ 215 & ' --- (2) =',I15/ 216 & ' NUMBER OF NODES IN THE TREE =',I15/ 217 & ' INFO (9) REAL SPACE FOR FACTORS =',I15/ 218 & ' --- (10) INTEGER SPACE FOR FACTORS =',I15/ 219 & ' --- (11) MAXIMUM SIZE OF FRONTAL MATRICES =',I15) 22099982 FORMAT (' --- (12) NUMBER OF OFF DIAGONAL PIVOTS =',I15) 22199986 FORMAT (' --- (13) NUMBER OF DELAYED PIVOTS =',I15/ 222 & ' --- (14) NUMBER OF MEMORY COMPRESSES =',I15/ 223 & ' --- (25) NUMBER OF ENTRIES IN FACTORS =',I15/ 224 & ' RINFO(2) OPERATIONS DURING NODE ASSEMBLY =',1PD10.3/ 225 & ' -----(3) OPERATIONS DURING NODE ELIMINATION =',1PD10.3) 226 END SUBROUTINE CMUMPS_FAC_B 227