File: sfac_process_end_facto_slave.F

package info (click to toggle)
mumps 5.1.2-5
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 15,704 kB
  • sloc: fortran: 310,672; ansic: 12,364; xml: 521; makefile: 469
file content (269 lines) | stat: -rw-r--r-- 10,155 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
C
C  This file is part of MUMPS 5.1.2, released
C  on Mon Oct  2 07:37:01 UTC 2017
C
C
C  Copyright 1991-2017 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
C  University of Bordeaux.
C
C  This version of MUMPS is provided to you free of charge. It is
C  released under the CeCILL-C license:
C  http://www.cecill.info/licences/Licence_CeCILL-C_V1-en.html
C
      RECURSIVE SUBROUTINE SMUMPS_END_FACTO_SLAVE(
     &    COMM_LOAD, ASS_IRECV, 
     &    N, INODE, FPERE, 
     &    root,
     &    MYID, COMM,
     &    
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
     &    PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER,
     &    PAMASTER,
     &    NSTK, COMP, IFLAG, IERROR, NBPROCFILS,
     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW,
     &    INTARR, DBLARR, ICNTL, KEEP,KEEP8,DKEEP, ND, FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT, 
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE 
     &               , LRGROUPS
     &    )
      USE SMUMPS_LOAD
#if ! defined(NO_FDM_MAPROW)
      USE MUMPS_FAC_MAPROW_DATA_M
#endif
      USE SMUMPS_LR_DATA_M  
      IMPLICIT NONE
      INCLUDE 'smumps_root.h'
      INCLUDE 'mumps_headers.h'
      INCLUDE 'mpif.h'
      INCLUDE 'mumps_tags.h'
      INTEGER INODE, FPERE
      TYPE (SMUMPS_ROOT_STRUC) :: root
      INTEGER COMM, MYID
      INTEGER ICNTL( 40 ), KEEP( 500 )
      INTEGER(8) KEEP8(150)
      REAL    DKEEP(230)
      INTEGER COMM_LOAD, ASS_IRECV
      INTEGER N
      INTEGER LBUFR, LBUFR_BYTES
      INTEGER BUFR( LBUFR )
      INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA
      INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)),
     &        NSTK(KEEP(28)), PTLUST_S(KEEP(28))
      INTEGER IWPOS, IWPOSCB
      INTEGER LIW
      INTEGER IW( LIW )
      REAL A( LA )
      INTEGER, intent(in) :: LRGROUPS(N)
      INTEGER LPTRAR, NELT
      INTEGER FRTPTR( N+1 ), FRTELT( NELT )
      INTEGER(8) :: PTRAST(KEEP(28))
      INTEGER(8) :: PTRFAC(KEEP(28))
      INTEGER(8) :: PAMASTER(KEEP(28))
      INTEGER STEP(N), PIMASTER(KEEP(28))
      INTEGER COMP, IFLAG, IERROR
      INTEGER NBPROCFILS( KEEP(28) )
      INTEGER LPOOL, LEAF
      INTEGER IPOOL( LPOOL )
      INTEGER NBFIN, SLAVEF
      DOUBLE PRECISION OPASSW, OPELIW
      INTEGER ITLOC( N + KEEP(253) ), FILS( N )
      REAL :: RHS_MUMPS(KEEP(255))
      INTEGER ND( KEEP(28) )
      INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
      INTEGER FRERE(KEEP(28))
      INTEGER INTARR( KEEP8(27) )
      REAL DBLARR( KEEP8(26) )
      INTEGER ISTEP_TO_INIV2(KEEP(71)), 
     &        TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
      INTEGER MRS_INODE
      INTEGER MRS_ISON
      INTEGER MRS_NSLAVES_PERE
      INTEGER MRS_NASS_PERE
      INTEGER MRS_NFRONT_PERE
      INTEGER MRS_LMAP
      INTEGER MRS_NFS4FATHER
      INTEGER, POINTER, DIMENSION(:) :: MRS_SLAVES_PERE, MRS_TROW
      INTEGER ITYPE2
      INTEGER IHDR_REC
      PARAMETER (ITYPE2=2)
      INTEGER IOLDPS, NROW, LDA
      INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND,
     &        SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON
      INTEGER(8) :: SHIFT_VAL_SON
      INTEGER(8) MEM_GAIN 
#if ! defined(NO_FDM_MAPROW)
      TYPE(MAPROW_STRUC_T), POINTER :: MRS
