OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
asspar5.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "scr18_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ asspar5()

subroutine asspar5 ( integer nthread,
integer numnod,
integer nodft,
integer nodlt,
integer iroddl,
integer npart,
integer partft,
integer partlt,
a,
ar,
partsav,
stifn,
stifr,
integer*8, dimension(3,3,*) i8a,
integer*8, dimension(3,3,*) i8ar,
integer*8, dimension(3,*) i8stifn,
integer*8, dimension(3,*) i8stifr,
viscn,
integer*8, dimension(3,*) i8viscn,
integer greft,
integer grelt,
gresav,
integer ngpe,
integer nthpart )

Definition at line 28 of file asspar5.F.

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
my_real
#define my_real
Definition cppsort.cpp:32