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
14     &    DMUMPS_PROCESS_ROOT2SON( COMM_LOAD, ASS_IRECV,
15     &    INODE, NELIM_ROOT, root,
16     &
17     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
18     &    IWPOS, IWPOSCB, IPTRLU,
19     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
20     &    PTLUST_S, PTRFAC,
21     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
22     &    IFLAG, IERROR, COMM,
23     &    NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
24     &
25     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS,
26     &    FILS, PTRARW, PTRAIW,
27     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,
28     &    LPTRAR, NELT, FRTPTR, FRTELT,
29     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE
30     &               , LRGROUPS
31     &     )
32      IMPLICIT NONE
33      INCLUDE 'dmumps_root.h'
34      INCLUDE 'mpif.h'
35      TYPE (DMUMPS_ROOT_STRUC) :: root
36      INTEGER KEEP(500), ICNTL( 40 )
37      INTEGER(8) KEEP8(150)
38      DOUBLE PRECISION       DKEEP(230)
39      INTEGER COMM_LOAD, ASS_IRECV
40      INTEGER INODE, NELIM_ROOT
41      INTEGER LBUFR, LBUFR_BYTES
42      INTEGER BUFR( LBUFR )
43      INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS
44      INTEGER IWPOS, IWPOSCB
45      INTEGER N, LIW
46      INTEGER IW( LIW )
47      DOUBLE PRECISION A( LA )
48      INTEGER, intent(in) :: LRGROUPS(N)
49      INTEGER(8) :: PTRAST(KEEP(28))
50      INTEGER(8) :: PTRFAC(KEEP(28))
51      INTEGER(8) :: PAMASTER(KEEP(28))
52      INTEGER PTRIST(KEEP(28)), PTLUST_S(KEEP(28))
53      INTEGER STEP(N), PIMASTER(KEEP(28))
54      INTEGER COMP
55      INTEGER NSTK_S( KEEP(28) ), PROCNODE_STEPS( KEEP(28) )
56      INTEGER NBPROCFILS(KEEP(28))
57      INTEGER IFLAG, IERROR, COMM
58      INTEGER LPOOL, LEAF
59      INTEGER IPOOL( LPOOL )
60      INTEGER NELT, LPTRAR
61      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
62      INTEGER MYID, SLAVEF, NBFIN
63      DOUBLE PRECISION OPASSW, OPELIW
64      INTEGER ITLOC( N + KEEP(253) ), FILS( N )
65      DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
66      INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
67      INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )
68      INTEGER INTARR(KEEP8(27))
69      DOUBLE PRECISION DBLARR(KEEP8(26))
70      INTEGER ISTEP_TO_INIV2(KEEP(71)),
71     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
72      INCLUDE 'mumps_tags.h'
73      INCLUDE 'mumps_headers.h'
74      INTEGER I, LCONT, NCOL_TO_SEND, LDA
75      INTEGER(8) :: SHIFT_VAL_SON, POSELT
76      INTEGER FPERE, IOLDPS, NFRONT, NPIV, NASS, NSLAVES,
77     &        H_INODE, NELIM, NBCOL, LIST_NELIM_ROW,
78     &        LIST_NELIM_COL, NELIM_LOCAL, TYPE_SON,
79     &        NROW, NCOL, NBROW, SHIFT_LIST_ROW_SON,
80     &        SHIFT_LIST_COL_SON, LDAFS, IERR,
81     &        ISON, PDEST_MASTER_ISON
82      INTEGER :: STATUS(MPI_STATUS_SIZE)
83      LOGICAL BLOCKING, SET_IRECV, MESSAGE_RECEIVED
84      INTEGER MSGSOU, MSGTAG
85      LOGICAL TRANSPOSE_ASM
86      INTEGER  MUMPS_PROCNODE, MUMPS_TYPENODE
87      EXTERNAL MUMPS_PROCNODE, MUMPS_TYPENODE
88      FPERE = KEEP(38)
89      TYPE_SON = MUMPS_TYPENODE(PROCNODE_STEPS(STEP(INODE)),SLAVEF)
90      IF ( MUMPS_PROCNODE( PROCNODE_STEPS(STEP(INODE)),
91     &     SLAVEF ).EQ.MYID) THEN
92       IOLDPS   = PTLUST_S(STEP(INODE))
93       NFRONT   = IW(IOLDPS+KEEP(IXSZ))
94       NPIV     = IW(IOLDPS+1+KEEP(IXSZ))
95       NASS     = iabs(IW(IOLDPS + 2+KEEP(IXSZ)))
96       NSLAVES  =  IW(IOLDPS+5+KEEP(IXSZ))
97       H_INODE  = 6 + NSLAVES + KEEP(IXSZ)
98       NELIM    = NASS - NPIV
99       NBCOL = NFRONT - NPIV
100       LIST_NELIM_ROW = IOLDPS + H_INODE + NPIV
101       LIST_NELIM_COL = LIST_NELIM_ROW + NFRONT
102           IF (NELIM.LE.0) THEN
103            write(6,*) ' ERROR 1 in DMUMPS_PROCESS_ROOT2SON ', NELIM
104            write(6,*) MYID,':Process root2son: INODE=',INODE,
105     & 'Header=',IW(PTLUST_S(STEP(INODE)):PTLUST_S(STEP(INODE))
106     &  +5+KEEP(IXSZ))
107            CALL MUMPS_ABORT()
108           ENDIF
109       NELIM_LOCAL = NELIM_ROOT
110       DO I=1, NELIM
111        root%RG2L_ROW(IW(LIST_NELIM_ROW)) = NELIM_LOCAL
112        root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL
113        NELIM_LOCAL = NELIM_LOCAL + 1
114        LIST_NELIM_ROW = LIST_NELIM_ROW + 1
115        LIST_NELIM_COL = LIST_NELIM_COL + 1
116       ENDDO
117       NBROW = NFRONT - NPIV
118       NROW = NELIM
119       IF ( KEEP( 50 ) .eq. 0 ) THEN
120         NCOL = NFRONT - NPIV
121       ELSE
122         NCOL = NELIM
123       END IF
124       SHIFT_LIST_ROW_SON = H_INODE + NPIV
125       SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV
126       IF ( KEEP(50).eq.0 .OR. TYPE_SON .eq. 1 ) THEN
127         LDAFS = NFRONT
128       ELSE
129         LDAFS = NASS
130       END IF
131       SHIFT_VAL_SON = int(NPIV,8) * int(LDAFS,8) + int(NPIV,8)
132       CALL DMUMPS_BUILD_AND_SEND_CB_ROOT( COMM_LOAD,
133     &   ASS_IRECV,
134     &   N, INODE, FPERE,
135     &   PTLUST_S(1), PTRAST(1),
136     &   root, NROW, NCOL, SHIFT_LIST_ROW_SON,
137     &   SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDAFS,
138     &   ROOT_NON_ELIM_CB, MYID, COMM,
139     &   BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
140     &   IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
141     &   PTRIST, PTLUST_S(1), PTRFAC(1), PTRAST(1),
142     &   STEP, PIMASTER, PAMASTER,
143     &   NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
144     &   IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
145     &   OPASSW, OPELIW, ITLOC, RHS_MUMPS,
146     &   FILS, PTRARW, PTRAIW,
147     &   INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,.FALSE.,ND,FRERE,
148     &   LPTRAR, NELT, FRTPTR, FRTELT,
149     &   ISTEP_TO_INIV2, TAB_POS_IN_PERE
150     &               , LRGROUPS
151     &    )
152       IF (IFLAG.LT.0 ) RETURN
153       IF (TYPE_SON.EQ.1) THEN
154        NROW = NFRONT - NASS
155        NCOL = NELIM
156        SHIFT_LIST_ROW_SON = H_INODE + NASS
157        SHIFT_LIST_COL_SON = H_INODE + NFRONT + NPIV
158        SHIFT_VAL_SON      = int(NASS,8) * int(NFRONT,8) + int(NPIV,8)
159        IF ( KEEP( 50 ) .eq. 0 ) THEN
160          TRANSPOSE_ASM = .FALSE.
161        ELSE
162          TRANSPOSE_ASM = .TRUE.
163        END IF
164        CALL DMUMPS_BUILD_AND_SEND_CB_ROOT( COMM_LOAD, ASS_IRECV,
165     &    N, INODE, FPERE,
166     &    PTLUST_S, PTRAST,
167     &    root, NROW, NCOL, SHIFT_LIST_ROW_SON,
168     &    SHIFT_LIST_COL_SON , SHIFT_VAL_SON, NFRONT,
169     &    ROOT_NON_ELIM_CB, MYID, COMM,
170     &
171     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
172     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
173     &    PTRIST, PTLUST_S, PTRFAC,
174     &    PTRAST, STEP, PIMASTER, PAMASTER,
175     &    NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
176     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
177     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS,
178     &    FILS, PTRARW, PTRAIW,
179     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,
180     &    TRANSPOSE_ASM,ND,FRERE,
181     &    LPTRAR, NELT, FRTPTR, FRTELT,
182     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE, LRGROUPS )
183        IF (IFLAG.LT.0 ) RETURN
184       ENDIF
185       IOLDPS = PTLUST_S(STEP(INODE))
186       POSELT = PTRAST(STEP(INODE))
187       IW(IOLDPS + 4+KEEP(IXSZ)) = STEP(INODE)
188       PTRFAC(STEP(INODE))=POSELT
189       IF ( TYPE_SON .eq. 1 ) THEN
190         NBROW = NFRONT - NPIV
191       ELSE
192         NBROW = NELIM
193       END IF
194       IF ( TYPE_SON .eq. 1 .OR. KEEP(50).EQ.0) THEN
195         LDA = NFRONT
196       ELSE
197         LDA = NPIV+NBROW
198       ENDIF
199       CALL DMUMPS_COMPACT_FACTORS(A(POSELT), LDA,
200     &          NPIV, NBROW, KEEP(50),
201     &          int(LDA,8)*int(NBROW+NPIV,8))
202       IW(IOLDPS + KEEP(IXSZ))     = NBCOL
203       IW(IOLDPS + 1 +KEEP(IXSZ)) = NASS - NPIV
204       IF (TYPE_SON.EQ.2) THEN
205        IW(IOLDPS + 2 +KEEP(IXSZ)) = NASS
206       ELSE
207        IW(IOLDPS + 2 +KEEP(IXSZ)) = NFRONT
208       ENDIF
209       IW(IOLDPS + 3 +KEEP(IXSZ)) = NPIV
210      CALL DMUMPS_COMPRESS_LU(0_8,MYID,N,IOLDPS,TYPE_SON,IW,LIW,
211     &    A, LA, POSFAC, LRLU, LRLUS,
212     &    IWPOS, PTRAST,PTRFAC,STEP, KEEP,KEEP8, .FALSE.,INODE,IERR
213     &    , LRGROUPS, NASS
214     &    )
215      IF(IERR.LT.0)THEN
216         IFLAG=IERR
217         IERROR=0
218         RETURN
219      ENDIF
220      ELSE
221        ISON = INODE
222        PDEST_MASTER_ISON =
223     &      MUMPS_PROCNODE(PROCNODE_STEPS(STEP(ISON)), SLAVEF)
224        IF ( PTRIST(STEP(ISON)) .EQ. 0) THEN
225          CALL DMUMPS_TREAT_DESCBAND( ISON, COMM_LOAD,
226     &    ASS_IRECV,
227     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
228     &    IWPOS, IWPOSCB, IPTRLU,
229     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
230     &    PTLUST_S, PTRFAC,
231     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
232     &    IFLAG, IERROR, COMM,
233     &    NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
234     &
235     &    root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
236     &    FILS, PTRARW, PTRAIW,
237     &    INTARR, DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND,FRERE,LPTRAR,
238     &    NELT, FRTPTR, FRTELT,
239     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
240     &               , LRGROUPS
241     &   )
242          IF ( IFLAG .LT. 0 ) RETURN
243        ENDIF
244        DO WHILE (
245     &     ( IW( PTRIST(STEP(ISON)) + 1  +KEEP(IXSZ)) .NE.
246     &       IW( PTRIST(STEP(ISON)) + 3  +KEEP(IXSZ)) ) .OR.
247     &     ( KEEP(50) .NE. 0 .AND.
248     &       IW( PTRIST(STEP(ISON)) + 6  +KEEP(IXSZ)) .NE. 0 ) )
249          IF ( KEEP(50).eq.0) THEN
250#if defined(IBC_TEST)
251            MSGSOU = IW( PTRIST(STEP(ISON)) + 7 +  KEEP(IXSZ) )
252            MSGTAG = BLOC_FACTO
253#else
254            MSGSOU = PDEST_MASTER_ISON
255            MSGTAG = BLOC_FACTO
256#endif
257          ELSE
258            IF ( IW( PTRIST(STEP(ISON)) + 1  +KEEP(IXSZ)) .NE.
259     &           IW( PTRIST(STEP(ISON)) + 3  +KEEP(IXSZ)) ) THEN
260#if defined(IBC_TEST)
261              MSGSOU = IW( PTRIST(STEP(ISON)) + 9 +  KEEP(IXSZ) )
262              MSGTAG = BLOC_FACTO_SYM
263#else
264              MSGSOU = PDEST_MASTER_ISON
265              MSGTAG = BLOC_FACTO_SYM
266#endif
267            ELSE
268              MSGSOU = MPI_ANY_SOURCE
269              MSGTAG = BLOC_FACTO_SYM_SLAVE
270            END IF
271          END IF
272          BLOCKING  = .TRUE.
273          SET_IRECV = .FALSE.
274          MESSAGE_RECEIVED = .FALSE.
275          CALL DMUMPS_TRY_RECVTREAT( COMM_LOAD, ASS_IRECV,
276     &    BLOCKING, SET_IRECV, MESSAGE_RECEIVED,
277     &    MSGSOU, MSGTAG,
278     &    STATUS,
279     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
280     &    IWPOS, IWPOSCB, IPTRLU,
281     &    LRLU, LRLUS, N, IW, LIW, A, LA, PTRIST,
282     &    PTLUST_S, PTRFAC,
283     &    PTRAST, STEP, PIMASTER, PAMASTER, NSTK_S, COMP,
284     &    IFLAG, IERROR, COMM,
285     &    NBPROCFILS, IPOOL, LPOOL, LEAF, NBFIN, MYID, SLAVEF,
286     &
287     &    root, OPASSW, OPELIW, ITLOC, RHS_MUMPS,
288     &    FILS, PTRARW, PTRAIW,
289     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,ND, FRERE, LPTRAR,
290     &    NELT, FRTPTR, FRTELT,
291     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE, .TRUE.
292     &               , LRGROUPS
293     &   )
294          IF ( IFLAG .LT. 0 ) RETURN
295        END DO
296       IOLDPS = PTRIST(STEP(INODE))
297       LCONT  = IW(IOLDPS+KEEP(IXSZ))
298       NROW   = IW(IOLDPS+2+KEEP(IXSZ))
299       NPIV   = IW(IOLDPS+3+KEEP(IXSZ))
300       NASS   = IW(IOLDPS+4+KEEP(IXSZ))
301       NELIM  = NASS-NPIV
302       IF (NELIM.LE.0) THEN
303         write(6,*) MYID,': INODE,LCONT, NROW, NPIV, NASS, NELIM=',
304     &   INODE,LCONT, NROW, NPIV, NASS, NELIM
305         write(6,*) MYID,': IOLDPS=',IOLDPS
306         write(6,*) MYID,': ERROR 2 in DMUMPS_PROCESS_ROOT2SON '
307         CALL MUMPS_ABORT()
308       ENDIF
309       NSLAVES= IW(IOLDPS+5+KEEP(IXSZ))
310       H_INODE = 6 + NSLAVES + KEEP(IXSZ)
311       LIST_NELIM_COL = IOLDPS + H_INODE + NROW + NPIV
312       NELIM_LOCAL = NELIM_ROOT
313       DO I = 1, NELIM
314        root%RG2L_COL(IW(LIST_NELIM_COL)) = NELIM_LOCAL
315        root%RG2L_ROW(IW(LIST_NELIM_COL)) = NELIM_LOCAL
316        NELIM_LOCAL = NELIM_LOCAL + 1
317        LIST_NELIM_COL = LIST_NELIM_COL + 1
318       ENDDO
319       SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ)
320       SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NPIV
321       NCOL_TO_SEND       = NELIM
322       LDA = -9999
323       SHIFT_VAL_SON = -9999_8
324       IF ( KEEP( 50 ) .eq. 0 ) THEN
325         TRANSPOSE_ASM = .FALSE.
326       ELSE
327         TRANSPOSE_ASM = .TRUE.
328       END IF
329       CALL DMUMPS_BUILD_AND_SEND_CB_ROOT( COMM_LOAD, ASS_IRECV,
330     &    N, INODE, FPERE,
331     &    PTRIST, PTRAST,
332     &    root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,
333     &    SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA,
334     &    ROOT_NON_ELIM_CB, MYID, COMM,
335     &
336     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
337     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
338     &    PTRIST, PTLUST_S, PTRFAC,
339     &    PTRAST, STEP, PIMASTER, PAMASTER,
340     &    NSTK_S, COMP, IFLAG, IERROR, NBPROCFILS,
341     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
342     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS,
343     &    FILS, PTRARW, PTRAIW,
344     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,TRANSPOSE_ASM,
345     &    ND, FRERE, LPTRAR, NELT, FRTPTR, FRTELT,
346     &   ISTEP_TO_INIV2, TAB_POS_IN_PERE, LRGROUPS)
347        IF (IFLAG.LT.0 ) RETURN
348       IF (KEEP(214).EQ.2) THEN
349        CALL DMUMPS_STACK_BAND( N, INODE,
350     &      PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
351     &      LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
352     &      IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
353     &      IFLAG, IERROR, SLAVEF, MYID, COMM,
354     &      KEEP, KEEP8, DKEEP,TYPE_SON
355     &      )
356       ENDIF
357        IF (IFLAG.LT.0) THEN
358           CALL DMUMPS_BDC_ERROR( MYID, SLAVEF, COMM, KEEP )
359        ENDIF
360      ENDIF
361      RETURN
362      END SUBROUTINE DMUMPS_PROCESS_ROOT2SON
363