OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sigin3b.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "vect01_c.inc"
#include "scr19_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ sigin3b()

subroutine sigin3b ( integer, dimension(nel) mat,
pm,
integer, dimension(npropmi,*) ipm,
sig,
vol,
sigsp,
sigi,
eint,
rho,
integer, dimension(nix,*) ix,
integer nix,
integer nsigi,
integer nsigs,
integer nel,
integer idef,
bufmat,
integer, dimension(*) npf,
tf,
integer, dimension(*) strsglob,
integer, dimension(*) straglob,
integer jhbe,
integer igtyp,
x,
bufgama,
type(buf_lay_), target bufly,
integer l_pla,
integer, dimension(*) pt )

Definition at line 33 of file sigin3b.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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
srota6_m1
subroutine srota6_m1(x, ixs, kcvt, tens, gama, khbe, ityp)
Definition srota6_M1.F:36