OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
outmaxsubr.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!|| gps_solid ../engine/source/output/outmaxsubr.F
25!||--- called by ------------------------------------------------------
26!|| upd_tmax ../engine/source/output/upd_outmax.F
27!||--- calls -----------------------------------------------------
28!|| spmd_exch_v ../engine/source/mpi/generic/spmd_exch_v.F
29!|| tensgps3 ../engine/source/output/anim/generate/tensor6.F
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!||====================================================================
34 SUBROUTINE gps_solid(ELBUF_TAB,IPARG ,GEO ,PM ,
35 . IXS ,IXS10 ,IXS16 ,IXS20 ,IXQ ,
36 . IXC ,IXTG ,IXT ,IXP ,IXR ,
37 . X ,IAD_ELEM,FR_ELEM ,WEIGHT ,SIG_N ,
38 . ITAGPS)
39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE elbufdef_mod
43 use element_mod , only : nixs,nixq,nixc,nixp,nixr,nixt,nixtg
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 "com04_c.inc"
53#include "param_c.inc"
54#include "tabsiz_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
59 INTEGER, DIMENSION(NIXC,NUMELC) ,INTENT(IN):: IXC
60 INTEGER, DIMENSION(NIXTG,NUMELTG) ,INTENT(IN):: IXTG
61 INTEGER, DIMENSION(NIXS,NUMELS) ,INTENT(IN):: IXS
62 INTEGER, DIMENSION(NIXQ,NUMELQ) ,INTENT(IN):: IXQ
63 INTEGER, DIMENSION(NIXT,NUMELT) ,INTENT(IN):: IXT
64 INTEGER, DIMENSION(NIXP,NUMELP) ,INTENT(IN):: IXP
65 INTEGER, DIMENSION(NIXR,NUMELR) ,INTENT(IN):: IXR
66 INTEGER, DIMENSION(6,NUMELS10) ,INTENT(IN):: IXS10
67 INTEGER, DIMENSION(8,NUMELS16) ,INTENT(IN):: IXS16
68 INTEGER, DIMENSION(12,NUMELS20) ,INTENT(IN):: IXS20
69 INTEGER, DIMENSION(2,NSPMD+1) ,INTENT(IN):: IAD_ELEM
70 INTEGER, DIMENSION(SFR_ELEM) ,INTENT(IN):: FR_ELEM
71 INTEGER, DIMENSION(NUMNOD) ,INTENT(IN):: WEIGHT
72 INTEGER, DIMENSION(NUMNOD) ,INTENT(INOUT):: ITAGPS
73 my_real, DIMENSION(NPROPG,NUMGEO) ,INTENT(IN):: geo
74 my_real, DIMENSION(NPROPM,NUMMAT) ,INTENT(IN):: pm
75 my_real, DIMENSION(3,NUMNOD) ,INTENT(IN):: x
76 my_real, DIMENSION(NUMNOD,6) ,INTENT(OUT):: sig_n
77 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER N, LENR, NSIZ
82 my_real
83 . FAC
84 my_real
85 . , DIMENSION(:,:), ALLOCATABLE, TARGET :: vcom
86 my_real
87 . , DIMENSION(:,:), POINTER :: aflu, vflu
88C-----------------------------------------------
89C
90 nsiz = 7
91 ALLOCATE(vcom(nsiz,numnod))
92 aflu=>vcom(1:3,1:numnod)
93 vflu=>vcom(4:6,1:numnod)
94 vcom = zero
95
96 sig_n(1:numnod,1:6) = zero
97 itagps(1:numnod) = 0
98 CALL tensgps3(elbuf_tab ,vflu ,aflu ,iparg ,geo ,
99 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
100 . ixc ,ixtg ,ixt ,ixp ,ixr ,
101 . x ,itagps ,pm )
102 IF(nspmd > 1)THEN
103 vcom(7,1:numnod) =itagps(1:numnod)
104 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
105 CALL spmd_exch_v(vcom,nsiz,iad_elem,fr_elem,lenr)
106 itagps(1:numnod)=nint(vcom(7,1:numnod))
107 ENDIF
108 DO n=1,numnod
109 IF (itagps(n) == 0) cycle
110 fac = one/itagps(n)
111 sig_n(n,1:3)=fac*vflu(1:3,n)
112 sig_n(n,4:6)=fac*aflu(1:3,n)
113 ENDDO
114
115 DEALLOCATE(vcom)
116
117 RETURN
118 END
119!||====================================================================
120!|| gpstra_solid ../engine/source/output/outmaxsubr.F
121!||--- called by ------------------------------------------------------
122!|| upd_tmax ../engine/source/output/upd_outmax.F
123!||--- calls -----------------------------------------------------
124!|| spmd_exch_n ../engine/source/mpi/generic/spmd_exch_n.f
125!|| spmd_exch_nodareai ../engine/source/mpi/anim/spmd_exch_nodareai.F
126!|| tensgpstrain ../engine/source/output/anim/generate/tensgpstrain.F
127!||--- uses -----------------------------------------------------
128!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
129!|| element_mod ../common_source/modules/elements/element_mod.F90
130!||====================================================================
131 SUBROUTINE gpstra_solid(ELBUF_TAB,IPARG ,GEO ,PM ,
132 . IXS ,IXS10 ,IXS16 ,IXS20 ,IXQ ,
133 . IXC ,IXTG ,IXT ,IXP ,IXR ,
134 . X ,IAD_ELEM,FR_ELEM ,WEIGHT ,STR_N ,
135 . ITAGPS)
136C-----------------------------------------------
137C M o d u l e s
138C-----------------------------------------------
139 USE elbufdef_mod
140 use element_mod , only : nixs,nixq,nixc,nixp,nixr,nixt,nixtg
141C-----------------------------------------------
142C I m p l i c i t T y p e s
143C-----------------------------------------------
144#include "implicit_f.inc"
145C-----------------------------------------------
146C C o m m o n B l o c k s
147C-----------------------------------------------
148#include "com01_c.inc"
149#include "com04_c.inc"
150#include "param_c.inc"
151#include "tabsiz_c.inc"
152C-----------------------------------------------
153C D u m m y A r g u m e n t s
154C-----------------------------------------------
155 INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
156 INTEGER, DIMENSION(NIXC,NUMELC) ,INTENT(IN):: IXC
157 INTEGER, DIMENSION(NIXTG,NUMELTG) ,INTENT(IN):: IXTG
158 INTEGER, DIMENSION(NIXS,NUMELS) ,INTENT(IN):: IXS
159 INTEGER, DIMENSION(NIXQ,NUMELQ) ,INTENT(IN):: IXQ
160 INTEGER, DIMENSION(NIXT,NUMELT) ,INTENT(IN):: IXT
161 INTEGER, DIMENSION(NIXP,NUMELP) ,INTENT(IN):: IXP
162 INTEGER, DIMENSION(NIXR,NUMELR) ,INTENT(IN):: IXR
163 INTEGER, DIMENSION(6,NUMELS10) ,INTENT(IN):: IXS10
164 INTEGER, DIMENSION(8,NUMELS16) ,INTENT(IN):: IXS16
165 INTEGER, DIMENSION(12,NUMELS20) ,INTENT(IN):: IXS20
166 INTEGER, DIMENSION(2,NSPMD+1) ,INTENT(IN):: IAD_ELEM
167 INTEGER, DIMENSION(SFR_ELEM) ,INTENT(IN):: FR_ELEM
168 INTEGER, DIMENSION(NUMNOD) ,INTENT(IN):: WEIGHT
169 INTEGER, DIMENSION(NUMNOD) ,INTENT(INOUT):: ITAGPS
170 my_real, DIMENSION(NPROPG,NUMGEO) ,INTENT(IN):: geo
171 my_real, DIMENSION(NPROPM,NUMMAT) ,INTENT(IN):: pm
172 my_real, DIMENSION(3,NUMNOD) ,INTENT(IN):: x
173 my_real, DIMENSION(NUMNOD,6) ,INTENT(OUT):: str_n
174 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
175C-----------------------------------------------
176C L o c a l V a r i a b l e s
177C-----------------------------------------------
178 INTEGER N, LENR
179 my_real
180 . fac
181 my_real
182 . , DIMENSION(:,:), ALLOCATABLE :: aflu, vflu
183C-----------------------------------------------
184C
185 ALLOCATE(aflu(3,numnod))
186 ALLOCATE(vflu(3,numnod))
187
188
189 str_n(1:numnod,1:6) = zero
190 DO n=1,numnod
191 itagps(n) = 0
192 vflu(1:3,n) = zero
193 aflu(1:3,n) = zero
194 ENDDO
195 CALL tensgpstrain(elbuf_tab,vflu ,aflu ,iparg ,geo ,
196 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
197 . ixc ,ixtg ,ixt ,ixp ,ixr ,
198 . x ,itagps ,pm )
199 IF(nspmd > 1)THEN
200 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
201 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
202 CALL spmd_exch_n(vflu,iad_elem,fr_elem,lenr)
203 CALL spmd_exch_n(aflu,iad_elem,fr_elem,lenr)
204 ENDIF
205 DO n=1,numnod
206 IF (itagps(n) == 0) cycle
207 fac = one/itagps(n)
208 str_n(n,1:3)=fac*vflu(1:3,n)
209 str_n(n,4:6)=fac*aflu(1:3,n)
210 ENDDO
211
212 DEALLOCATE(aflu)
213 DEALLOCATE(vflu)
214
215 RETURN
216 END
217!||====================================================================
218!|| sig2dpin2 ../engine/source/output/outmaxsubr.F
219!||--- called by ------------------------------------------------------
220!|| sig2d2pin ../engine/source/output/outmaxsubr.F
221!|| tm_sig_shell ../engine/source/output/outmaxsubr.F
222!|| tm_stra_shell ../engine/source/output/outmaxsubr.F
223!||====================================================================
224 SUBROUTINE sig2dpin2(SIG,PIN,NEL)
225C-----------------------------------------------------------------------
226C I m p l i c i t T y p e s
227C-----------------------------------------------
228#include "implicit_f.inc"
229C-----------------------------------------------
230C D u m m y A r g u m e n t s
231C-----------------------------------------------
232 INTEGER ,INTENT(IN) :: NEL
233 my_real, DIMENSION(NEL,3) ,INTENT(IN):: SIG
234 my_real, DIMENSION(NEL,2) ,INTENT(OUT):: PIN
235C-----------------------------------------------
236C L o c a l V a r i a b l e s
237C-----------------------------------------------
238 INTEGER I
239 my_real
240 . s1,t1,det,r
241C-----------------------------------------------
242C S o u r c e L i n e s
243C-----------------------------------------------
244 DO i=1,nel
245 t1 = sig(i,1)+sig(i,2)
246 det = sig(i,1)*sig(i,2)-sig(i,3)*sig(i,3)
247 r = sqrt(t1*t1-four*det)
248 pin(i,1) = half*(t1+r)
249 pin(i,2) = half*(t1-r)
250 ENDDO
251C
252 RETURN
253 END
254!||====================================================================
255!|| sig3dpin2 ../engine/source/output/outmaxsubr.F
256!||--- called by ------------------------------------------------------
257!|| sig3d2pin ../engine/source/output/outmaxsubr.F
258!|| tm_sig_solid ../engine/source/output/outmaxsubr.F
259!|| tm_stra_solid ../engine/source/output/outmaxsubr.F
260!||====================================================================
261 SUBROUTINE sig3dpin2(SIG,PIN,NEL)
262C-----------------------------------------------------------------------
263C I m p l i c i t T y p e s
264C-----------------------------------------------
265#include "implicit_f.inc"
266C-----------------------------------------------
267C D u m m y A r g u m e n t s
268C-----------------------------------------------
269 INTEGER ,INTENT(IN) :: NEL
270 my_real, DIMENSION(NEL,6) ,INTENT(IN) :: SIG
271 my_real, DIMENSION(NEL,2) ,INTENT(OUT):: PIN
272C-----------------------------------------------
273C L o c a l V a r i a b l e s
274C-----------------------------------------------
275 INTEGER I
276 my_real
277 . s1,t1,t2,t3,s(6),p1,detb,dets,r,alpha
278C-----------------------------------------------
279C S o u r c e L i n e s
280C-----------------------------------------------
281 DO i=1,nel
282 s1 = sig(i,4)*sig(i,4)+sig(i,5)*sig(i,5)+sig(i,6)*sig(i,6)
283 IF (s1 > em10) THEN
284 t1 = third*(sig(i,1)+sig(i,2)+sig(i,3))
285 s(1:3) = sig(i,1:3) - t1
286 s(4) = sig(i,4)
287 s(5) = sig(i,6)
288 s(6) = sig(i,5)
289 t2 = s(1)*s(1)+s(2)*s(2)+s(3)*s(3) + two*s1
290 p1 = sqrt(t2/six)
291 dets = s(1)*(s(2)*s(3)-s(6)*s(6))-s(4)*(s(4)*s(3)-s(5)*s(6))
292 . +s(5)*(s(4)*s(6)-s(2)*s(5))
293 detb = dets/p1
294 r = half*detb
295 IF (r <= -one) THEN
296 alpha = third*pi
297 ELSEIF (r >= one) THEN
298 alpha = zero
299 ELSE
300 alpha = third*acos(r)
301 END IF
302 pin(i,1) = t1 + two * p1* cos(alpha)
303 pin(i,2) = t1 + two * p1* cos(alpha+2*pi/3)
304 ELSE
305 pin(i,1) = max(sig(i,1),sig(i,2),sig(i,3))
306 pin(i,2) = min(sig(i,1),sig(i,2),sig(i,3))
307 END IF
308 END DO
309C
310 RETURN
311 END
312!||====================================================================
313!|| sig3d2pin ../engine/source/output/outmaxsubr.F
314!||--- called by ------------------------------------------------------
315!|| ini_tmax ../engine/source/output/ini_outmax.F
316!||--- calls -----------------------------------------------------
317!|| sig3dpin2 ../engine/source/output/outmaxsubr.F
318!||====================================================================
319 SUBROUTINE sig3d2pin(SIG1,SIG3,PIN,NEL)
320C-----------------------------------------------------------------------
321C I m p l i c i t T y p e s
322C-----------------------------------------------
323#include "implicit_f.inc"
324C-----------------------------------------------
325C D u m m y A r g u m e n t s
326C-----------------------------------------------
327 INTEGER ,INTENT(IN) :: NEL
328 my_real, DIMENSION(NEL,6) ,INTENT(IN):: SIG1,SIG3
329 my_real, DIMENSION(NEL,2) ,INTENT(OUT):: PIN
330C-----------------------------------------------
331C L o c a l V a r i a b l e s
332C-----------------------------------------------
333
334 my_real
335 . p2(nel,2)
336C-----------------------------------------------
337C S o u r c e L i n e s
338C-----------------------------------------------
339 CALL sig3dpin2(sig1,p2,nel)
340 CALL sig3dpin2(sig3,pin,nel)
341 pin(1:nel,1) = p2(1:nel,1)
342C
343 RETURN
344 END
345!||====================================================================
346!|| sig2d2pin ../engine/source/output/outmaxsubr.F
347!||--- called by ------------------------------------------------------
348!|| ini_tmax ../engine/source/output/ini_outmax.F
349!||--- calls -----------------------------------------------------
350!|| sig2dpin2 ../engine/source/output/outmaxsubr.F
351!||====================================================================
352 SUBROUTINE sig2d2pin(SIG1,SIG3,PIN,NEL)
353C-----------------------------------------------------------------------
354C I m p l i c i t T y p e s
355C-----------------------------------------------
356#include "implicit_f.inc"
357C-----------------------------------------------
358C D u m m y A r g u m e n t s
359C-----------------------------------------------
360 INTEGER ,INTENT(IN) :: NEL
361 my_real, DIMENSION(NEL,3) ,INTENT(IN):: SIG1,SIG3
362 my_real, DIMENSION(NEL,2) ,INTENT(OUT):: PIN
363C-----------------------------------------------
364C L o c a l V a r i a b l e s
365C-----------------------------------------------
366
367 my_real
368 . p2(nel,2)
369C-----------------------------------------------
370C S o u r c e L i n e s
371C-----------------------------------------------
372 CALL sig2dpin2(sig1,p2,nel)
373 CALL sig2dpin2(sig3,pin,nel)
374 pin(1:nel,1) = p2(1:nel,1)
375C
376 RETURN
377 END
378!||====================================================================
379!|| ini_tmnorm2 ../engine/source/output/outmaxsubr.F
380!||--- called by ------------------------------------------------------
381!|| ini_tmax ../engine/source/output/ini_outmax.F
382!||====================================================================
383 SUBROUTINE ini_tmnorm2(TM_D,TM_NORM2,NNOD)
384C-----------------------------------------------------------------------
385C I m p l i c i t T y p e s
386C-----------------------------------------------
387#include "implicit_f.inc"
388C-----------------------------------------------
389C D u m m y A r g u m e n t s
390C-----------------------------------------------
391 INTEGER NNOD
392 my_real, DIMENSION(3,NNOD) ,INTENT(IN):: TM_D
393 my_real, DIMENSION(NNOD) ,INTENT(OUT):: TM_NORM2
394C-----------------------------------------------
395C L o c a l V a r i a b l e s
396C-----------------------------------------------
397 INTEGER I
398 my_real
399 . s(3)
400C-----------------------------------------------
401C S o u r c e L i n e s
402C-----------------------------------------------
403 DO i=1,nnod
404 s(1:3) = tm_d(1:3,i)
405 tm_norm2(i) = s(1)*s(1)+s(2)*s(2)+s(3)*s(3)
406 ENDDO
407C
408 RETURN
409 END
410!||====================================================================
411!|| tm_vonm_solid ../engine/source/output/outmaxsubr.F
412!||--- called by ------------------------------------------------------
413!|| tm_seq_solid ../engine/source/output/outmaxsubr.F
414!|| upd_tmax ../engine/source/output/upd_outmax.F
415!||====================================================================
416 SUBROUTINE tm_vonm_solid(IVISC,SIG,VISC,VALUE,NEL)
417C-----------------------------------------------------------------------
418C I m p l i c i t T y p e s
419C-----------------------------------------------
420#include "implicit_f.inc"
421C-----------------------------------------------
422C D u m m y A r g u m e n t s
423C-----------------------------------------------
424 INTEGER IVISC,NEL
425 my_real, DIMENSION(NEL,6) ,INTENT(IN):: SIG,VISC
426 my_real, DIMENSION(NEL) ,INTENT(INOUT):: VALUE
427C-----------------------------------------------
428C L o c a l V a r i a b l e s
429C-----------------------------------------------
430 INTEGER I
431 my_real
432 . s(6),s1,s2,s3,vonm,p,vonm2
433C-----------------------------------------------
434C S o u r c e L i n e s
435C-----------------------------------------------
436 DO i=1,nel
437 s(1:6) = sig(i,1:6)
438 IF(ivisc > 0 ) s(1:6) = s(1:6) + visc(i,1:6)
439 p = - (s(1) + s(2) + s(3) ) * third
440 s1= s(1) + p
441 s2= s(2) + p
442 s3= s(3) + p
443 vonm2= three*(s(4)*s(4) + s(5)*s(5) + s(6)*s(6) +
444 . half*(s1*s1 + s2*s2 + s3*s3) )
445 vonm= sqrt(vonm2) ! can be optimized
446 value(i) = max(value(i),vonm)
447 ENDDO
448C
449 RETURN
450 END
451!||====================================================================
452!|| tm_seq_solid ../engine/source/output/outmaxsubr.F
453!||--- called by ------------------------------------------------------
454!|| upd_tmax ../engine/source/output/upd_outmax.F
455!||--- calls -----------------------------------------------------
456!|| tm_vonm_solid ../engine/source/output/outmaxsubr.F
457!||--- uses -----------------------------------------------------
458!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
459!||====================================================================
460 SUBROUTINE tm_seq_solid(ELBUF_TAB,NLAY,NPTR,NPTS,NPTT,IVISC,VALUE,NEL)
461C-----------------------------------------------
462C M o d u l e s
463C-----------------------------------------------
464 USE elbufdef_mod
465C-----------------------------------------------------------------------
466C I m p l i c i t T y p e s
467C-----------------------------------------------
468#include "implicit_f.inc"
469C-----------------------------------------------
470C D u m m y A r g u m e n t s
471C-----------------------------------------------
472 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,NPTT,NEL,IVISC
473 my_real, DIMENSION(NEL) ,INTENT(INOUT):: VALUE
474 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
475C-----------------------------------------------
476C L o c a l V a r i a b l e s
477C-----------------------------------------------
478 INTEGER I, IL, IR, IS, IT
479 my_real
480 . s(6),s1,s2,s3,vonm
481 TYPE(g_bufel_) ,POINTER :: GBUF
482 TYPE(l_bufel_) ,POINTER :: LBUF
483C-----------------------------------------------
484C S o u r c e L i n e s
485C-----------------------------------------------
486 gbuf => elbuf_tab%GBUF
487 DO il=1,nlay
488 DO it=1,nptt
489 DO ir=1,nptr
490 DO is=1,npts
491 lbuf => elbuf_tab%BUFLY(il)%LBUF(ir,is,it)
492 IF (elbuf_tab%BUFLY(il)%L_SEQ > 0) THEN
493 DO i=1,nel
494 value(i) = max(value(i),lbuf%SEQ(i))
495 ENDDO
496 ELSE
497 CALL tm_vonm_solid(ivisc,lbuf%SIG,lbuf%VISC,VALUE,nel)
498 ENDIF ! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_SEQ > 0)
499 ENDDO ! DO IS=1,NPTS
500 ENDDO ! DO IR=1,NPTR
501 ENDDO ! DO IT=1,NPTT
502 ENDDO ! DO IL=1,NLAY
503C
504 RETURN
505 END
506!||====================================================================
507!|| tm_dmg_solid ../engine/source/output/outmaxsubr.F
508!||--- called by ------------------------------------------------------
509!|| upd_tmax ../engine/source/output/upd_outmax.F
510!||--- uses -----------------------------------------------------
511!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
512!||====================================================================
513 SUBROUTINE tm_dmg_solid(ELBUF_TAB,NLAY,NPTR,NPTS,NPTT,VALUE,NEL)
514C-----------------------------------------------
515C M o d u l e s
516C-----------------------------------------------
517 USE elbufdef_mod
518C-----------------------------------------------------------------------
519C I m p l i c i t T y p e s
520C-----------------------------------------------
521#include "implicit_f.inc"
522C-----------------------------------------------
523C D u m m y A r g u m e n t s
524C-----------------------------------------------
525 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,NPTT,NEL
526 my_real, DIMENSION(NEL) ,INTENT(INOUT):: VALUE
527 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
528C-----------------------------------------------
529C L o c a l V a r i a b l e s
530C-----------------------------------------------
531 INTEGER I, IL, IR, IS, IT, NFAIL, IIR
532
533 my_real,
534 . DIMENSION(:), POINTER :: dfmax
535C-----------------------------------------------
536C S o u r c e L i n e s
537C-----------------------------------------------
538 DO il=1,nlay
539 nfail = elbuf_tab%BUFLY(il)%NFAIL
540 DO is=1,npts
541 DO it=1,nptt
542 DO iir=1,nptr
543 DO ir=1,nfail
544 dfmax=>elbuf_tab%BUFLY(il)%FAIL(iir,is,it)%FLOC(ir)%DAMMX
545 DO i=1,nel
546 value(i) = max(value(i),dfmax(i))
547 ENDDO
548 ENDDO
549 ENDDO
550 ENDDO
551 ENDDO
552 ENDDO
553C
554 RETURN
555 END
556!||====================================================================
557!|| tm_sig_solid ../engine/source/output/outmaxsubr.F
558!||--- called by ------------------------------------------------------
559!|| upd_tmax ../engine/source/output/upd_outmax.F
560!||--- calls -----------------------------------------------------
561!|| sig3dpin2 ../engine/source/output/outmaxsubr.F
562!||--- uses -----------------------------------------------------
563!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
564!||====================================================================
565 SUBROUTINE tm_sig_solid(ELBUF_TAB,NLAY,NPTR,NPTS,NPTT,IVISC,
566 . TEN1,TEN3,P2,NEL)
567C-----------------------------------------------
568C M o d u l e s
569C-----------------------------------------------
570 USE elbufdef_mod
571C-----------------------------------------------------------------------
572C I m p l i c i t T y p e s
573C-----------------------------------------------
574#include "implicit_f.inc"
575C-----------------------------------------------
576C D u m m y A r g u m e n t s
577C-----------------------------------------------
578 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,NPTT,NEL,IVISC
579 my_real, DIMENSION(NEL,6) ,INTENT(INOUT):: ten1,ten3
580 my_real, DIMENSION(NEL,2) ,INTENT(INOUT):: p2
581 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
582C-----------------------------------------------
583C L o c a l V a r i a b l e s
584C-----------------------------------------------
585 INTEGER I, IL, IR, IS, IT, JJ(6)
586 my_real
587 . s(nel,6),s1,s2,s3,sp2(nel,2)
588 TYPE(l_bufel_) ,POINTER :: LBUF
589C-----------------------------------------------
590C S o u r c e L i n e s
591C-----------------------------------------------
592 DO i=1,6
593 jj(i) = nel*(i-1)
594 ENDDO
595 DO il=1,nlay
596 DO it=1,nptt
597 DO ir=1,nptr
598 DO is=1,npts
599 lbuf => elbuf_tab%BUFLY(il)%LBUF(ir,is,it)
600 DO i = 1,nel
601 s(i,1:6) = lbuf%SIG(jj(1:6)+i)
602 END DO
603 IF(ivisc > 0 ) THEN
604 DO i = 1,nel
605 s(i,1:6) = s(i,1:6) + lbuf%VISC(jj(1:6)+i)
606 END DO
607 END IF
608 CALL sig3dpin2(s,sp2,nel)
609 DO i = 1,nel
610 IF (sp2(i,1) > p2(i,1)) THEN
611 ten1(i,1:6) = s(i,1:6)
612 p2(i,1) = sp2(i,1)
613 END IF
614 IF (sp2(i,2) < p2(i,2)) THEN
615 ten3(i,1:6) = s(i,1:6)
616 p2(i,2) = sp2(i,2)
617 END IF
618 END DO
619 ENDDO ! DO IS=1,NPTS
620 ENDDO ! DO IR=1,NPTR
621 ENDDO ! DO IT=1,NPTT
622 ENDDO ! DO IL=1,NLAY
623C
624 RETURN
625 END
626!||====================================================================
627!|| tm_stra_solid ../engine/source/output/outmaxsubr.F
628!||--- called by ------------------------------------------------------
629!|| upd_tmax ../engine/source/output/upd_outmax.F
630!||--- calls -----------------------------------------------------
631!|| sig3dpin2 ../engine/source/output/outmaxsubr.F
632!||--- uses -----------------------------------------------------
633!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
634!||====================================================================
635 SUBROUTINE tm_stra_solid(ELBUF_TAB,NLAY,NPTR,NPTS,NPTT,
636 . TEN1,TEN3,P2,NEL)
637C-----------------------------------------------
638C M o d u l e s
639C-----------------------------------------------
640 USE elbufdef_mod
641C-----------------------------------------------------------------------
642C I m p l i c i t T y p e s
643C-----------------------------------------------
644#include "implicit_f.inc"
645C-----------------------------------------------
646C D u m m y A r g u m e n t s
647C-----------------------------------------------
648 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,NPTT,NEL
649 my_real, DIMENSION(NEL,6) ,INTENT(INOUT):: TEN1,TEN3
650 my_real, DIMENSION(NEL,2) ,INTENT(INOUT):: p2
651 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
652C-----------------------------------------------
653C L o c a l V a r i a b l e s
654C-----------------------------------------------
655 INTEGER I, IL, IR, IS, IT, JJ(6)
656 my_real
657 . S(NEL,6),S1,S2,S3,SP2(NEL,2)
658 TYPE(l_bufel_) ,POINTER :: LBUF
659C-----------------------------------------------
660C S o u r c e L i n e s
661C-----------------------------------------------
662 DO i=1,6
663 jj(i) = nel*(i-1)
664 ENDDO
665 DO il=1,nlay
666 DO it=1,nptt
667 DO ir=1,nptr
668 DO is=1,npts
669 lbuf => elbuf_tab%BUFLY(il)%LBUF(ir,is,it)
670C !!!!! law 12,14
671 IF (elbuf_tab%BUFLY(il)%L_STRA > 0) THEN
672 DO i = 1,nel
673 s(i,1:6) = lbuf%STRA(jj(1:6)+i)
674 END DO
675 CALL sig3dpin2(s,sp2,nel)
676 DO i = 1,nel
677 IF (sp2(i,1) > p2(i,1)) THEN
678 ten1(i,1:6) = s(i,1:6)
679 p2(i,1) = sp2(i,1)
680 END IF
681 IF (sp2(i,2) < p2(i,2)) THEN
682 ten3(i,1:6) = s(i,1:6)
683 p2(i,2) = sp2(i,2)
684 END IF
685 END DO
686 END IF !(ELBUF_TAB%BUFLY(IL)%L_STRA > 0) THEN
687 ENDDO ! DO IS=1,NPTS
688 ENDDO ! DO IR=1,NPTR
689 ENDDO ! DO IT=1,NPTT
690 ENDDO ! DO IL=1,NLAY
691C
692 RETURN
693 END
694!||====================================================================
695!|| tm_vonm_shell ../engine/source/output/outmaxsubr.F
696!||--- called by ------------------------------------------------------
697!|| tm_seq_shell ../engine/source/output/outmaxsubr.F
698!|| upd_tmax ../engine/source/output/upd_outmax.F
699!||====================================================================
700 SUBROUTINE tm_vonm_shell(FOR,VALUE,NEL)
701C-----------------------------------------------------------------------
702C I m p l i c i t T y p e s
703C-----------------------------------------------
704#include "implicit_f.inc"
705C-----------------------------------------------
706C D u m m y A r g u m e n t s
707C-----------------------------------------------
708 INTEGER NEL
709 my_real, DIMENSION(NEL,5) ,INTENT(IN):: FOR
710 my_real, DIMENSION(NEL) ,INTENT(INOUT):: VALUE
711C-----------------------------------------------
712C L o c a l V a r i a b l e s
713C-----------------------------------------------
714 INTEGER I
715 my_real
716 . S(3),S1,S2,S12,VONM2,VONM
717C-----------------------------------------------
718C S o u r c e L i n e s
719C-----------------------------------------------
720 DO i=1,nel
721 s1 = for(i,1)
722 s2 = for(i,2)
723 s12 = for(i,3)
724 vonm2= s1*s1 + s2*s2 - s1*s2 + three*s12*s12
725 vonm= sqrt(vonm2)
726 value(i) = max(value(i),vonm)
727 ENDDO
728C
729 RETURN
730 END
731!||====================================================================
732!|| tm_seq_shell ../engine/source/output/outmaxsubr.F
733!||--- called by ------------------------------------------------------
734!|| upd_tmax ../engine/source/output/upd_outmax.F
735!||--- calls -----------------------------------------------------
736!|| tm_vonm_shell ../engine/source/output/outmaxsubr.F
737!||--- uses -----------------------------------------------------
738!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
739!||====================================================================
740 SUBROUTINE tm_seq_shell(ELBUF_TAB,NLAY,NPTR,NPTS,VALUE,NEL)
741C-----------------------------------------------
742C M o d u l e s
743C-----------------------------------------------
744 USE elbufdef_mod
745C-----------------------------------------------------------------------
746C I m p l i c i t T y p e s
747C-----------------------------------------------
748#include "implicit_f.inc"
749C-----------------------------------------------
750C D u m m y A r g u m e n t s
751C-----------------------------------------------
752 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,NEL
753 my_real, DIMENSION(NEL) ,INTENT(INOUT):: VALUE
754 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
755C-----------------------------------------------
756C L o c a l V a r i a b l e s
757C-----------------------------------------------
758 INTEGER I, IL, IR, IS, IT
759 my_real
760 . S(3),S1,S2,S3,VONM
761 TYPE(BUF_LAY_) ,POINTER :: BUFLY
762 TYPE(l_bufel_) ,POINTER :: LBUF
763C-----------------------------------------------
764C S o u r c e L i n e s
765C-----------------------------------------------
766 DO is = 1,npts
767 DO ir = 1,nptr
768 DO il =1,nlay
769 bufly => elbuf_tab%BUFLY(il)
770 DO it=1,bufly%NPTT
771 lbuf => bufly%LBUF(ir,is,it)
772 IF (bufly%L_SEQ > 0) THEN
773 DO i=1,nel
774 value(i) = max(value(i),lbuf%SEQ(i))
775 ENDDO
776 ELSE
777 CALL tm_vonm_shell(lbuf%SIG,VALUE,nel)
778 ENDIF ! IF (ELBUF_TAB(NG)%BUFLY(IL)%L_SEQ > 0)
779 ENDDO ! IT=1,
780 ENDDO ! ILAY =1
781 ENDDO ! IR = 1
782 ENDDO ! DO IS = 1
783C
784 RETURN
785 END
786!||====================================================================
787!|| tm_sig_shell ../engine/source/output/outmaxsubr.F
788!||--- called by ------------------------------------------------------
789!|| upd_tmax ../engine/source/output/upd_outmax.F
790!||--- calls -----------------------------------------------------
791!|| sig2dpin2 ../engine/source/output/outmaxsubr.F
792!||--- uses -----------------------------------------------------
793!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
794!||====================================================================
795 SUBROUTINE tm_sig_shell(ELBUF_TAB,NLAY,NPTR,NPTS,TEN1,TEN3,P2,NEL)
796C-----------------------------------------------
797C M o d u l e s
798C-----------------------------------------------
799 USE elbufdef_mod
800C-----------------------------------------------------------------------
801C I m p l i c i t T y p e s
802C-----------------------------------------------
803#include "implicit_f.inc"
804C-----------------------------------------------
805C D u m m y A r g u m e n t s
806C-----------------------------------------------
807 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,NEL
808 my_real, DIMENSION(NEL,3) ,INTENT(INOUT):: TEN1,TEN3
809 my_real, DIMENSION(NEL,2) ,INTENT(INOUT):: p2
810 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
811C-----------------------------------------------
812C L o c a l V a r i a b l e s
813C-----------------------------------------------
814 INTEGER I, IL, IR, IS, IT, JJ(3)
815 my_real
816 . S(NEL,3),S1,S2,S3,SP2(NEL,2)
817 TYPE(buf_lay_) ,POINTER :: BUFLY
818 TYPE(l_bufel_) ,POINTER :: LBUF
819C-----------------------------------------------
820C S o u r c e L i n e s
821C-----------------------------------------------
822 DO i=1,3
823 jj(i) = nel*(i-1)
824 ENDDO
825 DO is = 1,npts
826 DO ir = 1,nptr
827 DO il =1,nlay
828 bufly => elbuf_tab%BUFLY(il)
829 DO it=1,bufly%NPTT
830 lbuf => bufly%LBUF(ir,is,it)
831 DO i = 1,nel
832 s(i,1:3) = lbuf%SIG(jj(1:3)+i)
833 END DO
834 CALL sig2dpin2(s,sp2,nel)
835 DO i = 1,nel
836 IF (sp2(i,1) > p2(i,1)) THEN
837 ten1(i,1:3) = s(i,1:3)
838 p2(i,1) = sp2(i,1)
839 END IF
840 IF (sp2(i,2) < p2(i,2)) THEN
841 ten3(i,1:3) = s(i,1:3)
842 p2(i,2) = sp2(i,2)
843 END IF
844 END DO
845 ENDDO ! IT=1,
846 ENDDO ! ILAY =1
847 ENDDO ! IR = 1
848 ENDDO ! DO IS = 1
849C
850 RETURN
851 END
852!||====================================================================
853!|| tm_stra_shell ../engine/source/output/outmaxsubr.F
854!||--- called by ------------------------------------------------------
855!|| upd_tmax ../engine/source/output/upd_outmax.F
856!||--- calls -----------------------------------------------------
857!|| sig2dpin2 ../engine/source/output/outmaxsubr.F
858!||--- uses -----------------------------------------------------
859!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
860!||====================================================================
861 SUBROUTINE tm_stra_shell(ELBUF_TAB,NPTR,NPTS,TEN1,TEN3,P2,NEL)
862C-----------------------------------------------
863C M o d u l e s
864C-----------------------------------------------
865 USE elbufdef_mod
866C-----------------------------------------------------------------------
867C I m p l i c i t T y p e s
868C-----------------------------------------------
869#include "implicit_f.inc"
870C-----------------------------------------------
871C D u m m y A r g u m e n t s
872C-----------------------------------------------
873 INTEGER,INTENT(IN):: NPTR,NPTS,NEL
874 my_real, DIMENSION(NEL,3) ,INTENT(INOUT):: TEN1,TEN3
875 my_real, DIMENSION(NEL,2) ,INTENT(INOUT):: p2
876 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
877C-----------------------------------------------
878C L o c a l V a r i a b l e s
879C-----------------------------------------------
880 INTEGER I, IR, IS, JJ(3), NPG, LENS, NG, PTS
881 my_real
882 . S(NEL,3),S1,S2,S3,SP2(NEL,2)
883 TYPE(g_bufel_) ,POINTER :: GBUF
884C-----------------------------------------------
885C S o u r c e L i n e s
886C-----------------------------------------------
887 DO i=1,3
888 jj(i) = nel*(i-1)
889 ENDDO
890 gbuf => elbuf_tab%GBUF
891 npg = npts*nptr
892 IF (npg == 1) THEN
893 DO i = 1,nel
894 s(i,1:3) = gbuf%STRA(jj(1:3)+i)
895 END DO
896 CALL sig2dpin2(s,sp2,nel)
897 DO i = 1,nel
898 IF (sp2(i,1) > p2(i,1)) THEN
899 ten1(i,1:3) = s(i,1:3)
900 p2(i,1) = sp2(i,1)
901 END IF
902 IF (sp2(i,2) < p2(i,2)) THEN
903 ten3(i,1:3) = s(i,1:3)
904 p2(i,2) = sp2(i,2)
905 END IF
906 END DO
907 ELSE
908 lens = nel*gbuf%G_STRPG/npg
909 DO is = 1,npts
910 DO ir = 1,nptr
911 ng = nptr*(is-1) + ir
912 pts = (ng-1)*lens+1
913 DO i = 1,nel
914 s(i,1:3) = gbuf%STRPG(pts+jj(1:3)+i)
915 END DO
916 CALL sig2dpin2(s,sp2,nel)
917 DO i = 1,nel
918 IF (sp2(i,1) > p2(i,1)) THEN
919 ten1(i,1:3) = s(i,1:3)
920 p2(i,1) = sp2(i,1)
921 END IF
922 IF (sp2(i,2) < p2(i,2)) THEN
923 ten3(i,1:3) = s(i,1:3)
924 p2(i,2) = sp2(i,2)
925 END IF
926 END DO
927 ENDDO ! ir = 1
928 ENDDO ! DO IS = 1
929 END IF !(NPG == 1) THEN
930C
931 RETURN
932 END
933!||====================================================================
934!|| tm_dmg_shells ../engine/source/output/outmaxsubr.F
935!||--- called by ------------------------------------------------------
936!|| upd_tmax ../engine/source/output/upd_outmax.f
937!||--- uses -----------------------------------------------------
938!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
939!||====================================================================
940 SUBROUTINE tm_dmg_shells(ELBUF_TAB,NLAY,NPTR,NPTS,VALUE,NEL)
941C-----------------------------------------------
942C M o d u l e s
943C-----------------------------------------------
944 USE elbufdef_mod
945C-----------------------------------------------
946C I m p l i c i t T y p e s
947C-----------------------------------------------
948#include "implicit_f.inc"
949C-----------------------------------------------
950C D u m m y A r g u m e n t s
951C-----------------------------------------------
952 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,NEL
953 my_real, DIMENSION(NEL) ,INTENT(INOUT):: VALUE
954 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
955C-----------------------------------------------
956C L o c a l V a r i a b l e s
957C-----------------------------------------------
958 INTEGER I, IL, IR, IS, IT, NFAIL, IIR
959 my_real, DIMENSION(:), POINTER :: DFMAX
960 TYPE(BUF_LAY_) ,POINTER :: BUFLY
961C-----------------------------------------------
962C S o u r c e L i n e s
963C-----------------------------------------------
964 DO il=1,nlay
965 bufly => elbuf_tab%BUFLY(il)
966 nfail = bufly%NFAIL
967 DO is=1,npts
968 DO ir=1,nptr
969 DO it=1,bufly%NPTT
970 DO iir=1,nfail
971 dfmax=>bufly%FAIL(ir,is,it)%FLOC(iir)%DAMMX
972 DO i=1,nel
973 value(i) = max(value(i),dfmax(i))
974 ENDDO
975 ENDDO
976 ENDDO
977 ENDDO
978 ENDDO
979 ENDDO
980C
981 RETURN
982 END
983!||====================================================================
984!|| tm_dmgl25_shell ../engine/source/output/outmaxsubr.F
985!||--- called by ------------------------------------------------------
986!|| upd_tmax ../engine/source/output/upd_outmax.F
987!||--- uses -----------------------------------------------------
988!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
989!||====================================================================
990 SUBROUTINE tm_dmgl25_shell(ELBUF_TAB,NLAY,NPTR,NPTS,IGTYP,
991 . PM,MATLY,VALUE,NEL)
992C-----------------------------------------------
993C M o d u l e s
994C-----------------------------------------------
995 USE elbufdef_mod
996C-----------------------------------------------------------------------
997C I m p l i c i t T y p e s
998C-----------------------------------------------
999#include "implicit_f.inc"
1000C-----------------------------------------------
1001C C o m m o n B l o c k s
1002C-----------------------------------------------
1003#include "mvsiz_p.inc"
1004#include "com04_c.inc"
1005#include "param_c.inc"
1006C-----------------------------------------------
1007C D u m m y A r g u m e n t s
1008C-----------------------------------------------
1009 INTEGER,INTENT(IN):: NLAY,NPTR,NPTS,IGTYP,NEL
1010 INTEGER,DIMENSION((MVSIZ*100)),INTENT(IN):: MATLY
1011 my_real, DIMENSION(NPROPM,NUMMAT) ,INTENT(IN):: PM
1012 my_real, DIMENSION(NEL) ,INTENT(INOUT):: VALUE
1013 TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_TAB
1014C-----------------------------------------------
1015C L o c a l V a r i a b l e s
1016C-----------------------------------------------
1017 INTEGER I,J,IL,IR,IS,IT,NFAIL,IIR,IPT,IADR,JJ(3)
1018 my_real
1019 . VG(5),VLY(5),VE(5)
1020 my_real,
1021 . DIMENSION(MVSIZ) :: dmax,wpmax,epst1,epst2,epsf1,epsf2
1022 my_real,
1023 . DIMENSION(:), POINTER :: dfmax
1024 TYPE(buf_lay_) ,POINTER :: BUFLY
1025 TYPE(L_BUFEL_) ,POINTER :: LBUF
1026C-----------------------------------------------
1027C S o u r c e L i n e s
1028C-----------------------------------------------
1029 DO il=1,nlay
1030 bufly => elbuf_tab%BUFLY(il)
1031 nfail = bufly%NFAIL
1032 DO is=1,npts
1033 DO ir=1,nptr
1034 DO it=1,bufly%NPTT
1035 DO iir=1,nfail
1036 dfmax=>bufly%FAIL(ir,is,it)%FLOC(iir)%DAMMX
1037 DO i=1,nel
1038 value(i) = max(value(i),dfmax(i))
1039 END DO
1040 END DO
1041 END DO
1042 END DO
1043 END DO !DO IS=1
1044 END DO
1045C
1046 IF(igtyp == 10 .OR. igtyp == 11 .OR.
1047 . igtyp == 17 .OR. igtyp == 51 .OR. igtyp == 52 ) THEN
1048 DO i=1,3
1049 jj(i) = nel*(i-1)
1050 ENDDO
1051 DO il=1,nlay
1052 bufly => elbuf_tab%BUFLY(il)
1053 DO ipt=1,bufly%NPTT
1054 iadr = (ipt - 1)*nel
1055 DO i=1,nel
1056 j = iadr + i
1057 vly(1:5) = zero
1058 vg(1:5) = zero
1059 DO ir=1,nptr
1060 DO is=1,npts
1061 lbuf => bufly%LBUF(ir,is,ipt)
1062 dmax(i) = one/pm(64,matly(j))
1063 wpmax(i)= one/pm(41,matly(j))
1064 epst1(i)= pm(60,matly(j))
1065 epst2(i)= pm(61,matly(j))
1066 epsf1(i)= one/pm(98,matly(j))
1067 epsf2(i)= one/pm(99,matly(j))
1068C
1069 vg(1) = max(vg(1),lbuf%DAM(jj(1)+i)*dmax(i))
1070 vg(2) = max(vg(2),lbuf%DAM(jj(2)+i)*dmax(i))
1071 vg(3) = max(vg(3),abs(lbuf%PLA(i))*wpmax(i))
1072 IF(lbuf%CRAK(jj(1)+i) > zero) vg(4)= max(vg(4),
1073 . (lbuf%CRAK(jj(1)+i)+epst1(i))*epsf1(i))
1074 IF(lbuf%CRAK(jj(2)+i) > zero )vg(5) = max(vg(5),
1075 . (lbuf%CRAK(jj(2)+i)+epst2(i))*epsf2(i))
1076 END DO
1077 END DO
1078 vly(1) =vly(1) + vg(1)
1079 vly(2) =vly(2) + vg(2)
1080 vly(3) =vly(3) + vg(3)
1081 vly(4) =vly(4) + vg(4)
1082 vly(5) =vly(5) + vg(5)
1083C
1084 value(i) = max(value(i),vly(1),vly(2),vly(3),vly(4),vly(5))
1085 END DO ! I=1,NEL
1086 END DO !IPT=1,BUFLY%NPTT
1087 END DO !IL=1,NLAY
1088 END IF !(IGTYP == 10 .OR. IGTYP == 11 .OR.
1089C
1090 RETURN
1091 END
1092!||====================================================================
1093!|| upd_tmnorm2 ../engine/source/output/outmaxsubr.F
1094!||--- called by ------------------------------------------------------
1095!|| upd_tmax ../engine/source/output/upd_outmax.F
1096!||====================================================================
1097 SUBROUTINE upd_tmnorm2(D,TM_D,TM_NORM2,NFT,NLT)
1098C-----------------------------------------------------------------------
1099C I m p l i c i t T y p e s
1100C-----------------------------------------------
1101#include "implicit_f.inc"
1102C-----------------------------------------------
1103C C o m m o n B l o c k s
1104C-----------------------------------------------
1105#include "com04_c.inc"
1106C-----------------------------------------------
1107C D u m m y A r g u m e n t s
1108C-----------------------------------------------
1109 INTEGER NFT,NLT
1110 my_real, DIMENSION(3,NUMNOD) ,INTENT(IN):: D
1111 my_real, DIMENSION(NUMNOD) ,INTENT(INOUT):: TM_NORM2
1112 my_real, DIMENSION(3,NUMNOD) ,INTENT(INOUT):: TM_D
1113C-----------------------------------------------
1114C L o c a l V a r i a b l e s
1115C-----------------------------------------------
1116 INTEGER I
1117 my_real
1118 . S(3),NORM2
1119C-----------------------------------------------
1120C S o u r c e L i n e s
1121C-----------------------------------------------
1122 DO i=nft,nlt
1123 s(1:3) = d(1:3,i)
1124 norm2 = s(1)*s(1)+s(2)*s(2)+s(3)*s(3)
1125 IF (norm2 > tm_norm2(i)) THEN
1126 tm_norm2(i) = norm2
1127 tm_d(1:3,i) = s(1:3)
1128 END IF
1129 ENDDO
1130C
1131 RETURN
1132 END
1133!||====================================================================
1134!|| upd_tmtens ../engine/source/output/outmaxsubr.F
1135!||--- called by ------------------------------------------------------
1136!|| upd_tmax ../engine/source/output/upd_outmax.F
1137!||====================================================================
1138 SUBROUTINE upd_tmtens(NSIG,PNSIG,TM_NSIG1,TM_NSIG3,TM_PNSIG,NFT,NLT,IGPSTAG)
1139C-----------------------------------------------------------------------
1140C I m p l i c i t T y p e s
1141C-----------------------------------------------
1142#include "implicit_f.inc"
1143C-----------------------------------------------
1144C C o m m o n B l o c k s
1145C-----------------------------------------------
1146#include "com04_c.inc"
1147C-----------------------------------------------
1148C D u m m y A r g u m e n t s
1149C-----------------------------------------------
1150 INTEGER NFT,NLT
1151 INTEGER ,DIMENSION(NUMNOD) ,INTENT(IN):: IGPSTAG
1152 my_real, DIMENSION(NUMNOD,6) ,INTENT(IN):: NSIG
1153 my_real, DIMENSION(NUMNOD,2) ,INTENT(IN):: PNSIG
1154 my_real, DIMENSION(NUMNOD,2) ,INTENT(INOUT):: TM_PNSIG
1155 my_real, DIMENSION(NUMNOD,6) ,INTENT(INOUT):: TM_NSIG1,TM_NSIG3
1156C-----------------------------------------------
1157C L o c a l V a r i a b l e s
1158C-----------------------------------------------
1159 INTEGER I
1160 my_real
1161 . s(3),norm2
1162C-----------------------------------------------
1163C S o u r c e L i n e s
1164C-----------------------------------------------
1165 DO i=nft,nlt
1166 IF (igpstag(i)==0) cycle
1167 IF (pnsig(i,1) > tm_pnsig(i,1)) THEN
1168 tm_pnsig(i,1) = pnsig(i,1)
1169 tm_nsig1(i,1:6) = nsig(i,1:6)
1170 END IF
1171 IF (pnsig(i,2) < tm_pnsig(i,2)) THEN
1172 tm_pnsig(i,2) = pnsig(i,2)
1173 tm_nsig3(i,1:6) = nsig(i,1:6)
1174 END IF
1175 ENDDO
1176C
1177 RETURN
1178 END
1179!||====================================================================
1180!|| sig3dpin2h ../engine/source/output/outmaxsubr.F
1181!||--- called by ------------------------------------------------------
1182!|| upd_tmax ../engine/source/output/upd_outmax.f
1183!||====================================================================
1184 SUBROUTINE sig3dpin2h(SIG,PIN,NFT,NLT,IGPSTAG)
1185C-----------------------------------------------------------------------
1186C I m p l i c i t T y p e s
1187C-----------------------------------------------
1188#include "implicit_f.inc"
1189C-----------------------------------------------
1190C C o m m o n B l o c k s
1191C-----------------------------------------------
1192#include "com04_c.inc"
1193C-----------------------------------------------
1194C D u m m y A r g u m e n t s
1195C-----------------------------------------------
1196 INTEGER ,INTENT(IN) :: NFT,NLT
1197 INTEGER ,DIMENSION(NUMNOD) ,INTENT(IN):: IGPSTAG
1198 my_real, DIMENSION(NUMNOD,6) ,INTENT(IN) :: SIG
1199 my_real, DIMENSION(NUMNOD,2) ,INTENT(INOUT):: PIN
1200C-----------------------------------------------
1201C L o c a l V a r i a b l e s
1202C-----------------------------------------------
1203 INTEGER I
1204 my_real
1205 . S1,T1,T2,T3,S(6),P1,DETB,DETS,R,ALPHA
1206C-----------------------------------------------
1207C S o u r c e L i n e s
1208C-----------------------------------------------
1209 DO i=nft,nlt
1210 IF (igpstag(i)==0) cycle
1211 s1 = sig(i,4)*sig(i,4)+sig(i,5)*sig(i,5)+sig(i,6)*sig(i,6)
1212 IF (s1 > em10) THEN
1213 t1 = third*(sig(i,1)+sig(i,2)+sig(i,3))
1214 s(1:3) = sig(i,1:3) - t1
1215 s(4) = sig(i,4)
1216 s(5) = sig(i,6)
1217 s(6) = sig(i,5)
1218 t2 = s(1)*s(1)+s(2)*s(2)+s(3)*s(3) + two*s1
1219 p1 = sqrt(t2/six)
1220 dets = s(1)*(s(2)*s(3)-s(6)*s(6))-s(4)*(s(4)*s(3)-s(5)*s(6))
1221 . +s(5)*(s(4)*s(6)-s(2)*s(5))
1222 detb = dets/p1
1223 r = half*detb
1224 IF (r <= -one) THEN
1225 alpha = third*pi
1226 ELSEIF (r >= one) THEN
1227 alpha = zero
1228 ELSE
1229 alpha = third*acos(r)
1230 END IF
1231 pin(i,1) = t1 + two * p1* cos(alpha)
1232 pin(i,2) = t1 + two * p1* cos(alpha+2*pi/3)
1233 ELSE
1234 pin(i,1) = max(sig(i,1),sig(i,2),sig(i,3))
1235 pin(i,2) = min(sig(i,1),sig(i,2),sig(i,3))
1236 END IF
1237 END DO
1238C
1239 RETURN
1240 END
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tm_dmgl25_shell
subroutine tm_dmgl25_shell(elbuf_tab, nlay, nptr, npts, igtyp, pm, matly, value, nel)
Definition outmaxsubr.F:992
upd_tmnorm2
subroutine upd_tmnorm2(d, tm_d, tm_norm2, nft, nlt)
Definition outmaxsubr.F:1098
upd_tmtens
subroutine upd_tmtens(nsig, pnsig, tm_nsig1, tm_nsig3, tm_pnsig, nft, nlt, igpstag)
Definition outmaxsubr.F:1139
gps_solid
subroutine gps_solid(elbuf_tab, iparg, geo, pm, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, iad_elem, fr_elem, weight, sig_n, itagps)
Definition outmaxsubr.F:39
tm_seq_solid
subroutine tm_seq_solid(elbuf_tab, nlay, nptr, npts, nptt, ivisc, value, nel)
Definition outmaxsubr.F:461
ini_tmnorm2
subroutine ini_tmnorm2(tm_d, tm_norm2, nnod)
Definition outmaxsubr.F:384
tm_seq_shell
subroutine tm_seq_shell(elbuf_tab, nlay, nptr, npts, value, nel)
Definition outmaxsubr.F:741
tm_stra_shell
subroutine tm_stra_shell(elbuf_tab, nptr, npts, ten1, ten3, p2, nel)
Definition outmaxsubr.F:862
sig3dpin2
subroutine sig3dpin2(sig, pin, nel)
Definition outmaxsubr.F:262
tm_sig_solid
subroutine tm_sig_solid(elbuf_tab, nlay, nptr, npts, nptt, ivisc, ten1, ten3, p2, nel)
Definition outmaxsubr.F:567
sig2d2pin
subroutine sig2d2pin(sig1, sig3, pin, nel)
Definition outmaxsubr.F:353
sig3dpin2h
subroutine sig3dpin2h(sig, pin, nft, nlt, igpstag)
Definition outmaxsubr.F:1185
tm_dmg_solid
subroutine tm_dmg_solid(elbuf_tab, nlay, nptr, npts, nptt, value, nel)
Definition outmaxsubr.F:514
tm_vonm_shell
subroutine tm_vonm_shell(for, value, nel)
Definition outmaxsubr.F:701
gpstra_solid
subroutine gpstra_solid(elbuf_tab, iparg, geo, pm, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, iad_elem, fr_elem, weight, str_n, itagps)
Definition outmaxsubr.F:136
tm_dmg_shells
subroutine tm_dmg_shells(elbuf_tab, nlay, nptr, npts, value, nel)
Definition outmaxsubr.F:941
tm_sig_shell
subroutine tm_sig_shell(elbuf_tab, nlay, nptr, npts, ten1, ten3, p2, nel)
Definition outmaxsubr.F:796
sig3d2pin
subroutine sig3d2pin(sig1, sig3, pin, nel)
Definition outmaxsubr.F:320
sig2dpin2
subroutine sig2dpin2(sig, pin, nel)
Definition outmaxsubr.F:225
tm_stra_solid
subroutine tm_stra_solid(elbuf_tab, nlay, nptr, npts, nptt, ten1, ten3, p2, nel)
Definition outmaxsubr.F:637
tm_vonm_solid
subroutine tm_vonm_solid(ivisc, sig, visc, value, nel)
Definition outmaxsubr.F:417
spmd_exch_n
subroutine spmd_exch_n(xnorm, iad_elem, fr_elem, lenr)
Definition spmd_exch_n.F:37
spmd_exch_nodareai
subroutine spmd_exch_nodareai(nodareai, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodareai.F:38
spmd_exch_v
subroutine spmd_exch_v(xnorm, nsiz, iad_elem, fr_elem, lenr)
Definition spmd_exch_v.F:33
tensgpstrain
subroutine tensgpstrain(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
Definition tensgpstrain.F:44
tensgps3
subroutine tensgps3(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
Definition tensor6.F:3916
upd_tmax
subroutine upd_tmax(elbuf_tab, iparg, geo, pm, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, d, v, iad_elem, fr_elem, weight, ipm, igeo, stack, itask)
Definition upd_outmax.F:57