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

Go to the source code of this file.

Functions/Subroutines

subroutine csigini4 (elbuf_str, ihbe, jft, jlt, nft, npt, istrain, thk, eint, gstr, hh, for, mom, sigsh, nsigsh, numel, ix, nix, numsh, ptsh, igeo, ir, is, ipg, npg, g_pla, epsp, thke, igtyp, nel, isigsh, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, dir_a, dir_b, posly)
subroutine cg2leps (e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, eps)
subroutine cg2lsig (e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z, sig)
subroutine loc2orth (tens, dir_a, dir_b, ii, ilaw, igtyp, nel)
subroutine rotovs (sig, dir1, dir2)

Function/Subroutine Documentation

◆ cg2leps()

subroutine cg2leps ( e1x,
e2x,
e3x,
e1y,
e2y,
e3y,
e1z,
e2z,
e3z,
eps )

Definition at line 791 of file scigini4.F.

794C-----------------------------------------------
795C I m p l i c i t T y p e s
796C-----------------------------------------------
797#include "implicit_f.inc"
798C-----------------------------------------------
799C D u m m y A r g u m e n t s
800C-----------------------------------------------
801 my_real
802 . eps(6),e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z
803C------------------------------------------------------
804C L o c a l V a r i a b l e s
805C-----------------------------------------------
806 INTEGER I
807 my_real
808 . txx,tyy,tzz,txy,tyz,tzx,uxx,uyy,uzz,uxy,uyz,uzx,a,b,c
809C---------out EPS : exx,eyy,2exy,2eyz,2ezx,0
810 txx = eps(1)
811 tyy = eps(2)
812 tzz = eps(3)
813 txy = eps(4)
814 tyz = eps(5)
815 tzx = eps(6)
816C
817 a = e1x*txx + e1y*txy + e1z*tzx
818 b = e1x*txy + e1y*tyy + e1z*tyz
819 c = e1x*tzx + e1y*tyz + e1z*tzz
820 uxx = a*e1x + b*e1y + c*e1z
821 uxy = a*e2x + b*e2y + c*e2z
822 uzx = a*e3x + b*e3y + c*e3z
823 a = e2x*txx + e2y*txy + e2z*tzx
824 b = e2x*txy + e2y*tyy + e2z*tyz
825 c = e2x*tzx + e2y*tyz + e2z*tzz
826 uyy = a*e2x + b*e2y + c*e2z
827 uyz = a*e3x + b*e3y + c*e3z
828 eps(1) = uxx
829 eps(2) = uyy
830 eps(3) = two*uxy
831 eps(4) = two*uyz
832 eps(5) = two*uzx
833 eps(6) = zero
834 RETURN
my_real
#define my_real
Definition cppsort.cpp:32

◆ cg2lsig()

subroutine cg2lsig ( e1x,
e2x,
e3x,
e1y,
e2y,
e3y,
e1z,
e2z,
e3z,
sig )

Definition at line 842 of file scigini4.F.

845C-----------------------------------------------
846C I m p l i c i t T y p e s
847C-----------------------------------------------
848#include "implicit_f.inc"
849C-----------------------------------------------
850C D u m m y A r g u m e n t s
851C-----------------------------------------------
852 my_real
853 . sig(6),e1x,e2x,e3x,e1y,e2y,e3y,e1z,e2z,e3z
854C------------------------------------------------------
855C L o c a l V a r i a b l e s
856C-----------------------------------------------
857 INTEGER I
858 my_real
859 . txx,tyy,tzz,txy,tyz,tzx,uxx,uyy,uzz,uxy,uyz,uzx,a,b,c
860C---------out EPS : exx,eyy,exy,eyz,ezx,0
861 txx = sig(1)
862 tyy = sig(2)
863 tzz = sig(3)
864 txy = sig(4)
865 tyz = sig(5)
866 tzx = sig(6)
867C
868 a = e1x*txx + e1y*txy + e1z*tzx
869 b = e1x*txy + e1y*tyy + e1z*tyz
870 c = e1x*tzx + e1y*tyz + e1z*tzz
871 uxx = a*e1x + b*e1y + c*e1z
872 uxy = a*e2x + b*e2y + c*e2z
873 uzx = a*e3x + b*e3y + c*e3z
874 a = e2x*txx + e2y*txy + e2z*tzx
875 b = e2x*txy + e2y*tyy + e2z*tyz
876 c = e2x*tzx + e2y*tyz + e2z*tzz
877 uyy = a*e2x + b*e2y + c*e2z
878 uyz = a*e3x + b*e3y + c*e3z
879 sig(1) = uxx
880 sig(2) = uyy
881 sig(3) = uxy
882 sig(4) = uyz
883 sig(5) = uzx
884 sig(6) = zero
885 RETURN

◆ csigini4()

subroutine csigini4 ( type(elbuf_struct_), target elbuf_str,
integer ihbe,
integer jft,
integer jlt,
integer nft,
integer npt,
integer istrain,
thk,
eint,
gstr,
hh,
for,
mom,
sigsh,
integer nsigsh,
integer numel,
integer, dimension(nix,*) ix,
integer nix,
integer numsh,
integer, dimension(*) ptsh,
integer, dimension(npropgi,*) igeo,
integer ir,
integer is,
integer ipg,
integer npg,
integer g_pla,
epsp,
thke,
integer igtyp,
integer nel,
integer isigsh,
e1x,
e2x,
e3x,
e1y,
e2y,
e3y,
e1z,
e2z,
e3z,
dir_a,
dir_b,
posly )

