OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s20cumu3p.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "parit_c.inc"
#include "com04_c.inc"
#include "scr18_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine s20cumu3p (offg, stig, fsky, fskyv, iads, fx, fy, fz, iadsp, nc, iperm1, iperm2, npe, them, fthesky, condnsky, condeg, nel, nft, jthe, nodadt_therm)

Function/Subroutine Documentation

◆ s20cumu3p()

subroutine s20cumu3p ( offg,
stig,
fsky,
fskyv,
integer, dimension(8,*) iads,
fx,
fy,
fz,
integer, dimension(npe-8,*) iadsp,
integer, dimension(mvsiz,npe) nc,
integer, dimension(npe) iperm1,
integer, dimension(npe) iperm2,
integer npe,
them,
fthesky,
condnsky,
condeg,
integer, intent(in) nel,
integer, intent(in) nft,
integer, intent(in) jthe,
integer, intent(in) nodadt_therm )

Definition at line 29 of file s20cumu3p.F.

36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C G l o b a l P a r a m e t e r s
42C-----------------------------------------------
43#include "mvsiz_p.inc"
44C-----------------------------------------------
45C C o m m o n B l o c k s
46C-----------------------------------------------
47#include "parit_c.inc"
48#include "com04_c.inc"
49#include "scr18_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER, INTENT(IN) :: NEL
54 INTEGER, INTENT(IN) :: NFT
55 INTEGER, INTENT(IN) :: JTHE
56 INTEGER, INTENT(IN) :: NODADT_THERM
57 INTEGER NPE
58 INTEGER IADS(8,*),IADSP(NPE-8,*),NC(MVSIZ,NPE),
59 . IPERM1(NPE),IPERM2(NPE)
60C REAL
61 my_real
62 . offg(*),fskyv(lsky,8),fsky(8,lsky),stig(mvsiz,npe),
63 . fx(mvsiz,npe), fy(mvsiz,npe), fz(mvsiz,npe),them(mvsiz,npe),
64 . fthesky(*),condnsky(*),condeg(mvsiz,npe)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER I, II, K,N,J
69 INTEGER N1,N2,NN
70C-----------------------------------------------
71 my_real
72 . off_l
73C-----------------------------------------------
74 off_l = 0.
75 DO i=1,nel
76Cf small3b IF(OFF(I)<1.)OFFG(I) = OFF(I)
77 off_l = min(off_l,offg(i))
78 ENDDO
79 IF(off_l<zero)THEN
80 DO n=1,npe
81 DO i=1,nel
82 IF(offg(i)<zero)THEN
83 fx(i,n)=zero
84 fy(i,n)=zero
85 fz(i,n)=zero
86 stig(i,n)=zero
87 ENDIF
88 ENDDO
89 ENDDO
90 ENDIF
91
92 IF(jthe < 0 ) THEN
93 IF(off_l<=zero)THEN
94 DO j=1,npe
95 DO i=1,nel
96 IF(offg(i)<=zero)THEN
97 them(i,j)=zero
98 ENDIF
99 ENDDO
100 ENDDO
101 ENDIF
102 IF(nodadt_therm == 1) THEN
103 IF(off_l<zero)THEN
104 DO j=1,npe
105 DO i=1,nel
106 IF(offg(i)<zero)THEN
107 condeg(i,j)=zero
108 ENDIF
109 ENDDO
110 ENDDO
111 ENDIF
112 ENDIF
113 ENDIF
114
115 IF(ivector==1) THEN
116 DO n= 1,8
117#include "vectorize.inc"
118 DO i=1,nel
119C II=I+NFT
120 k = iads(n,i)
121 fskyv(k,1)=fx(i,n)
122 fskyv(k,2)=fy(i,n)
123 fskyv(k,3)=fz(i,n)
124 fskyv(k,7)=stig(i,n)
125 ENDDO
126 ENDDO
127 DO n= 1,npe-8
128 n1=iperm1(n+8)
129 n2=iperm2(n+8)
130 DO i=1,nel
131C II=I+NFT-NUMELS+NUMELS20
132 nn = nc(i,n+8)
133 IF(nn/=0)THEN
134 k = iadsp(n,i)
135 fskyv(k,1)=fx(i,n+8)
136 fskyv(k,2)=fy(i,n+8)
137 fskyv(k,3)=fz(i,n+8)
138 fskyv(k,7)=stig(i,n+8)
139 ELSE
140 k = iads(n1,i)
141 fskyv(k,1)=fskyv(k,1)+half*fx(i,n+8)
142 fskyv(k,2)=fskyv(k,2)+half*fy(i,n+8)
143 fskyv(k,3)=fskyv(k,3)+half*fz(i,n+8)
144 fskyv(k,7)=fskyv(k,7)+half*stig(i,n+8)
145 k = iads(n2,i)
146 fskyv(k,1)=fskyv(k,1)+half*fx(i,n+8)
147 fskyv(k,2)=fskyv(k,2)+half*fy(i,n+8)
148 fskyv(k,3)=fskyv(k,3)+half*fz(i,n+8)
149 fskyv(k,7)=fskyv(k,7)+half*stig(i,n+8)
150 ENDIF
151 ENDDO
152 ENDDO
153 ELSE
154 DO n= 1,8
155 DO i=1,nel
156 k = iads(n,i)
157 fsky(1,k)=fx(i,n)
158 fsky(2,k)=fy(i,n)
159 fsky(3,k)=fz(i,n)
160 fsky(7,k)=stig(i,n)
161 ENDDO
162 ENDDO
163 DO n= 1,npe-8
164 n1=iperm1(n+8)
165 n2=iperm2(n+8)
166 DO i=1,nel
167C II=I+NFT-NUMELS+NUMELS20
168 nn = nc(i,n+8)
169 IF(nn/=0)THEN
170 k = iadsp(n,i)
171 fsky(1,k)=fx(i,n+8)
172 fsky(2,k)=fy(i,n+8)
173 fsky(3,k)=fz(i,n+8)
174 fsky(7,k)=stig(i,n+8)
175 ELSE
176 k = iads(n1,i)
177 fsky(1,k)=fsky(1,k)+half*fx(i,n+8)
178 fsky(2,k)=fsky(2,k)+half*fy(i,n+8)
179 fsky(3,k)=fsky(3,k)+half*fz(i,n+8)
180 fsky(7,k)=fsky(7,k)+half*stig(i,n+8)
181 k = iads(n2,i)
182 fsky(1,k)=fsky(1,k)+half*fx(i,n+8)
183 fsky(2,k)=fsky(2,k)+half*fy(i,n+8)
184 fsky(3,k)=fsky(3,k)+half*fz(i,n+8)
185 fsky(7,k)=fsky(7,k)+half*stig(i,n+8)
186 ENDIF
187 ENDDO
188 ENDDO
189 ENDIF
190C
191 IF(jthe < 0 ) THEN
192 DO n= 1,8
193 DO i=1,nel
194 k = iads(n,i)
195 fthesky(k)=them(i,n)
196 ENDDO
197 ENDDO
198 DO n= 1,npe-8
199 n1=iperm1(n+8)
200 n2=iperm2(n+8)
201 DO i=1,nel
202C II=I+NFT-NUMELS+NUMELS20
203 nn = nc(i,n+8)
204 IF(nn/=0)THEN
205 k = iadsp(n,i)
206 fthesky(k)=them(i,n+8)
207 ELSE
208 k = iads(n1,i)
209 fthesky(k)=fthesky(k) + half*them(i,n+8)
210 k = iads(n2,i)
211 fthesky(k)=fthesky(k) + half*them(i,n+8)
212 ENDIF
213 ENDDO
214 ENDDO
215
216 IF(nodadt_therm == 1) THEN
217 DO n= 1,8
218 DO i=1,nel
219 k = iads(n,i)
220 condnsky(k)=condeg(i,n)
221 ENDDO
222 ENDDO
223 DO n= 1,npe-8
224 n1=iperm1(n+8)
225 n2=iperm2(n+8)
226 DO i=1,nel
227C II=I+NFT-NUMELS+NUMELS20
228 nn = nc(i,n+8)
229 IF(nn/=0)THEN
230 k = iadsp(n,i)
231 condnsky(k)=condeg(i,n+8)
232 ELSE
233 k = iads(n1,i)
234 condnsky(k)=condnsky(k) + half*condeg(i,n+8)
235 k = iads(n2,i)
236 condnsky(k)=condnsky(k) + half*condeg(i,n+8)
237 ENDIF
238 ENDDO
239 ENDDO
240 ENDIF
241
242 ENDIF
243 IF(nsect>0)THEN
244 DO n= 1,npe-8
245 n1=iperm1(n+8)
246 n2=iperm2(n+8)
247 DO i=1,nel
248 nn = nc(i,n+8)
249 IF(nn==0)THEN
250 fx(i,n1)=fx(i,n1)+half*fx(i,n+8)
251 fy(i,n1)=fy(i,n1)+half*fy(i,n+8)
252 fz(i,n1)=fz(i,n1)+half*fz(i,n+8)
253 fx(i,n2)=fx(i,n2)+half*fx(i,n+8)
254 fy(i,n2)=fy(i,n2)+half*fy(i,n+8)
255 fz(i,n2)=fz(i,n2)+half*fz(i,n+8)
256 END IF
257 END DO
258 END DO
259 END IF
260C
261 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20