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

Go to the source code of this file.

Functions/Subroutines

subroutine dmumps_process_desc_bande (myid, bufr, lbufr, lbufr_bytes, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, slavef, procnode_steps, dad, ptrist, ptrast, step, pimaster, pamaster, comp, keep, keep8, dkeep, itloc, rhs_mumps, istep_to_iniv2, iwhandler_in, iflag, ierror)
recursive subroutine dmumps_treat_descband (inode, comm_load, ass_irecv, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, 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, stack_right_authorized, lrgroups)

Function/Subroutine Documentation

◆ dmumps_process_desc_bande()

subroutine dmumps_process_desc_bande ( integer myid,
integer, dimension( lbufr ) bufr,
integer lbufr,
integer lbufr_bytes,
integer iwpos,
integer iwposcb,
integer(8) iptrlu,
integer(8) lrlu,
integer(8) lrlus,
integer n,
integer, dimension( liw ) iw,
integer liw,
double precision, dimension( la ) a,
integer(8) la,
integer, intent(in) slavef,
integer, dimension(keep(28)), intent(in) procnode_steps,
integer, dimension(keep(28)), intent(in) dad,
integer, dimension(keep(28)) ptrist,
integer(8), dimension(keep(28)) ptrast,
integer, dimension(n) step,
integer, dimension(keep(28)) pimaster,
integer(8), dimension(keep(28)) pamaster,
integer comp,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, dimension(230) dkeep,
integer, dimension( n + keep(253) ) itloc,
double precision, dimension(keep(255)) rhs_mumps,
integer, dimension(keep(71)) istep_to_iniv2,
integer iwhandler_in,
integer iflag,
integer ierror )

Definition at line 14 of file dfac_process_band.F.

