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      RECURSIVE SUBROUTINE DMUMPS_END_FACTO_SLAVE(
14     &    COMM_LOAD, ASS_IRECV,
15     &    N, INODE, FPERE,
16     &    root,
17     &    MYID, COMM,
18     &
19     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
20     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
21     &    PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER,
22     &    PAMASTER,
23     &    NSTK, COMP, IFLAG, IERROR, NBPROCFILS,
24     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
25     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW,
26     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
27     &    LPTRAR, NELT, FRTPTR, FRTELT,
28     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE
29     &               , LRGROUPS
30     &    )
31      USE DMUMPS_LOAD
32#if ! defined(NO_FDM_MAPROW)
33      USE MUMPS_FAC_MAPROW_DATA_M
34#endif
35      USE DMUMPS_LR_DATA_M
36      IMPLICIT NONE
37      INCLUDE 'dmumps_root.h'
38      INCLUDE 'mumps_headers.h'
39      INCLUDE 'mpif.h'
40      INCLUDE 'mumps_tags.h'
41      INTEGER INODE, FPERE
42      TYPE (DMUMPS_ROOT_STRUC) :: root
43      INTEGER COMM, MYID
44      INTEGER ICNTL( 40 ), KEEP( 500 )
45      INTEGER(8) KEEP8(150)
46      DOUBLE PRECISION    DKEEP(230)
47      INTEGER COMM_LOAD, ASS_IRECV
48      INTEGER N
49      INTEGER LBUFR, LBUFR_BYTES
50      INTEGER BUFR( LBUFR )
51      INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA
52      INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)),
53     &        NSTK(KEEP(28)), PTLUST_S(KEEP(28))
54      INTEGER IWPOS, IWPOSCB
55      INTEGER LIW
56      INTEGER IW( LIW )
57      DOUBLE PRECISION A( LA )
58      INTEGER, intent(in) :: LRGROUPS(N)
59      INTEGER LPTRAR, NELT
60      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
61      INTEGER(8) :: PTRAST(KEEP(28))
62      INTEGER(8) :: PTRFAC(KEEP(28))
63      INTEGER(8) :: PAMASTER(KEEP(28))
64      INTEGER STEP(N), PIMASTER(KEEP(28))
65      INTEGER COMP, IFLAG, IERROR
66      INTEGER NBPROCFILS( KEEP(28) )
67      INTEGER LPOOL, LEAF
68      INTEGER IPOOL( LPOOL )
69      INTEGER NBFIN, SLAVEF
70      DOUBLE PRECISION OPASSW, OPELIW
71      INTEGER ITLOC( N + KEEP(253) ), FILS( N )
72      DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
73      INTEGER ND( KEEP(28) )
74      INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
75      INTEGER FRERE(KEEP(28))
76      INTEGER INTARR( KEEP8(27) )
77      DOUBLE PRECISION DBLARR( KEEP8(26) )
78      INTEGER ISTEP_TO_INIV2(KEEP(71)),
79     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
80      INTEGER MRS_INODE
81      INTEGER MRS_ISON
82      INTEGER MRS_NSLAVES_PERE
83      INTEGER MRS_NASS_PERE
84      INTEGER MRS_NFRONT_PERE
85      INTEGER MRS_LMAP
86      INTEGER MRS_NFS4FATHER
87      INTEGER, POINTER, DIMENSION(:) :: MRS_SLAVES_PERE, MRS_TROW
88      INTEGER ITYPE2
89      INTEGER IHDR_REC
90      PARAMETER (ITYPE2=2)
91      INTEGER IOLDPS, NROW, LDA
92      INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND,
93     &        SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON
94      INTEGER(8) :: SHIFT_VAL_SON
95      INTEGER(8) MEM_GAIN
96#if ! defined(NO_FDM_MAPROW)
97      TYPE(MAPROW_STRUC_T), POINTER :: MRS
98#endif
99      INTEGER :: IWHANDLER_SAVE
100        IF (KEEP(50).EQ.0) THEN
101          IHDR_REC=6
102        ELSE
103          IHDR_REC=8
104        ENDIF
105        IOLDPS = PTRIST(STEP(INODE))
106        IWHANDLER_SAVE = IW(IOLDPS+XXA)
107        CALL DMUMPS_BLR_END_FRONT( IW(IOLDPS+XXF), IFLAG, KEEP8, .TRUE.)
108        IW(IOLDPS+XXS)=S_ALL
109         IF (KEEP(214).EQ.1) THEN
110          CALL DMUMPS_STACK_BAND( N, INODE,
111     &    PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
112     &    LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
113     &    IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
114     &    IFLAG, IERROR, SLAVEF, MYID, COMM,
115     &    KEEP,KEEP8, DKEEP, ITYPE2
116     &     )
117          IOLDPS = PTRIST(STEP(INODE))
118          IF (KEEP(38).NE.FPERE) THEN
119            IW(IOLDPS+XXS)=S_NOLCBNOCONTIG
120            IF (KEEP(216).NE.3) THEN
121             MEM_GAIN=int(IW( IOLDPS + 2 + KEEP(IXSZ) ),8)*
122     &                int(IW( IOLDPS + 3 + KEEP(IXSZ) ),8)
123             LRLUS = LRLUS+MEM_GAIN
124             KEEP8(70) = KEEP8(70) + MEM_GAIN
125             KEEP8(71) = KEEP8(71) + MEM_GAIN
126             CALL DMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,
127     &              LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLUS)
128            ENDIF
129          ENDIF
130          IF (KEEP(216).EQ.2) THEN
131           IF (FPERE.NE.KEEP(38)) THEN
132           CALL DMUMPS_MAKECBCONTIG(A,LA,PTRAST(STEP(INODE)),
133     &         IW( IOLDPS + 2 + KEEP(IXSZ) ),
134     &         IW( IOLDPS + KEEP(IXSZ) ),
135     &         IW( IOLDPS + 3 + KEEP(IXSZ) )+
136     &         IW( IOLDPS + KEEP(IXSZ) ), 0,
137     &         IW( IOLDPS + XXS ), 0_8 )
138           IW(IOLDPS+XXS)=S_NOLCBCONTIG
139           IW(IOLDPS+XXS)=S_NOLCBCONTIG
140           ENDIF
141          ENDIF
142         ENDIF
143      IF ( KEEP(38).EQ.FPERE) THEN
144       LCONT  = IW(IOLDPS+KEEP(IXSZ))
145       NROW   = IW(IOLDPS+2+KEEP(IXSZ))
146       NPIV   = IW(IOLDPS+3+KEEP(IXSZ))
147       NASS   = IW(IOLDPS+4+KEEP(IXSZ))
148       NELIM  = NASS-NPIV
149       NCOL_TO_SEND =  LCONT-NELIM
150       SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ)
151       SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS
152       SHIFT_VAL_SON      = int(NASS,8)
153       LDA                = LCONT + NPIV
154      IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN
155        IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_REC_CONTSTATIC
156      ELSE
157      ENDIF
158       CALL DMUMPS_BUILD_AND_SEND_CB_ROOT( COMM_LOAD, ASS_IRECV,
159     &    N, INODE, FPERE,
160     &    PTRIST, PTRAST,
161     &    root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,
162     &    SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA,
163     &    ROOT_CONT_STATIC, MYID, COMM,
164     &
165     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
166     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
167     &    PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER,
168     &    PAMASTER,
169     &    NSTK, COMP, IFLAG, IERROR, NBPROCFILS,
170     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
171     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW,
172     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,.FALSE.,ND,FRERE,
173     &    LPTRAR, NELT, FRTPTR, FRTELT,
174     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE
175     &               , LRGROUPS
176     &    )
177       IF ( IFLAG < 0 ) GOTO 600
178       IF (NELIM.EQ.0) THEN
179         IF (KEEP(214).EQ.2) THEN
180          CALL DMUMPS_STACK_BAND( N, INODE,
181     &    PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
182     &    LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
183     &    IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
184     &    IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8,DKEEP, ITYPE2
185     &    )
186         ENDIF
187         CALL DMUMPS_FREE_BAND( N, INODE, PTRIST, PTRAST, IW, LIW,
188     &        A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,
189     &        MYID, KEEP, KEEP8, ITYPE2
190     &         )
191       ELSE
192         IOLDPS = PTRIST(STEP(INODE))
193         IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN
194           CALL DMUMPS_FREE_BAND( N, INODE, PTRIST, PTRAST, IW, LIW,
195     &        A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,
196     &        MYID, KEEP, KEEP8, ITYPE2
197     &         )
198         ELSE
199          IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_ROOTBAND_INIT
200          IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN
201           IW(IOLDPS+XXS)=S_NOLCBNOCONTIG38
202           CALL DMUMPS_SIZEFREEINREC( IW(IOLDPS),
203     &                     LIW-IOLDPS+1,
204     &                     MEM_GAIN, KEEP(IXSZ) )
205           LRLUS = LRLUS + MEM_GAIN
206           KEEP8(70) = KEEP8(70) + MEM_GAIN
207           KEEP8(71) = KEEP8(71) + MEM_GAIN
208              CALL DMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,
209     &                LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLUS)
210            IF (KEEP(216).EQ.2) THEN
211              CALL DMUMPS_MAKECBCONTIG(A,LA,PTRAST(STEP(INODE)),
212     &         IW( IOLDPS + 2 + KEEP(IXSZ) ),
213     &         IW( IOLDPS + KEEP(IXSZ) ),
214     &         IW( IOLDPS + 3 + KEEP(IXSZ) )+
215     &         IW( IOLDPS + KEEP(IXSZ) ),
216     &         IW( IOLDPS + 4 + KEEP(IXSZ) ) -
217     &         IW( IOLDPS + 3 + KEEP(IXSZ) ),
218     &         IW( IOLDPS + XXS ),0_8)
219              IW(IOLDPS+XXS)=S_NOLCBCONTIG38
220            ENDIF
221          ENDIF
222         ENDIF
223       ENDIF
224      ENDIF
225 600  CONTINUE
226#if ! defined(NO_FDM_MAPROW)
227      IOLDPS = PTRIST(STEP(INODE))
228      IF (FPERE .NE. KEEP(38)) THEN
229       IF (MUMPS_FMRD_IS_MAPROW_STORED( IW(IOLDPS+XXA) )) THEN
230        CALL MUMPS_FMRD_RETRIEVE_MAPROW( IW(IOLDPS+XXA), MRS )
231        IF (FPERE .NE. MRS%INODE) THEN
232          WRITE(*,*) " Internal error 1 in DMUMPS_END_FACTO_SLAVE",
233     &               INODE, MRS%INODE, FPERE
234          CALL MUMPS_ABORT()
235        ENDIF
236        MRS_INODE        = MRS%INODE
237        MRS_ISON         = MRS%ISON
238        MRS_NSLAVES_PERE = MRS%NSLAVES_PERE
239        MRS_NASS_PERE    = MRS%NASS_PERE
240        MRS_NFRONT_PERE  = MRS%NFRONT_PERE
241        MRS_LMAP         = MRS%LMAP
242        MRS_NFS4FATHER   = MRS%NFS4FATHER
243        MRS_SLAVES_PERE  => MRS%SLAVES_PERE
244        MRS_TROW         => MRS%TROW
245        CALL DMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV,
246     &           BUFR, LBUFR, LBUFR_BYTES,
247     &  MRS_INODE, MRS_ISON,
248     &  MRS_NSLAVES_PERE, MRS_SLAVES_PERE(1),
249     &  MRS_NFRONT_PERE, MRS_NASS_PERE, MRS_NFS4FATHER,
250     &  MRS_LMAP, MRS_TROW(1),
251     &  PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
252     &  LRLUS, N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC,
253     &  PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP,
254     &  IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF,
255     &  NBFIN, ICNTL, KEEP,KEEP8,DKEEP,
256     &  root, OPASSW, OPELIW,
257     &  ITLOC, RHS_MUMPS,
258     &  FILS, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE,
259     &  LPTRAR, NELT, FRTPTR, FRTELT,
260     &
261     &  ISTEP_TO_INIV2, TAB_POS_IN_PERE
262     &               , LRGROUPS
263     &  )
264       CALL MUMPS_FMRD_FREE_MAPROW_STRUC( IWHANDLER_SAVE )
265       ENDIF
266      ENDIF
267#endif
268      RETURN
269      END SUBROUTINE DMUMPS_END_FACTO_SLAVE
270