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

Go to the source code of this file.

Functions/Subroutines

subroutine smumps_mv_elt (n, nelt, eltptr, eltvar, a_elt, x, y, k50, mtype)
subroutine smumps_loc_mv8 (n, nz_loc8, irn_loc, jcn_loc, a_loc, x, y_loc, ldlt, mtype)
subroutine smumps_mv8 (n, nz8, irn, icn, aspk, x, y, ldlt, mtype, maxtrans, perm, iflag, ierror)
subroutine smumps_loc_omega1 (n, nz_loc8, irn_loc, jcn_loc, a_loc, x, y_loc, ldlt, mtype)

Function/Subroutine Documentation

◆ smumps_loc_mv8()

subroutine smumps_loc_mv8 ( integer n,
integer(8) nz_loc8,
integer, dimension( nz_loc8 ) irn_loc,
integer, dimension( nz_loc8 ) jcn_loc,
real, dimension( nz_loc8 ) a_loc,
real, dimension( n ) x,
real, dimension( n ) y_loc,
integer ldlt,
integer mtype )

Definition at line 123 of file ssol_matvec.F.

126 IMPLICIT NONE
127C
128C Purpose:
129C =======
130C
131C Perform a distributed matrix vector product.
132C Y_loc <- A X if MTYPE = 1
133C Y_loc <- A^T X if MTYPE = 0
134C
135C Notes:
136C =====
137C
138C 1) assembly of all Y_loc still has to be done on exit.
139C 2) X should be available on all processors.
140C
141C Arguments:
142C =========
143C
144 INTEGER N
145 INTEGER(8) :: NZ_loc8
146 INTEGER IRN_loc( NZ_loc8 ), JCN_loc( NZ_loc8 )
147 REAL A_loc( NZ_loc8 ), X( N ), Y_loc( N )
148 INTEGER LDLT, MTYPE
149C
150C Locals variables:
151C ================
152C
153 INTEGER I, J
154 INTEGER(8) :: K8
155 REAL ZERO
156 parameter( zero = 0.0e0 )
157 y_loc = zero
158 IF ( ldlt .eq. 0 ) THEN
159C Unsymmetric
160 IF ( mtype .eq. 1 ) THEN
161C No transpose
162 DO k8 = 1_8, nz_loc8
163 i = irn_loc(k8)
164 j = jcn_loc(k8)
165 IF ((i .LE. 0) .OR. (i .GT. n) .OR.
166 & (j .LE. 0) .OR. (j .GT. n)
167 & ) cycle
168 y_loc(i) = y_loc(i) + a_loc(k8) * x(j)
169 ENDDO
170 ELSE
171C Transpose
172 DO k8 = 1_8, nz_loc8
173 i = irn_loc(k8)
174 j = jcn_loc(k8)
175 IF ((i .LE. 0) .OR. (i .GT. n)
176 & .OR. (j .LE. 0) .OR. (j .GT. n)
177 & ) cycle
178 y_loc(j) = y_loc(j) + a_loc(k8) * x(i)
179 ENDDO
180 END IF
181 ELSE
182C Lower (or upper) part of symmetric
183C matrix was provided (LDLT facto)
184 DO k8 = 1_8, nz_loc8
185 i = irn_loc(k8)
186 j = jcn_loc(k8)
187 IF ((i .LE. 0) .OR. (i .GT. n) .OR.
188 & (j .LE. 0) .OR. (j .GT. n)
189 & ) cycle
190 y_loc(i) = y_loc(i) + a_loc(k8) * x(j)
191 IF (j.NE.i) THEN
192 y_loc(j) = y_loc(j) + a_loc(k8) * x(i)
193 ENDIF
194 ENDDO
195 END IF
196 RETURN

◆ smumps_loc_omega1()

subroutine smumps_loc_omega1 ( integer n,
integer(8) nz_loc8,
integer, dimension( nz_loc8 ) irn_loc,
integer, dimension( nz_loc8 ) jcn_loc,
real, dimension( nz_loc8 ) a_loc,
real, dimension( n ) x,
real, dimension( n ) y_loc,
integer ldlt,
integer mtype )

Definition at line 302 of file ssol_matvec.F.