#endif
      INTEGER :: IWHANDLER_SAVE
        IF (KEEP(50).EQ.0) THEN
          IHDR_REC=6
        ELSE
          IHDR_REC=8
        ENDIF
        IOLDPS = PTRIST(STEP(INODE))
        IWHANDLER_SAVE = IW(IOLDPS+XXA)
        CALL SMUMPS_BLR_END_FRONT( IW(IOLDPS+XXF), IFLAG, KEEP8, .TRUE.)
        IW(IOLDPS+XXS)=S_ALL
         IF (KEEP(214).EQ.1) THEN
          CALL SMUMPS_STACK_BAND( N, INODE,
     &    PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
     &    LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP, 
     &    IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
     &    IFLAG, IERROR, SLAVEF, MYID, COMM,
     &    KEEP,KEEP8, DKEEP, ITYPE2
     &     )
          IOLDPS = PTRIST(STEP(INODE))
          IF (KEEP(38).NE.FPERE) THEN
            IW(IOLDPS+XXS)=S_NOLCBNOCONTIG
            IF (KEEP(216).NE.3) THEN
             MEM_GAIN=int(IW( IOLDPS + 2 + KEEP(IXSZ) ),8)*
     &                int(IW( IOLDPS + 3 + KEEP(IXSZ) ),8)
             LRLUS = LRLUS+MEM_GAIN
             KEEP8(70) = KEEP8(70) + MEM_GAIN
             KEEP8(71) = KEEP8(71) + MEM_GAIN
             CALL SMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,
     &              LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLUS)
            ENDIF
          ENDIF
          IF (KEEP(216).EQ.2) THEN
           IF (FPERE.NE.KEEP(38)) THEN
           CALL SMUMPS_MAKECBCONTIG(A,LA,PTRAST(STEP(INODE)),
     &         IW( IOLDPS + 2 + KEEP(IXSZ) ),
     &         IW( IOLDPS + KEEP(IXSZ) ),
     &         IW( IOLDPS + 3 + KEEP(IXSZ) )+
     &         IW( IOLDPS + KEEP(IXSZ) ), 0,
     &         IW( IOLDPS + XXS ), 0_8 )
           IW(IOLDPS+XXS)=S_NOLCBCONTIG
           IW(IOLDPS+XXS)=S_NOLCBCONTIG
           ENDIF
          ENDIF 
         ENDIF 
      IF ( KEEP(38).EQ.FPERE) THEN
       LCONT  = IW(IOLDPS+KEEP(IXSZ))
       NROW   = IW(IOLDPS+2+KEEP(IXSZ))
       NPIV   = IW(IOLDPS+3+KEEP(IXSZ))
       NASS   = IW(IOLDPS+4+KEEP(IXSZ))
       NELIM  = NASS-NPIV
       NCOL_TO_SEND =  LCONT-NELIM
       SHIFT_LIST_ROW_SON = 6 + IW(IOLDPS+5+KEEP(IXSZ)) + KEEP(IXSZ)
       SHIFT_LIST_COL_SON = SHIFT_LIST_ROW_SON + NROW + NASS
       SHIFT_VAL_SON      = int(NASS,8)
       LDA                = LCONT + NPIV
      IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOTBAND_INIT) THEN
        IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_REC_CONTSTATIC
      ELSE
      ENDIF
       CALL SMUMPS_BUILD_AND_SEND_CB_ROOT( COMM_LOAD, ASS_IRECV, 
     &    N, INODE, FPERE, 
     &    PTRIST, PTRAST, 
     &    root, NROW, NCOL_TO_SEND, SHIFT_LIST_ROW_SON,
     &    SHIFT_LIST_COL_SON , SHIFT_VAL_SON, LDA, 
     &    ROOT_CONT_STATIC, MYID, COMM,
     &    
     &    BUFR, LBUFR, LBUFR_BYTES, PROCNODE_STEPS, POSFAC,
     &    IWPOS, IWPOSCB, IPTRLU, LRLU, LRLUS, IW, LIW, A, LA,
     &    PTRIST, PTLUST_S, PTRFAC, PTRAST, STEP, PIMASTER,
     &    PAMASTER,
     &    NSTK, COMP, IFLAG, IERROR, NBPROCFILS,
     &    IPOOL, LPOOL, LEAF, NBFIN, SLAVEF,
     &    OPASSW, OPELIW, ITLOC, RHS_MUMPS, FILS, PTRARW, PTRAIW,
     &    INTARR,DBLARR,ICNTL,KEEP,KEEP8,DKEEP,.FALSE.,ND,FRERE,
     &    LPTRAR, NELT, FRTPTR, FRTELT, 
     &    ISTEP_TO_INIV2, TAB_POS_IN_PERE 
     &               , LRGROUPS
     &    )
       IF ( IFLAG < 0 ) GOTO 600
       IF (NELIM.EQ.0) THEN
         IF (KEEP(214).EQ.2) THEN
          CALL SMUMPS_STACK_BAND( N, INODE,  
     &    PTRIST, PTRAST, PTLUST_S, PTRFAC, IW, LIW, A, LA,
     &    LRLU, LRLUS, IWPOS, IWPOSCB, POSFAC, COMP,
     &    IPTRLU, OPELIW, STEP, PIMASTER, PAMASTER,
     &    IFLAG, IERROR, SLAVEF, MYID, COMM, KEEP,KEEP8,DKEEP, ITYPE2
     &    )
         ENDIF
         CALL SMUMPS_FREE_BAND( N, INODE, PTRIST, PTRAST, IW, LIW,
     &        A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,
     &        MYID, KEEP, KEEP8, ITYPE2
     &         )
       ELSE
         IOLDPS = PTRIST(STEP(INODE))
         IF (IW(IOLDPS+IHDR_REC+KEEP(IXSZ)).EQ.S_ROOT2SON_CALLED) THEN
           CALL SMUMPS_FREE_BAND( N, INODE, PTRIST, PTRAST, IW, LIW,
     &        A, LA, LRLU, LRLUS, IWPOSCB, IPTRLU, STEP,
     &        MYID, KEEP, KEEP8, ITYPE2
     &         )
         ELSE
          IW(IOLDPS+IHDR_REC+KEEP(IXSZ)) = S_ROOTBAND_INIT
          IF (KEEP(214).EQ.1.AND.KEEP(216).NE.3) THEN
           IW(IOLDPS+XXS)=S_NOLCBNOCONTIG38
           CALL SMUMPS_SIZEFREEINREC( IW(IOLDPS),
     &                     LIW-IOLDPS+1,
     &                     MEM_GAIN, KEEP(IXSZ) )
           LRLUS = LRLUS + MEM_GAIN
           KEEP8(70) = KEEP8(70) + MEM_GAIN
           KEEP8(71) = KEEP8(71) + MEM_GAIN
              CALL SMUMPS_LOAD_MEM_UPDATE(.FALSE.,.FALSE.,
     &                LA-LRLUS,0_8,-MEM_GAIN,KEEP,KEEP8,LRLUS)
            IF (KEEP(216).EQ.2) THEN
              CALL SMUMPS_MAKECBCONTIG(A,LA,PTRAST(STEP(INODE)),
     &         IW( IOLDPS + 2 + KEEP(IXSZ) ),
     &         IW( IOLDPS + KEEP(IXSZ) ),
     &         IW( IOLDPS + 3 + KEEP(IXSZ) )+
     &         IW( IOLDPS + KEEP(IXSZ) ),
     &         IW( IOLDPS + 4 + KEEP(IXSZ) ) -
     &         IW( IOLDPS + 3 + KEEP(IXSZ) ),
     &         IW( IOLDPS + XXS ),0_8)
              IW(IOLDPS+XXS)=S_NOLCBCONTIG38
            ENDIF
          ENDIF
         ENDIF 
       ENDIF 
      ENDIF 
 600  CONTINUE
