OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cdk6updt3.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!|| cdk6updt3 ../engine/source/elements/sh3n/coquedk6/cdk6updt3.F
25!||--- called by ------------------------------------------------------
26!|| cdk6forc3 ../engine/source/elements/sh3n/coquedk6/cdk6forc3.F
27!||====================================================================
28 SUBROUTINE cdk6updt3(JFT ,JLT ,F ,M , NVC ,
29 2 OFFG ,OFF ,STI ,STIR,STIFN,
30 3 STIFR,IXTG,IXTG1, F11 ,
31 4 F12 ,F13 ,F21 ,F22 ,F23 ,
32 5 F31 ,F32 ,F33 ,F14 ,F15 ,
33 7 F16 ,F24 ,F25 ,F26 ,F34 ,
34 8 F35 ,F36 ,NVS ,IVS )
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
139 END
140!||====================================================================
141!|| cdk6updt3p ../engine/source/elements/sh3n/coquedk6/cdk6updt3.F
142!||--- called by ------------------------------------------------------
143!|| cdk6forc3 ../engine/source/elements/sh3n/coquedk6/cdk6forc3.F
144!||====================================================================
145 SUBROUTINE cdk6updt3p(JFT,JLT ,OFFG ,OFF,STI,
146 2 STIR,FSKY,FSKYV,IADTG,IADTG1,
147 4 F11 ,F12 ,F13 ,F21 ,F22 ,
148 5 F23 ,F31 ,F32 ,F33 ,F14 ,
149 7 F15 ,F16 ,F24 ,F25 ,F26 ,
150 8 F34 ,F35 ,F36 )
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
260 END
cdk6updt3
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)
Definition cdk6updt3.F:35
cdk6updt3p
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)
Definition cdk6updt3.F:151