OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigin3b.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!|| sigin3b ../starter/source/elements/solid/solid8p/sigin3b.F
25!||--- called by ------------------------------------------------------
26!|| sinit3 ../starter/source/elements/solid/solide/sinit3.F
27!||--- calls -----------------------------------------------------
28!|| m38init ../starter/source/materials/mat/mat038/m38init.F
29!|| m70init ../starter/source/materials/mat/mat070/m70init.f
30!|| srota6_m1 ../starter/source/output/anim/srota6_M1.F
31!||--- uses -----------------------------------------------------
32!||====================================================================
33 SUBROUTINE sigin3b(MAT ,PM ,IPM ,SIG ,VOL ,
34 2 SIGSP ,SIGI ,EINT ,RHO ,
35 3 IX ,NIX ,NSIGI ,NSIGS ,
36 4 NEL ,IDEF ,BUFMAT ,NPF ,
37 5 TF ,STRSGLOB,STRAGLOB,JHBE ,
38 6 IGTYP ,X ,BUFGAMA ,BUFLY ,L_PLA ,
39 7 PT )
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE elbufdef_mod
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C C o m m o n B l o c k s
50C-----------------------------------------------
51#include "com01_c.inc"
52#include "param_c.inc"
53#include "vect01_c.inc"
54#include "scr19_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER NIX, N, JPS, NSIGI, NEL,IDEF,JHBE,IGTYP, NSIGS
59 INTEGER IX(NIX,*), IPM(NPROPMI,*), NPF(*) ,
60 . STRSGLOB(*),STRAGLOB(*),MAT(NEL),L_PLA,PT(*)
61C REAL
62 my_real
63 . SIG(NEL,6),EINT(NEL),RHO(NEL),VOL(*),BUFGAMA(6*NEL),
64 . sigsp(nsigi,*),pm(npropm,*),sigi(nsigs,*),
65 . bufmat(*), tf(*),x(3,*)
66 TYPE(buf_lay_), TARGET :: BUFLY
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER I,J,II,JJ,IPT,JPT,JPTP,JPS1,NUVAR,MA,IADBUF,NPAR,
71 . NFUNC,IFLAGINI,KK(6)
72 INTEGER IFUNC(MAXFUNC)
73C REAL
74 my_real
75 . RHO0(NEL),GAMA(6),TENS(6)
76 my_real,
77 . DIMENSION(:) ,POINTER :: uvar
78 TYPE(l_bufel_) ,POINTER :: LBUF
79C=======================================================================
80 nuvar = bufly%NVAR_MAT
81 DO i=lft,llt
82 ma=mat(i)
83 eint(i)=pm(23,ma)
84 rho(i) =pm(89,ma)
85 ENDDO
86
87!
88 DO j=1,6
89 kk(j) = (j-1)*nel
90 ENDDO
91!
92C
93 IF (mtn >= 28) THEN
94 npar = ipm(9,mat(1))
95 iadbuf = ipm(7,mat(1))
96 DO i=lft,llt
97 rho0(i)= pm( 1,mat(i))
98 END DO
99C attention loi 36
100 nfunc = ipm(10,mat(1))
101 DO i=1,nfunc
102 ifunc(i) = ipm(10+i,mat(1))
103 ENDDO
104C
105 DO ipt = 1,8
106 uvar => bufly%MAT(1,1,ipt)%VAR
107 IF (mtn == 38) THEN
108 CALL m38init(
109 1 nel , npar , nuvar ,nfunc ,ifunc ,
110 2 npf ,tf , bufmat(iadbuf),rho0 ,vol ,
111 3 eint ,uvar )
112 ELSEIF (mtn == 70) THEN
113 CALL m70init(nel,npar,nuvar,bufmat(iadbuf),uvar)
114 ENDIF
115 END DO
116 ENDIF
117C-----------------------
118 IF (isigi /= 0)THEN
119C
120 DO ipt = 1,8
121 lbuf => bufly%LBUF(1,1,ipt)
122 jpt =(ipt-1)*nel
123 jptp= (ipt-1)*nel*nuvar
124 jps = 4 + (ipt-1)*9
125 jps1 = nvsolid1 + (ipt-1)*6
126c
127 DO i = lft,llt
128 iflagini = 0
129 IF (straglob(i) == 1 .OR. strsglob(i) == 1)THEN
130 IF (jcvt==2 .AND. jhbe/=14) THEN
131 gama(1)=bufgama(i )
132 gama(2)=bufgama(i + nel)
133 gama(3)=bufgama(i + 2*nel)
134 gama(4)=bufgama(i + 3*nel)
135 gama(5)=bufgama(i + 4*nel)
136 gama(6)=bufgama(i + 5*nel)
137 ELSE
138 gama(1)=one
139 gama(2)=zero
140 gama(3)=zero
141 gama(4)=zero
142 gama(5)=one
143 gama(6)=zero
144 END IF
145 ENDIF
146C CONTRAINTES INITIALES
147 ii=nft+i
148 jj=pt(ii)
149 iflagini = 1
150 IF(jj==0)iflagini = 0
151c---
152 IF (iflagini == 1) THEN
153 IF (sigsp(1,jj) == 1) THEN
154 IF (strsglob(i) == 1) THEN
155 tens(1) = sigsp(jps+1,jj)
156 tens(2) = sigsp(jps+2,jj)
157 tens(3) = sigsp(jps+3,jj)
158 tens(4) = sigsp(jps+4,jj)
159 tens(5) = sigsp(jps+5,jj)
160 tens(6) = sigsp(jps+6,jj)
161 CALL srota6_m1(x,ix(1,ii),jcvt,
162 . tens,gama,jhbe,igtyp)
163 sigsp(jps+1,jj) = tens(1)
164 sigsp(jps+2,jj) = tens(2)
165 sigsp(jps+3,jj) = tens(3)
166 sigsp(jps+4,jj) = tens(4)
167 sigsp(jps+5,jj) = tens(5)
168 sigsp(jps+6,jj) = tens(6)
169 ENDIF
170 lbuf%SIG(kk(1)+i) = sigsp(jps+1,jj)
171 lbuf%SIG(kk(2)+i) = sigsp(jps+2,jj)
172 lbuf%SIG(kk(3)+i) = sigsp(jps+3,jj)
173 lbuf%SIG(kk(4)+i) = sigsp(jps+4,jj)
174 lbuf%SIG(kk(5)+i) = sigsp(jps+5,jj)
175 lbuf%SIG(kk(6)+i) = sigsp(jps+6,jj)
176 IF(l_pla /= 0 .AND. sigsp(jps+7,jj) /= zero)
177 . lbuf%PLA(i) = sigsp(jps+7,jj)
178 IF (sigsp(3,jj) /= 0.0) eint(i)=sigsp(3,jj)
179 IF (sigsp(4,jj) /= 0.0) THEN
180 vol(i) = sigsp(4,jj)*vol(i) / rho(i)
181 rho(i) = sigsp(4,jj)
182 ENDIF
183 sig(i,1) = sig(i,1) + one_over_8*lbuf%SIG(kk(1)+i)
184 sig(i,2) = sig(i,2) + one_over_8*lbuf%SIG(kk(2)+i)
185 sig(i,3) = sig(i,3) + one_over_8*lbuf%SIG(kk(3)+i)
186 sig(i,4) = sig(i,4) + one_over_8*lbuf%SIG(kk(4)+i)
187 sig(i,5) = sig(i,5) + one_over_8*lbuf%SIG(kk(5)+i)
188 sig(i,6) = sig(i,6) + one_over_8*lbuf%SIG(kk(6)+i)
189 ELSE
190 lbuf%SIG(kk(1)+i)= sig(i,1)
191 lbuf%SIG(kk(2)+i)= sig(i,2)
192 lbuf%SIG(kk(3)+i)= sig(i,3)
193 lbuf%SIG(kk(4)+i)= sig(i,4)
194 lbuf%SIG(kk(5)+i)= sig(i,5)
195 lbuf%SIG(kk(6)+i)= sig(i,6)
196 eint(i) = sigi(9,jj)
197 IF (bufly%L_PLA > 0) lbuf%PLA(i) = sigi(10,jj)
198 IF (strsglob(i) == 1) THEN
199 tens(1) = lbuf%SIG(kk(1)+i)
200 tens(2) = lbuf%SIG(kk(2)+i)
201 tens(3) = lbuf%SIG(kk(3)+i)
202 tens(4) = lbuf%SIG(kk(4)+i)
203 tens(5) = lbuf%SIG(kk(5)+i)
204 tens(6) = lbuf%SIG(kk(6)+i)
205 CALL srota6_m1(x ,ix(1,ii) ,jcvt ,
206 . tens ,gama,jhbe ,igtyp )
207 lbuf%SIG(kk(1)+i) = tens(1)
208 lbuf%SIG(kk(2)+i) = tens(2)
209 lbuf%SIG(kk(3)+i) = tens(3)
210 lbuf%SIG(kk(4)+i) = tens(4)
211 lbuf%SIG(kk(5)+i) = tens(5)
212 lbuf%SIG(kk(6)+i) = tens(6)
213 ENDIF
214 ENDIF ! STRSGLOB(I) == 1
215c
216 IF (nvsolid2 /= 0 .AND. idef /= 0) THEN
217 lbuf%STRA(kk(1)+i) = sigsp(jps1 + 1,jj)
218 lbuf%STRA(kk(2)+i) = sigsp(jps1 + 2,jj)
219 lbuf%STRA(kk(3)+i) = sigsp(jps1 + 3,jj)
220 lbuf%STRA(kk(4)+i) = sigsp(jps1 + 4,jj)
221 lbuf%STRA(kk(5)+i) = sigsp(jps1 + 5,jj)
222 lbuf%STRA(kk(6)+i) = sigsp(jps1 + 6,jj)
223 IF (straglob(i) == 1) THEN
224 tens(1) = lbuf%STRA(kk(1)+i)
225 tens(2) = lbuf%STRA(kk(2)+i)
226 tens(3) = lbuf%STRA(kk(3)+i)
227 tens(4) = lbuf%STRA(kk(4)+i)
228 tens(5) = lbuf%STRA(kk(5)+i)
229 tens(6) = lbuf%STRA(kk(6)+i)
230 CALL srota6_m1(x ,ix(1,ii),jcvt ,
231 . tens ,gama,jhbe ,igtyp )
232 lbuf%STRA(kk(1)+i) = tens(1)
233 lbuf%STRA(kk(2)+i) = tens(2)
234 lbuf%STRA(kk(3)+i) = tens(3)
235 lbuf%STRA(kk(4)+i) = tens(4)
236 lbuf%STRA(kk(5)+i) = tens(5)
237 lbuf%STRA(kk(6)+i) = tens(6)
238 ENDIF
239 ENDIF
240 ENDIF ! IFLAGINI == 1
241c---
242 ENDDO ! I = LFT,LLT
243 ENDDO ! IPT
244 ENDIF ! ISIGI /= 0
245C-----------
246 RETURN
247 END
m38init
subroutine m38init(nel, nuparam, nuvar, nfunc, ifunc, npf, tf, uparam, rho0, volume, eint, uvar)
Definition m38init.F:34
m70init
subroutine m70init(nel, nuparam, nuvar, uparam, uvar)
Definition m70init.F:30
sigin3b
subroutine sigin3b(mat, pm, ipm, sig, vol, sigsp, sigi, eint, rho, ix, nix, nsigi, nsigs, nel, idef, bufmat, npf, tf, strsglob, straglob, jhbe, igtyp, x, bufgama, bufly, l_pla, pt)
Definition sigin3b.F:40
srota6_m1
subroutine srota6_m1(x, ixs, kcvt, tens, gama, khbe, ityp)
Definition srota6_M1.F:36
starter
program starter
Definition starter.F:39