OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
scmorth3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| scmorth3 ../starter/source/elements/thickshell/solidec/scmorth3.F
25!||--- called by ------------------------------------------------------
26!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
27!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
28!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
29!||--- calls -----------------------------------------------------
30!|| ancmsg ../starter/source/output/message/message.F
31!|| fretitl2 ../starter/source/starter/freform.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.f
34!||====================================================================
35 SUBROUTINE scmorth3(PID ,GEO ,IGEO ,SKEW ,IREP ,GAMA ,
36 . RX ,RY ,RZ ,SX ,SY ,SZ ,TX ,TY ,TZ ,
37 . E1X ,E1Y ,E1Z ,E2X ,E2Y ,E2Z ,E3X ,E3Y ,E3Z ,
38 . NGL ,ANGLE,NSIGI,SIGSP,NSIGS,SIGI ,IXS ,ILAY ,
39 . ORTHOGLOB ,PT,NEL)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE names_and_titles_mod , ONLY : nchartitle
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com01_c.inc"
57#include "param_c.inc"
58#include "vect01_c.inc"
59#include "scr17_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER PID(*),IGEO(NPROPGI,*),IREP,NGL(*),NSIGI,NSIGS,
64 . IXS(NIXS,*),ILAY,IPID,ORTHOGLOB(*),PT(*),NEL
65 my_real GEO(NPROPG,*),SKEW(LSKEW,*),GAMA(NEL,6),ANGLE(*),
66 . RX(*) ,RY(*) ,RZ(*) ,SX(*) ,SY(*) ,SZ(*) ,TX(*) ,TY(*) ,TZ(*),
67 . e1x(*),e1y(*),e1z(*),e2x(*),e2y(*),e2z(*),e3x(*),e3y(*),e3z(*),
68 . sigsp(nsigi,*),sigi(nsigs,*)
69 INTEGER ID
70 CHARACTER(LEN=NCHARTITLE)::TITR
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER I,IG,IGTYP,ISK,IPNUM,ISKV,IIS,II,J,JJ,N,IFLAGINI,INIORTH(MVSIZ)
75 my_real
76 . VX,VY,VZ,VR,VS,VN,V,PHI,CP,SP,CPN,SPN,
77 . S,D1,D2,U1X,U1Y,U2X,U2Y,DET,W1X,W2X,W1Y,W2Y
78 my_real gamatmp(6)
79C=======================================================================
80C---- tag elm /w /INIBRI/ORTHO
81 iniorth(lft:llt)=0
82 IF (nvsolid3 /= 0) THEN
83 iis= nvsolid1 + nvsolid2 + 4 +nusolid
84 DO i=lft,llt
85 jj=pt(nft+i)
86 IF(jj ==0 ) cycle
87 IF(orthoglob(i) == 0) THEN ! IF COS(PHI), SIN(PHI)
88 IF(sigsp((ilay-1)*6+iis+1,jj) /=zero.OR.
89 . sigsp((ilay-1)*6+iis+2,jj)/=zero ) THEN
90 iniorth(i) = 1
91 ENDIF
92 ELSE ! IF ORTHOTROPIC AXES IN GLOBAL REFERENCE
93 IF(
94 . sigsp((ilay-1)*6+iis+1,jj) /= zero .OR.
95 . sigsp((ilay-1)*6+iis+2,jj) /= zero .OR.
96 . sigsp((ilay-1)*6+iis+3,jj) /= zero .OR.
97 . sigsp((ilay-1)*6+iis+4,jj) /= zero .OR.
98 . sigsp((ilay-1)*6+iis+5,jj) /= zero .OR.
99 . sigsp((ilay-1)*6+iis+6,jj) /= zero )THEN
100 iniorth(i) = 1
101 ENDIF
102 ENDIF
103 ENDDO
104 ENDIF
105C---
106C Repere orthotrope pour thick shells-------
107C Stockage de Transpose(G) p.r.a. corotationel systems comme les coques
108C GAMA(1)= sina , GAMA(2) = cosa, only first 2 are useful --
109C---
110C------------HA8: variable thickness direction ---------
111
112 DO i=lft,llt
113C
114 IF(iniorth(i) ==1 ) cycle
115 ig = pid(i)
116 id=igeo(1,ig)
117 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ig),ltitr)
118 IF (ig > 0) THEN
119 igtyp = igeo(11,ig)
120 ipnum = igeo(2,ig)
121 iskv = igeo(7,ig)
122 phi = angle(i) * pi/hundred80
123 cp = cos(phi)
124 sp = sin(phi)
125C------------------Vx,Vy,VZ defined by skew-----
126 IF (iskv==0) THEN
127 vx=geo(7,ig)
128 vy=geo(8,ig)
129 vz=geo(9,ig)
130 ELSE
131 vx=skew(1,iskv)
132 vy=skew(2,iskv)
133 vz=skew(3,iskv)
134 ENDIF
135 SELECT CASE (ipnum)
136 CASE (1)
137 vn=vx*e1x(i)+vy*e1y(i)+vz*e1z(i)
138 vx=vx-vn*e1x(i)
139 vy=vy-vn*e1y(i)
140 vz=vz-vn*e1z(i)
141 v=sqrt(vx*vx+vy*vy+vz*vz)
142 IF(v<em3)THEN
143 CALL ancmsg(msgid=526,
144 . msgtype=msgerror,
145 . anmode=aninfo_blind_1,
146 . i1=id,
147 . c1=titr,
148 . i2=ngl(i))
149 ENDIF
150C
151 v=one/max(v,em20)
152 vx=vx*v
153 vy=vy*v
154 vz=vz*v
155 vr=vx*e2x(i)+vy*e2y(i)+vz*e2z(i)
156 vs=vx*e3x(i)+vy*e3y(i)+vz*e3z(i)
157 cpn=vr*cp-vs*sp
158 spn=vs*cp+vr*sp
159C
160 CASE (2)
161 vn=vx*e2x(i)+vy*e2y(i)+vz*e2z(i)
162 vx=vx-vn*e2x(i)
163 vy=vy-vn*e2y(i)
164 vz=vz-vn*e2z(i)
165 v=sqrt(vx*vx+vy*vy+vz*vz)
166 IF(v<em3)THEN
167 CALL ancmsg(msgid=526,
168 . msgtype=msgerror,
169 . anmode=aninfo_blind_1,
170 . i1=id,
171 . c1=titr,
172 . i2=ngl(i))
173 ENDIF
174C
175 v=one/max(v,em20)
176 vx=vx*v
177 vy=vy*v
178 vz=vz*v
179 vr=vx*e3x(i)+vy*e3y(i)+vz*e3z(i)
180 vs=vx*e1x(i)+vy*e1y(i)+vz*e1z(i)
181 cpn=vr*cp-vs*sp
182 spn=vs*cp+vr*sp
183C
184 CASE (3)
185 vn=vx*e3x(i)+vy*e3y(i)+vz*e3z(i)
186 vx=vx-vn*e3x(i)
187 vy=vy-vn*e3y(i)
188 vz=vz-vn*e3z(i)
189 v=sqrt(vx*vx+vy*vy+vz*vz)
190 IF(v<em3)THEN
191 CALL ancmsg(msgid=526,
192 . msgtype=msgerror,
193 . anmode=aninfo_blind_1,
194 . i1=id,
195 . c1=titr,
196 . i2=ngl(i))
197 ENDIF
198C
199 v=one/max(v,em20)
200 vx=vx*v
201 vy=vy*v
202 vz=vz*v
203 vr=vx*e1x(i)+vy*e1y(i)+vz*e1z(i)
204 vs=vx*e2x(i)+vy*e2y(i)+vz*e2z(i)
205 cpn=vr*cp-vs*sp
206 spn=vs*cp+vr*sp
207C
208 END SELECT
209 gama(i,1)=cpn
210 gama(i,2)=spn
211 ENDIF
212C
213 ENDDO
214C------Uij-->gij; Wij->[g]-1-----
215 IF (irep==1) THEN
216 DO i=lft,llt
217 ig = pid(i)
218 ipnum = igeo(2,ig)
219C----par rapport a HA8, permitation si s16----
220 SELECT CASE (ipnum)
221 CASE (1)
222 u1x = rx(i)*e2x(i)+ry(i)*e2y(i)+rz(i)*e2z(i)
223 u1y = rx(i)*e3x(i)+ry(i)*e3y(i)+rz(i)*e3z(i)
224 u2x = sx(i)*e2x(i)+sy(i)*e2y(i)+sz(i)*e2z(i)
225 u2y = sx(i)*e3x(i)+sy(i)*e3y(i)+sz(i)*e3z(i)
226 det = u1x*u2y-u1y*u2x
227 w1x = u2y/det
228 w2y = u1x/det
229 w1y = -u1y/det
230 w2x = -u2x/det
231 d1=gama(i,1)
232 d2=gama(i,2)
233 cpn= w1x*d1 + w2x*d2
234 spn= w1y*d1 + w2y*d2
235 s=max(em20,sqrt(cpn*cpn+spn*spn))
236 cpn = cpn/s
237 spn = spn/s
238C
239 CASE (2)
240 u1x = sx(i)*e3x(i)+sy(i)*e3y(i)+sz(i)*e3z(i)
241 u1y = sx(i)*e1x(i)+sy(i)*e1y(i)+sz(i)*e1z(i)
242 u2x = tx(i)*e3x(i)+ty(i)*e3y(i)+tz(i)*e3z(i)
243 u2y = tx(i)*e1x(i)+ty(i)*e1y(i)+tz(i)*e1z(i)
244 det = u1x*u2y-u1y*u2x
245 w1x = u2y/det
246 w2y = u1x/det
247 w1y = -u1y/det
248 w2x = -u2x/det
249 d1=gama(i,1)
250 d2=gama(i,2)
251 cpn= w1x*d1 + w2x*d2
252 spn= w1y*d1 + w2y*d2
253 s=max(em20,sqrt(cpn*cpn+spn*spn))
254 cpn = cpn/s
255 spn = spn/s
256C
257 CASE (3)
258 u1x = tx(i)*e1x(i)+ty(i)*e1y(i)+tz(i)*e1z(i)
259 u1y = tx(i)*e2x(i)+ty(i)*e2y(i)+tz(i)*e2z(i)
260 u2x = rx(i)*e1x(i)+ry(i)*e1y(i)+rz(i)*e1z(i)
261 u2y = rx(i)*e2x(i)+ry(i)*e2y(i)+rz(i)*e2z(i)
262 det = u1x*u2y-u1y*u2x
263 w1x = u2y/det
264 w2y = u1x/det
265 w1y = -u1y/det
266 w2x = -u2x/det
267 d1=gama(i,1)
268 d2=gama(i,2)
269 cpn= w1x*d1 + w2x*d2
270 spn= w1y*d1 + w2y*d2
271 s=max(em20,sqrt(cpn*cpn+spn*spn))
272 cpn = cpn/s
273 spn = spn/s
274C
275 END SELECT
276 gama(i,1)=cpn
277 gama(i,2)=spn
278 ENDDO
279 ENDIF
280C
281C---
282 IF (nvsolid3 /= 0) THEN
283 iis= nvsolid1 + nvsolid2 + 4 +nusolid
284 DO i=lft,llt
285 IF(orthoglob(i) == 0) THEN ! IF COS(PHI), SIN(PHI)
286 ii=nft+i
287 jj=pt(ii)
288 iflagini = 1
289 IF(jj==0)iflagini = 0
290 IF(iflagini == 1 .AND.
291 . ( sigsp((ilay-1)*6+iis+1,jj) /= zero.OR.
292 . sigsp((ilay-1)*6+iis+2,jj)/=zero) ) THEN
293 gama(i,1) = sigsp((ilay-1)*6+iis+1,jj)
294 gama(i,2) = sigsp((ilay-1)*6+iis+2,jj)
295 ENDIF
296 ELSE ! IF ORTHOTROPIC AXES IN GLOBAL REFERENCE
297 ii=nft+i
298 jj=pt(ii)
299 ig = pid(i)
300 ipnum = igeo(2,ig)
301 iflagini = 1
302 IF(jj==0)iflagini = 0
303 IF(iflagini == 1 .AND.
304 . ( sigsp((ilay-1)*6+iis+1,jj) /= zero .OR.
305 . sigsp((ilay-1)*6+iis+2,jj) /= zero .OR.
306 . sigsp((ilay-1)*6+iis+3,jj) /= zero .OR.
307 . sigsp((ilay-1)*6+iis+4,jj) /= zero .OR.
308 . sigsp((ilay-1)*6+iis+5,jj) /= zero .OR.
309 . sigsp((ilay-1)*6+iis+6,jj) /= zero) )THEN
310 gamatmp(1) = sigsp((ilay-1)*6+iis+1,jj)
311 gamatmp(2) = sigsp((ilay-1)*6+iis+2,jj)
312 gamatmp(3) = sigsp((ilay-1)*6+iis+3,jj)
313 gamatmp(4) = sigsp((ilay-1)*6+iis+4,jj)
314 gamatmp(5) = sigsp((ilay-1)*6+iis+5,jj)
315 gamatmp(6) = sigsp((ilay-1)*6+iis+6,jj)
316 gama(i,1:6) = zero
317 SELECT CASE (ipnum)
318 CASE (1)
319 gama(i,1) = gamatmp(1)*e2x(i)+
320 . gamatmp(2)*e2y(i)+gamatmp(3)*e2z(i)
321 gama(i,2) = gamatmp(1)*e3x(i)+
322 . gamatmp(2)*e3y(i)+gamatmp(3)*e3z(i)
323 CASE (2)
324 gama(i,1) = gamatmp(1)*e3x(i)+
325 . gamatmp(2)*e3y(i)+gamatmp(3)*e3z(i)
326 gama(i,2) = gamatmp(1)*e1x(i)+
327 . gamatmp(2)*e1y(i)+gamatmp(3)*e1z(i)
328 CASE (3)
329 gama(i,1) = gamatmp(1)*e1x(i)+
330 . gamatmp(2)*e1y(i)+gamatmp(3)*e1z(i)
331 gama(i,2) = gamatmp(1)*e2x(i)+
332 . gamatmp(2)*e2y(i)+gamatmp(3)*e2z(i)
333 END SELECT
334 ENDIF
335 ENDIF
336 ENDDO
337 ENDIF
338C---
339 RETURN
340 END SUBROUTINE scmorth3
max
#define max(a, b)
Definition macros.h:21
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
scmorth3
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)
Definition scmorth3.F:40
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
starter
program starter
Definition starter.F:39