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