OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
csigini.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!|| csigini ../starter/source/elements/shell/coque/csigini.F
25!||--- called by ------------------------------------------------------
26!|| c3init3 ../starter/source/elements/sh3n/coque3n/c3init3.F
27!|| cinit3 ../starter/source/elements/shell/coque/cinit3.F
28!||--- calls -----------------------------------------------------
29!|| ancmsg ../starter/source/output/message/message.F
30!|| cg2leps ../starter/source/elements/shell/coqueba/scigini4.F
31!|| cg2lsig ../starter/source/elements/shell/coqueba/scigini4.F
32!|| fretitl2 ../starter/source/starter/freform.f
33!|| loc2orth ../starter/source/elements/shell/coqueba/scigini4.F
34!||--- uses -----------------------------------------------------
35!|| message_mod ../starter/share/message_module/message_mod.F
36!||====================================================================
37 SUBROUTINE csigini(ELBUF_STR,
38 1 JFT ,JLT ,NFT ,NPT ,ISTRAIN,
39 2 THK ,EINT ,GSTR ,HH ,PLAS ,
40 3 FOR ,MOM ,SIGSH ,NLAY ,G_HOURG,
41 4 NUMEL ,IX ,NIX ,NSIGSH,NUMSH ,
42 5 PTSH ,IGEO ,THKE ,NEL ,E1X ,
43 6 E2X ,E3X ,E1Y ,E2Y ,E3Y ,
44 7 E1Z ,E2Z ,E3Z ,ISIGSH,DIR_A ,
45 9 DIR_B ,POSLY ,IGTYP )
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE elbufdef_mod
50 USE message_mod
51 USE names_and_titles_mod , ONLY : nchartitle
52C-----------------------------------------------
53C////////////////////////////////////////////////
54C ROUTINE GENERIQUE 4NOEUDS-3NOEUDS
55C////////////////////////////////////////////////
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C G l o b a l P a r a m e t e r s
62C-----------------------------------------------
63#include "mvsiz_p.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "param_c.inc"
68#include "com01_c.inc"
69#include "scr17_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER JFT,JLT,NUMEL,NIX,NFT,NLAY,NPT,ISTRAIN,NSIGSH,NUMSH,
74 . G_HOURG,NEL,ISIGSH,IGTYP
75 INTEGER IX(NIX,*),PTSH(*),IGEO(NPROPGI,*)
76 my_real
77 . THK(*),EINT(NEL,2),GSTR(NEL,8),FOR(NEL,5),MOM(NEL,3),
78 . HH(NEL,5),PLAS(*),SIGSH(NSIGSH,*),THKE(*),
79 . E1X(MVSIZ),E2X(MVSIZ),E3X(MVSIZ),
80 . E1Y(MVSIZ),E2Y(MVSIZ),E3Y(MVSIZ),
81 . e1z(mvsiz),e2z(mvsiz),e3z(mvsiz),dir_a(*),dir_b(*),
82 . posly(mvsiz,*)
83 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
84C------------------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER I, II, J, JJ, KK(5),N, NPTI, I1, PID, IPID, L_PLA,PT,
88 . ILAY,IPT_ALL,IPT,PTN,JDIR,ILAW,NPTT,IT
89 my_real
90 . TXX,TYY,TZZ,TXY,TYZ,TZX,UXX,UYY,UZZ,UXY,UYZ,UZX,A,B,C,
91 . e1(6),e2(6),z1,z2,z0,aa,s6(6),posi(mvsiz,npt),
92 . forj(5),momj(3),tj,unpt,npgi,f2m
93 CHARACTER(LEN=NCHARTITLE)::TITR1
94 TYPE(L_BUFEL_) ,POINTER :: LBUF
95 TYPE(buf_lay_) ,POINTER :: BUFLY
96C=======================================================================
97 bufly => elbuf_str%BUFLY(1)
98 l_pla = elbuf_str%GBUF%G_PLA
99!
100 DO i=1,5
101 kk(i) = nel*(i-1)
102 ENDDO
103!
104 DO i=jft,jlt
105 IF(abs(isigi) /= 3.AND.abs(isigi) /= 4.AND.abs(isigi) /= 5)THEN
106 ii = ptsh(i+nft)
107 IF(ii == 0 ) GOTO 100
108 n = nint(sigsh(1,ii))
109 IF(n == ix(nix,i+nft))THEN
110 jj = i+nft
111 ELSE
112 jj = i+nft
113 DO j = 1,numel
114 ii= j
115 n = nint(sigsh(1,ii))
116 IF (n == 0) GOTO 100
117 IF (n == ix(nix,jj)) GOTO 60
118 ENDDO
119 GOTO 100
120 60 CONTINUE
121 ENDIF
122 ELSE
123 jj=nft+i
124 n =ix(nix,jj)
125 ii=ptsh(jj)
126 IF(ii == 0)GOTO 100
127 END IF
128 IF(sigsh(nvshell - 1 ,ii) == zero ) cycle
129c
130 npgi=nint(sigsh(nvshell,ii))
131 npti=nint(sigsh(2,ii))
132 IF(sigsh(3,ii) /= zero) THEN
133 thk(i)=sigsh(3,ii)
134 thke(i)=thk(i)
135 ENDIF
136 eint(i,1)=sigsh(4,ii)
137 eint(i,2)=sigsh(5,ii)
138 IF (g_hourg > 0) THEN
139 hh(i,1)= sigsh(14,ii)
140 hh(i,2)= sigsh(15,ii)
141 hh(i,3)= sigsh(16,ii)
142 ENDIF
143
144 IF(npt /= npti .AND. npt/=0.OR.npgi>1) THEN
145 ipid=ix(nix-1,nft+i)
146 pid=igeo(1,ipid)
147 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid),ltitr)
148 IF(npti == 0 .AND. ithkshel /= 2)THEN
149 CALL ancmsg(msgid=2020,
150 . anmode=aninfo,
151 . msgtype=msgerror,
152 . c1=titr1,
153 . i1=pid,
154 . i2=n,
155 . prmod=msg_cumu)
156 ELSEIF(isigsh /= 0) THEN
157 CALL ancmsg(msgid=26,
158 . anmode=aninfo,
159 . msgtype=msgerror,
160 . i2=n,
161 . i1=pid,
162 . c1=titr1)
163 ENDIF
164 ENDIF
165 IF (istrain /= 0.AND.ithkshel==2) THEN
166 IF(sigsh(17,ii) == one)THEN
167C--- in global sys
168 pt = inishvar1
169 IF (npti==1) THEN
170 e1(1:6) = sigsh(pt:pt+5,ii)
171 z1 = sigsh(pt+6,ii)
172 CALL cg2leps(
173 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
174 8 e1z(i) ,e2z(i),e3z(i),e1 )
175 gstr(i,1:5)=e1(1:5)
176 ELSE
177 e1(1:6) = sigsh(pt:pt+5,ii)
178 z1 = sigsh(pt+6,ii)
179 e2(1:6) = sigsh(pt+7:pt+12,ii)
180 z2 = sigsh(pt+13,ii)
181 aa = half*thke(i)
182 CALL cg2leps(
183 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
184 8 e1z(i) ,e2z(i),e3z(i),e1 )
185 CALL cg2leps(
186 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
187 8 e1z(i) ,e2z(i),e3z(i),e2 )
188 IF (z1==z2) THEN
189c error out
190 CALL ancmsg(msgid=1904,
191 . anmode=aninfo,
192 . msgtype=msgerror,
193 . i1=n,
194 . r1=z1)
195 ELSEIF (z1==zero) THEN
196 gstr(i,1:5)=e1(1:5)
197 z0 = aa*z2
198 gstr(i,6:8)=(e2(1:3)-e1(1:3))/z0
199 ELSEIF (z2==zero) THEN
200 gstr(i,1:5)=e2(1:5)
201 z0 = aa*z1
202 gstr(i,6:8)=(e1(1:3)-e2(1:3))/z0
203 ELSE
204 z0 = aa*(z2-z1)
205 gstr(i,6:8)=(e2(1:3)-e1(1:3))/z0
206 gstr(i,1:3)=e1(1:3)-aa*z1*gstr(i,6:8)
207 gstr(i,4:5)= half*(e2(4:5) + e1(4:5))
208 END IF
209 END IF
210 ELSE
211 gstr(i,1)=sigsh(6,ii)
212 gstr(i,2)=sigsh(7,ii)
213 gstr(i,3)=sigsh(8,ii)
214 gstr(i,4)=sigsh(9,ii)
215 gstr(i,5)=sigsh(10,ii)
216 gstr(i,6)=sigsh(11,ii)
217 gstr(i,7)=sigsh(12,ii)
218 gstr(i,8)=sigsh(13,ii)
219 ENDIF
220 ENDIF
221 IF (isigsh==0) cycle
222 IF (npt == 0) THEN
223 IF(sigsh(17,ii) == one)THEN
224 IF (npti>1) THEN
225 unpt = one/npti
226 forj(1:5) = zero
227 f2m = zero
228 DO it=1,npti
229 pt = 22 + 6*(it-1)
230 s6(1:2)=sigsh(pt:pt+1,ii)
231 s6(3)=sigsh(inishvar+it,ii)
232 s6(4:6)=sigsh(pt+2:pt+4,ii)
233 tj=six*sigsh(inishvar+npti+it,ii)
234 CALL cg2lsig(
235 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
236 8 e1z(i) ,e2z(i),e3z(i),s6 )
237 forj(1:5) = forj(1:5) + unpt*s6(1:5)
238 IF (tj>zero) THEN
239 f2m = one/tj
240 momj(1:3) = s6(1:3)
241 END IF
242 ENDDO
243 sigsh(22:26,ii)=forj(1:5)
244 sigsh(28:30,ii)=f2m*(momj(1:3)-forj(1:3))
245 ELSE
246 txx = sigsh(22,ii)
247 tyy = sigsh(23,ii)
248 tzz = sigsh(18,ii)
249 txy = sigsh(24,ii)
250 tyz = sigsh(25,ii)
251 tzx = sigsh(26,ii)
252C
253 a = e1x(i)*txx + e1y(i)*txy + e1z(i)*tzx
254 b = e1x(i)*txy + e1y(i)*tyy + e1z(i)*tyz
255 c = e1x(i)*tzx + e1y(i)*tyz + e1z(i)*tzz
256 uxx = a*e1x(i) + b*e1y(i) + c*e1z(i)
257 uxy = a*e2x(i) + b*e2y(i) + c*e2z(i)
258 uzx = a*e3x(i) + b*e3y(i) + c*e3z(i)
259 a = e2x(i)*txx + e2y(i)*txy + e2z(i)*tzx
260 b = e2x(i)*txy + e2y(i)*tyy + e2z(i)*tyz
261 c = e2x(i)*tzx + e2y(i)*tyz + e2z(i)*tzz
262 uyy = a*e2x(i) + b*e2y(i) + c*e2z(i)
263 uyz = a*e3x(i) + b*e3y(i) + c*e3z(i)
264C
265 sigsh(22,ii) = uxx
266 sigsh(23,ii) = uyy
267 sigsh(24,ii) = uxy
268 sigsh(25,ii) = uyz
269 sigsh(26,ii) = uzx
270C
271 txx = sigsh(28,ii)
272 tyy = sigsh(29,ii)
273 tzz = sigsh(19,ii)
274 txy = sigsh(30,ii)
275 tyz = sigsh(20,ii)
276 tzx = sigsh(21,ii)
277C
278 a = e1x(i)*txx + e1y(i)*txy + e1z(i)*tzx
279 b = e1x(i)*txy + e1y(i)*tyy + e1z(i)*tyz
280 c = e1x(i)*tzx + e1y(i)*tyz + e1z(i)*tzz
281 uxx = a*e1x(i) + b*e1y(i) + c*e1z(i)
282 uxy = a*e2x(i) + b*e2y(i) + c*e2z(i)
283 a = e2x(i)*txx + e2y(i)*txy + e2z(i)*tzx
284 b = e2x(i)*txy + e2y(i)*tyy + e2z(i)*tyz
285 c = e2x(i)*tzx + e2y(i)*tyz + e2z(i)*tzz
286 uyy = a*e2x(i) + b*e2y(i) + c*e2z(i)
287C
288 sigsh(28,ii) = uxx
289 sigsh(29,ii) = uyy
290 sigsh(30,ii) = uxy
291 END IF !(NPTI>1) THEN
292 ENDIF
293 for(i,1)=sigsh(22,ii)
294 for(i,2)=sigsh(23,ii)
295 for(i,3)=sigsh(24,ii)
296 for(i,4)=sigsh(25,ii)
297 for(i,5)=sigsh(26,ii)
298 IF (l_pla > 0) plas(i) =sigsh(27,ii)
299 mom(i,1)=sigsh(28,ii)
300 mom(i,2)=sigsh(29,ii)
301 mom(i,3)=sigsh(30,ii)
302 ELSEIF(npti == 0)THEN
303 IF(sigsh(17,ii) == one)THEN
304 txx = sigsh(22,ii)
305 tyy = sigsh(23,ii)
306 tzz = sigsh(18,ii)
307 txy = sigsh(24,ii)
308 tyz = sigsh(25,ii)
309 tzx = sigsh(26,ii)
310C
311 a = e1x(i)*txx + e1y(i)*txy + e1z(i)*tzx
312 b = e1x(i)*txy + e1y(i)*tyy + e1z(i)*tyz
313 c = e1x(i)*tzx + e1y(i)*tyz + e1z(i)*tzz
314 uxx = a*e1x(i) + b*e1y(i) + c*e1z(i)
315 uxy = a*e2x(i) + b*e2y(i) + c*e2z(i)
316 uzx = a*e3x(i) + b*e3y(i) + c*e3z(i)
317 a = e2x(i)*txx + e2y(i)*txy + e2z(i)*tzx
318 b = e2x(i)*txy + e2y(i)*tyy + e2z(i)*tyz
319 c = e2x(i)*tzx + e2y(i)*tyz + e2z(i)*tzz
320 uyy = a*e2x(i) + b*e2y(i) + c*e2z(i)
321 uyz = a*e3x(i) + b*e3y(i) + c*e3z(i)
322C
323 sigsh(22,ii) = uxx
324 sigsh(23,ii) = uyy
325 sigsh(24,ii) = uxy
326 sigsh(25,ii) = uyz
327 sigsh(26,ii) = uzx
328 ENDIF
329 DO j=1,npt
330 IF (nlay > 1) THEN
331 lbuf => elbuf_str%BUFLY(j)%LBUF(1,1,1)
332 l_pla = elbuf_str%BUFLY(j)%L_PLA
333 ELSE
334 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,j)
335 l_pla = elbuf_str%BUFLY(1)%L_PLA
336 ENDIF
337 lbuf%SIG(kk(1)+i)=sigsh(22,ii)
338 lbuf%SIG(kk(2)+i)=sigsh(23,ii)
339 lbuf%SIG(kk(3)+i)=sigsh(24,ii)
340 lbuf%SIG(kk(4)+i)=sigsh(25,ii)
341 lbuf%SIG(kk(5)+i)=sigsh(26,ii)
342 IF (l_pla > 0) lbuf%PLA(i) = sigsh(27,ii)
343 ENDDO
344 ELSEIF(npt /= 0)THEN
345 IF(sigsh(17,ii) == one)THEN
346 pt = 22
347 ipt_all = 0
348 DO ilay=1,nlay
349 nptt = elbuf_str%BUFLY(ilay)%NPTT
350 ilaw = elbuf_str%BUFLY(ilay)%ILAW
351 jdir = 1 + (ilay-1)*nel*2
352 jj = jdir + i-1
353 DO it=1,nptt
354 ipt =ipt_all+it
355 s6(1:2)=sigsh(pt:pt+1,ii)
356 ptn = inishvar+ipt
357 s6(3)=sigsh(ptn,ii)
358 s6(4:6)=sigsh(pt+2:pt+4,ii)
359 CALL cg2lsig(
360 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
361 8 e1z(i) ,e2z(i),e3z(i),s6 )
362 CALL loc2orth(s6,dir_a,dir_b,jj,ilaw,igtyp,nel)
363 sigsh(pt:pt+4,ii) = s6(1:5)
364 posi(i,ipt)=sigsh(ptn+npt,ii)
365 pt = pt + 6
366 ENDDO
367 ipt_all = ipt_all + nptt
368 ENDDO
369 END IF !IF(SIGSH(17,II)
370 ipt_all = 0
371 pt = 22
372 DO ilay=1,nlay
373 nptt = elbuf_str%BUFLY(ilay)%NPTT
374 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
375 DO it=1,nptt
376 lbuf => elbuf_str%BUFLY(ilay)%LBUF(1,1,it)
377 lbuf%SIG(kk(1)+i)=sigsh(pt,ii)
378 lbuf%SIG(kk(2)+i)=sigsh(pt+1,ii)
379 lbuf%SIG(kk(3)+i)=sigsh(pt+2,ii)
380 lbuf%SIG(kk(4)+i)=sigsh(pt+3,ii)
381 lbuf%SIG(kk(5)+i)=sigsh(pt+4,ii)
382 IF (l_pla > 0) lbuf%PLA(i) = sigsh(pt+5,ii)
383 pt = pt + 6
384 END DO !IT=1,NPTT
385 ENDDO
386 ENDIF
387 100 CONTINUE
388 ENDDO
389 CALL ancmsg(msgid=2020,
390 . anmode=aninfo_blind_2,
391 . msgtype=msgerror,
392 . prmod=msg_print)
393C-----------
394 RETURN
395 END
396
csigini
subroutine csigini(elbuf_str, jft, jlt, nft, npt, istrain, thk, eint, gstr, hh, plas, for, mom, sigsh, nlay, g_hourg, numel, ix, nix, nsigsh, numsh, ptsh, igeo, thke, nel, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, isigsh, dir_a, dir_b, posly, igtyp)
Definition csigini.F:46
freform
subroutine freform(irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
Definition freform.F:88
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
loc2orth
subroutine loc2orth(tens, dir_a, dir_b, ii, ilaw, igtyp, nel)
Definition scigini4.F:896
cg2lsig
subroutine cg2lsig(e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, sig)
Definition scigini4.F:845
cg2leps
subroutine cg2leps(e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, eps)
Definition scigini4.F:794
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