#if ! defined(NO_FDM_MAPROW)
      IOLDPS = PTRIST(STEP(INODE)) 
      IF (FPERE .NE. KEEP(38)) THEN
       IF (MUMPS_FMRD_IS_MAPROW_STORED( IW(IOLDPS+XXA) )) THEN
        CALL MUMPS_FMRD_RETRIEVE_MAPROW( IW(IOLDPS+XXA), MRS )
        IF (FPERE .NE. MRS%INODE) THEN
          WRITE(*,*) " Internal error 1 in SMUMPS_END_FACTO_SLAVE",
     &               INODE, MRS%INODE, FPERE
          CALL MUMPS_ABORT()
        ENDIF
        MRS_INODE        = MRS%INODE
        MRS_ISON         = MRS%ISON
        MRS_NSLAVES_PERE = MRS%NSLAVES_PERE
        MRS_NASS_PERE    = MRS%NASS_PERE
        MRS_NFRONT_PERE  = MRS%NFRONT_PERE
        MRS_LMAP         = MRS%LMAP
        MRS_NFS4FATHER   = MRS%NFS4FATHER
        MRS_SLAVES_PERE  => MRS%SLAVES_PERE
        MRS_TROW         => MRS%TROW
        CALL SMUMPS_MAPLIG( COMM_LOAD, ASS_IRECV,
     &           BUFR, LBUFR, LBUFR_BYTES,
     &  MRS_INODE, MRS_ISON,
     &  MRS_NSLAVES_PERE, MRS_SLAVES_PERE(1),
     &  MRS_NFRONT_PERE, MRS_NASS_PERE, MRS_NFS4FATHER,
     &  MRS_LMAP, MRS_TROW(1),
     &  PROCNODE_STEPS, SLAVEF, POSFAC, IWPOS, IWPOSCB, IPTRLU, LRLU,
     &  LRLUS, N, IW, LIW, A, LA, PTRIST, PTLUST_S, PTRFAC,
     &  PTRAST, STEP, PIMASTER, PAMASTER, NSTK, COMP,
     &  IFLAG, IERROR, MYID, COMM, NBPROCFILS, IPOOL, LPOOL, LEAF,
     &  NBFIN, ICNTL, KEEP,KEEP8,DKEEP,
     &  root, OPASSW, OPELIW,
     &  ITLOC, RHS_MUMPS,
     &  FILS, PTRARW, PTRAIW, INTARR, DBLARR, ND, FRERE,
     &  LPTRAR, NELT, FRTPTR, FRTELT, 
     &
     &  ISTEP_TO_INIV2, TAB_POS_IN_PERE 
     &               , LRGROUPS
     &  )
       CALL MUMPS_FMRD_FREE_MAPROW_STRUC( IWHANDLER_SAVE )
       ENDIF
      ENDIF
#endif
      RETURN
      END SUBROUTINE SMUMPS_END_FACTO_SLAVE