OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
asspar5.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| asspar5 ../engine/source/assembly/asspar5.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||====================================================================
28 SUBROUTINE asspar5(NTHREAD ,NUMNOD,NODFT ,NODLT,IRODDL,
29 . NPART,PARTFT ,PARTLT,A ,AR ,
30 . PARTSAV,STIFN ,STIFR,I8A ,I8AR ,
31 . I8STIFN,I8STIFR,VISCN ,I8VISCN,GREFT,
32 . GRELT ,GRESAV ,NGPE,NTHPART)
33C-----------------------------------------------
34C I m p l i c i t T y p e s
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C C o m m o n B l o c k s
39C-----------------------------------------------
40#include "param_c.inc"
41#include "scr18_c.inc"
42C
43 INTEGER NTHREAD,NUMNOD,NODFT,NODLT,IRODDL,
44 . NPART,PARTFT,PARTLT,GREFT,GRELT,NGPE,NTHPART
45 INTEGER K,KN,IKN,IKN1,IKN2,I,KM,KM1,KM2,NUM7,NUM8
46 integer*8
47 . i8a(3,3,*),i8ar(3,3,*),i8stifn(3,*),i8stifr(3,*),
48 . i8viscn(3,*)
49 my_real
50 . a(3,*),ar(3,*),partsav(*),stifn(*),stifr(*),viscn(*),gresav(*)
51c___________________________________________________
52 double precision r8_deuxm43
53 integer*8 i8_deuxp43
54 data i8_deuxp43 /'80000000000'x/
55 r8_deuxm43 = 1.d00 / i8_deuxp43
56c___________________________________________________
57C
58 num7 = npsav*npart
59 num8 = ngpe*npart
60C
61 kn = 0
62 km = 0
63 km1 = 0
64 DO k=1,nthread-1
65 kn = kn + numnod
66#include "vectorize.inc"
67 DO i=nodft,nodlt
68 ikn = i+kn
69 i8stifn(1,i) = i8stifn(1,i) + i8stifn(1,ikn)
70 i8stifn(1,ikn) = 0
71 i8stifn(2,i) = i8stifn(2,i) + i8stifn(2,ikn)
72 i8stifn(2,ikn) = 0
73 i8stifn(3,i) = i8stifn(3,i) + i8stifn(3,ikn)
74 i8stifn(3,ikn) = 0
75 i8a(1,1,i) = i8a(1,1,i) + i8a(1,1,ikn)
76 i8a(1,2,i) = i8a(1,2,i) + i8a(1,2,ikn)
77 i8a(1,3,i) = i8a(1,3,i) + i8a(1,3,ikn)
78 i8a(1,1,ikn) = 0
79 i8a(1,2,ikn) = 0
80 i8a(1,3,ikn) = 0
81 i8a(2,1,i) = i8a(2,1,i) + i8a(2,1,ikn)
82 i8a(2,2,i) = i8a(2,2,i) + i8a(2,2,ikn)
83 i8a(2,3,i) = i8a(2,3,i) + i8a(2,3,ikn)
84 i8a(2,1,ikn) = 0
85 i8a(2,2,ikn) = 0
86 i8a(2,3,ikn) = 0
87 i8a(3,1,i) = i8a(3,1,i) + i8a(3,1,ikn)
88 i8a(3,2,i) = i8a(3,2,i) + i8a(3,2,ikn)
89 i8a(3,3,i) = i8a(3,3,i) + i8a(3,3,ikn)
90 i8a(3,1,ikn) = 0
91 i8a(3,2,ikn) = 0
92 i8a(3,3,ikn) = 0
93 ENDDO
94 IF (iroddl/=0) THEN
95#include "vectorize.inc"
96 DO i=nodft,nodlt
97 ikn = i+kn
98 i8stifr(1,i) = i8stifr(1,i) + i8stifr(1,ikn)
99 i8stifr(1,ikn) = 0
100 i8stifr(2,i) = i8stifr(2,i) + i8stifr(2,ikn)
101 i8stifr(2,ikn) = 0
102 i8stifr(3,i) = i8stifr(3,i) + i8stifr(3,ikn)
103 i8stifr(3,ikn) = 0
104 i8ar(1,1,i) = i8ar(1,1,i) + i8ar(1,1,ikn)
105 i8ar(1,2,i) = i8ar(1,2,i) + i8ar(1,2,ikn)
106 i8ar(1,3,i) = i8ar(1,3,i) + i8ar(1,3,ikn)
107 i8ar(1,1,ikn) = 0
108 i8ar(1,2,ikn) = 0
109 i8ar(1,3,ikn) = 0
110 i8ar(2,1,i) = i8ar(2,1,i) + i8ar(2,1,ikn)
111 i8ar(2,2,i) = i8ar(2,2,i) + i8ar(2,2,ikn)
112 i8ar(2,3,i) = i8ar(2,3,i) + i8ar(2,3,ikn)
113 i8ar(2,1,ikn) = 0
114 i8ar(2,2,ikn) = 0
115 i8ar(2,3,ikn) = 0
116 i8ar(3,1,i) = i8ar(3,1,i) + i8ar(3,1,ikn)
117 i8ar(3,2,i) = i8ar(3,2,i) + i8ar(3,2,ikn)
118 i8ar(3,3,i) = i8ar(3,3,i) + i8ar(3,3,ikn)
119 i8ar(3,1,ikn) = 0
120 i8ar(3,2,ikn) = 0
121 i8ar(3,3,ikn) = 0
122 ENDDO
123 ENDIF
124 IF(kdtint/=0)THEN
125#include "vectorize.inc"
126 DO i=nodft,nodlt
127 ikn = i+kn
128 i8viscn(1,i) = i8viscn(1,i) + i8viscn(1,ikn)
129 i8viscn(1,ikn) = 0
130 i8viscn(2,i) = i8viscn(2,i) + i8viscn(2,ikn)
131 i8viscn(2,ikn) = 0
132 i8viscn(3,i) = i8viscn(3,i) + i8viscn(3,ikn)
133 i8viscn(3,ikn) = 0
134 ENDDO
135 ENDIF
136 km = km + num7
137#include "vectorize.inc"
138 DO i=partft,partlt
139 partsav(i) = partsav(i) + partsav(i+km)
140 partsav(i+km) = 0.
141 ENDDO
142 km1 = km1 + num8
143 IF (nthpart > 0) THEN
144#include "vectorize.inc"
145 DO i=greft,grelt
146 gresav(i) = gresav(i) + gresav(i+km1)
147 gresav(i+km1) = 0.
148 ENDDO
149 ENDIF
150 ENDDO
151#include "vectorize.inc"
152 DO i=nodft,nodlt
153 stifn(i) = stifn(i) +
154 . i8stifn(1,i) + r8_deuxm43 * (
155 . i8stifn(2,i) + r8_deuxm43 * i8stifn(3,i))
156 i8stifn(1,i) = 0
157 i8stifn(2,i) = 0
158 i8stifn(3,i) = 0
159 a(1,i) = a(1,i) +
160 . i8a(1,1,i) + r8_deuxm43 * (
161 . i8a(2,1,i) + r8_deuxm43 * i8a(3,1,i))
162 a(2,i) = a(2,i) +
163 . i8a(1,2,i) + r8_deuxm43 * (
164 . i8a(2,2,i) + r8_deuxm43 * i8a(3,2,i))
165 a(3,i) = a(3,i) +
166 . i8a(1,3,i) + r8_deuxm43 * (
167 . i8a(2,3,i) + r8_deuxm43 * i8a(3,3,i))
168 i8a(1,1,i) = 0
169 i8a(1,2,i) = 0
170 i8a(1,3,i) = 0
171 i8a(2,1,i) = 0
172 i8a(2,2,i) = 0
173 i8a(2,3,i) = 0
174 i8a(3,1,i) = 0
175 i8a(3,2,i) = 0
176 i8a(3,3,i) = 0
177 ENDDO
178 IF (iroddl/=0) THEN
179#include "vectorize.inc"
180 DO i=nodft,nodlt
181 stifr(i) = stifr(i) +
182 . i8stifr(1,i) + r8_deuxm43 * (
183 . i8stifr(2,i) + r8_deuxm43 * i8stifr(3,i))
184 i8stifr(1,i) = 0
185 i8stifr(2,i) = 0
186 i8stifr(3,i) = 0
187 ar(1,i) = ar(1,i) +
188 . i8ar(1,1,i) + r8_deuxm43 * (
189 . i8ar(2,1,i) + r8_deuxm43 * i8ar(3,1,i))
190 ar(2,i) = ar(2,i) +
191 . i8ar(1,2,i) + r8_deuxm43 * (
192 . i8ar(2,2,i) + r8_deuxm43 * i8ar(3,2,i))
193 ar(3,i) = ar(3,i) +
194 . i8ar(1,3,i) + r8_deuxm43 * (
195 . i8ar(2,3,i) + r8_deuxm43 * i8ar(3,3,i))
196 i8ar(1,1,i) = 0
197 i8ar(1,2,i) = 0
198 i8ar(1,3,i) = 0
199 i8ar(2,1,i) = 0
200 i8ar(2,2,i) = 0
201 i8ar(2,3,i) = 0
202 i8ar(3,1,i) = 0
203 i8ar(3,2,i) = 0
204 i8ar(3,3,i) = 0
205 ENDDO
206 ENDIF
207 IF(kdtint/=0)THEN
208#include "vectorize.inc"
209 DO i=nodft,nodlt
210 viscn(i) = viscn(i) +
211 . i8viscn(1,i) + r8_deuxm43 * (
212 . i8viscn(2,i) + r8_deuxm43 * i8viscn(3,i))
213 i8viscn(1,i) = 0
214 i8viscn(2,i) = 0
215 i8viscn(3,i) = 0
216 ENDDO
217 ENDIF
218C
219 1000 CONTINUE
220 RETURN
221 END
asspar5
subroutine asspar5(nthread, numnod, nodft, nodlt, iroddl, npart, partft, partlt, a, ar, partsav, stifn, stifr, i8a, i8ar, i8stifn, i8stifr, viscn, i8viscn, greft, grelt, gresav, ngpe, nthpart)
Definition asspar5.F:33
my_real
#define my_real
Definition cppsort.cpp:32