Definition at line 37 of file scigini4.F.

47! points Gauss a corriger !!!!!!
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE elbufdef_mod
52 USE message_mod
53 USE names_and_titles_mod , ONLY : nchartitle
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C G l o b a l P a r a m e t e r s
60C-----------------------------------------------
61#include "mvsiz_p.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "param_c.inc"
66#include "com01_c.inc"
67#include "scr17_c.inc"
68C-----------------------------------------------
69C D u m m y A r g u m e n t s
70C-----------------------------------------------
71 INTEGER JFT,JLT,IR,IS,IT,NUMEL,NIX,NFT,NPT,ISTRAIN,NEL
72 INTEGER IX(NIX,*),NSIGSH ,IHBE ,NPGI,IPG,NPG,G_PLA,
73 . NUMSH, PTSH(*),IGEO(NPROPGI,*),IGTYP,ISIGSH
74 my_real
75 . thk(*) ,eint(jlt,2),gstr(nel,8),sigsh(nsigsh,*),
76 . e1x(mvsiz),e2x(mvsiz),e3x(mvsiz),
77 . e1y(mvsiz),e2y(mvsiz),e3y(mvsiz),
78 . e1z(mvsiz),e2z(mvsiz),e3z(mvsiz),dir_a(*),dir_b(*),
79 . for(nel,5) ,mom(nel,3) ,hh(nel,12),epsp(*),thke(*),posly(mvsiz,*)
80 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
81C------------------------------------------------------
82C L o c a l V a r i a b l e s
83C-----------------------------------------------
84 CHARACTER(LEN=NCHARTITLE)::TITR
85 INTEGER I,II,J,JJ,KK(8),N,NPTI,I1,I2,PT,PID1,IPID1,L_PLA,NLAY,
86 . ILAY,LAYNPT_MAX,LAY_MAX,NPTT,NPTMX,IP,PTS,LENS,IPT_ALL,
87 . IPT,PTN,JDIR,ILAW
88 INTEGER LI(MVSIZ)
89 parameter(laynpt_max = 10)
90 parameter(lay_max = 100)
91 my_real
92 . s1(laynpt_max*lay_max),s2(laynpt_max*lay_max),s3(laynpt_max*lay_max),
93 . s4(laynpt_max*lay_max),sm(laynpt_max*lay_max),pg2i,pg,fm,s6(6),
94 . posi(mvsiz,npt)
95 my_real
96 . e1(6),e2(6),z1,z2,z0,aa,e1g(6,4),e2g(6,4),z1g(4),z2g(4),ung,
97 . forj(5,4),momj(3,4),tj,unpt,f2mj(4),f2m
98C--------------------------------------------------------------
99 TYPE(G_BUFEL_) ,POINTER :: GBUF
100 TYPE(L_BUFEL_) ,POINTER :: LBUF
101c
102 parameter(pg=.577350269189626)
103C=======================================================================
104 gbuf => elbuf_str%GBUF
105 nlay = elbuf_str%NLAY
106!
107 DO i=1,8
108 kk(i) = nel*(i-1)
109 ENDDO
110!
111 IF (ihbe == 23) npg=4
112 DO i=jft,jlt
113 IF (abs(isigi) /= 3.AND.abs(isigi) /= 4.AND.abs(isigi) /= 5)THEN
114 ii = ptsh(i + nft)
115 IF(ii == 0) GOTO 100
116 n = nint(sigsh(1,ii))
117 IF (n /= ix(nix,i + nft)) THEN
118 jj = i + nft
119 DO j = 1,numel
120 ii = j
121 n = nint(sigsh(1,ii))
122 IF (n == 0) GOTO 100
123 IF (n == ix(nix,jj)) GOTO 60
124 ENDDO
125 60 CONTINUE
126 ENDIF
127 ELSE
128 jj=nft+i
129 n =ix(nix,jj)
130 ii=ptsh(jj)
131 IF (ii == 0) GOTO 100
132 ENDIF
133 li(i) = ii
134 IF(sigsh(nvshell - 1 ,ii) == zero ) cycle
135 npti=nint(sigsh(2,ii))
136 npgi=nint(sigsh(nvshell,ii))
137 IF (sigsh(3,ii) /= zero) THEN
138 thk(i)=sigsh(3,ii)
139 thke(i)=thk(i)
140 ENDIF
141 eint(i,1)=sigsh(4,ii)
142 eint(i,2)=sigsh(5,ii)
143C for IGTYP == 51, NPT now =NPTI
144 IF ((npt /= npti.AND.npt/=0) .OR. npg /= npgi) THEN
145 ipid1=ix(nix-1,nft+i)
146 pid1=igeo(1,ipid1)
147 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
148 IF (npt > 0 .AND. (npti == 0 .AND. ithkshel /= 2)) THEN
149C----limite number of error out
150 IF (ipg<=1) then
151 CALL ancmsg(msgid=2020,
152 . anmode=aninfo,
153 . msgtype=msgerror,
154c . C1=TITR,
155 . i1=pid1,
156 . i2=n,
157 . prmod=msg_cumu)
158 ENDIF
159 ELSEIF(isigsh /= 0) THEN
160 CALL ancmsg(msgid=26,
161 . anmode=aninfo,
162 . msgtype=msgerror,
163 . c1=titr,
164 . i1=pid1,
165 . i2=n)
166 ENDIF
167 ENDIF
168 IF (istrain /= 0.AND.ithkshel==2) THEN
169C--- reading in another routine for QEPH
170 IF(sigsh(17,ii) == one .AND. ihbe /= 23)THEN
171 pt = inishvar1
172 IF(npgi <= 1.OR.ihbe == 23)THEN
173 IF (npti==1) THEN
174 e1(1:6) = sigsh(pt:pt+5,ii)
175 z1 = sigsh(pt+6,ii)
176 CALL cg2leps(
177 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
178 8 e1z(i) ,e2z(i),e3z(i),e1 )
179 gstr(i,1:5)=e1(1:5)
180 ELSE
181 e1(1:6) = sigsh(pt:pt+5,ii)
182 z1 = sigsh(pt+6,ii)
183 e2(1:6) = sigsh(pt+7:pt+12,ii)
184 z2 = sigsh(pt+13,ii)
185 aa = half*thke(i)
186 CALL cg2leps(
187 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
188 8 e1z(i) ,e2z(i),e3z(i),e1 )
189 CALL cg2leps(
190 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
191 8 e1z(i) ,e2z(i),e3z(i),e2 )
192 IF (z1==z2) THEN
193c error out
194 CALL ancmsg(msgid=1904,
195 . anmode=aninfo,
196 . msgtype=msgerror,
197 . i1=n,
198 . r1=z1)
199 ELSEIF (z1==zero) THEN
200 gstr(i,1:5)=e1(1:5)
201 z0 = aa*z2
202 gstr(i,6:8)=(e2(1:3)-e1(1:3))/z0
203 ELSEIF (z2==zero) THEN
204 gstr(i,1:5)=e2(1:5)
205 z0 = aa*z1
206 gstr(i,6:8)=(e1(1:3)-e2(1:3))/z0
207 ELSE
208 z0 = aa*(z2-z1)
209 gstr(i,6:8)=(e2(1:3)-e1(1:3))/z0
210 gstr(i,1:3)=e1(1:3)-aa*z1*gstr(i,6:8)
211 gstr(i,4:5)= half*(e2(4:5) + e1(4:5))
212 END IF
213 END IF
214C------ NPG > 1 : GSTR-> GBUF%STRPG
215 ELSE
216 IF (npti==1) THEN
217 DO ip = 1,npg
218 e1(1:6) = sigsh(pt:pt+5,ii)
219 z1 = sigsh(pt+6,ii)
220 IF (ip==ipg) THEN
221 CALL cg2leps(
222 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
223 8 e1z(i) ,e2z(i),e3z(i),e1 )
224c GBUF%STRPG(PTS+KK(1:5))=E1(1:5)
225 gstr(i,1:5) = e1(1:5)
226 END IF !(IP==IPG)
227 pt = pt + 7
228 END DO
229 ELSE
230 aa = half*thke(i)
231 DO ip = 1,npg
232 e1g(1:6,ip) = sigsh(pt:pt+5,ii)
233 z1g(ip) = sigsh(pt+6,ii)
234 pt = pt + 7
235 END DO
236 DO ip = 1,npg
237 e2g(1:6,ip) = sigsh(pt:pt+5,ii)
238 z2g(ip) = sigsh(pt+6,ii)
239 pt = pt + 7
240 END DO
241 DO ip = 1,npg
242 IF (ip==ipg) THEN
243 CALL cg2leps(
244 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
245 8 e1z(i) ,e2z(i),e3z(i),e1g(1,ip))
246 CALL cg2leps(
247 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
248 8 e1z(i) ,e2z(i),e3z(i),e2g(1,ip))
249 IF (z1g(ip)==z2g(ip)) THEN
250c error out
251 CALL ancmsg(msgid=1904,
252 . anmode=aninfo,
253 . msgtype=msgerror,
254 . i1=n,
255 . r1=z1g(ip))
256 ELSEIF (z1g(ip)==zero) THEN
257 gstr(i,1:5)=e1g(1:5,ip)
258 z0 = aa*z2g(ip)
259 gstr(i,6:8)=(e2g(1:3,ip)-e1g(1:3,ip))/z0
260 ELSEIF (z2g(ip)==zero) THEN
261 gstr(i,1:5)=e2g(1:5,ip)
262 z0 = aa*z1g(ip)
263 gstr(i,6:8)=(e1g(1:3,ip)-e2g(1:3,ip))/z0
264 ELSE
265 z0 = aa*(z2g(ip)-z1g(ip))
266 gstr(i,6:8)=(e2g(1:3,ip)-e1g(1:3,ip))/z0
267 gstr(i,1:3)=e1g(1:3,ip)-aa*z1g(ip)*gstr(i,6:8)
268 gstr(i,4:5)= half*(e2g(4:5,ip)+e1g(4:5,ip))
269 END IF
270 END IF !(IP==IPG) THEN
271 END DO
272 END IF
273 END IF !IF(NPGI <= 1
274 ELSE
275 gstr(i,1)=sigsh(6,ii)
276 gstr(i,2)=sigsh(7,ii)
277 gstr(i,3)=sigsh(8,ii)
278 gstr(i,4)=sigsh(9,ii)
279 gstr(i,5)=sigsh(10,ii)
280 gstr(i,6)=sigsh(11,ii)
281 gstr(i,7)=sigsh(12,ii)
282 gstr(i,8)=sigsh(13,ii)
283 ENDIF
284 ENDIF
285 IF (isigsh==0) cycle
286C--- in global sys modifying directly SIGSH
287 IF(sigsh(17,ii) == one)THEN
288 IF (npt == 0)THEN
289 IF (npti>1) THEN
290 unpt = one/npti
291 IF (npg>1) THEN
292 IF (ihbe == 23) THEN ! QEPH-----
293 pt = 22
294 forj(1:5,1:4) = zero
295 f2mj(1:4) = zero
296 DO it=1,npti
297 DO ip=1,npg
298 s6(1:6)=sigsh(pt:pt+5,ii)
299 CALL cg2lsig(
300 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
301 8 e1z(i) ,e2z(i),e3z(i),s6 )
302 tj=six*sigsh(pt+7,ii)
303 pt = pt + 8
304 forj(1:5,ip) = forj(1:5,ip) + unpt*s6(1:5)
305 IF (tj>zero) THEN
306 f2mj(ip) = one/tj
307 momj(1:3,ip) = s6(1:3)
308 END IF
309 END DO
310 ENDDO
311 DO ip =1,npg
312 momj(1:3,ip) = f2mj(ip)*(momj(1:3,ip)-forj(1:3,ip))
313 ptn= 22 + 9*(ip-1)
314 sigsh(ptn:ptn+4,ii)=forj(1:5,ip)
315 sigsh(ptn+5,ii)=zero
316 sigsh(ptn+6:ptn+8,ii)=momj(1:3,ip)
317 END DO !IP =1,NPG
318 ELSE
319 pt = 22 + 8*(ipg -1)
320 forj(1:5,1) = zero
321 f2m = zero
322 DO it=1,npti
323 s6(1:6)=sigsh(pt:pt+5,ii)
324 CALL cg2lsig(
325 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
326 8 e1z(i) ,e2z(i),e3z(i),s6 )
327 tj=six*sigsh(pt+7,ii)
328 pt = pt + 8
329 forj(1:5,1) = forj(1:5,1) + unpt*s6(1:5)
330 IF (tj>zero) THEN
331 f2m = one/tj
332 momj(1:3,1) = s6(1:3)
333 END IF
334 ENDDO
335 for(i,1:5)=forj(1:5,1)
336 mom(i,1:3)=f2m*(momj(1:3,1)-forj(1:3,1))
337 END IF ! IHBE
338 ELSE
339C------ Q4,T3
340 forj(1:5,1) = zero
341 f2m = zero
342 DO it=1,npti
343 pt = 22 + 6*(it-1)
344 s6(1:2)=sigsh(pt:pt+1,ii)
345 s6(3)=sigsh(inishvar+it,ii)
346 s6(4:6)=sigsh(pt+2:pt+4,ii)
347 tj=six*sigsh(inishvar+npti+it,ii)
348 CALL cg2lsig(
349 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
350 8 e1z(i) ,e2z(i),e3z(i),s6 )
351 forj(1:5,1) = forj(1:5,1) + unpt*s6(1:5)
352 IF (tj>zero) THEN
353 f2m = one/tj
354 momj(1:3,1) = s6(1:3)
355 END IF
356 ENDDO
357 sigsh(22:26,ii)=forj(1:5,1)
358 sigsh(28:30,ii)=f2m*(momj(1:3,1)-forj(1:3,1))
359 END IF !(NPG>1) THEN
360 ELSE ! NPTI=0
361C
362 IF (npg>1) THEN
363 IF (ihbe == 23) THEN
364 DO ip =1,npg
365 pt = 22 + 13*(ip-1)
366 ptn= 22 + 9*(ip-1)
367!
368 s6(1:6)=sigsh(pt:pt+5,ii)
369 CALL cg2lsig(
370 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
371 8 e1z(i) ,e2z(i),e3z(i),s6 )
372 sigsh(ptn:ptn+4,ii)=s6(1:5)
373 sigsh(ptn+5,ii)=sigsh(pt+12,ii)
374 s6(1:6)=sigsh(pt+6:pt+11,ii)
375 CALL cg2lsig(
376 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
377 8 e1z(i) ,e2z(i),e3z(i),s6 )
378 sigsh(ptn+6:ptn+8,ii)=s6(1:3)
379 END DO !IP =1,NPG
380 ELSE
381 pt = 22 + 13*(ipg-1)
382 l_pla = elbuf_str%BUFLY(1)%L_PLA
383 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,1)
384 s6(1:6)=sigsh(pt:pt+5,ii)
385 CALL cg2lsig(
386 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
387 8 e1z(i) ,e2z(i),e3z(i),s6 )
388C
389 IF (npg<4) s6(4:5)=zero
390 for(i,1:5)=s6(1:5)
391 IF (l_pla > 0) lbuf%PLA(i)=sigsh(pt+12,ii)
392 s6(1:6)=sigsh(pt+6:pt+11,ii)
393 CALL cg2lsig(
394 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
395 8 e1z(i) ,e2z(i),e3z(i),s6 )
396 mom(i,1:3)=s6(1:3)
397 END IF ! IHBE
398C------------NPG=1
399 ELSE
400 s6(1:2)=sigsh(22:23,ii)
401 s6(3)=sigsh(18,ii)
402 s6(4:6)=sigsh(24:26,ii)
403 CALL cg2lsig(
404 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
405 8 e1z(i) ,e2z(i),e3z(i),s6 )
406 sigsh(22:26,ii)=s6(1:5)
407C---MOM
408 s6(1:2)=sigsh(28:29,ii)
409 s6(3)=sigsh(19,ii)
410 s6(4)=sigsh(30,ii)
411 s6(5:6)=sigsh(20:21,ii)
412 CALL cg2lsig(
413 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
414 8 e1z(i) ,e2z(i),e3z(i),s6 )
415 sigsh(28:30,ii)=s6(1:3)
416 END IF ! NPG
417 END IF !(NPTI>1) THEN
418 ELSE
419C-------npt>1
420 IF (npg>1) THEN
421 IF (ihbe == 23) THEN ! QEPH-----
422 pt = 22
423 ptn = 22
424 ipt_all = 0
425 DO ilay=1,nlay
426 nptt = elbuf_str%BUFLY(ilay)%NPTT
427 ilaw = elbuf_str%BUFLY(ilay)%ILAW
428 DO it=1,nptt
429 ipt =ipt_all+it
430 jdir = 1 + (ilay-1)*nel*2
431 jj = jdir + i-1
432 DO ip=1,npg
433 s6(1:6)=sigsh(pt:pt+5,ii)
434 CALL cg2lsig(
435 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
436 8 e1z(i) ,e2z(i),e3z(i),s6 )
437 CALL loc2orth(s6,dir_a,dir_b,jj,ilaw,igtyp,nel)
438 sigsh(ptn:ptn+4,ii) = s6(1:5)
439 sigsh(ptn+5,ii) = sigsh(pt+6,ii)
440 posi(i,ipt)=sigsh(pt+7,ii)
441 pt = pt + 8
442 ptn = ptn + 6
443 END DO !IT=1,NPG
444 ENDDO
445 ipt_all = ipt_all + nptt
446 ENDDO
447 ELSE
448C----------unlike QEPH, SIGSH can't be updated w/ reduced dim
449 pt = 22 + 8*(ipg -1)
450 ipt_all = 0
451 DO ilay=1,nlay
452 nptt = elbuf_str%BUFLY(ilay)%NPTT
453 ilaw = elbuf_str%BUFLY(ilay)%ILAW
454 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
455 jdir = 1 + (ilay-1)*nel*2
456 jj = jdir + i-1
457 DO it=1,nptt
458 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
459 ipt =ipt_all+it
460 s6(1:6)=sigsh(pt:pt+5,ii)
461 CALL cg2lsig(
462 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
463 8 e1z(i) ,e2z(i),e3z(i),s6 )
464C---------no transverse shear for DKT
465 IF (npg<4) s6(4:5)=zero
466 CALL loc2orth(s6,dir_a,dir_b,jj,ilaw,igtyp,nel)
467 lbuf%SIG(kk(1:5)+i) = s6(1:5)
468 IF (l_pla > 0) lbuf%PLA(i) = sigsh(pt+6,ii)
469 posi(i,ipt)=sigsh(pt+7,ii)
470 pt = pt + 8*npg
471 ENDDO
472 ipt_all = ipt_all + nptt
473 ENDDO
474 END IF !(IHBE == 23)
475 ELSE
476C------ Q4,T3
477 ipt_all = 0
478 DO ilay=1,nlay
479 nptt = elbuf_str%BUFLY(ilay)%NPTT
480 ilaw = elbuf_str%BUFLY(ilay)%ILAW
481 DO it=1,nptt
482 ipt =ipt_all+it
483 jdir = 1 + (ilay-1)*nel*2
484 jj = jdir + i-1
485 pt = 22 + 6*(ipt-1)
486 s6(1:2)=sigsh(pt:pt+1,ii)
487 s6(3)=sigsh(inishvar+ipt,ii)
488 s6(4:6)=sigsh(pt+2:pt+4,ii)
489 posi(i,ipt)=sigsh(inishvar+npt+ipt,ii)
490 CALL cg2lsig(
491 7 e1x(i) ,e2x(i),e3x(i),e1y(i),e2y(i),e3y(i),
492 8 e1z(i) ,e2z(i),e3z(i),s6 )
493 CALL loc2orth(s6,dir_a,dir_b,jj,ilaw,igtyp,nel)
494 sigsh(pt:pt+4,ii) = s6(1:5)
495 ENDDO
496 ipt_all = ipt_all + nptt
497 ENDDO
498 END IF
499 END IF
500 ENDIF
501 IF (ihbe == 23) THEN ! QEPH-----
502c---
503 pg2i=half/pg
504 IF (npt == 0)THEN
505
506 pt = 22
507 s1(1)=sigsh(pt,ii)
508 s2(1)=sigsh(pt+9,ii)
509 s3(1)=sigsh(pt+18,ii)
510 s4(1)=sigsh(pt+27,ii)
511 for(i,1)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
512 hh(i,1)=(s3(1)+s4(1)-two*for(i,1))*pg2i
513 hh(i,7)=-(s2(1)+s3(1)-two*for(i,1))*pg2i
514
515 pt = 23
516 s1(1)=sigsh(pt,ii)
517 s2(1)=sigsh(pt+9,ii)
518 s3(1)=sigsh(pt+18,ii)
519 s4(1)=sigsh(pt+27,ii)
520 for(i,2)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
521 hh(i,2)=-(s3(1)+s4(1)-two*for(i,2))*pg2i
522 hh(i,8)=(s2(1)+s3(1)-two*for(i,2))*pg2i
523
524 pt = 24
525 s1(1)=sigsh(pt,ii)
526 s2(1)=sigsh(pt+9,ii)
527 s3(1)=sigsh(pt+18,ii)
528 s4(1)=sigsh(pt+27,ii)
529 for(i,3)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
530
531 pt = 25
532 s1(1)=sigsh(pt,ii)
533 s2(1)=sigsh(pt+9,ii)
534 s3(1)=sigsh(pt+18,ii)
535 s4(1)=sigsh(pt+27,ii)
536 for(i,4)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
537 hh(i,6)=-(s3(1)+s4(1)-two*for(i,4))*pg2i
538 hh(i,12)=(s2(1)+s3(1)-two*for(i,4))*pg2i
539
540 pt = 26
541 s1(1)=sigsh(pt,ii)
542 s2(1)=sigsh(pt+9,ii)
543 s3(1)=sigsh(pt+18,ii)
544 s4(1)=sigsh(pt+27,ii)
545 for(i,5)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
546 hh(i,5)=(s3(1)+s4(1)-two*for(i,5))*pg2i
547 hh(i,11)=-(s2(1)+s3(1)-two*for(i,5))*pg2i
548
549 pt = 27
550 s1(1)=sigsh(pt,ii)
551 s2(1)=sigsh(pt+9,ii)
552 s3(1)=sigsh(pt+18,ii)
553 s4(1)=sigsh(pt+27,ii)
554 IF (g_pla > 0) epsp(i)=min(s1(1),s2(1),s3(1),s4(1))
555
556 pt = 28
557 s1(1)=sigsh(pt,ii)
558 s2(1)=sigsh(pt+9,ii)
559 s3(1)=sigsh(pt+18,ii)
560 s4(1)=sigsh(pt+27,ii)
561 mom(i,1)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
562 hh(i,3)= (s3(1)+s4(1)-two*mom(i,1))*pg2i
563 hh(i,9)=-(s2(1)+s3(1)-two*mom(i,1))*pg2i
564
565 pt = 29
566 s1(1)=sigsh(pt,ii)
567 s2(1)=sigsh(pt+9,ii)
568 s3(1)=sigsh(pt+18,ii)
569 s4(1)=sigsh(pt+27,ii)
570 mom(i,2)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
571 hh(i,4)=-(s3(1)+s4(1)-two*mom(i,2))*pg2i
572 hh(i,10)=(s2(1)+s3(1)-two*mom(i,2))*pg2i
573
574 pt = 30
575 s1(1)=sigsh(pt,ii)
576 s2(1)=sigsh(pt+9,ii)
577 s3(1)=sigsh(pt+18,ii)
578 s4(1)=sigsh(pt+27,ii)
579 mom(i,3)=fourth*(s1(1)+s2(1)+s3(1)+s4(1))
580
581 ELSE ! IHBE=23, NPT > 0
582
583 fm = -pg2i/thk(i)
584C---------Sx-----------------
585 pt = 22
586 nptmx = 0
587 DO ilay=1,nlay
588 nptt = elbuf_str%BUFLY(ilay)%NPTT
589 DO it=1,nptt
590 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
591 ip = nptmx + it
592 s1(ip)=sigsh(pt,ii)
593 s2(ip)=sigsh(pt+6,ii)
594 s3(ip)=sigsh(pt+12,ii)
595 s4(ip)=sigsh(pt+18,ii)
596 sm(ip)=fourth*(s1(ip)+s2(ip)+s3(ip)+s4(ip))
597 lbuf%SIG(kk(1)+i)=sm(ip)
598 pt = pt + 6*npg
599 ENDDO
600 nptmx = nptmx + nptt
601 ENDDO
602 hh(i,1)=half*pg2i*(s3(1)+s4(1)-two*sm(1)+
603 . s3(nptmx)+s4(nptmx)-two*sm(nptmx))
604 hh(i,7)=-half*pg2i*(s2(1)+s3(1)-two*sm(1)+
605 . s2(nptmx)+s3(nptmx)-two*sm(nptmx))
606 hh(i,3)=fm*(s3(1)-s3(nptmx)+s4(1)-s4(nptmx)
607 . -two*(sm(1)-sm(nptmx)))
608 hh(i,9)=-fm*(s2(1)-s2(nptmx)+s3(1)-s3(nptmx)
609 . -two*(sm(1)-sm(nptmx)))
610C---------Sy-----------------------
611 pt = 22
612 nptmx = 0
613 DO ilay=1,nlay
614 nptt = elbuf_str%BUFLY(ilay)%NPTT
615 DO it=1,nptt
616 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
617 ip = nptmx + it
618 s1(ip)=sigsh(pt+1,ii)
619 s2(ip)=sigsh(pt+7,ii)
620 s3(ip)=sigsh(pt+13,ii)
621 s4(ip)=sigsh(pt+19,ii)
622 sm(ip)=fourth*(s1(ip)+s2(ip)+s3(ip)+s4(ip))
623 lbuf%SIG(kk(2)+i)=sm(ip)
624 pt = pt + 6*npg
625 ENDDO
626 nptmx = nptmx + nptt
627 ENDDO
628 hh(i,2)=-half*pg2i*(s3(1)+s4(1)-two*sm(1)+
629 . s3(nptmx)+s4(nptmx)-two*sm(nptmx))
630 hh(i,8)=half*pg2i*(s2(1)+s3(1)-two*sm(1)+
631 . s2(nptmx)+s3(nptmx)-two*sm(nptmx))
632 hh(i,4)=-fm*(s3(1)-s3(nptmx)+s4(1)-s4(nptmx)
633 . -two*(sm(1)-sm(nptmx)))
634 hh(i,10)=fm*(s2(1)-s2(nptmx)+s3(1)-s3(nptmx)
635 . -two*(sm(1)-sm(nptmx)))
636C---------Sxy,ep-----------------------
637 pt = 22
638 nptmx = 0
639 DO ilay=1,nlay
640 nptt = elbuf_str%BUFLY(ilay)%NPTT
641 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
642 DO it=1,nptt
643 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
644 ip = nptmx + it
645 s1(ip)=sigsh(pt+2,ii)
646 s2(ip)=sigsh(pt+8,ii)
647 s3(ip)=sigsh(pt+14,ii)
648 s4(ip)=sigsh(pt+20,ii)
649 sm(ip)=fourth*(s1(ip)+s2(ip)+s3(ip)+s4(ip))
650 lbuf%SIG(kk(3)+i)=sm(ip)
651 s1(ip)=sigsh(pt+5,ii)
652 s2(ip)=sigsh(pt+11,ii)
653 s3(ip)=sigsh(pt+17,ii)
654 s4(ip)=sigsh(pt+23,ii)
655 sm(ip)=min(s1(ip),s2(ip),s3(ip),s4(ip))
656C SM(IT)=FOURTH*(S1(IT)+S2(IT)+S3(IT)+S4(IT))
657 IF (l_pla > 0) lbuf%PLA(i)=sm(ip)
658 pt = pt + 6*npg
659 ENDDO
660 nptmx = nptmx + nptt
661 ENDDO
662C---------Syz-----------------------
663 pt = 22
664 nptmx = 0
665 DO ilay=1,nlay
666 nptt = elbuf_str%BUFLY(ilay)%NPTT
667 DO it=1,nptt
668 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
669 ip = nptmx + it
670 s1(ip)=sigsh(pt+3,ii)
671 s2(ip)=sigsh(pt+9,ii)
672 s3(ip)=sigsh(pt+15,ii)
673 s4(ip)=sigsh(pt+21,ii)
674 sm(ip)=fourth*(s1(ip)+s2(ip)+s3(ip)+s4(ip))
675 lbuf%SIG(kk(4)+i)=sm(ip)
676 pt = pt + 6*npg
677 ENDDO
678 nptmx = nptmx + nptt
679 ENDDO
680 hh(i,6)=-half*pg2i*(s3(1)+s4(1)-two*sm(1)+
681 . s3(nptmx)+s4(nptmx)-two*sm(nptmx))
682 hh(i,12)=half*pg2i*(s2(1)+s3(1)-two*sm(1)+
683 . s2(nptmx)+s3(nptmx)-two*sm(nptmx))
684C---------Sxz-----------------------
685 pt = 22
686 nptmx = 0
687 DO ilay=1,nlay
688 nptt = elbuf_str%BUFLY(ilay)%NPTT
689 DO it=1,nptt
690 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
691 ip = nptmx + it
692 s1(ip)=sigsh(pt+4,ii)
693 s2(ip)=sigsh(pt+10,ii)
694 s3(ip)=sigsh(pt+16,ii)
695 s4(ip)=sigsh(pt+22,ii)
696 sm(ip)=fourth*(s1(ip)+s2(ip)+s3(ip)+s4(ip))
697 lbuf%SIG(kk(5)+i)=sm(ip)
698 pt = pt + 6*npg
699 ENDDO
700 nptmx = nptmx + nptt
701 ENDDO
702 hh(i,5)=half*pg2i*(s3(1)+s4(1)-two*sm(1)+
703 . s3(nptmx)+s4(nptmx)-two*sm(nptmx))
704 hh(i,11)=-half*pg2i*(s2(1)+s3(1)-two*sm(1)+
705 . s2(nptmx)+s3(nptmx)-two*sm(nptmx))
706 ENDIF
707c---
708 ELSEIF (ihbe == 11.AND.sigsh(17,ii) == zero) THEN ! QBAT,DKT18-----
709c---
710 IF (npt == 0) THEN
711 pt = 22 + 9*(ipg-1)
712!
713 l_pla = elbuf_str%BUFLY(1)%L_PLA
714 lbuf => elbuf_str%BUFLY(1)%LBUF(ir,is,1)
715!
716 for(i,1)=sigsh(pt,ii)
717 for(i,2)=sigsh(pt+1,ii)
718 for(i,3)=sigsh(pt+2,ii)
719 for(i,4)=sigsh(pt+3,ii)
720 for(i,5)=sigsh(pt+4,ii)
721 IF (l_pla > 0) lbuf%PLA(i)=sigsh(pt+5,ii)
722 mom(i,1)=sigsh(pt+6,ii)
723 mom(i,2)=sigsh(pt+7,ii)
724 mom(i,3)=sigsh(pt+8,ii)
725 ELSE ! NPT /= 0
726 pt = 22 + 6*(ipg -1)
727 DO ilay=1,nlay
728 nptt = elbuf_str%BUFLY(ilay)%NPTT
729 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
730 DO it=1,nptt
731 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
732 lbuf%SIG(kk(1)+i) = sigsh(pt,ii)
733 lbuf%SIG(kk(2)+i) = sigsh(pt+1,ii)
734 lbuf%SIG(kk(3)+i) = sigsh(pt+2,ii)
735 lbuf%SIG(kk(4)+i) = sigsh(pt+3,ii)
736 lbuf%SIG(kk(5)+i) = sigsh(pt+4,ii)
737 IF (l_pla > 0) lbuf%PLA(i) = sigsh(pt+5,ii)
738 pt = pt + 6*npg
739 ENDDO
740 ENDDO
741 ENDIF
742c
743 ELSEIF (sigsh(17,ii) == zero) THEN ! QPH,QPPS, take account quadrature points only-----
744 IF (npt == 0) THEN
745 ii = li(i)
746!
747 l_pla = elbuf_str%BUFLY(1)%L_PLA
748 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
749!
750 for(i,1)=sigsh(22,ii)
751 for(i,2)=sigsh(23,ii)
752 for(i,3)=sigsh(24,ii)
753 for(i,4)=sigsh(25,ii)
754 for(i,5)=sigsh(26,ii)
755 IF (l_pla > 0) lbuf%PLA(i)=sigsh(27,ii)
756 mom(i,1)=sigsh(28,ii)
757 mom(i,2)=sigsh(29,ii)
758 mom(i,3)=sigsh(30,ii)
759 ELSE
760 DO ilay=1,nlay
761 nptt = elbuf_str%BUFLY(ilay)%NPTT
762 l_pla = elbuf_str%BUFLY(ilay)%L_PLA
763 DO it=1,nptt
764 lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
765 lbuf%SIG(kk(1)+i) = sigsh(22 +(it-1)*6,ii)
766 lbuf%SIG(kk(2)+i) = sigsh(23 +(it-1)*6,ii)
767 lbuf%SIG(kk(3)+i) = sigsh(24 +(it-1)*6,ii)
768 lbuf%SIG(kk(4)+i) = sigsh(25 +(it-1)*6,ii)
769 lbuf%SIG(kk(5)+i) = sigsh(26 +(it-1)*6,ii)
770 IF (l_pla > 0) lbuf%PLA(i) = sigsh(27+(it-1)*6,ii)
771 ENDDO
772 ENDDO
773 ENDIF
774 ENDIF ! IF (IHBE == 23)
775 100 CONTINUE
776 ENDDO
777 CALL ancmsg(msgid=2020,
778 . anmode=aninfo_blind_2,
779 . msgtype=msgerror,
780 . prmod=msg_print)
781C-----------
782 RETURN
min
#define min(a, b)
Definition macros.h:20
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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

