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