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 30 of file cdk6updt3.F.

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

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