OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdk6updt3.F File Reference
#include "implicit_f.inc"
#include "parit_c.inc"
#include "vectorize.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine cdk6updt3 (jft, jlt, f, m, nvc, offg, off, sti, stir, stifn, stifr, ixtg, ixtg1, f11, f12, f13, f21, f22, f23, f31, f32, f33, f14, f15, f16, f24, f25, f26, f34, f35, f36, nvs, ivs)
subroutine cdk6updt3p (jft, jlt, offg, off, sti, stir, fsky, fskyv, iadtg, iadtg1, f11, f12, f13, f21, f22, f23, f31, f32, f33, f14, f15, f16, f24, f25, f26, f34, f35, f36)

Function/Subroutine Documentation

◆ cdk6updt3()

subroutine cdk6updt3 ( integer jft,
integer jlt,
f,
m,
integer nvc,
offg,
off,
sti,
stir,
stifn,
stifr,
integer, dimension(nixtg,*) ixtg,
integer, dimension(4,*) ixtg1,
f11,
f12,
f13,
f21,
f22,
f23,
f31,
f32,
f33,
f14,
f15,
f16,
f24,
f25,
f26,
f34,
f35,
f36,
integer nvs,
integer, dimension(*) ivs )

Definition at line 28 of file cdk6updt3.F.

35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C D u m m y A r g u m e n t s
41C-----------------------------------------------
42 INTEGER JFT, JLT, NVC,IXTG(NIXTG,*),IXTG1(4,*),NVS,IVS(*)
43 my_real
44 . offg(*), off(*), sti(*), stir(*),
45 . f(3,*), m(3,*), stifn(*), stifr(*)
46 my_real
47 . f11(*), f12(*), f13(*),
48 . f21(*), f22(*), f23(*), f31(*), f32(*), f33(*),
49 . f14(*), f15(*), f16(*),f24(*), f25(*), f26(*),
50 . f34(*), f35(*), f36(*)
51C-----------------------------------------------
52C L o c a l V a r i a b l e s
53C-----------------------------------------------
54 INTEGER NVC1, NVC2, NVC3, I, J, EP
55 INTEGER NC1, NC2, NC3,NC,NCJ
56C-----------------------------------------------
57C
58 DO 20 i=jft,jlt
59 IF(off(i)<1.)offg(i) = off(i)
60 20 CONTINUE
61C
62C NVC1= NVC/8
63C NVC2=(NVC-NVC1*8)/4
64C NVC3=(NVC-NVC1*8-NVC2*4)/2
65C
66 DO i=jft,jlt
67 nc = ixtg(2,i)
68 f(1,nc)=f(1,nc)-f11(i)
69 f(2,nc)=f(2,nc)-f21(i)
70 f(3,nc)=f(3,nc)-f31(i)
71 stifn(nc)=stifn(nc)+sti(i)
72 ENDDO
73 DO i=jft,jlt
74 nc = ixtg(3,i)
75 f(1,nc)=f(1,nc)-f12(i)
76 f(2,nc)=f(2,nc)-f22(i)
77 f(3,nc)=f(3,nc)-f32(i)
78 stifn(nc)=stifn(nc)+sti(i)
79 ENDDO
80 DO i=jft,jlt
81 nc = ixtg(4,i)
82 f(1,nc)=f(1,nc)-f13(i)
83 f(2,nc)=f(2,nc)-f23(i)
84 f(3,nc)=f(3,nc)-f33(i)
85 stifn(nc)=stifn(nc)+sti(i)
86 ENDDO
87C---------avec voisins----------------------
88 DO ep=jft,nvs
89 i =ivs(ep)
90 ncj = ixtg1(1,i)
91 f(1,ncj)=f(1,ncj)-f14(i)
92 f(2,ncj)=f(2,ncj)-f24(i)
93 f(3,ncj)=f(3,ncj)-f34(i)
94 ENDDO
95 DO ep=jft,nvs
96 i =ivs(ep)
97 ncj = ixtg1(2,i)
98 f(1,ncj)=f(1,ncj)-f15(i)
99 f(2,ncj)=f(2,ncj)-f25(i)
100 f(3,ncj)=f(3,ncj)-f35(i)
101 ENDDO
102 DO ep=jft,nvs
103 i =ivs(ep)
104 ncj = ixtg1(3,i)
105 f(1,ncj)=f(1,ncj)-f16(i)
106 f(2,ncj)=f(2,ncj)-f26(i)
107 f(3,ncj)=f(3,ncj)-f36(i)
108 ENDDO
109C---------sans voisins----------------------
110 DO ep=nvs+1,jlt
111 i =ivs(ep)
112 ncj = ixtg1(1,i)
113 IF (ncj > 0) THEN
114 f(1,ncj)=f(1,ncj)-f14(i)
115 f(2,ncj)=f(2,ncj)-f24(i)
116 f(3,ncj)=f(3,ncj)-f34(i)
117 ENDIF
118 ENDDO
119 DO ep=nvs+1,jlt
120 i =ivs(ep)
121 ncj = ixtg1(2,i)
122 IF (ncj > 0) THEN
123 f(1,ncj)=f(1,ncj)-f15(i)
124 f(2,ncj)=f(2,ncj)-f25(i)
125 f(3,ncj)=f(3,ncj)-f35(i)
126 ENDIF
127 ENDDO
128 DO ep=nvs+1,jlt
129 i =ivs(ep)
130 ncj = ixtg1(3,i)
131 IF (ncj > 0) THEN
132 f(1,ncj)=f(1,ncj)-f16(i)
133 f(2,ncj)=f(2,ncj)-f26(i)
134 f(3,ncj)=f(3,ncj)-f36(i)
135 ENDIF
136 ENDDO
137C
138 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ cdk6updt3p()

