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

Go to the source code of this file.

Functions/Subroutines

subroutine smumps_process_contrib_type3 (bufr, lbufr, lbufr_bytes, root, n, iw, liw, a, la, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptlust, ptrfac, ptrast, step, pimaster, pamaster, comp, lrlus, ipool, lpool, leaf, fils, dad, myid, lptrar, nelt, frtptr, frtelt, ptraiw, ptrarw, intarr, dblarr, keep, keep8, dkeep, iflag, ierror, comm, comm_load, itloc, rhs_mumps, nd, procnode_steps, slavef, opassw)

Function/Subroutine Documentation

◆ smumps_process_contrib_type3()

subroutine smumps_process_contrib_type3 ( integer, dimension( lbufr_bytes ) bufr,
integer lbufr,
integer lbufr_bytes,
type (smumps_root_struc ) root,
integer n,
integer, dimension( liw ) iw,
integer liw,
real, dimension( la ) a,
integer(8) la,
integer(8) lrlu,
integer(8) iptrlu,
integer iwpos,
integer iwposcb,
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 comp,
integer(8) lrlus,
integer, dimension( leaf ) ipool,
integer lpool,
integer leaf,
integer, dimension( n ) fils,
integer, dimension(keep(28)) dad,
integer myid,
integer lptrar,
integer nelt,
integer, dimension( n+1 ) frtptr,
integer, dimension( nelt ) frtelt,
integer(8), dimension( lptrar ), intent(in) ptraiw,
integer(8), dimension( lptrar ), intent(in) ptrarw,
integer, dimension(keep8(27)) intarr,
real, dimension(keep8(26)) dblarr,
integer, dimension( 500 ) keep,
integer(8), dimension(150) keep8,
real, dimension(230) dkeep,
integer iflag,
integer ierror,
integer comm,
integer comm_load,
integer, dimension( n+keep(253) ) itloc,
real, dimension(keep(255)) rhs_mumps,
integer, dimension(keep(28)) nd,
integer, dimension(keep(28)) procnode_steps,
integer slavef,
double precision opassw )

Definition at line 14 of file sfac_process_contrib_type3.F.

