OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
q4rcoor2.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine q4rcoor2 (x, ncp, y1, y2, y3, y4, z1, z2, z3, z4, nc1, nc2, nc3, nc4, ngl, mat, ngeo, vd2, r11, r12, r13, r21, r22, r23, r31, r32, r33, gama, y234, y124, vis, v, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, yavg, ay, exx, nel, isorth)

Function/Subroutine Documentation

◆ q4rcoor2()

subroutine q4rcoor2 ( x,
integer, dimension(7,*) ncp,
y1,
y2,
y3,
y4,
z1,
z2,
z3,
z4,
integer, dimension(*) nc1,
integer, dimension(*) nc2,
integer, dimension(*) nc3,
integer, dimension(*) nc4,
integer, dimension(*) ngl,
integer, dimension(*) mat,
integer, dimension(*) ngeo,
vd2,
r11,
r12,
r13,
r21,
r22,
r23,
r31,
r32,
r33,
gama,
y234,
y124,
vis,
v,
vy1,
vy2,
vy3,
vy4,
vz1,
vz2,
vz3,
vz4,
yavg,
ay,
exx,
integer, intent(in) nel,
integer, intent(in) isorth )

Definition at line 30 of file q4rcoor2.F.

43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50#include "mvsiz_p.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 INTEGER, INTENT(IN) :: ISORTH
55 INTEGER, INTENT(IN) :: NEL
56 INTEGER NC1(*), NC2(*), NC3(*), NC4(*), MAT(*), NGL(*), NGEO(*),
57 . NCP(7,*)
58C REAL
59 my_real
60 . x(3,*),y1(*),y2(*),y3(*),y4(*),z1(*),z2(*),z3(*),z4(*),vd2(*),
61 . vy1(*),vy2(*),vy3(*),vy4(*),
62 . vz1(*),vz2(*),vz3(*),vz4(*),
63 . r11(*),r12(*),r13(*),
64 . r21(*),r22(*),r23(*),
65 . r31(*),r32(*),r33(*),gama(mvsiz,6),
66 . y234(*),y124(*),vis(*),v(3,*),yavg(*),exx(*),ay(*)
67C-----------------------------------------------
68C C o m m o n B l o c k s
69C-----------------------------------------------
70#include "com01_c.inc"
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I,II,IV
75 my_real
76 . sy(mvsiz) , sz(mvsiz) ,
77 . ty(mvsiz) , tz(mvsiz) ,
78 . yl , zl , suma,cs,ct,
79 . g22,g23,g32,g33,
80 . t22,t23,t32,t33,vyg
81C-----------------------------------------------
82 DO i=1,nel
83 ngeo(i)=ncp(6,i)
84 ngl(i)=ncp(7,i)
85 mat(i)=ncp(1,i)
86 nc1(i)=ncp(2,i)
87 nc2(i)=ncp(3,i)
88 nc3(i)=ncp(4,i)
89 nc4(i)=ncp(5,i)
90 END DO
91C
92C----------------------------
93C COORDONNEES NODALES
94C----------------------------
95 DO i=1,nel
96 y1(i)=x(2,nc1(i))
97 z1(i)=x(3,nc1(i))
98 y2(i)=x(2,nc2(i))
99 z2(i)=x(3,nc2(i))
100 y3(i)=x(2,nc3(i))
101 z3(i)=x(3,nc3(i))
102 y4(i)=x(2,nc4(i))
103 z4(i)=x(3,nc4(i))
104 END DO
105 DO i=1,nel
106 vy1(i)=v(2,nc1(i))
107 vz1(i)=v(3,nc1(i))
108 vy2(i)=v(2,nc2(i))
109 vz2(i)=v(3,nc2(i))
110 vy3(i)=v(2,nc3(i))
111 vz3(i)=v(3,nc3(i))
112 vy4(i)=v(2,nc4(i))
113 vz4(i)=v(3,nc4(i))
114 END DO
115C-----Exx ia calculated anyway in global system
116 IF(n2d==1) THEN
117 DO i=1,nel
118 yavg(i) = y1(i)+y2(i)+y3(i)+y4(i)
119 vyg = vy1(i)+vy2(i)+vy3(i)+vy4(i)
120 y234(i)=y2(i)+y3(i)+y4(i)
121 y124(i)=y1(i)+y2(i)+y4(i)
122C-----constant Exx,
123 ay(i) =one/max(em20,yavg(i))
124 exx(i) = vyg*ay(i)
125 ENDDO
126 ENDIF
127C---------------------------------------
128C REPERE LOCAL
129C---------------------------------------
130 DO i=1,nel
131 sy(i)=half*(y2(i)+y3(i)-y1(i)-y4(i))
132 sz(i)=half*(z2(i)+z3(i)-z1(i)-z4(i))
133 ty(i)=half*(y3(i)+y4(i)-y1(i)-y2(i))
134 tz(i)=half*(z3(i)+z4(i)-z1(i)-z2(i))
135 END DO
136C-----------
137C REPERE CONVECTE : Same than the shell
138C-----------
139 DO i=1,nel
140 ct = ty(i)*ty(i)+tz(i)*tz(i)
141 cs = sy(i)*sy(i)+sz(i)*sz(i)
142 IF(cs /= zero) THEN
143 suma = sqrt(ct/max(em20,cs))
144 sy(i) = sy(i)*suma + tz(i)
145 sz(i) = sz(i)*suma - ty(i)
146 ELSEIF(ct /= zero)THEN
147 suma = sqrt(cs/max(em20,ct))
148 sy(i) = sy(i) + tz(i)*suma
149 sz(i) = sz(i) - ty(i)*suma
150 END IF
151 ENDDO
152 DO i=1,nel
153 suma=one/max(sqrt(sy(i)*sy(i)+sz(i)*sz(i)),em20)
154 sy(i)=sy(i)*suma
155 sz(i)=sz(i)*suma
156 ENDDO
157 DO i=1,nel
158 r11(i)= one
159 r21(i)= zero
160 r31(i)= zero
161 r12(i)= zero
162 r22(i)= sy(i)
163 r32(i)= sz(i)
164 r13(i)= zero
165 r23(i)=-sz(i)
166 r33(i)= sy(i)
167 END DO
168C-----------
169 DO i=1,nel
170 yl=r22(i)*y1(i)+r32(i)*z1(i)
171 zl=r23(i)*y1(i)+r33(i)*z1(i)
172 y1(i)=yl
173 z1(i)=zl
174 yl=r22(i)*y2(i)+r32(i)*z2(i)
175 zl=r23(i)*y2(i)+r33(i)*z2(i)
176 y2(i)=yl
177 z2(i)=zl
178 yl=r22(i)*y3(i)+r32(i)*z3(i)
179 zl=r23(i)*y3(i)+r33(i)*z3(i)
180 y3(i)=yl
181 z3(i)=zl
182 yl=r22(i)*y4(i)+r32(i)*z4(i)
183 zl=r23(i)*y4(i)+r33(i)*z4(i)
184 y4(i)=yl
185 z4(i)=zl
186 END DO
187C-----------
188C PASSAGE AU REPERE ORTHOTROPE.
189C-----------
190 IF (isorth /= 0)THEN
191 DO i=1,nel
192C Extration de G tq Xortho=Transpose(G) Xcvt
193C =Transpose(G) Transpose(R) Xglobal.
194 g22=gama(i,2)
195 g32=gama(i,3)
196 g23=gama(i,5)
197 g33=gama(i,6)
198C
199 yl=g22*y1(i)+g32*z1(i)
200 zl=g23*y1(i)+g33*z1(i)
201 y1(i)=yl
202 z1(i)=zl
203 yl=g22*y2(i)+g32*z2(i)
204 zl=g23*y2(i)+g33*z2(i)
205 y2(i)=yl
206 z2(i)=zl
207 yl=g22*y3(i)+g32*z3(i)
208 zl=g23*y3(i)+g33*z3(i)
209 y3(i)=yl
210 z3(i)=zl
211 yl=g22*y4(i)+g32*z4(i)
212 zl=g23*y4(i)+g33*z4(i)
213 y4(i)=yl
214 z4(i)=zl
215C MATRICE DE PASSAGE GLOBAL -> ORTHOTROPE.
216 t22=r22(i)*g22+r23(i)*g32
217 t23=r22(i)*g23+r23(i)*g33
218 t32=r32(i)*g22+r33(i)*g32
219 t33=r32(i)*g23+r33(i)*g33
220 r22(i)=t22
221 r23(i)=t23
222 r32(i)=t32
223 r33(i)=t33
224 ENDDO
225 ENDIF
226 CALL q4rrota2(
227 1 r22, r23, r32, r33,
228 2 vy1, vy2, vy3, vy4,
229 3 vz1, vz2, vz3, vz4,
230 4 nel)
231C-----------
232 DO i=1,nel
233 vd2(i)=zero
234 vis(i)=zero
235 END DO
236C
237 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
q4rrota2
subroutine q4rrota2(r22, r23, r32, r33, y1, y2, y3, y4, z1, z2, z3, z4, nel)
Definition q4rrota2.F:34