OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sfac_process_end_facto_slave.F File Reference

Go to the source code of this file.

Functions/Subroutines

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, perm, ipool, lpool, leaf, nbfin, slavef, opassw, opeliw, itloc, rhs_mumps, fils, dad, ptrarw, ptraiw, intarr, dblarr, icntl, keep, keep8, dkeep, nd, frere, lptrar, nelt, frtptr, frtelt, istep_to_iniv2, tab_pos_in_pere, lrgroups)

Function/Subroutine Documentation

◆ smumps_end_facto_slave()

recursive subroutine smumps_end_facto_slave ( integer comm_load,
integer ass_irecv,
integer n,
integer inode,
integer fpere,
type (smumps_root_struc) root,
integer myid,
integer comm,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer, dimension(keep(28)) procnode_steps,
integer(8) posfac,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer, dimension( liw ) iw,
integer liw,
real, dimension( la ) a,
integer(8) la,
integer, dimension(keep(28)) ptrist,
integer, dimension(keep(28)) ptlust_s,
integer(8), dimension(keep(28)) ptrfac,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer, dimension(keep(28)) nstk,
integer comp,
integer iflag,
integer ierror,
integer, dimension(n) perm,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer nbfin,
integer slavef,
double precision opassw,
double precision opeliw,
integer, dimension( n + keep(253) ) itloc,
real, dimension(keep(255)) rhs_mumps,
integer, dimension( n ) fils,
integer, dimension( keep(28) ) dad,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer, dimension( keep8(27) ) intarr,
real, dimension( keep8(26) ) dblarr,
integer, dimension( 60 ) icntl,
integer, dimension( 500 ) keep,
integer(8), dimension(150) keep8,
real, dimension(230) dkeep,
integer, dimension( keep(28) ) nd,
integer, dimension(keep(28)) frere,
integer lptrar,
integer nelt,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
integer, dimension(keep(71)) istep_to_iniv2,
integer, dimension(slavef+2,max(1,keep(56))) tab_pos_in_pere,
integer, dimension(n), intent(in) lrgroups )

Definition at line 14 of file sfac_process_end_facto_slave.F.

32 USE smumps_load
33#if ! defined(NO_FDM_MAPROW)
35#endif
37 USE smumps_struc_def, ONLY : smumps_root_struc
38 IMPLICIT NONE
39 include 'mumps_headers.h'
40 include 'mpif.h'
41 include 'mumps_tags.h'
42 INTEGER INODE, FPERE
43 TYPE (SMUMPS_ROOT_STRUC) :: root
44 INTEGER COMM, MYID
45 INTEGER ICNTL( 60 ), KEEP( 500 )
46 INTEGER(8) KEEP8(150)
47 REAL DKEEP(230)
48 INTEGER COMM_LOAD, ASS_IRECV
49 INTEGER N
50 INTEGER LBUFR, 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 IWPOS, IWPOSCB
56 INTEGER LIW
57 INTEGER IW( LIW )
58 REAL 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, SLAVEF
71 DOUBLE PRECISION OPASSW, OPELIW
72 INTEGER ITLOC( N + KEEP(253) ), FILS( N ), DAD( KEEP(28) )
73 REAL :: RHS_MUMPS(KEEP(255))
74 INTEGER ND( KEEP(28) )
75 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
76 INTEGER FRERE(KEEP(28))
77 INTEGER INTARR( KEEP8(27) )
78 REAL 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 ! defined(NO_FDM_MAPROW)
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
119 CALL smumps_blr_end_front(iw(ioldps+xxf), iflag, keep8,
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
127 CALL smumps_stack_band( n, inode,
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
141 CALL mumps_geti8(mem_gain, iw(ioldps+xxr))
142 lrlus = lrlus + mem_gain
143 keep8(69) = keep8(69) - mem_gain
144 CALL smumps_load_mem_update(.false.,.false.,
145 & la-lrlus,0_8,-mem_gain,keep,keep8,lrlus)
146 ELSE
147 iw(ioldps+xxs)=s_nolcbnocontig
148 CALL mumps_geti8( dyn_size, iw(ioldps+xxd))
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
155 CALL smumps_load_mem_update(.false.,.false.,
156 & la-lrlus,0_8,-mem_gain,keep,keep8,lrlus)
157 ENDIF
158 ENDIF
159 ENDIF
160 CALL mumps_geti8( dyn_size, iw(ioldps+xxd))
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
165 CALL smumps_makecbcontig(a,la,ptrast(step(inode)),
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
191 CALL smumps_build_and_send_cb_root( comm_load, ass_irecv,
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
213 CALL smumps_stack_band( n, inode,
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
221 CALL smumps_free_band( n, inode, ptrist, ptrast, iw, liw,
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
228 CALL smumps_free_band( n, inode, ptrist, ptrast, iw, liw,
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
236 CALL smumps_sizefreeinrec( iw(ioldps),
237 & liw-ioldps+1,
238 & mem_gain, keep(ixsz) )
239 lrlus = lrlus + mem_gain
240 keep8(69) = keep8(69) - mem_gain
241 CALL smumps_load_mem_update(.false.,.false.,
242 & la-lrlus,0_8,-mem_gain,keep,keep8,lrlus)
243 IF (keep(216).EQ.2) THEN
244 CALL smumps_makecbcontig(a,la,ptrast(step(inode)),
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
262 IF (mumps_fmrd_is_maprow_stored( iw(ioldps+xxa) )) THEN
263 CALL mumps_fmrd_retrieve_maprow( iw(ioldps+xxa), mrs )
264 IF (fpere .NE. mrs%INODE) THEN
265 WRITE(*,*) " Internal error 1 in SMUMPS_END_FACTO_SLAVE",
266 & inode, mrs%INODE, fpere
267 CALL mumps_abort()
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
278 CALL smumps_maplig( comm_load, ass_irecv,
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 & )
297 CALL mumps_fmrd_free_maprow_struc( iwhandler_save )
298 ENDIF
299 ENDIF
300#endif
301 RETURN
#define mumps_abort
Definition VE_Metis.h:25
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)
subroutine, public smumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
integer, save, private myid
Definition smumps_load.F:57
subroutine, public smumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
int comp(int a, int b)
subroutine smumps_sizefreeinrec(iw, lrec, size_free, xsize)
subroutine smumps_makecbcontig(a, la, rcurrent, nrow, ncb, ld, nelim, nodestate, ishift)
recursive subroutine smumps_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)
subroutine smumps_stack_band(n, ison, ptrist, ptrast, ptlust_s, ptrfac, iw, liw, a, la, lrlu, lrlus, iwpos, iwposcb, posfac, comp, iptrlu, opeliw, step, pimaster, pamaster, iflag, ierror, slavef, procnode_steps, dad, myid, comm, keep, keep8, dkeep, type_son)
Definition stools.F:219
subroutine smumps_free_band(n, ison, ptrist, ptrast, iw, liw, a, la, lrlu, lrlus, iwposcb, iptrlu, step, myid, keep, keep8, type_son)
Definition stools.F:461
recursive subroutine smumps_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)
Definition stype3_root.F:84
subroutine mumps_geti8(i8, int_array)