26 USE smumps_load
27 USE smumps_ooc
28 USE smumps_struc_def, ONLY : smumps_root_struc
29 IMPLICIT NONE
30 TYPE (SMUMPS_ROOT_STRUC ) :: root
31 INTEGER :: KEEP( 500 )
32 INTEGER(8) :: KEEP8(150)
33 REAL :: DKEEP(230)
34 INTEGER(8) :: LA, LRLU, IPTRLU, LRLUS
35 INTEGER(8) :: PAMASTER(KEEP(28))
36 INTEGER(8) :: PTRAST(KEEP(28))
37 INTEGER(8) :: PTRFAC(KEEP(28))
38 INTEGER LBUFR, LBUFR_BYTES, N, LIW,
39 & IWPOS, IWPOSCB, COMP, COMM, COMM_LOAD, IFLAG,
40 & IERROR
41 INTEGER LPOOL, LEAF
42 INTEGER IPOOL( LEAF )
43 INTEGER PTRIST(KEEP(28))
44 INTEGER PTLUST(KEEP(28))
45 INTEGER STEP(N), PIMASTER(KEEP(28)), ITLOC( N+KEEP(253) )
46 REAL :: RHS_MUMPS(KEEP(255))
47 INTEGER BUFR( LBUFR_BYTES )
48 INTEGER IW( LIW )
49 INTEGER ND(KEEP(28)), PROCNODE_STEPS(KEEP(28))
50 INTEGER SLAVEF
51 REAL A( LA )
52 INTEGER MYID
53 INTEGER FILS( N ), DAD(KEEP(28))
54 INTEGER LPTRAR, NELT
55 INTEGER FRTPTR( N+1 ), FRTELT( NELT )
56 INTEGER(8), INTENT(IN) :: PTRAIW( LPTRAR ), PTRARW( LPTRAR )
57 INTEGER INTARR(KEEP8(27))
58 REAL DBLARR(KEEP8(26))
59 DOUBLE PRECISION OPASSW
60 include 'mpif.h'
61 INTEGER IERR
62 EXTERNAL mumps_procnode
63 INTEGER MUMPS_PROCNODE
64 INTEGER POSITION, LOCAL_M, LOCAL_N, LREQI
65 INTEGER(8) :: LREQA, POS_ROOT
66 INTEGER NSUBSET_ROW, NSUBSET_COL, IROOT, ISON, NSUBSET_COL_EFF
67 INTEGER NSUPCOL_EFF
68 INTEGER NBROWS_ALREADY_SENT, NBROWS_PACKET
69 INTEGER NSUPROW, NSUPCOL, BBPCBP
70 include 'mumps_headers.h'
71 position = 0
72 CALL mpi_unpack( bufr, lbufr_bytes, position,
73 & ison, 1, mpi_integer, comm, ierr )
74 CALL mpi_unpack( bufr, lbufr_bytes, position,
75 & nsubset_row, 1, mpi_integer, comm, ierr )
76 CALL mpi_unpack( bufr, lbufr_bytes, position,
77 & nsuprow, 1, mpi_integer, comm, ierr )
78 CALL mpi_unpack( bufr, lbufr_bytes, position,
79 & nsubset_col, 1, mpi_integer, comm, ierr )
80 CALL mpi_unpack( bufr, lbufr_bytes, position,
81 & nsupcol, 1, mpi_integer, comm, ierr )
82 CALL mpi_unpack( bufr, lbufr_bytes, position,
83 & nbrows_already_sent, 1, mpi_integer,
84 & comm, ierr )
85 CALL mpi_unpack( bufr, lbufr_bytes, position,
86 & nbrows_packet, 1, mpi_integer,
87 & comm, ierr )
88 CALL mpi_unpack( bufr, lbufr_bytes, position,
89 & bbpcbp, 1, mpi_integer,
90 & comm, ierr )
91 IF (bbpcbp .EQ. 1) THEN
92 nsubset_col_eff = nsubset_col - nsupcol
93 nsupcol_eff = 0
94 ELSE
95 nsubset_col_eff = nsubset_col
96 nsupcol_eff = nsupcol
97 ENDIF
98 iroot = keep( 38 )
99 IF ( ptrist( step(iroot) ) .NE. 0 .OR.
100 & ptlust( step(iroot)) .NE. 0 ) THEN
101 IF (nbrows_already_sent + nbrows_packet .EQ. nsubset_row
102 & - nsuprow .OR. nsubset_row - nsuprow.EQ.0 .OR.
103 & nsubset_col_eff .EQ. 0)THEN
104 keep(121) = keep(121) - 1
105 IF ( keep(121) .eq. 0 ) THEN
106 IF (keep(201).EQ.1) THEN
107 CALL smumps_ooc_force_wrt_buf_panel(ierr)
108 ELSEIF (keep(201).EQ.2) THEN
109 CALL smumps_force_write_buf(ierr)
110 ENDIF
111 CALL smumps_insert_pool_n( n, ipool, lpool,
112 & procnode_steps, slavef, keep(199),
113 & keep(28), keep(76),
114 & keep(80), keep(47),
115 & step, iroot + n)
116 IF (keep(47) .GE. 3) THEN
117 CALL smumps_load_pool_upd_new_pool(
118 & ipool, lpool,
119 & procnode_steps, keep,keep8, slavef, comm_load,
120 & myid, step, n, nd, fils )
121 ENDIF
122 ENDIF
123 ENDIF
124 ELSE
125 IF (nbrows_already_sent + nbrows_packet .EQ.
126 & nsubset_row - nsuprow .OR.
127 & nsubset_row - nsuprow.EQ.0 .OR.
128 & nsubset_col_eff .EQ. 0)THEN
129 keep(121)=-1
130 ENDIF
131 CALL smumps_root_alloc_static( root, iroot, n,
132 & iw, liw, a, la,
133 & fils, dad, myid, slavef, procnode_steps,
134 & lptrar, nelt, frtptr, frtelt,
135 & ptraiw, ptrarw, intarr, dblarr,
136 & lrlu, iptrlu,
137 & iwpos, iwposcb, ptrist, ptrast,
138 & step, pimaster, pamaster, itloc, rhs_mumps,
139 & comp, lrlus, iflag, keep,keep8,dkeep,ierror )
140 IF ( iflag .LT. 0 ) RETURN
141 END IF
142 IF (keep(60) .EQ.0) THEN
143 IF ( ptrist(step(iroot)) .GE. 0 ) THEN
144 IF ( ptrist(step(iroot)) .NE. 0 ) THEN
145 local_n = -iw( ptrist(step( iroot )) + keep(ixsz) )
146 local_m = iw( ptrist(step( iroot )) + 1 + keep(ixsz))
147 pos_root = pamaster(step( iroot ))
148 ELSE
149 local_n = iw( ptlust(step( iroot ) ) + 1 + keep(ixsz))
150 local_m = iw( ptlust(step( iroot ) ) + 2 + keep(ixsz))
151 pos_root = ptrfac(iw(ptlust(step(iroot))+4+
152 & keep(ixsz)))
153 END IF
154 ENDIF
155 ELSE
156 local_m = root%SCHUR_LLD
157 local_n = root%SCHUR_NLOC
158 ENDIF
159 IF ( (bbpcbp.EQ.1).AND. (nbrows_already_sent.EQ.0).AND.
160 & (min(nsuprow, nsupcol) .GT. 0)
161 & ) THEN
162 lreqi = nsuprow+nsupcol
163 lreqa = int(nsuprow,8) * int(nsupcol,8)
164 IF ( (lreqa.NE.0_8) .AND.
165 & (ptrist(step(iroot)).LT.0).AND.
166 & keep(60)==0) THEN
167 WRITE(*,*) ' Error in SMUMPS_PROCESS_CONTRIB_TYPE3'
168 CALL mumps_abort()
169 ENDIF
170 CALL smumps_alloc_cb(.false.,0_8,.false.,.false.,
171 & myid,n,keep,keep8,dkeep,iw,liw,a, la,
172 & lrlu, iptrlu, iwpos, iwposcb, slavef, procnode_steps, dad,
173 & ptrist, ptrast, step, pimaster, pamaster,
174 & lreqi, lreqa, -1234, s_notfree, .false.,
175 & comp, lrlus, keep8(67), iflag, ierror
176 & )
177 IF ( iflag .LT. 0 ) RETURN
178 CALL mpi_unpack( bufr, lbufr_bytes, position,
179 & iw( iwposcb + 1 ), lreqi,
180 & mpi_integer, comm, ierr )
181 CALL mpi_unpack( bufr, lbufr_bytes, position,
182 & a( iptrlu + 1_8 ), int(lreqa),
183 & mpi_real, comm, ierr )
184 opassw = opassw + lreqa
185 CALL smumps_ass_root( root, keep(50), nsuprow, nsupcol,
186 & iw( iwposcb + 1 ),
187 & iw( iwposcb + nsuprow + 1 ), nsupcol,
188 & a( iptrlu + 1_8 ),
189 & a( 1 ),
190 & local_m, local_n,
191 & root%RHS_ROOT(1,1), root%RHS_NLOC,
192 & 1)
193 iwposcb = iwposcb + lreqi
194 iptrlu = iptrlu + lreqa
195 lrlu = lrlu + lreqa
196 lrlus = lrlus + lreqa
197 keep8(69) = keep8(69) - lreqa
198 CALL smumps_load_mem_update(.false.,.false.,
199 & la-lrlus,0_8,-lreqa,keep,keep8,lrlus)
200 ENDIF
201 lreqi = nbrows_packet + nsubset_col_eff
202 lreqa = int(nbrows_packet,8) * int(nsubset_col_eff,8)
203 IF ( (lreqa.NE.0_8) .AND.
204 & (ptrist(step(iroot)).LT.0).AND.
205 & keep(60)==0) THEN
206 WRITE(*,*) ' Error in SMUMPS_PROCESS_CONTRIB_TYPE3'
207 CALL mumps_abort()
208 ENDIF
209 IF (lreqa.NE.0_8) THEN
210 CALL smumps_alloc_cb(.false.,0_8,.false.,.false.,
211 & myid,n,keep,keep8,dkeep,iw,liw,a, la,
212 & lrlu, iptrlu, iwpos, iwposcb, slavef, procnode_steps, dad,
213 & ptrist, ptrast, step, pimaster, pamaster,
214 & lreqi, lreqa, -1234, s_notfree, .false.,
215 & comp, lrlus, keep8(67), iflag, ierror
216 & )
217 IF ( iflag .LT. 0 ) RETURN
218 CALL mpi_unpack( bufr, lbufr_bytes, position,
219 & iw( iwposcb + 1 ), lreqi,
220 & mpi_integer, comm, ierr )
221 CALL mpi_unpack( bufr, lbufr_bytes, position,
222 & a( iptrlu + 1_8 ), int(lreqa),
223 & mpi_real, comm, ierr )
224 opassw = opassw + lreqa
225 IF (keep(60).EQ.0) THEN
226 CALL smumps_ass_root( root, keep(50),
227 & nbrows_packet, nsubset_col_eff,
228 & iw( iwposcb + 1 ),
229 & iw( iwposcb + nbrows_packet + 1 ),
230 & nsupcol_eff,
231 & a( iptrlu + 1_8 ),
232 & a( pos_root ), local_m, local_n,
233 & root%RHS_ROOT(1,1), root%RHS_NLOC,
234 & 0)
235 ELSE
236 CALL smumps_ass_root( root, keep(50),
237 & nbrows_packet, nsubset_col_eff,
238 & iw( iwposcb + 1 ),
239 & iw( iwposcb + nbrows_packet + 1 ),
240 & nsupcol_eff,
241 & a( iptrlu + 1_8 ),
242 & root%SCHUR_POINTER(1),
243 & root%SCHUR_LLD , root%SCHUR_NLOC,
244 & root%RHS_ROOT(1,1), root%RHS_NLOC,
245 & 0)
246 ENDIF
247 iwposcb = iwposcb + lreqi
248 iptrlu = iptrlu + lreqa
249 lrlu = lrlu + lreqa
250 lrlus = lrlus + lreqa
251 keep8(69) = keep8(69) - lreqa
252 CALL smumps_load_mem_update(.false.,.false.,
253 & la-lrlus,0_8,-lreqa,keep,keep8,lrlus)
254 ENDIF
255 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
min
#define min(a, b)
Definition macros.h:20
mpi_unpack
subroutine mpi_unpack(inbuf, insize, position, outbuf, outcnt, datatype, comm, ierr)
Definition mpi.f:514
smumps_load
Definition smumps_load.F:14
smumps_load::smumps_load_mem_update
subroutine, public smumps_load_mem_update(ssarbr, process_bande_arg, mem_value, new_lu, inc_mem_arg, keep, keep8, lrlus)
Definition smumps_load.F:920
smumps_load::smumps_load_pool_upd_new_pool
subroutine, public smumps_load_pool_upd_new_pool(pool, lpool, procnode, keep, keep8, slavef, comm, myid, step, n, nd, fils)
Definition smumps_load.F:1820
smumps_load::myid
integer, save, private myid
Definition smumps_load.F:57
smumps_ooc
Definition smumps_ooc.F:14
smumps_ooc::smumps_ooc_force_wrt_buf_panel
subroutine smumps_ooc_force_wrt_buf_panel(ierr)
Definition smumps_ooc.F:2965
smumps_ooc::smumps_force_write_buf
subroutine smumps_force_write_buf(ierr)
Definition smumps_ooc.F:2951
smumps_struc_def
Definition smumps_struc_def.F:14
comp
int comp(int a, int b)
Definition set_surface_lines.cpp:102
smumps_alloc_cb
subroutine smumps_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)
Definition sfac_mem_alloc_cb.F:23
smumps_insert_pool_n
subroutine smumps_insert_pool_n(n, pool, lpool, procnode, slavef, keep199, k28, k76, k80, k47, step, inode)
Definition sfac_sol_pool.F:27
smumps_root_alloc_static
subroutine smumps_root_alloc_static(root, iroot, n, iw, liw, a, la, fils, dad, myid, slavef, procnode_steps, lptrar, nelt, frtptr, frtelt, ptraiw, ptrarw, intarr, dblarr, lrlu, iptrlu, iwpos, iwposcb, ptrist, ptrast, step, pimaster, pamaster, itloc, rhs_mumps, comp, lrlus, iflag, keep, keep8, dkeep, ierror)
Definition stype3_root.F:1089
smumps_ass_root
subroutine smumps_ass_root(root, keep50, nrow_son, ncol_son, indrow_son, indcol_son, nsupcol, val_son, val_root, local_m, local_n, rhs_root, nloc_root, cbp)
Definition stype3_root.F:19
mumps_procnode
integer function mumps_procnode(procinfo_inode, k199)
Definition tools_common.F:151