25 USE dmumps_load
28#if ! defined(NO_FDM_DESCBAND)
30#endif
31 IMPLICIT NONE
32 INTEGER MYID
33 INTEGER KEEP(500)
34 INTEGER(8) KEEP8(150)
35 DOUBLE PRECISION DKEEP(230)
36 INTEGER LBUFR, LBUFR_BYTES
37 INTEGER BUFR( LBUFR )
38 INTEGER(8) :: IPTRLU, LRLU, LRLUS, LA
39 INTEGER IWPOS, IWPOSCB, N, LIW
40 INTEGER IW( LIW )
41 DOUBLE PRECISION A( LA )
42 INTEGER, INTENT(IN) :: SLAVEF
43 INTEGER, INTENT(IN) :: PROCNODE_STEPS(KEEP(28)), DAD(KEEP(28))
44 INTEGER(8) :: PAMASTER(KEEP(28))
45 INTEGER(8) :: PTRAST(KEEP(28))
46 INTEGER PTRIST(KEEP(28)), STEP(N),
47 & PIMASTER(KEEP(28)),
48 & ITLOC( N + KEEP(253) )
49 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
50 INTEGER :: ISTEP_TO_INIV2(KEEP(71))
51#if ! defined(NO_FDM_DESCBAND)
52 INTEGER IWHANDLER_IN
53#endif
54 INTEGER COMP, IFLAG, IERROR
55 INTEGER INODE, NBPROCFILS, NCOL, NROW, NASS, NSLAVES
56 INTEGER NSLAVES_HDR, NFRONT
57 INTEGER LREQ
58 INTEGER :: IBUFR
59 INTEGER(8) :: LREQCB
60#if ! defined(NO_FDM_DESCBAND)
61 INTEGER :: IWHANDLER_LOC
62#endif
63 DOUBLE PRECISION FLOP1
64 include 'mumps_headers.h'
65#if ! defined(NO_FDM_DESCBAND)
66 INTEGER :: INFO_TMP(2)
67#else
68#endif
69 INTEGER :: LRSTATUS
70 INTEGER :: ESTIM_NFS4FATHER_ATSON
71 LOGICAL :: LR_ACTIVATED, COMPRESS_CB
72 DOUBLE PRECISION, POINTER, DIMENSION(:) :: DYNAMIC_CB
73 INTEGER(8) :: TMP_ADDRESS
74 INTEGER :: allocok
75 inode = bufr( 2 )
76 nbprocfils = bufr( 3 )
77 nrow = bufr( 4 )
78 ncol = bufr( 5 )
79 nass = bufr( 6 )
80 nfront = bufr( 7 )
81 nslaves_hdr = bufr( 8 )
82 nslaves = bufr( 9 )
83 lrstatus = bufr(10 )
84 estim_nfs4father_atson = bufr(11)
85 ibufr = 12
86#if ! defined(NO_FDM_DESCBAND)
87 iwhandler_loc = iwhandler_in
88 IF ((iwhandler_in .LE. 0) .AND.
89 & (inode .NE. inode_waited_for)) THEN
90 info_tmp=0
91 CALL mumps_fdbd_save_descband(inode, bufr(1), bufr,
92 & iwhandler_loc, info_tmp)
93 IF (info_tmp(1) < 0) THEN
94 iflag = info_tmp(1)
95 ierror = info_tmp(2)
96 RETURN
97 ENDIF
98 GOTO 555
99 ENDIF
100#endif
101 IF ( keep(50) .eq. 0 ) THEN
102 flop1 = dble( nass * nrow ) +
103 & dble(nrow*nass)*dble(2*ncol-nass-1)
104 ELSE
105 flop1 = dble( nass ) * dble( nrow )
106 & * dble( 2 * ncol - nrow - nass + 1)
107 END IF
108 CALL dmumps_load_update(1,.true.,flop1, keep,keep8)
109 IF ( keep(50) .eq. 0 ) THEN
110 nslaves = nslaves_hdr + xtra_slaves_unsym
111 ELSE
112 nslaves = nslaves_hdr + xtra_slaves_sym
113 END IF
114 lreq = nrow + ncol + 6 + nslaves + keep(ixsz)
115 lreqcb = int(ncol,8) * int(nrow,8)
116 IF ( lreqcb .GT. lrlus .AND. keep(101) .EQ. 0 .AND.
117 & keep8(73) + lreqcb .LE. keep8(75) ) THEN
118 CALL dmumps_alloc_cb(.false., 0_8, .false.,.true.,
119 & myid,n, keep, keep8, dkeep, iw, liw, a, la,
120 & lrlu, iptrlu,iwpos,iwposcb, slavef, procnode_steps, dad,
121 & ptrist,ptrast, step, pimaster,pamaster,
122 & lreq, 0_8,
123 & inode, s_active, .true.,
124 & comp, lrlus, keep8(67), iflag, ierror
125 & )
126 IF ( iflag .LT. 0 ) RETURN
127#if defined(MUMPS_ALLOC_FROM_C)
128 CALL mumps_malloc_c( tmp_address,
129 & lreqcb * int(keep(35),8) )
130 IF (tmp_address .EQ. 0_8) THEN
131 allocok=1
132 ELSE
133 allocok=0
134 ENDIF
135#else
136 ALLOCATE(dynamic_cb(lreqcb), stat=allocok)
137#endif
138 IF (allocok .GT. 0) THEN
139 CALL dmumps_free_block_cb_static( .false., myid, n,
140 & iwposcb + 1, iw, liw, lrlu, lrlus, iptrlu, iwposcb,
141 & la, keep, keep8, .false. )
142 ELSE
143 CALL mumps_dm_fac_upd_dyn_memcnts( lreqcb,
144 & keep(405).EQ.1,
145 & keep8, iflag, ierror,
146 & .true.,
147 & .false. )
148#if ! defined(MUMPS_ALLOC_FROM_C)
149 CALL mumps_addr_c( dynamic_cb(1), tmp_address )
150#endif
151 CALL mumps_storei8(lreqcb, iw(iwposcb+1+xxd))
152 ptrist(step(inode)) = iwposcb + 1
153 ptrast(step(inode)) = tmp_address
154 ENDIF
155 ENDIF
156 IF ( ptrist(step(inode)) .EQ. 0 ) THEN
157 CALL dmumps_alloc_cb(.false., 0_8, .false.,.true.,
158 & myid,n, keep, keep8, dkeep, iw, liw, a, la,
159 & lrlu, iptrlu,iwpos,iwposcb, slavef, procnode_steps, dad,
160 & ptrist,ptrast, step, pimaster,pamaster,
161 & lreq, lreqcb, inode, s_active, .true.,
162 & comp, lrlus, keep8(67), iflag, ierror
163 & )
164 IF ( iflag .LT. 0 ) RETURN
165 ptrist(step(inode)) = iwposcb + 1
166 ptrast(step(inode)) = iptrlu + 1_8
167 ENDIF
168# if ! defined(NO_FDM_DESCBAND)
169 555 CONTINUE
170# endif
171# if ! defined(NO_FDM_DESCBAND)
172 IF ((iwhandler_in .LE. 0) .AND.
173 & (inode .NE. inode_waited_for)) THEN
174 RETURN
175 ENDIF
176 iw(iwposcb+1+xxa) = iwhandler_loc
177# endif
178 iw(iwposcb+1+xxf) = -9999
179 iw( iwposcb + 1+keep(ixsz) ) = ncol
180 iw( iwposcb + 2+keep(ixsz) ) = - nass
181 iw( iwposcb + 3+keep(ixsz) ) = nrow
182 iw( iwposcb + 4+keep(ixsz) ) = 0
183 iw( iwposcb + 5+keep(ixsz) ) = nass
184 iw( iwposcb + 6+keep(ixsz) ) = nslaves
185 iw( iwposcb + 7+keep(ixsz)+nslaves :
186 & iwposcb + 6+keep(ixsz)+nslaves + nrow + ncol )
187 &= bufr( ibufr + nslaves_hdr :
188 & ibufr + nslaves_hdr + nrow + ncol - 1 )
189 IF ( keep(50) .eq. 0 ) THEN
190 iw( iwposcb + 7+keep(ixsz) ) = s_rootband_init
191 IF (nslaves_hdr.GT.0) THEN
192 write(6,*) " Internal error in DMUMPS_PROCESS_DESC_BANDE "
193 CALL mumps_abort()
194 ENDIF
195 ELSE
196 iw( iwposcb+7+keep(ixsz) ) = huge(iw(iwposcb+7+keep(ixsz)))
197 iw( iwposcb + 8+keep(ixsz) ) = nfront
198 iw( iwposcb + 9+keep(ixsz) ) = s_rootband_init
199 iw( iwposcb + 7+xtra_slaves_sym+keep(ixsz):
200 & iwposcb + 6+xtra_slaves_sym+keep(ixsz)+nslaves_hdr ) =
201 & bufr( ibufr: ibufr - 1 + nslaves_hdr )
202 END IF
203 iw(iwposcb+1+xxnbpr)=nbprocfils
204 iw(iwposcb+1+xxlr)=lrstatus
205 compress_cb = ((lrstatus.EQ.1).OR.
206 & (lrstatus.EQ.3))
207 lr_activated = (lrstatus.GT.0)
208 IF (lr_activated.AND.
209 & (keep(480).NE.0
210 & .OR.
211 & (
212 & (keep(486).EQ.2)
213 & )
214 & .OR.compress_cb
215 & )) THEN
216 info_tmp=0
217 CALL dmumps_blr_init_front (iw(iwposcb+1+xxf), info_tmp)
218 IF (info_tmp(1).LT.0) THEN
219 iflag = info_tmp(1)
220 ierror = info_tmp(2)
221 RETURN
222 ENDIF
223 IF (compress_cb.AND.
224 & (keep(219).NE.0).AND.(keep(50).EQ.2).AND.
225 & (estim_nfs4father_atson.GE.0)
226 & ) THEN
227 CALL dmumps_blr_save_nfs4father ( iw(iwposcb+1+xxf),
228 & estim_nfs4father_atson )
229 ENDIF
230 ENDIF
231 IF (nbprocfils .EQ. 0) THEN
232 ENDIF
233 RETURN
#define mumps_abort
Definition VE_Metis.h:25
subroutine dmumps_alloc_cb(inplace, min_space_in_place, ssarbr, process_bande, myid, n, keep, keep8, dkeep, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, slavef, procnode_steps, dad, ptrist, ptrast, step, pimaster, pamaster, lreq, lreqcb, node_arg, state_arg, set_header, comp, lrlus, lrlusm, iflag, ierror)
subroutine dmumps_free_block_cb_static(ssarbr, myid, n, iposblock, iw, liw, lrlu, lrlus, iptrlu, iwposcb, la, keep, keep8, in_place_stats)
integer, save, private myid
Definition dmumps_load.F:57
subroutine, public dmumps_load_update(check_flops, process_bande, inc_load, keep, keep8)
subroutine, public dmumps_blr_init_front(iwhandler, info, mtk405)
subroutine, public dmumps_blr_save_nfs4father(iwhandler, nfs4father)
integer, save, public inode_waited_for
subroutine, public mumps_fdbd_save_descband(inode, lbufr, bufr, iwhandler, info)
int comp(int a, int b)
subroutine mumps_storei8(i8, int_array)
subroutine mumps_dm_fac_upd_dyn_memcnts(mem_count_allocated, atomic_updates, keep8, iflag, ierror, k69upd, k71upd)

