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