OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10coor3.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!|| s10coor3 ../starter/source/elements/solid/solide10/s10coor3.F
25!||--- called by ------------------------------------------------------
26!|| s10init3 ../starter/source/elements/solid/solide10/s10init3.F
27!||--- calls -----------------------------------------------------
28!|| checkvolume_4n ../starter/source/elements/solid/solide/checksvolume.F
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE s10coor3(
33 1 X ,V ,IXS ,IXS10 ,XX ,
34 2 YY ,ZZ ,VX ,VY ,VZ ,
35 3 NC ,NGL ,MXT ,NGEO ,MASS,
36 4 DTELEM ,STI ,SIGG ,EINTG ,RHOG,
37 5 QG ,TEMP0 ,TEMP ,SAV ,NEL ,
38 6 NINTEMP)
39C-----------------------------------------------
40 USE message_mod
41 use element_mod , only : nixs
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C G l o b a l P a r a m e t e r s
48C-----------------------------------------------
49#include "mvsiz_p.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "vect01_c.inc"
54#include "com04_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NEL
59 INTEGER ,INTENT(IN) :: NINTEMP
60C REAL
61 DOUBLE PRECISION
62 . XX(MVSIZ,10), YY(MVSIZ,10), ZZ(MVSIZ,10),SAV(NEL,30)
63
64 my_real
65 . x(3,*), v(3,*),
66 . vx(mvsiz,10), vy(mvsiz,10), vz(mvsiz,10),
67 . mass(mvsiz),dtelem(*),sti(*),
68 . sigg(nel,6),eintg(*),rhog(*),qg(*),temp0(*), temp(*)
69 INTEGER NC(MVSIZ,10), MXT(*), NGL(*),NGEO(*)
70 INTEGER IXS(NIXS,*),IXS10(6,*)
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I, IPERM1(10),IPERM2(10),N,N1,N2,NN,IUN
75C REAL
76 DATA iperm1/0,0,0,0,1,2,3,1,2,3/
77 DATA iperm2/0,0,0,0,2,3,1,4,4,4/
78C-----------------------------------------------
79C E x t e r n a l F u n c t i o n s
80C-----------------------------------------------
81 my_real
82 . checkvolume_4n
83C=======================================================================
84 iun = 1
85C
86 DO i=lft,llt
87 ngeo(i) =ixs(10,i)
88 ngl(i) =ixs(11,i)
89 mxt(i) =ixs(1,i)
90 nc(i,1) =ixs(2,i)
91 nc(i,2) =ixs(4,i)
92 nc(i,3) =ixs(7,i)
93 nc(i,4) =ixs(6,i)
94 IF(isrot /= 1)THEN
95 nc(i,5) =ixs10(1,i)
96 nc(i,6) =ixs10(2,i)
97 nc(i,7) =ixs10(3,i)
98 nc(i,8) =ixs10(4,i)
99 nc(i,9) =ixs10(5,i)
100 nc(i,10)=ixs10(6,i)
101 ELSE
102 nc(i,5) = 0
103 nc(i,6) = 0
104 nc(i,7) = 0
105 nc(i,8) = 0
106 nc(i,9) = 0
107 nc(i,10)= 0
108 ENDIF
109 dtelem(i)=ep30
110 sti(i)=zero
111 eintg(i)=zero
112 rhog(i)=zero
113 qg(i)=zero
114 sigg(i,1)=zero
115 sigg(i,2)=zero
116 sigg(i,3)=zero
117 sigg(i,4)=zero
118 sigg(i,5)=zero
119 sigg(i,6)=zero
120 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
121C renumber connectivity
122 nc(i,1) =ixs(2,i)
123 nc(i,2) =ixs(6,i)
124 nc(i,3) =ixs(7,i)
125 nc(i,4) =ixs(4,i)
126 ixs(2,i) = nc(i,1)
127 ixs(4,i) = nc(i,2)
128 ixs(7,i) = nc(i,3)
129 ixs(6,i) = nc(i,4)
130 IF(isrot /= 1)THEN
131 nc(i,5) =ixs10(4,i)
132 nc(i,6) =ixs10(6,i)
133 nc(i,7) =ixs10(3,i)
134 nc(i,8) =ixs10(1,i)
135 nc(i,9) =ixs10(5,i)
136 nc(i,10)=ixs10(2,i)
137 ixs10(1,i) = nc(i,5)
138 ixs10(2,i) = nc(i,6)
139 ixs10(3,i) = nc(i,7)
140 ixs10(4,i) = nc(i,8)
141 ixs10(5,i) = nc(i,9)
142 ixs10(6,i) = nc(i,10)
143 ENDIF
144 ENDIF
145 ENDDO
146C----------------------------
147C NODAL COORDINATES |
148C----------------------------
149 DO n=1,10
150 DO i=lft,llt
151 nn = max(iun,nc(i,n))
152 xx(i,n)=x(1,nn)
153 yy(i,n)=x(2,nn)
154 zz(i,n)=x(3,nn)
155 vx(i,n)=v(1,nn)
156 vy(i,n)=v(2,nn)
157 vz(i,n)=v(3,nn)
158 ENDDO
159 ENDDO
160C
161 DO i=lft,llt
162 mass(i)=zero
163 ENDDO
164C
165 DO n=5,10
166 n1=iperm1(n)
167 n2=iperm2(n)
168 DO i=lft,llt
169 IF(nc(i,n)==0)THEN
170 xx(i,n) = half*(xx(i,n1)+xx(i,n2))
171 yy(i,n) = half*(yy(i,n1)+yy(i,n2))
172 zz(i,n) = half*(zz(i,n1)+zz(i,n2))
173 vx(i,n) = half*(vx(i,n1)+vx(i,n2))
174 vy(i,n) = half*(vy(i,n1)+vy(i,n2))
175 vz(i,n) = half*(vz(i,n1)+vz(i,n2))
176 ENDIF
177 ENDDO
178 ENDDO
179C
180C initial nodal temperature
181C
182 IF (jthe < 0 .or. nintemp > 0) THEN
183 IF(nintemp > 0 ) THEN
184 DO n =1,10
185 DO i=lft,llt
186 nn = max(iun,nc(i,n))
187 IF(temp(nn)== zero) temp(nn) = temp0(i)
188 ENDDO
189 ENDDO
190 ELSE
191 DO n =1,10
192 DO i=lft,llt
193 nn = max(iun,nc(i,n))
194 temp(nn) = temp0(i)
195 ENDDO
196 ENDDO
197 ENDIF
198 ENDIF
199C
200 IF(ismstr>=10.AND.ismstr<=12)THEN
201 DO n=1,10
202 DO i=lft,llt
203 nn = nc(i,n)
204 sav(i,n) =xx(i,n)
205 sav(i,n+10)=yy(i,n)
206 sav(i,n+20)=zz(i,n)
207 ENDDO
208 END DO
209 END IF
210CC
211 RETURN
212 END
213!||====================================================================
214!|| s10coor3_old ../starter/source/elements/solid/solide10/s10coor3.F
215!||--- called by ------------------------------------------------------
216!|| inirig_mat ../starter/source/elements/initia/inirig_mat.F
217!||--- calls -----------------------------------------------------
218!|| checkvolume_4n ../starter/source/elements/solid/solide/checksvolume.F
219!||--- uses -----------------------------------------------------
220!|| message_mod ../starter/share/message_module/message_mod.F
221!||====================================================================
222 SUBROUTINE s10coor3_old(X,V, IXS,IXS10,
223 . XX, YY, ZZ, VX, VY, VZ,NC,
224 . NGL,MXT,NGEO,MASS,DTELEM,STI,
225 . SIGG,EINTG,RHOG,QG, TEMP0,
226 . TEMP,NEL,NINTEMP)
227C-----------------------------------------------
228 USE message_mod
229 use element_mod , only : nixs
230C-----------------------------------------------
231C I m p l i c i t T y p e s
232C-----------------------------------------------
233#include "implicit_f.inc"
234C-----------------------------------------------
235C G l o b a l P a r a m e t e r s
236C-----------------------------------------------
237#include "mvsiz_p.inc"
238C-----------------------------------------------
239C C o m m o n B l o c k s
240C-----------------------------------------------
241#include "vect01_c.inc"
242#include "com04_c.inc"
243C-----------------------------------------------
244C D u m m y A r g u m e n t s
245C-----------------------------------------------
246 INTEGER NEL,NINTEMP
247C REAL
248 DOUBLE PRECISION
249 . XX(MVSIZ,10), YY(MVSIZ,10), ZZ(MVSIZ,10)
250
251 my_real
252 . X(3,*), V(3,*),
253 . VX(MVSIZ,10), VY(MVSIZ,10), VZ(MVSIZ,10),
254 . MASS(MVSIZ),DTELEM(*),STI(*),
255 . SIGG(NEL,6),EINTG(*),RHOG(*),QG(*),TEMP0(*), TEMP(*)
256 INTEGER NC(MVSIZ,10), MXT(*), NGL(*),NGEO(*)
257 INTEGER IXS(NIXS,*),IXS10(6,*)
258C-----------------------------------------------
259C L o c a l V a r i a b l e s
260C-----------------------------------------------
261 INTEGER I, IPERM1(10),IPERM2(10),N,N1,N2,NN,IUN
262C REAL
263 DATA IPERM1/0,0,0,0,1,2,3,1,2,3/
264 DATA IPERM2/0,0,0,0,2,3,1,4,4,4/
265C-----------------------------------------------
266C E x t e r n a l F u n c t i o n s
267C-----------------------------------------------
268 my_real
269 . checkvolume_4n
270C=======================================================================
271 iun = 1
272C
273 DO i=lft,llt
274 ngeo(i) =ixs(10,i)
275 ngl(i) =ixs(11,i)
276 mxt(i) =ixs(1,i)
277 nc(i,1) =ixs(2,i)
278 nc(i,2) =ixs(4,i)
279 nc(i,3) =ixs(7,i)
280 nc(i,4) =ixs(6,i)
281 IF(isrot /= 1)THEN
282 nc(i,5) =ixs10(1,i)
283 nc(i,6) =ixs10(2,i)
284 nc(i,7) =ixs10(3,i)
285 nc(i,8) =ixs10(4,i)
286 nc(i,9) =ixs10(5,i)
287 nc(i,10)=ixs10(6,i)
288 ELSE
289 nc(i,5) = 0
290 nc(i,6) = 0
291 nc(i,7) = 0
292 nc(i,8) = 0
293 nc(i,9) = 0
294 nc(i,10)= 0
295 ENDIF
296 dtelem(i)=ep30
297 sti(i)=zero
298 eintg(i)=zero
299 rhog(i)=zero
300 qg(i)=zero
301 sigg(i,1)=zero
302 sigg(i,2)=zero
303 sigg(i,3)=zero
304 sigg(i,4)=zero
305 sigg(i,5)=zero
306 sigg(i,6)=zero
307 IF (checkvolume_4n(x ,ixs(1,i)) < zero) THEN
308C renumber connectivity
309 nc(i,1) =ixs(2,i)
310 nc(i,2) =ixs(6,i)
311 nc(i,3) =ixs(7,i)
312 nc(i,4) =ixs(4,i)
313 ixs(2,i) = nc(i,1)
314 ixs(4,i) = nc(i,2)
315 ixs(7,i) = nc(i,3)
316 ixs(6,i) = nc(i,4)
317 IF(isrot /= 1)THEN
318 nc(i,5) =ixs10(4,i)
319 nc(i,6) =ixs10(6,i)
320 nc(i,7) =ixs10(3,i)
321 nc(i,8) =ixs10(1,i)
322 nc(i,9) =ixs10(5,i)
323 nc(i,10)=ixs10(2,i)
324 ixs10(1,i) = nc(i,5)
325 ixs10(2,i) = nc(i,6)
326 ixs10(3,i) = nc(i,7)
327 ixs10(4,i) = nc(i,8)
328 ixs10(5,i) = nc(i,9)
329 ixs10(6,i) = nc(i,10)
330 ENDIF
331 ENDIF
332 ENDDO
333C----------------------------
334C NODAL COORDINATES |
335C----------------------------
336 DO n=1,10
337 DO i=lft,llt
338 nn = max(iun,nc(i,n))
339 xx(i,n)=x(1,nn)
340 yy(i,n)=x(2,nn)
341 zz(i,n)=x(3,nn)
342 vx(i,n)=v(1,nn)
343 vy(i,n)=v(2,nn)
344 vz(i,n)=v(3,nn)
345 ENDDO
346 ENDDO
347C
348 DO i=lft,llt
349 mass(i)=zero
350 ENDDO
351C
352 DO n=5,10
353 n1=iperm1(n)
354 n2=iperm2(n)
355 DO i=lft,llt
356 IF(nc(i,n)==0)THEN
357 xx(i,n) = half*(xx(i,n1)+xx(i,n2))
358 yy(i,n) = half*(yy(i,n1)+yy(i,n2))
359 zz(i,n) = half*(zz(i,n1)+zz(i,n2))
360 vx(i,n) = half*(vx(i,n1)+vx(i,n2))
361 vy(i,n) = half*(vy(i,n1)+vy(i,n2))
362 vz(i,n) = half*(vz(i,n1)+vz(i,n2))
363 ENDIF
364 ENDDO
365 ENDDO
366C
367C initial nodal temperature
368C
369 IF (jthe < 0 .or. nintemp > 0) THEN
370 IF(nintemp > 0 ) THEN
371 DO n =1,10
372 DO i=lft,llt
373 nn = max(iun,nc(i,n))
374 IF(temp(nn)== zero) temp(nn) = temp0(i)
375 ENDDO
376 ENDDO
377 ELSE
378 DO n =1,10
379 DO i=lft,llt
380 nn = max(iun,nc(i,n))
381 temp(nn) = temp0(i)
382 ENDDO
383 ENDDO
384 ENDIF
385 ENDIF
386CC
387 RETURN
388 END
389
checkvolume_4n
function checkvolume_4n(x, ixs)
Definition checksvolume.F:217
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
s10coor3
subroutine s10coor3(x, v, ixs, ixs10, xx, yy, zz, vx, vy, vz, nc, ngl, mxt, ngeo, mass, dtelem, sti, sigg, eintg, rhog, qg, temp0, temp, sav, nel, nintemp)
Definition s10coor3.F:39
s10coor3_old
subroutine s10coor3_old(x, v, ixs, ixs10, xx, yy, zz, vx, vy, vz, nc, ngl, mxt, ngeo, mass, dtelem, sti, sigg, eintg, rhog, qg, temp0, temp, nel, nintemp)
Definition s10coor3.F:227