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

Go to the source code of this file.

Functions/Subroutines

subroutine scmorth3 (pid, geo, igeo, skew, irep, gama, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ngl, angle, nsigi, sigsp, nsigs, sigi, ixs, ilay, orthoglob, pt, nel)

Function/Subroutine Documentation

◆ scmorth3()

subroutine scmorth3 ( integer, dimension(*) pid,
geo,
integer, dimension(npropgi,*) igeo,
skew,
integer irep,
gama,
rx,
ry,
rz,
sx,
sy,
sz,
tx,
ty,
tz,
e1x,
e1y,
e1z,
e2x,
e2y,
e2z,
e3x,
e3y,
e3z,
integer, dimension(*) ngl,
angle,
integer nsigi,
sigsp,
integer nsigs,
sigi,
integer, dimension(nixs,*) ixs,
integer ilay,
integer, dimension(*) orthoglob,
integer, dimension(*) pt,
integer nel )

Definition at line 35 of file scmorth3.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE names_and_titles_mod , ONLY : nchartitle
45 use element_mod , only : nixs
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C G l o b a l P a r a m e t e r s
52C-----------------------------------------------
53#include "mvsiz_p.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com01_c.inc"
58#include "param_c.inc"
59#include "vect01_c.inc"
60#include "scr17_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER PID(*),IGEO(NPROPGI,*),IREP,NGL(*),NSIGI,NSIGS,
65 . IXS(NIXS,*),ILAY,ORTHOGLOB(*),PT(*),NEL
66 my_real geo(npropg,*),skew(lskew,*),gama(nel,6),angle(*),
67 . rx(*) ,ry(*) ,rz(*) ,sx(*) ,sy(*) ,sz(*) ,tx(*) ,ty(*) ,tz(*),
68 . e1x(*),e1y(*),e1z(*),e2x(*),e2y(*),e2z(*),e3x(*),e3y(*),e3z(*),
69 . sigsp(nsigi,*),sigi(nsigs,*)
70 INTEGER ID
71 CHARACTER(LEN=NCHARTITLE)::TITR
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I, IG, IGTYP, IPNUM, ISKV, IIS, II, JJ, IFLAGINI, INIORTH(MVSIZ)
76 my_real
77 . vx,vy,vz,vr,vs,vn,v,phi,cp,sp,cpn,spn,
78 . s,d1,d2,u1x,u1y,u2x,u2y,det,w1x,w2x,w1y,w2y
79 my_real gamatmp(6)
80C=======================================================================
81C---- tag elm /w /INIBRI/ORTHO
82 iniorth(lft:llt)=0
83 IF (nvsolid3 /= 0) THEN
84 iis= nvsolid1 + nvsolid2 + 4 +nusolid
85 DO i=lft,llt
86 jj=pt(nft+i)
87 IF(jj ==0 ) cycle
88 IF(orthoglob(i) == 0) THEN ! IF COS(PHI), SIN(PHI)
89 IF(sigsp((ilay-1)*6+iis+1,jj) /=zero.OR.
90 . sigsp((ilay-1)*6+iis+2,jj)/=zero ) THEN
91 iniorth(i) = 1
92 ENDIF
93 ELSE ! IF ORTHOTROPIC AXES IN GLOBAL REFERENCE
94 IF(
95 . sigsp((ilay-1)*6+iis+1,jj) /= zero .OR.
96 . sigsp((ilay-1)*6+iis+2,jj) /= zero .OR.
97 . sigsp((ilay-1)*6+iis+3,jj) /= zero .OR.
98 . sigsp((ilay-1)*6+iis+4,jj) /= zero .OR.
99 . sigsp((ilay-1)*6+iis+5,jj) /= zero .OR.
100 . sigsp((ilay-1)*6+iis+6,jj) /= zero )THEN
101 iniorth(i) = 1
102 ENDIF
103 ENDIF
104 ENDDO
105 ENDIF
106C---
107C Orthotropic frame for thick shells-------
108C Transpose storage (G) P.R.A.Corotationeel Systems like the shells
109C GAMA(1)= sina , GAMA(2) = cosa, only first 2 are useful --
110C---
111C------------HA8: variable thickness direction ---------
112
113 DO i=lft,llt
114C
115 IF(iniorth(i) ==1 ) cycle
116 ig = pid(i)
117 id=igeo(1,ig)
118 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
119 IF (ig > 0) THEN
120 igtyp = igeo(11,ig)
121 ipnum = igeo(2,ig)
122 iskv = igeo(7,ig)
123 phi = angle(i) * pi/hundred80
124 cp = cos(phi)
125 sp = sin(phi)
126C------------------Vx,Vy,VZ defined by skew-----
127 IF (iskv==0) THEN
128 vx=geo(7,ig)
129 vy=geo(8,ig)
130 vz=geo(9,ig)
131 ELSE
132 vx=skew(1,iskv)
133 vy=skew(2,iskv)
134 vz=skew(3,iskv)
135 ENDIF
136 SELECT CASE (ipnum)
137 CASE (1)
138 vn=vx*e1x(i)+vy*e1y(i)+vz*e1z(i)
139 vx=vx-vn*e1x(i)
140 vy=vy-vn*e1y(i)
141 vz=vz-vn*e1z(i)
142 v=sqrt(vx*vx+vy*vy+vz*vz)
143 IF(v<em3)THEN
144 CALL ancmsg(msgid=526,
145 . msgtype=msgerror,
146 . anmode=aninfo_blind_1,
147 . i1=id,
148 . c1=titr,
149 . i2=ngl(i))
150 ENDIF
151C
152 v=one/max(v,em20)
153 vx=vx*v
154 vy=vy*v
155 vz=vz*v
156 vr=vx*e2x(i)+vy*e2y(i)+vz*e2z(i)
157 vs=vx*e3x(i)+vy*e3y(i)+vz*e3z(i)
158 cpn=vr*cp-vs*sp
159 spn=vs*cp+vr*sp
160C
161 CASE (2)
162 vn=vx*e2x(i)+vy*e2y(i)+vz*e2z(i)
163 vx=vx-vn*e2x(i)
164 vy=vy-vn*e2y(i)
165 vz=vz-vn*e2z(i)
166 v=sqrt(vx*vx+vy*vy+vz*vz)
167 IF(v<em3)THEN
168 CALL ancmsg(msgid=526,
169 . msgtype=msgerror,
170 . anmode=aninfo_blind_1,
171 . i1=id,
172 . c1=titr,
173 . i2=ngl(i))
174 ENDIF
175C
176 v=one/max(v,em20)
177 vx=vx*v
178 vy=vy*v
179 vz=vz*v
180 vr=vx*e3x(i)+vy*e3y(i)+vz*e3z(i)
181 vs=vx*e1x(i)+vy*e1y(i)+vz*e1z(i)
182 cpn=vr*cp-vs*sp
183 spn=vs*cp+vr*sp
184C
185 CASE (3)
186 vn=vx*e3x(i)+vy*e3y(i)+vz*e3z(i)
187 vx=vx-vn*e3x(i)
188 vy=vy-vn*e3y(i)
189 vz=vz-vn*e3z(i)
190 v=sqrt(vx*vx+vy*vy+vz*vz)
191 IF(v<em3)THEN
192 CALL ancmsg(msgid=526,
193 . msgtype=msgerror,
194 . anmode=aninfo_blind_1,
195 . i1=id,
196 . c1=titr,
197 . i2=ngl(i))
198 ENDIF
199C
200 v=one/max(v,em20)
201 vx=vx*v
202 vy=vy*v
203 vz=vz*v
204 vr=vx*e1x(i)+vy*e1y(i)+vz*e1z(i)
205 vs=vx*e2x(i)+vy*e2y(i)+vz*e2z(i)
206 cpn=vr*cp-vs*sp
207 spn=vs*cp+vr*sp
208C
209 END SELECT
210 gama(i,1)=cpn
211 gama(i,2)=spn
212 ENDIF
213C
214 ENDDO
215C------Uij-->gij; Wij->[g]-1-----
216 IF (irep==1) THEN
217 DO i=lft,llt
218 ig = pid(i)
219 ipnum = igeo(2,ig)
220C----compared to HA8, permutation if s16----
221 SELECT CASE (ipnum)
222 CASE (1)
223 u1x = rx(i)*e2x(i)+ry(i)*e2y(i)+rz(i)*e2z(i)
224 u1y = rx(i)*e3x(i)+ry(i)*e3y(i)+rz(i)*e3z(i)
225 u2x = sx(i)*e2x(i)+sy(i)*e2y(i)+sz(i)*e2z(i)
226 u2y = sx(i)*e3x(i)+sy(i)*e3y(i)+sz(i)*e3z(i)
227 det = u1x*u2y-u1y*u2x
228 w1x = u2y/det
229 w2y = u1x/det
230 w1y = -u1y/det
231 w2x = -u2x/det
232 d1=gama(i,1)
233 d2=gama(i,2)
234 cpn= w1x*d1 + w2x*d2
235 spn= w1y*d1 + w2y*d2
236 s=max(em20,sqrt(cpn*cpn+spn*spn))
237 cpn = cpn/s
238 spn = spn/s
239C
240 CASE (2)
241 u1x = sx(i)*e3x(i)+sy(i)*e3y(i)+sz(i)*e3z(i)
242 u1y = sx(i)*e1x(i)+sy(i)*e1y(i)+sz(i)*e1z(i)
243 u2x = tx(i)*e3x(i)+ty(i)*e3y(i)+tz(i)*e3z(i)
244 u2y = tx(i)*e1x(i)+ty(i)*e1y(i)+tz(i)*e1z(i)
245 det = u1x*u2y-u1y*u2x
246 w1x = u2y/det
247 w2y = u1x/det
248 w1y = -u1y/det
249 w2x = -u2x/det
250 d1=gama(i,1)
251 d2=gama(i,2)
252 cpn= w1x*d1 + w2x*d2
253 spn= w1y*d1 + w2y*d2
254 s=max(em20,sqrt(cpn*cpn+spn*spn))
255 cpn = cpn/s
256 spn = spn/s
257C
258 CASE (3)
259 u1x = tx(i)*e1x(i)+ty(i)*e1y(i)+tz(i)*e1z(i)
260 u1y = tx(i)*e2x(i)+ty(i)*e2y(i)+tz(i)*e2z(i)
261 u2x = rx(i)*e1x(i)+ry(i)*e1y(i)+rz(i)*e1z(i)
262 u2y = rx(i)*e2x(i)+ry(i)*e2y(i)+rz(i)*e2z(i)
263 det = u1x*u2y-u1y*u2x
264 w1x = u2y/det
265 w2y = u1x/det
266 w1y = -u1y/det
267 w2x = -u2x/det
268 d1=gama(i,1)
269 d2=gama(i,2)
270 cpn= w1x*d1 + w2x*d2
271 spn= w1y*d1 + w2y*d2
272 s=max(em20,sqrt(cpn*cpn+spn*spn))
273 cpn = cpn/s
274 spn = spn/s
275C
276 END SELECT
277 gama(i,1)=cpn
278 gama(i,2)=spn
279 ENDDO
280 ENDIF
281C
282C---
283 IF (nvsolid3 /= 0) THEN
284 iis= nvsolid1 + nvsolid2 + 4 +nusolid
285 DO i=lft,llt
286 IF(orthoglob(i) == 0) THEN ! IF COS(PHI), SIN(PHI)
287 ii=nft+i
288 jj=pt(ii)
289 iflagini = 1
290 IF(jj==0)iflagini = 0
291 IF(iflagini == 1 .AND.
292 . ( sigsp((ilay-1)*6+iis+1,jj) /= zero.OR.
293 . sigsp((ilay-1)*6+iis+2,jj)/=zero) ) THEN
294 gama(i,1) = sigsp((ilay-1)*6+iis+1,jj)
295 gama(i,2) = sigsp((ilay-1)*6+iis+2,jj)
296 ENDIF
297 ELSE ! IF ORTHOTROPIC AXES IN GLOBAL REFERENCE
298 ii=nft+i
299 jj=pt(ii)
300 ig = pid(i)
301 ipnum = igeo(2,ig)
302 iflagini = 1
303 IF(jj==0)iflagini = 0
304 IF(iflagini == 1 .AND.
305 . ( sigsp((ilay-1)*6+iis+1,jj) /= zero .OR.
306 . sigsp((ilay-1)*6+iis+2,jj) /= zero .OR.
307 . sigsp((ilay-1)*6+iis+3,jj) /= zero .OR.
308 . sigsp((ilay-1)*6+iis+4,jj) /= zero .OR.
309 . sigsp((ilay-1)*6+iis+5,jj) /= zero .OR.
310 . sigsp((ilay-1)*6+iis+6,jj) /= zero) )THEN
311 gamatmp(1) = sigsp((ilay-1)*6+iis+1,jj)
312 gamatmp(2) = sigsp((ilay-1)*6+iis+2,jj)
313 gamatmp(3) = sigsp((ilay-1)*6+iis+3,jj)
314 gamatmp(4) = sigsp((ilay-1)*6+iis+4,jj)
315 gamatmp(5) = sigsp((ilay-1)*6+iis+5,jj)
316 gamatmp(6) = sigsp((ilay-1)*6+iis+6,jj)
317 gama(i,1:6) = zero
318 SELECT CASE (ipnum)
319 CASE (1)
320 gama(i,1) = gamatmp(1)*e2x(i)+
321 . gamatmp(2)*e2y(i)+gamatmp(3)*e2z(i)
322 gama(i,2) = gamatmp(1)*e3x(i)+
323 . gamatmp(2)*e3y(i)+gamatmp(3)*e3z(i)
324 CASE (2)
325 gama(i,1) = gamatmp(1)*e3x(i)+
326 . gamatmp(2)*e3y(i)+gamatmp(3)*e3z(i)
327 gama(i,2) = gamatmp(1)*e1x(i)+
328 . gamatmp(2)*e1y(i)+gamatmp(3)*e1z(i)
329 CASE (3)
330 gama(i,1) = gamatmp(1)*e1x(i)+
331 . gamatmp(2)*e1y(i)+gamatmp(3)*e1z(i)
332 gama(i,2) = gamatmp(1)*e2x(i)+
333 . gamatmp(2)*e2y(i)+gamatmp(3)*e2z(i)
334 END SELECT
335 ENDIF
336 ENDIF
337 ENDDO
338 ENDIF
339C---
340 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:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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:895
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799