◆ dmumps_treat_descband()

recursive subroutine dmumps_treat_descband ( integer, intent(in) inode,
integer comm_load,
integer ass_irecv,
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 n,
integer, dimension( liw ) iw,
integer liw,
double precision, dimension( la ) a,
integer(8) la,
integer, dimension( keep(28) ) ptrist,
integer, dimension(keep(28)) ptlust,
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_s,
integer comp,
integer iflag,
integer ierror,
integer comm,
integer, dimension(n) perm,
integer, dimension( lpool ) ipool,
integer lpool,
integer leaf,
integer nbfin,
integer myid,
integer slavef,
type (dmumps_root_struc) root,
double precision opassw,
double precision opeliw,
integer, dimension( n + keep(253) ) itloc,
double precision, 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,
double precision, dimension( keep8(26) ) dblarr,
integer, dimension(60) icntl,
integer, dimension(500) keep,
integer(8), dimension(150) keep8,
double precision, 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,
logical, intent(in) stack_right_authorized,
integer, dimension(n), intent(in) lrgroups )

Definition at line 235 of file dfac_process_band.F.

254# if ! defined(NO_FDM_DESCBAND)
256# endif
257 USE dmumps_struc_def, ONLY : dmumps_root_struc
258 IMPLICIT NONE
259 INTEGER, INTENT(IN) :: INODE
260 TYPE (DMUMPS_ROOT_STRUC) :: root
261 INTEGER KEEP(500), ICNTL(60)
262 INTEGER(8) KEEP8(150)
263 DOUBLE PRECISION DKEEP(230)
264 INTEGER LBUFR, LBUFR_BYTES
265 INTEGER COMM_LOAD, ASS_IRECV
266 INTEGER BUFR( LBUFR )
267 INTEGER(8) :: LA, POSFAC, IPTRLU, LRLU, LRLUS
268 INTEGER IWPOS, IWPOSCB
269 INTEGER N, LIW
270 INTEGER IW( LIW )
271 DOUBLE PRECISION A( LA )
272 INTEGER, intent(in) :: LRGROUPS(N)
273 INTEGER(8) :: PTRAST(KEEP(28))
274 INTEGER(8) :: PTRFAC(KEEP(28))
275 INTEGER(8) :: PAMASTER(KEEP(28))
276 INTEGER PTRIST( KEEP(28) ),
277 & PTLUST(KEEP(28))
278 INTEGER STEP(N),
279 & PIMASTER(KEEP(28))
280 INTEGER COMP
281 INTEGER NSTK_S(KEEP(28)), PROCNODE_STEPS( KEEP(28) )
282 INTEGER PERM(N)
283 INTEGER IFLAG, IERROR, COMM
284 INTEGER LPOOL, LEAF
285 INTEGER IPOOL( LPOOL )
286 INTEGER MYID, SLAVEF, NBFIN
287 DOUBLE PRECISION OPASSW, OPELIW
288 INTEGER NELT, LPTRAR
289 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
290 INTEGER ITLOC( N + KEEP(253) ), FILS( N ), DAD( KEEP(28) )
291 DOUBLE PRECISION :: RHS_MUMPS(KEEP(255))
292 INTEGER(8), INTENT(IN) :: PTRARW( LPTRAR ), PTRAIW( LPTRAR )
293 INTEGER ND( KEEP(28) ), FRERE( KEEP(28) )
294 INTEGER ISTEP_TO_INIV2(KEEP(71)),
295 & TAB_POS_IN_PERE(SLAVEF+2,max(1,KEEP(56)))
296 DOUBLE PRECISION DBLARR( KEEP8(26) )
297 INTEGER INTARR( KEEP8(27) )
298 LOGICAL, intent(in) :: STACK_RIGHT_AUTHORIZED
299 include 'mpif.h'
300 include 'mumps_tags.h'
301 include 'mumps_headers.h'
302 LOGICAL :: BLOCKING, SET_IRECV, MESSAGE_RECEIVED
303 INTEGER :: STATUS(MPI_STATUS_SIZE)
304 INTEGER :: SRC_DESCBAND
305#if ! defined(NO_FDM_DESCBAND)
306 INTEGER :: IWHANDLER
307 TYPE(DESCBAND_STRUC_T), POINTER :: DESCBAND_STRUC
308#endif
309 INTEGER MUMPS_PROCNODE
310 EXTERNAL mumps_procnode
311 src_descband = mumps_procnode( procnode_steps(step(inode)),
312 & keep(199) )
313# if ! defined(NO_FDM_DESCBAND)
314 IF (mumps_fdbd_is_descband_stored( inode, iwhandler )) THEN
315 CALL mumps_fdbd_retrieve_descband(iwhandler, descband_struc)
316 CALL dmumps_process_desc_bande( myid, descband_struc%BUFR(1),
317 & descband_struc%LBUFR,
318 & lbufr_bytes,
319 & iwpos, iwposcb,
320 & iptrlu, lrlu, lrlus,
321 & n, iw, liw, a, la, slavef, procnode_steps, dad,
322 & ptrist, ptrast, step, pimaster, pamaster, comp,
323 & keep, keep8, dkeep, itloc, rhs_mumps, istep_to_iniv2,
324 & iwhandler,
325 & iflag, ierror )
326 IF (iflag .LT. 0) GOTO 500
327 CALL mumps_fdbd_free_descband_struc(iw(ptrist(step(inode))+xxa))
328 ELSE
329 IF (inode_waited_for.GT.0) THEN
330 WRITE(*,*) " Internal error 1 in DMUMPS_TREAT_DESCBAND",
331 & inode, inode_waited_for
332 CALL mumps_abort()
333 ENDIF
334 inode_waited_for = inode
335# endif
336 DO WHILE (ptrist(step(inode)) .EQ. 0)
337 blocking = .true.
338 set_irecv = .false.
339 message_received = .false.
340 CALL dmumps_try_recvtreat(comm_load,
341 & ass_irecv, blocking, set_irecv, message_received,
342 & src_descband, maitre_desc_bande,
343 & status,
344 & bufr, lbufr, lbufr_bytes, procnode_steps, posfac,
345 & iwpos, iwposcb, iptrlu,
346 & lrlu, lrlus, n, iw, liw, a, la, ptrist,
347 & ptlust, ptrfac,
348 & ptrast, step, pimaster, pamaster, nstk_s, comp,
349 & iflag, ierror, comm,
350 & perm, ipool, lpool, leaf,
351 & nbfin, myid, slavef,
352 & root, opassw, opeliw, itloc, rhs_mumps,
353 & fils, dad, ptrarw, ptraiw,
354 & intarr, dblarr, icntl, keep,keep8,dkeep, nd, frere,
355 & lptrar, nelt, frtptr, frtelt,
356 & istep_to_iniv2, tab_pos_in_pere, .true.
357 & , lrgroups
358 & )
359 IF (iflag .LT. 0) THEN
360 RETURN
361 ENDIF
362 ENDDO
363# if ! defined(NO_FDM_DESCBAND)
365 ENDIF
366# endif
367 RETURN
368 500 CONTINUE
369 CALL dmumps_bdc_error( myid, slavef, comm, keep )
370 RETURN
subroutine dmumps_bdc_error(myid, slavef, comm, keep)
Definition dbcast_int.F:38
subroutine dmumps_process_desc_bande(myid, bufr, lbufr, lbufr_bytes, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, slavef, procnode_steps, dad, ptrist, ptrast, step, pimaster, pamaster, comp, keep, keep8, dkeep, itloc, rhs_mumps, istep_to_iniv2, iwhandler_in, iflag, ierror)
recursive subroutine dmumps_try_recvtreat(comm_load, ass_irecv, blocking, set_irecv, message_received, msgsou, msgtag, status, bufr, lbufr, lbufr_bytes, procnode_steps, posfac, iwpos, iwposcb, iptrlu, lrlu, lrlus, n, iw, liw, a, la, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, nstk_s, comp, iflag, ierror, comm, perm, ipool, lpool, leaf, nbfin, myid, slavef root, 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, stack_right_authorized, lrgroups)
subroutine, public mumps_fdbd_retrieve_descband(iwhandler, descband_struc)
subroutine, public mumps_fdbd_free_descband_struc(iwhandler)
logical function, public mumps_fdbd_is_descband_stored(inode, iwhandler)
integer function mumps_procnode(procinfo_inode, k199)