◆ loc2orth()

subroutine loc2orth ( tens,
dir_a,
dir_b,
integer ii,
integer ilaw,
integer igtyp,
integer nel )

Definition at line 895 of file scigini4.F.

896C-----------------------------------------------
897C I m p l i c i t T y p e s
898C-----------------------------------------------
899#include "implicit_f.inc"
900C-----------------------------------------------
901C D u m m y A r g u m e n t s
902C-----------------------------------------------
903 INTEGER II,ILAW,IGTYP,NEL
904C REAL
905 my_real
906 . tens(6), dir_a(*),dir_b(*)
907C-----------------------------------------------
908C L o c a l V a r i a b l e s
909C-----------------------------------------------
910 INTEGER J
911C REAL
912 my_real
913 . r1,r2,r3,s1,s2,s3,r12a,r22a,s12b,s22b,rs1,rs2,rs3,
914 . t1,t2,t3,phi,sum1,sum2,fact,r3r3,s3s3
915c------------------------------------------------
916 IF (igtyp /= 1) THEN
917c------------------------------------------------
918 IF (igtyp == 16) THEN
919c
920 ELSEIF ((igtyp == 51 .OR. igtyp == 52) .AND. ilaw == 58) THEN
921c II = JDIR + I-1
922 ELSE
923 IF (ilaw /= 1 .and. ilaw /= 2 .and. ilaw /= 19 .and. ilaw /= 27 .and. ilaw /= 32)
924 . CALL rotovs(tens,dir_a(ii),dir_a(ii+nel))
925 ENDIF
926 ENDIF ! IGTYP
927C
928 RETURN
rotovs
subroutine rotovs(sig, dir1, dir2)
Definition scigini4.F:936