subroutine cdk6updt3p ( integer jft,
integer jlt,
offg,
off,
sti,
stir,
fsky,
fskyv,
integer, dimension(3,*) iadtg,
integer, dimension(3,*) iadtg1,
f11,
f12,
f13,
f21,
f22,
f23,
f31,
f32,
f33,
f14,
f15,
f16,
f24,
f25,
f26,
f34,
f35,
f36 )

Definition at line 145 of file cdk6updt3.F.

151C-----------------------------------------------
152C I m p l i c i t T y p e s
153C-----------------------------------------------
154#include "implicit_f.inc"
155C-----------------------------------------------
156C C o m m o n B l o c k s
157C-----------------------------------------------
158#include "parit_c.inc"
159C-----------------------------------------------
160C D u m m y A r g u m e n t s
161C-----------------------------------------------
162 INTEGER JFT, JLT, IADTG(3,*),IADTG1(3,*)
163 my_real
164 . offg(*), off(*), sti(*), stir(*), fskyv(lsky,8),
165 . fsky(8,lsky)
166 my_real
167 . f11(*), f12(*), f13(*),
168 . f21(*), f22(*), f23(*), f31(*), f32(*), f33(*),
169 . f14(*), f15(*), f16(*), f24(*), f25(*), f26(*),
170 . f34(*), f35(*), f36(*)
171C-----------------------------------------------
172C L o c a l V a r i a b l e s
173C-----------------------------------------------
174 INTEGER I, II, K
175C-----------------------------------------------
176 DO 20 i=jft,jlt
177 IF(off(i)<1.)offg(i) = off(i)
178 20 CONTINUE
179C
180 IF (ivector==1) THEN
181#include "vectorize.inc"
182 DO i=jft,jlt
183 k = iadtg(1,i)
184 fskyv(k,1)=-f11(i)
185 fskyv(k,2)=-f21(i)
186 fskyv(k,3)=-f31(i)
187 fskyv(k,7)=sti(i)
188 k = iadtg(2,i)
189 fskyv(k,1)=-f12(i)
190 fskyv(k,2)=-f22(i)
191 fskyv(k,3)=-f32(i)
192 fskyv(k,7)=sti(i)
193 k = iadtg(3,i)
194 fskyv(k,1)=-f13(i)
195 fskyv(k,2)=-f23(i)
196 fskyv(k,3)=-f33(i)
197 fskyv(k,7)=sti(i)
198 ENDDO
199 DO i=jft,jlt
200 k = iadtg1(1,i)
201 IF (k>0) THEN
202 fskyv(k,1)=-f14(i)
203 fskyv(k,2)=-f24(i)
204 fskyv(k,3)=-f34(i)
205 ENDIF
206 k = iadtg1(2,i)
207 IF (k>0) THEN
208 fskyv(k,1)=-f15(i)
209 fskyv(k,2)=-f25(i)
210 fskyv(k,3)=-f35(i)
211 ENDIF
212 k = iadtg1(3,i)
213 IF (k>0) THEN
214 fskyv(k,1)=-f16(i)
215 fskyv(k,2)=-f26(i)
216 fskyv(k,3)=-f36(i)
217 ENDIF
218 ENDDO
219 ELSE
220 DO i=jft,jlt
221 k = iadtg(1,i)
222 fsky(1,k)=-f11(i)
223 fsky(2,k)=-f21(i)
224 fsky(3,k)=-f31(i)
225 fsky(7,k)=sti(i)
226 k = iadtg(2,i)
227 fsky(1,k)=-f12(i)
228 fsky(2,k)=-f22(i)
229 fsky(3,k)=-f32(i)
230 fsky(7,k)=sti(i)
231 k = iadtg(3,i)
232 fsky(1,k)=-f13(i)
233 fsky(2,k)=-f23(i)
234 fsky(3,k)=-f33(i)
235 fsky(7,k)=sti(i)
236 ENDDO
237 DO i=jft,jlt
238 k = iadtg1(1,i)
239 IF (k>0) THEN
240 fsky(1,k)=-f14(i)
241 fsky(2,k)=-f24(i)
242 fsky(3,k)=-f34(i)
243 ENDIF
244 k = iadtg1(2,i)
245 IF (k>0) THEN
246 fsky(1,k)=-f15(i)
247 fsky(2,k)=-f25(i)
248 fsky(3,k)=-f35(i)
249 ENDIF
250 k = iadtg1(3,i)
251 IF (k>0) THEN
252 fsky(1,k)=-f16(i)
253 fsky(2,k)=-f26(i)
254 fsky(3,k)=-f36(i)
255 ENDIF
256 ENDDO
257 ENDIF
258C
259 RETURN