305 IMPLICIT NONE
306C
307C Purpose:
308C =======
309C Compute
310C * If MTYPE = 1
311C Y_loc(i) = Sum | Aij | | Xj |
312C j
313C * If MTYPE = 0
314C Y_loc(j) = Sum | Aij | | Xi |
315C
316C
317C Notes:
318C =====
319C
320C 1) assembly of all Y_loc still has to be done.
321C 2) X should be available on all processors.
322C
323C Arguments:
324C =========
325C
326 INTEGER N
327 INTEGER(8) :: NZ_loc8
328 INTEGER IRN_loc( NZ_loc8 ), JCN_loc( NZ_loc8 )
329 REAL A_loc( NZ_loc8 ), X( N )
330 REAL Y_loc( N )
331 INTEGER LDLT, MTYPE
332C
333C Local variables:
334C ===============
335C
336 INTEGER I, J
337 INTEGER(8) :: K8
338 REAL, PARAMETER :: RZERO=0.0e0
339C
340 y_loc = rzero
341 IF ( ldlt .eq. 0 ) THEN
342C Unsymmetric
343 IF ( mtype .eq. 1 ) THEN
344C No transpose
345 DO k8 = 1_8, nz_loc8
346 i = irn_loc(k8)
347 j = jcn_loc(k8)
348 IF ((i .LE. 0) .OR. (i .GT. n) .OR.
349 & (j .LE. 0) .OR. (j .GT. n)
350 & ) cycle
351 y_loc(i) = y_loc(i) + abs( a_loc(k8) * x(j) )
352 ENDDO
353 ELSE
354C Transpose
355 DO k8 = 1_8, nz_loc8
356 i = irn_loc(k8)
357 j = jcn_loc(k8)
358 IF ((i .LE. 0) .OR. (i .GT. n)
359 & .OR. (j .LE. 0) .OR. (j .GT. n)
360 & ) cycle
361 y_loc(j) = y_loc(j) + abs( a_loc(k8) * x(i) )
362 ENDDO
363 END IF
364 ELSE
365C Lower (or upper) part of symmetric
366C matrix was provided (LDLT facto)
367 DO k8 = 1_8, nz_loc8
368 i = irn_loc(k8)
369 j = jcn_loc(k8)
370 IF ((i .LE. 0) .OR. (i .GT. n) .OR.
371 & (j .LE. 0) .OR. (j .GT. n)
372 & ) cycle
373 y_loc(i) = y_loc(i) + abs( a_loc(k8) * x(j) )
374 IF (j.NE.i) THEN
375 y_loc(j) = y_loc(j) + abs( a_loc(k8) * x(i) )
376 ENDIF
377 ENDDO
378 END IF
379 RETURN

◆ smumps_mv8()

subroutine smumps_mv8 ( integer n,
integer(8) nz8,
integer, dimension( nz8 ) irn,
integer, dimension( nz8 ) icn,
real, dimension( nz8 ) aspk,
real, dimension( n ) x,
real, dimension( n ) y,
integer ldlt,
integer mtype,
integer maxtrans,
integer, dimension( n ) perm,
integer, intent(inout) iflag,
integer, intent(inout) ierror )

Definition at line 198 of file ssol_matvec.F.

201C
202C Purpose:
203C =======
204C
205C Perform matrix-vector product
206C Y <- A X if MTYPE = 1
207C Y <- A^T X if MTYPE = 0
208C
209C
210C Note:
211C ====
212C
213C MAXTRANS should be set to 1 if a column permutation
214C was applied on A and we still want the matrix vector
215C product wrt the original matrix.
216C
217C Arguments:
218C =========
219C
220 INTEGER N, LDLT, MTYPE, MAXTRANS
221 INTEGER(8) :: NZ8
222 INTEGER IRN( NZ8 ), ICN( NZ8 )
223 INTEGER PERM( N )
224 REAL ASPK( NZ8 ), X( N ), Y( N )
225 INTEGER, intent(inout) :: IFLAG, IERROR
226C
227C Local variables
228C ===============
229C
230 INTEGER I, J
231 INTEGER(8) :: K8
232 REAL, DIMENSION(:), ALLOCATABLE :: PX
233 REAL ZERO
234 INTEGER :: allocok
235 parameter( zero = 0.0e0 )
236 y = zero
237 ALLOCATE(px(n), stat=allocok)
238 IF (allocok < 0) THEN
239 iflag = -13
240 ierror = n
241 RETURN
242 ENDIF
243C
244C --------------------------------------
245C Permute X if A has been permuted
246C with some max-trans column permutation
247C --------------------------------------
248 IF ( maxtrans .eq. 1 .and. mtype .eq. 1) THEN
249 DO i = 1, n
250 px(i) = x( perm( i ) )
251 END DO
252 ELSE
253 px = x
254 END IF
255 IF ( ldlt .eq. 0 ) THEN
256C
257C Complete unsymmetric matrix was provided (LU facto)
258 IF (mtype .EQ. 1) THEN
259 DO k8 = 1_8, nz8
260 i = irn(k8)
261 j = icn(k8)
262 IF ((i .LE. 0) .OR. (i .GT. n) .OR. (j .LE. 0) .OR. (j .GT. n)
263 & ) cycle
264 y(i) = y(i) + aspk(k8) * px(j)
265 ENDDO
266 ELSE
267 DO k8 = 1_8, nz8
268 i = irn(k8)
269 j = icn(k8)
270 IF ((i .LE. 0) .OR. (i .GT. n) .OR. (j .LE. 0) .OR. (j .GT. n)
271 & ) cycle
272 y(j) = y(j) + aspk(k8) * px(i)
273 ENDDO
274 ENDIF
275C
276 ELSE
277C
278C Lower (or upper) part of symmetric
279C matrix was provided (LDLT facto)
280 DO k8 = 1_8, nz8
281 i = irn(k8)
282 j = icn(k8)
283 IF ((i .LE. 0) .OR. (i .GT. n) .OR. (j .LE. 0) .OR. (j .GT. n)
284 & ) cycle
285 y(i) = y(i) + aspk(k8) * px(j)
286 IF (j.NE.i) THEN
287 y(j) = y(j) + aspk(k8) * px(i)
288 ENDIF
289 ENDDO
290 END IF
291 IF ( maxtrans .EQ. 1 .AND. mtype .eq. 0 ) THEN
292 px = y
293 DO i = 1, n
294 y( perm( i ) ) = px( i )
295 END DO
296 END IF
297 DEALLOCATE(px)
298 RETURN

