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
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
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_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 222 of file s10coor3.F.

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