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.LE..AND. IF ((IWHANDLER_IN 0)
89.NE. & (INODE 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.eq. IF ( KEEP(50) 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.eq. IF ( KEEP(50) 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.GT..AND..EQ..AND. IF ( LREQCB LRLUS KEEP(101) 0
117.LE. & KEEP8(73) + LREQCB 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.LT. IF ( IFLAG 0 ) RETURN
127#if defined(MUMPS_ALLOC_FROM_C)
128 CALL MUMPS_MALLOC_C( TMP_ADDRESS,
129 & LREQCB * int(KEEP(35),8) )
130.EQ. IF (TMP_ADDRESS 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.GT. IF (allocok 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.EQ. & KEEP(405)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.EQ. IF ( PTRIST(STEP(INODE)) 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.LT. IF ( IFLAG 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.LE..AND. IF ((IWHANDLER_IN 0)
173.NE. & (INODE 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.eq. IF ( KEEP(50) 0 ) THEN
190 IW( IWPOSCB + 7+KEEP(IXSZ) ) = S_ROOTBAND_INIT
191.GT. IF (NSLAVES_HDR0) 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.EQ..OR. COMPRESS_CB = ((LRSTATUS1)
206.EQ. & (LRSTATUS3))
207.GT. LR_ACTIVATED = (LRSTATUS0)
208.AND. IF (LR_ACTIVATED
209.NE. & (KEEP(480)0
210.OR. &
211 & (
212.EQ. & (KEEP(486)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.LT. IF (INFO_TMP(1)0) THEN
219 IFLAG = INFO_TMP(1)
220 IERROR = INFO_TMP(2)
221 RETURN
222 ENDIF
223.AND. IF (COMPRESS_CB
224.NE..AND..EQ..AND. & (KEEP(219)0)(KEEP(50)2)
225.GE. & (ESTIM_NFS4FATHER_ATSON0)
226 & ) THEN
227 CALL DMUMPS_BLR_SAVE_NFS4FATHER ( IW(IWPOSCB+1+XXF),
228 & ESTIM_NFS4FATHER_ATSON )
229 ENDIF
230 ENDIF
231.EQ. IF (NBPROCFILS 0) THEN
232 ENDIF
233 RETURN
subroutine, public dmumps_blr_init_front(iwhandler, info, mtk405)
subroutine, public dmumps_blr_save_nfs4father(iwhandler, nfs4father)

◆ 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
#define mumps_abort
Definition VE_Metis.h:25
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, save, public inode_waited_for
int comp(int a, int b)
integer function mumps_procnode(procinfo_inode, k199)