◆ rotovs()

subroutine rotovs ( sig,
dir1,
dir2 )

Definition at line 935 of file scigini4.F.

936C-----------------------------------------------
937C I m p l i c i t T y p e s
938C-----------------------------------------------
939#include "implicit_f.inc"
940C-----------------------------------------------
941C D u m m y A r g u m e n t s
942C-----------------------------------------------
943 my_real
944 . sig(6), dir1,dir2
945C-----------------------------------------------
946C L o c a l V a r i a b l e s
947C-----------------------------------------------
948 INTEGER I
949 my_real
950 . s1, s2, s3, s4, s5
951C-----------------------------------------------
952 s1 = dir1*dir1*sig(1)
953 . +dir2*dir2*sig(2)+two*dir1*dir2*sig(3)
954 s2 = dir2*dir2*sig(1)
955 . +dir1*dir1*sig(2)-two*dir2*dir1*sig(3)
956 s3 =-dir1*dir2*sig(1)
957 . +dir2*dir1*sig(2)
958 . +(dir1*dir1-dir2*dir2)*sig(3)
959 s4 =-dir2*sig(5)+dir1*sig(4)
960 s5 = dir1*sig(5)+dir2*sig(4)
961 sig(1)=s1
962 sig(2)=s2
963 sig(3)=s3
964 sig(4)=s4
965 sig(5)=s5
966C
967 RETURN