OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
qmorth2.F File Reference
#include "implicit_f.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine qmorth2 (pid, geo, igeo, gama, nel, ry, rz, sy, sz, e1y, e1z, e2y, e2z)

Function/Subroutine Documentation

◆ qmorth2()

subroutine qmorth2 ( integer, dimension(*) pid,
geo,
integer, dimension(npropgi,*) igeo,
gama,
integer nel,
ry,
rz,
sy,
sz,
e1y,
e1z,
e2y,
e2z )

Definition at line 34 of file qmorth2.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE message_mod
41 USE names_and_titles_mod , ONLY : nchartitle
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "vect01_c.inc"
50#include "param_c.inc"
51#include "scr17_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER JHBE,NEL
56 INTEGER PID(*),IGEO(NPROPGI,*)
57 my_real
58 . geo(npropg,*),gama(nel,6),
59 . ry(*) ,rz(*) ,sy(*) ,sz(*),
60 . e1y(*),e1z(*),e2y(*),e2z(*)
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I,IG,ID,ISK,IPNUM,IIS,II,J,JJ,N,IFLAGINI
65C REAL
66 my_real
67 . xl,yl,zl,sum,hx,hy,hz,kx,ky,kz,
68 . lx,ly,lz,phi,cp,sp,vx,vy,vz,vn,
69 . f3x,f3y,f3z,
70 . g11,g22,g33,g12,g21,g23,g32,g13,g31
71 my_real
72 . sk(6)
73 CHARACTER(LEN=NCHARTITLE)::TITR
74C-----------------------------------------------------------------------
75C Repere orthotrope
76C=======================================================================
77 DO i=lft,llt
78 ig = pid(i)
79 id=igeo(1,ig)
80 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
81 ipnum = igeo(2,ig)
82 vx = geo(7,ig)
83 vy = geo(8,ig)
84 vz = geo(9,ig)
85 phi = geo(1,ig) * pi/hundred80
86 cp = cos(phi)
87 sp = sin(phi)
88c
89 IF (jcvt == 0) THEN
90c ------------------------------
91c Angle d'orthotropie defini par rapport
92c a la premiere direction du repere isoparametrique
93c ------------------------------
94 IF(ipnum==11) THEN
95 sum=sqrt(ry(i)**2+rz(i)**2)
96 sum=one/max(sum,em20)
97 hx=zero
98 hy=ry(i)*sum
99 hz=rz(i)*sum
100 lx=hy*sz(i)-hz*sy(i)
101 ly=-hx*sz(i)
102 lz=zero
103 sum = sqrt(lx**2+ly**2+lz**2)
104 sum=one/max(sum,em20)
105 lx=lx*sum
106 ly=ly*sum
107 lz=lz*sum
108 kx=ly*hz-lz*hy
109 ky=lz*hx-lx*hz
110 kz=lx*hy-ly*hx
111 sum = sqrt(kx**2+ky**2+kz**2)
112 IF (sum > zero) sum=one/sum
113 kx=kx*sum
114 ky=ky*sum
115 kz=kz*sum
116 vn = vx*lx + vy*ly + vz*lz
117 vx = vx - vn*lx
118 vy = vy - vn*ly
119 vz = vz - vn*lz
120 sum = sqrt(vx**2+vy**2+vz**2)
121 IF (sum < em10) THEN
122 CALL ancmsg(msgid=1620,
123 . msgtype=msgwarning,
124 . anmode=aninfo_blind_1,
125 . i1=id,
126 . c1=titr)
127 sk(1) = hx
128 sk(2) = hy
129 sk(3) = hz
130 ELSE
131 sum = one / sum
132 sk(1) = vx * sum
133 sk(2) = vy * sum
134 sk(3) = vz * sum
135 ENDIF
136 sk(4) = ly* sk(3) - lz* sk(2)
137 sk(5) = lz* sk(1) - lx* sk(3)
138 sk(6) = lx* sk(2) - ly* sk(1)
139 gama(i,1) = sk(1)*hx + sk(2)*hy + sk(3)*hz
140 gama(i,2) = sk(1)*kx + sk(2)*ky + sk(3)*kz
141 gama(i,3) = zero
142 gama(i,4) = sk(4)*hx + sk(5)*hy + sk(6)*hz
143 gama(i,5) = sk(4)*kx + sk(5)*ky + sk(6)*kz
144 gama(i,6) = zero
145 ELSE
146 gama(i,1)= cp
147 gama(i,2)= sp
148 gama(i,3)= zero
149 gama(i,4)=-sp
150 gama(i,5)= cp
151 gama(i,6)= zero
152 ENDIF
153 ELSEIF (jcvt > 0) THEN
154 IF(ipnum==11) THEN
155 sum=sqrt(e1y(i)**2+e1z(i)**2)
156 IF (sum > zero) sum=one/sum
157 hx=zero
158 hy=e1y(i)*sum
159 hz=e1z(i)*sum
160 lx=hy*e2z(i)-hz*e2y(i)
161 ly=-hx*e2z(i)
162 lz=zero
163 sum = sqrt(lx**2+ly**2+lz**2)
164 IF (sum > zero) sum=one/sum
165 lx=lx*sum
166 ly=ly*sum
167 lz=lz*sum
168 kx=ly*hz-lz*hy
169 ky=lz*hx-lx*hz
170 kz=lx*hy-ly*hx
171 sum = sqrt(kx**2+ky**2+kz**2)
172 IF (sum > zero) sum=one/sum
173 kx=kx*sum
174 ky=ky*sum
175 kz=kz*sum
176 vn = vx*lx + vy*ly + vz*lz
177 vx = vx - vn*lx
178 vy = vy - vn*ly
179 vz = vz - vn*lz
180 sum = sqrt(vx**2+vy**2+vz**2)
181 IF (sum < em10) THEN
182 CALL ancmsg(msgid=1620,
183 . msgtype=msgwarning,
184 . anmode=aninfo_blind_1,
185 . i1=id,
186 . c1=titr)
187 sk(1) = hx
188 sk(2) = hy
189 sk(3) = hz
190 ELSE
191 sum = one / sum
192 sk(1) = vx * sum
193 sk(2) = vy * sum
194 sk(3) = vz * sum
195 ENDIF
196 sk(4) = ly* sk(3) - lz* sk(2)
197 sk(5) = lz* sk(1) - lx* sk(3)
198 sk(6) = lx* sk(2) - ly* sk(1)
199 ELSE
200c ------------------------------
201c ATTENTION !
202c Angle d'orthotropie est desormais toujours donne par l'utilisateur
203c par rapport au repere isoparametrique
204c Puis transforme en interne en angle par rapport au repere corrotationnel
205c (pour plus de simplicite cote utilisateur)
206c (anciennement donne directement par rapport au repere corot)
207c ------------------------------
208 sum=sqrt(ry(i)**2+rz(i)**2)
209 sum=one/max(sum,em20)
210 hx=zero
211 hy=ry(i)*sum
212 hz=rz(i)*sum
213 lx=hy*sz(i)-hz*sy(i)
214 ly=-hx*sz(i)
215 lz=zero
216 sum = sqrt(lx**2+ly**2+lz**2)
217 sum=one/max(sum,em20)
218 lx=lx*sum
219 ly=ly*sum
220 lz=lz*sum
221 kx=ly*hz-lz*hy
222 ky=lz*hx-lx*hz
223 kz=lx*hy-ly*hx
224 sum = sqrt(kx**2+ky**2+kz**2)
225 IF (sum > zero) sum=one/sum
226 kx=kx*sum
227 ky=ky*sum
228 kz=kz*sum
229 sk(1)= cp*hx+sp*kx
230 sk(2)= cp*hy+sp*ky
231 sk(3)= cp*hz+sp*kz
232 sk(4)=-sp*hx+cp*kx
233 sk(5)=-sp*hy+cp*ky
234 sk(6)=-sp*hz+cp*kz
235 hx=zero
236 hy=e1y(i)
237 hz=e1z(i)
238 kx=zero
239 ky=e2y(i)
240 kz=e2z(i)
241 ENDIF
242 gama(i,1) = zero
243 gama(i,2) = sk(1)*hx + sk(2)*hy + sk(3)*hz
244 gama(i,3) = sk(1)*kx + sk(2)*ky + sk(3)*kz
245 gama(i,4) = zero
246 gama(i,5) = sk(4)*hx + sk(5)*hy + sk(6)*hz
247 gama(i,6) = sk(4)*kx + sk(5)*ky + sk(6)*kz
248 ENDIF
249 ENDDO
250C-----
251
252 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804