◆ smumps_mv_elt()

subroutine smumps_mv_elt ( integer n,
integer nelt,
integer, dimension( nelt + 1 ) eltptr,
integer, dimension( * ) eltvar,
real, dimension( * ) a_elt,
real, dimension( n ) x,
real, dimension( n ) y,
integer k50,
integer mtype )

Definition at line 14 of file ssol_matvec.F.

16 IMPLICIT NONE
17C
18C Purpose
19C =======
20C
21C To perform the matrix vector product
22C A_ELT X = Y if MTYPE = 1
23C A_ELT^T X = Y if MTYPE = 0
24C
25C If K50 is different from 0, then the elements are
26C supposed to be in symmetric packed storage; the
27C lower part is stored by columns.
28C Otherwise, the element is square, stored by columns.
29C
30C Note
31C ====
32C
33C A_ELT is processed entry by entry and this code is not
34C optimized. In particular, one could gather/scatter
35C X / Y for each element to improve performance.
36C
37C Arguments
38C =========
39C
40 INTEGER N, NELT, K50, MTYPE
41 INTEGER ELTPTR( NELT + 1 ), ELTVAR( * )
42 REAL A_ELT( * ), X( N ), Y( N )
43C
44C Local variables
45C ===============
46C
47 INTEGER IEL, I , J, SIZEI, IELPTR
48 INTEGER(8) :: K8
49 REAL TEMP
50 REAL ZERO
51 parameter( zero = 0.0e0 )
52C
53C
54C Executable statements
55C =====================
56C
57 y = zero
58 k8 = 1_8
59C --------------------
60C Process the elements
61C --------------------
62 DO iel = 1, nelt
63 sizei = eltptr( iel + 1 ) - eltptr( iel )
64 ielptr = eltptr( iel ) - 1
65 IF ( k50 .eq. 0 ) THEN
66C -------------------
67C Unsymmetric element
68C stored by columns
69C -------------------
70 IF ( mtype .eq. 1 ) THEN
71C -----------------
72C Compute A_ELT x X
73C -----------------
74 DO j = 1, sizei
75 temp = x( eltvar( ielptr + j ) )
76 DO i = 1, sizei
77 y( eltvar( ielptr + i ) ) =
78 & y( eltvar( ielptr + i ) ) +
79 & a_elt( k8 ) * temp
80 k8 = k8 + 1
81 END DO
82 END DO
83 ELSE
84C -------------------
85C Compute A_ELT^T x X
86C -------------------
87 DO j = 1, sizei
88 temp = y( eltvar( ielptr + j ) )
89 DO i = 1, sizei
90 temp = temp +
91 & a_elt( k8 ) * x( eltvar( ielptr + i ) )
92 k8 = k8 + 1
93 END DO
94 y( eltvar( ielptr + j ) ) = temp
95 END DO
96 END IF
97 ELSE
98C -----------------
99C Symmetric element
100C L stored by cols
101C -----------------
102 DO j = 1, sizei
103C Diagonal counted once
104 y( eltvar( ielptr + j ) ) =
105 & y( eltvar( ielptr + j ) ) +
106 & a_elt( k8 ) * x( eltvar( ielptr + j ) )
107 k8 = k8 + 1
108 DO i = j+1, sizei
109C Off diagonal + transpose
110 y( eltvar( ielptr + i ) ) =
111 & y( eltvar( ielptr + i ) ) +
112 & a_elt( k8 ) * x( eltvar( ielptr + j ) )
113 y( eltvar( ielptr + j ) ) =
114 & y( eltvar( ielptr + j ) ) +
115 & a_elt( k8 ) * x( eltvar( ielptr + i ) )
116 k8 = k8 + 1
117 END DO
118 END DO
119 END IF
120 END DO
121 RETURN