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!||--- uses -----------------------------------------------------
28!|| element_mod ../common_source/modules/elements/element_mod.F90
29!||====================================================================
30 SUBROUTINE cdk6updt3(JFT ,JLT ,F ,M , NVC ,
31 2 OFFG ,OFF ,STI ,STIR,STIFN,
32 3 STIFR,IXTG,IXTG1, F11 ,
33 4 F12 ,F13 ,F21 ,F22 ,F23 ,
34 5 F31 ,F32 ,F33 ,F14 ,F15 ,
35 7 F16 ,F24 ,F25 ,F26 ,F34 ,
36 8 F35 ,F36 ,NVS ,IVS )
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
142 END
143!||====================================================================
144!|| cdk6updt3p ../engine/source/elements/sh3n/coquedk6/cdk6updt3.F
145!||--- called by ------------------------------------------------------
146!|| cdk6forc3 ../engine/source/elements/sh3n/coquedk6/cdk6forc3.F
147!||====================================================================
148 SUBROUTINE cdk6updt3p(JFT,JLT ,OFFG ,OFF,STI,
149 2 STIR,FSKY,FSKYV,IADTG,IADTG1,
150 4 F11 ,F12 ,F13 ,F21 ,F22 ,
151 5 F23 ,F31 ,F32 ,F33 ,F14 ,
152 7 F15 ,F16 ,F24 ,F25 ,F26 ,
153 8 F34 ,F35 ,F36 )
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
263 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:37
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:154