OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s10coor3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)
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)

Function/Subroutine Documentation

◆ s10coor3()

subroutine s10coor3 ( x,
v,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
double precision, dimension(mvsiz,10) xx,
double precision, dimension(mvsiz,10) yy,
double precision, dimension(mvsiz,10) zz,
vx,
vy,
vz,
integer, dimension(mvsiz,10) nc,
integer, dimension(*) ngl,
integer, dimension(*) mxt,
integer, dimension(*) ngeo,
mass,
dtelem,
sti,
sigg,
eintg,
rhog,
qg,
temp0,
temp,
double precision, dimension(nel,30) sav,
integer nel,
integer, intent(in) nintemp )

Definition at line 32 of file s10coor3.F.

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
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

◆ s10coor3_old()

subroutine s10coor3_old ( x,
v,
integer, dimension(nixs,*) ixs,
integer, dimension(6,*) ixs10,
double precision, dimension(mvsiz,10) xx,
double precision, dimension(mvsiz,10) yy,
double precision, dimension(mvsiz,10) zz,
vx,
vy,
vz,
integer, dimension(mvsiz,10) nc,
integer, dimension(*) ngl,
integer, dimension(*) mxt,
integer, dimension(*) ngeo,
mass,
dtelem,
sti,
sigg,
eintg,
rhog,
qg,
temp0,
temp,
integer nel,
integer nintemp )

Definition at line 221 of file s10coor3.F.

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