33#if ! defined(NO_FDM_MAPROW)
35#endif
38 IMPLICIT NONE
39 include 'mumps_headers.h'
40 include 'mpif.h'
41 include 'mumps_tags.h'
42 INTEGER INODE, FPERE
43 TYPE (ZMUMPS_ROOT_STRUC) :: root
44 INTEGER COMM, MYID
45 INTEGER ICNTL( 60 ), KEEP( 500 )
46 INTEGER(8) KEEP8(150)
47 DOUBLE PRECISION DKEEP(230)
48 INTEGER COMM_LOAD, ASS_IRECV
49 INTEGER N
50 INTEGER , LBUFR_BYTES
51 INTEGER BUFR( LBUFR )
52 INTEGER(8) :: POSFAC, IPTRLU, LRLU, LRLUS, LA
53 INTEGER PROCNODE_STEPS(KEEP(28)), PTRIST(KEEP(28)),
54 & NSTK(KEEP(28)), PTLUST_S(KEEP(28))
55 INTEGER , IWPOSCB
56 INTEGER LIW
57 INTEGER IW( )
58 COMPLEX(kind=8) A( LA )
59 INTEGER, intent(in) :: LRGROUPS(N)
60 INTEGER LPTRAR, NELT
61 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
62 INTEGER(8) :: PTRAST(KEEP(28))
63 INTEGER(8) :: PTRFAC(KEEP(28))
64 INTEGER(8) :: PAMASTER(KEEP(28))
65 INTEGER STEP(N), PIMASTER(KEEP(28))
66 INTEGER COMP, IFLAG, IERROR
67 INTEGER PERM(N)
68 INTEGER LPOOL, LEAF
69 INTEGER IPOOL( LPOOL )
70 INTEGER NBFIN,
71 DOUBLE PRECISION OPASSW, OPELIW
72 INTEGER ITLOC( N + KEEP(253) ), FILS( N ), DAD( KEEP(28) )
73 COMPLEX(kind=8) :: RHS_MUMPS(KEEP(255))
74 INTEGER ND( KEEP(28) )
75 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( )
76 INTEGER FRERE(KEEP(28))
77 INTEGER ( KEEP8(27) )
78 COMPLEX(kind=8) DBLARR( KEEP8(26) )
79 INTEGER ISTEP_TO_INIV2(KEEP(71)),
80 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
81 INTEGER MRS_INODE
82 INTEGER MRS_ISON
83 INTEGER MRS_NSLAVES_PERE
84 INTEGER MRS_NASS_PERE
85 INTEGER MRS_NFRONT_PERE
86 INTEGER MRS_LMAP
87 INTEGER MRS_NFS4FATHER
88 INTEGER, POINTER, DIMENSION(:) :: MRS_SLAVES_PERE, MRS_TROW
89 INTEGER ITYPE2
90 INTEGER IHDR_REC
91 parameter(itype2=2)
92 INTEGER IOLDPS, NROW, LDA
93 INTEGER NPIV, LCONT, NELIM, NASS, NCOL_TO_SEND,
94 & SHIFT_LIST_ROW_SON, SHIFT_LIST_COL_SON
95 INTEGER(8) :: SHIFT_VAL_SON
96 INTEGER(8) :: MEM_GAIN
97 INTEGER(8) :: DYN_SIZE
98#if
99 TYPE(MAPROW_STRUC_T), POINTER :: MRS
100#endif
101 INTEGER :: IWHANDLER_SAVE
102 INTEGER :: LRSTATUS
103 LOGICAL :: CB_STORED_IN_BLRSTRUC, COMPRESS_CB
104 IF (keep(50).EQ.0) THEN
105 ihdr_rec=6
106 ELSE
107 ihdr_rec=8
108 ENDIF
109 ioldps = ptrist(step(inode))
110 iwhandler_save = iw(ioldps+xxa)
111 lrstatus = iw(ioldps+xxlr)
112 compress_cb = ((lrstatus.EQ.1).OR.
113 & (lrstatus.EQ.3))
114 IF (.NOT.
115 & (
116 & (keep(486).EQ.2)
117 & )
118 & .AND..NOT.compress_cb) THEN
120 & keep(34))
121 ENDIF
122 iw(ioldps+xxs)=s_all
123 ioldps = ptrist(step(inode))
124 lrstatus = iw(ioldps+xxlr)
125 IF ( (keep(214).EQ.1)
126 & ) THEN
128 & ptrist, ptrast, ptlust_s, ptrfac, iw, liw, a, la,
129 & lrlu, lrlus, iwpos, iwposcb, posfac,
comp,
130 & iptrlu, opeliw, step, pimaster, pamaster,
131 & iflag, ierror, slavef, procnode_steps, dad,
myid, comm,
132 & keep,keep8, dkeep, itype2
133 & )
134 ioldps = ptrist(step(inode))
135 IF (keep(38).NE.fpere) THEN
136 cb_stored_in_blrstruc = .false.
137 lrstatus = iw(ioldps+xxlr)
138 IF ((lrstatus.EQ.1).OR.(lrstatus.EQ.3)) THEN
139 cb_stored_in_blrstruc = .true.
140 iw(ioldps+xxs) = s_nolnocb
142 lrlus = lrlus + mem_gain
143 keep8(69) = keep8(69) - mem_gain
145 & la-lrlus,0_8,-mem_gain,keep,keep8,lrlus)
146 ELSE
147 iw(ioldps+xxs)=s_nolcbnocontig
149 IF (dyn_size .GT.0) THEN
150 ELSE IF (keep(216).NE.3) THEN
151 mem_gain=int(iw( ioldps + 2 + keep(ixsz) ),8)*
152 & int(iw( ioldps + 3 + keep(ixsz) ),8)
153 lrlus = lrlus+mem_gain
154 keep8(69) = keep8(69) - mem_gain
156 & la-lrlus,0_8,-mem_gain,keep,keep8,lrlus)
157 ENDIF
158 ENDIF
159 ENDIF
161 IF (dyn_size > 0_8) THEN
162 ELSE IF (keep(216).EQ.2) THEN
163 IF (fpere.NE.keep(38)) THEN
164 IF (.NOT. cb_stored_in_blrstruc) THEN
166 & iw( ioldps + 2 + keep(ixsz) ),
167 & iw( ioldps + keep(ixsz) ),
168 & iw( ioldps + 3 + keep(ixsz) )+
169 & iw( ioldps + keep(ixsz) ), 0,
170 & iw( ioldps + xxs ), 0_8 )
171 iw(ioldps+xxs)=s_nolcbcontig
172 ENDIF
173 ENDIF
174 ENDIF
175 ENDIF
176 IF ( keep(38).EQ.fpere) THEN
177 lcont = iw(ioldps+keep(ixsz))
178 nrow = iw(ioldps+2+keep(ixsz))
179 npiv = iw(ioldps+3+keep(ixsz))
180 nass = iw(ioldps+4+keep(ixsz))
181 nelim = nass-npiv
182 ncol_to_send = lcont-nelim
183 shift_list_row_son = 6 + iw(ioldps+5+keep(ixsz)) + keep(ixsz)
184 shift_list_col_son = shift_list_row_son + nrow + nass
185 shift_val_son = int(nass,8)
186 lda = lcont + npiv
187 IF (iw(ioldps+ihdr_rec+keep(ixsz)).EQ.s_rootband_init) THEN
188 iw(ioldps+ihdr_rec+keep(ixsz)) = s_rec_contstatic
189 ELSE
190 ENDIF
192 & n, inode, fpere,
193 & ptrist, ptrast,
194 & root, nrow, ncol_to_send, shift_list_row_son,
195 & shift_list_col_son , shift_val_son, lda,
196 & root_cont_static,
myid, comm,
197 &
198 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
199 & iwpos, iwposcb, iptrlu, lrlu, lrlus, iw, liw, a, la,
200 & ptrist, ptlust_s, ptrfac, ptrast, step, pimaster,
201 & pamaster,
202 & nstk,
comp, iflag, ierror, perm,
203 & ipool, lpool, leaf, nbfin, slavef,
204 & opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw,
205 & intarr,dblarr,icntl,keep,keep8,dkeep,.false.,nd,frere,
206 & lptrar, nelt, frtptr, frtelt,
207 & istep_to_iniv2, tab_pos_in_pere
208 & , lrgroups
209 & )
210 IF ( iflag < 0 ) GOTO 600
211 IF (nelim.EQ.0) THEN
212 IF (keep(214).EQ.2) THEN
214 & ptrist, ptrast, ptlust_s, ptrfac, iw, liw, a, la,
215 & lrlu, lrlus, iwpos, iwposcb, posfac,
comp,
216 & iptrlu, opeliw, step, pimaster, pamaster,
217 & iflag, ierror, slavef, procnode_steps, dad,
myid,
218 & comm, keep,keep8,dkeep, itype2
219 & )
220 ENDIF
222 & a, la, lrlu, lrlus, iwposcb, iptrlu, step,
223 &
myid, keep, keep8, itype2
224 & )
225 ELSE
226 ioldps = ptrist(step(inode))
227 IF (iw(ioldps+ihdr_rec+keep(ixsz)).EQ.s_root2son_called) THEN
229 & a, la, lrlu, lrlus, iwposcb, iptrlu, step,
230 &
myid, keep, keep8, itype2
231 & )
232 ELSE
233 iw(ioldps+ihdr_rec+keep(ixsz)) = s_rootband_init
234 IF (keep(214).EQ.1.AND.keep(216).NE.3) THEN
235 iw(ioldps+xxs)=s_nolcbnocontig38
237 & liw-ioldps+1,
238 & mem_gain, keep(ixsz) )
239 lrlus = lrlus + mem_gain
240 keep8(69) = keep8(69) - mem_gain
242 & la-lrlus,0_8,-mem_gain,keep,keep8,lrlus)
243 IF (keep(216).EQ.2) THEN
245 & iw( ioldps + 2 + keep(ixsz) ),
246 & iw( ioldps + keep(ixsz) ),
247 & iw( ioldps + 3 + keep(ixsz) )+
248 & iw( ioldps + keep(ixsz) ),
249 & iw( ioldps + 4 + keep(ixsz) ) -
250 & iw( ioldps + 3 + keep(ixsz) ),
251 & iw( ioldps + xxs ),0_8)
252 iw(ioldps+xxs)=s_nolcbcontig38
253 ENDIF
254 ENDIF
255 ENDIF
256 ENDIF
257 ENDIF
258 600 CONTINUE
259#if ! defined(NO_FDM_MAPROW)
260 ioldps = ptrist(step(inode))
261 IF (fpere .NE. keep(38)) THEN
264 IF (fpere .NE. mrs%INODE) THEN
265 WRITE(*,*) " Internal error 1 in ZMUMPS_END_FACTO_SLAVE",
266 & inode, mrs%INODE, fpere
268 ENDIF
269 mrs_inode = mrs%INODE
270 mrs_ison = mrs%ISON
271 mrs_nslaves_pere = mrs%NSLAVES_PERE
272 mrs_nass_pere = mrs%NASS_PERE
273 mrs_nfront_pere = mrs%NFRONT_PERE
274 mrs_lmap = mrs%LMAP
275 mrs_nfs4father = mrs%NFS4FATHER
276 mrs_slaves_pere => mrs%SLAVES_PERE
277 mrs_trow => mrs%TROW
279 & bufr, lbufr, lbufr_bytes,
280 & mrs_inode, mrs_ison,
281 & mrs_nslaves_pere, mrs_slaves_pere(1),
282 & mrs_nfront_pere, mrs_nass_pere, mrs_nfs4father,
283 & mrs_lmap, mrs_trow(1),
284 & procnode_steps, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu,
285 & lrlus, n, iw, liw, a, la, ptrist, ptlust_s, ptrfac,
286 & ptrast, step, pimaster, pamaster, nstk,
comp,
287 & iflag, ierror,
myid, comm, perm, ipool, lpool, leaf,
288 & nbfin, icntl, keep,keep8,dkeep,
289 & root, opassw, opeliw,
290 & itloc, rhs_mumps,
291 & fils, dad, ptrarw, ptraiw, intarr, dblarr, nd, frere,
292 & lptrar, nelt, frtptr, frtelt,
293 &
294 & istep_to_iniv2, tab_pos_in_pere
295 & , lrgroups
296 & )
298 ENDIF
299 ENDIF
300#endif
301 RETURN
logical function, public mumps_fmrd_is_maprow_stored(iwhandler)
subroutine, public mumps_fmrd_free_maprow_struc(iwhandler)
subroutine, public mumps_fmrd_retrieve_maprow(iwhandler, maprow_struc)
integer, save, private myid
subroutine, public zmumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
subroutine, public zmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
subroutine zmumps_makecbcontig(a, la, rcurrent, nrow, ncb, ld, nelim, nodestate, ishift)
subroutine zmumps_sizefreeinrec(iw, lrec, size_free, xsize)
recursive subroutine zmumps_maplig(comm_load, ass_irecv, bufr, lbufr, lbufr_bytes inode_pere, ison, nslaves_pere, list_slaves_pere, nfront_pere, nass_pere, nfs4father, lmap, trow, procnode_steps, slavef, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk, comp, iflag, ierror, myid, comm, perm, ipool, lpool, leaf, nbfin, icntl, keep, keep8, dkeep, root, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)
recursive subroutine zmumps_build_and_send_cb_root(comm_load, ass_irecv, n, ison, iroot, ptri, ptrr, root, nbrow, nbcol, shift_list_row_son, shift_list_col_son, shift_val_son_arg, lda_arg, tag, 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, perm, ipool, lpool, leaf, nbfin, slavef, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, transpose_asm, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)