OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
m1ismstr10_pon.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!|| m1ismstr10_pon ../engine/source/materials/mat/mat001/m1ismstr10_pon.F
25!||--- called by ------------------------------------------------------
26!|| m1lawtot ../engine/source/materials/mat/mat001/m1lawtot.F
27!||--- calls -----------------------------------------------------
28!|| princ_u ../engine/source/materials/mat/mat001/princ_u.F
29!||====================================================================
30 SUBROUTINE m1ismstr10_pon(NEL ,
31 1 ES1 , ES2 ,ES3 ,ES4 ,ES5 ,
32 2 ES6 ,EPSTH, C1 ,G ,SIG )
33C-----------------------------------------------
34C I M P L I C I T T Y P E S
35C-----------------------------------------------
36#include "implicit_f.inc"
37C-----------------------------------------------
38C G L O B A L P A R A M E T E R S
39C-----------------------------------------------
40#include "mvsiz_p.inc"
41C-----------------------------------------------
42C C O M M O N
43C-----------------------------------------------
44C----------------------------------------------------------------
45C I N P U T A R G U M E N T S
46C----------------------------------------------------------------
47 INTEGER NEL
48 my_real
49 . es1(*), es2(*), es3(*),
50 . es4(*), es5(*), es6(*),
51 . sig(mvsiz,6), epsth(*),c1(*),g(*)
52C----------------------------------------------------------------
53C L O C A L V A R I B L E S
54C----------------------------------------------------------------
55 INTEGER I,J,K,IJK,IFAST(MVSIZ),NPRIN,INDEX(MVSIZ),NFAST
56 INTEGER :: IFAST1
57 INTEGER, DIMENSION(MVSIZ) :: IFAST1_INDEX
58 my_real
59 . sv(3),ev(mvsiz,3),dirprv(mvsiz,3,3),ekk,dav,p3,g2(mvsiz),
60 . espin1(mvsiz), espin2(mvsiz), espin3(mvsiz),
61 . espin4(mvsiz), espin5(mvsiz), espin6(mvsiz),
62 . e1, e2, e3, e4, e5, e6,espin(mvsiz,6),
63 . e1q,e2q,e3q,e4q,e5q,e6q,
64 . e1t,e2t,e3t,e4t,e5t,e6t,b2(6),emin,emax
65C----------------------------------------------------------------
66 g2(1:nel)=two*g(1:nel)
67 nprin = 0
68 ifast1 = 0
69 DO i=1,nel
70 ifast(i) =1
71 emin=min(es1(i),es2(i),es3(i),es4(i),es5(i),es6(i))
72 emax=max(es1(i),es2(i),es3(i),es4(i),es5(i),es6(i))
73 IF (emin<-em01.OR.emax>em01) THEN
74 nprin = nprin + 1
75 index(nprin) = i
76 ifast(i) =0
77 espin1(nprin)=es1(i)
78 espin2(nprin)=es2(i)
79 espin3(nprin)=es3(i)
80 espin4(nprin)=es4(i)
81 espin6(nprin)=es6(i)
82 espin5(nprin)=es5(i)
83 ELSE
84 ifast1 = ifast1 + 1
85 ifast1_index(ifast1) = i
86 END IF
87 ENDDO
88C
89#include "vectorize.inc"
90 DO ijk=1,ifast1
91 i = ifast1_index(ijk)
92 e1=es1(i)
93 e2=es2(i)
94 e3=es3(i)
95 e4=es4(i)
96 e6=es6(i)
97 e5=es5(i)
98 e1q = e1*e1
99 e2q = e2*e2
100 e3q = e3*e3
101 e4q = e4*e4
102 e6q = e6*e6
103 e5q = e5*e5
104 b2(1)=e1q+e4q+e6q
105 b2(2)=e4q+e2q+e5q
106 b2(3)=e6q+e5q+e3q
107 b2(4)=e1*e4+e2*e4+e5*e6
108 b2(6)=e1*e6+e4*e5+e3*e6
109 b2(5)=e4*e6+e2*e5+e3*e5
110 es1(i)=half*(e1-half*b2(1))
111 es2(i)=half*(e2-half*b2(2))
112 es3(i)=half*(e3-half*b2(3))
113 es4(i)=e4-half*b2(4)
114 es6(i)=e6-half*b2(6)
115 es5(i)=e5-half*b2(5)
116 ENDDO
117#include "vectorize.inc"
118 DO ijk=1,ifast1
119 i = ifast1_index(ijk)
120 ekk=es1(i)+es2(i)+es3(i)-epsth(i)
121 dav=-third*(es1(i)+es2(i)+es3(i))
122 p3 = c1(i)*ekk
123 sig(i,1)=p3+g2(i)*(es1(i)+dav)
124 sig(i,2)=p3+g2(i)*(es2(i)+dav)
125 sig(i,3)=p3+g2(i)*(es3(i)+dav)
126 sig(i,4)=g(i)*es4(i)
127 sig(i,5)=g(i)*es5(i)
128 sig(i,6)=g(i)*es6(i)
129 ENDDO
130C
131 IF (nprin>0) THEN
132 CALL princ_u(
133 1 nprin , espin1 , espin2 ,espin3 ,espin4 ,
134 2 espin5 ,espin6 ,ev , dirprv )
135#include "vectorize.inc"
136 DO k=1,nprin
137 i = index(k)
138 ekk=ev(k,1)+ev(k,2)+ev(k,3)
139 dav=-third*ekk
140 p3 = c1(i)*(ekk-epsth(i))
141 sv(1)=p3 +g2(i)*(ev(k,1)+dav)
142 sv(2)=p3 +g2(i)*(ev(k,2)+dav)
143 sv(3)=p3 +g2(i)*(ev(k,3)+dav)
144 sig(i,1) = dirprv(k,1,1)*dirprv(k,1,1)*sv(1)
145 . + dirprv(k,1,2)*dirprv(k,1,2)*sv(2)
146 . + dirprv(k,1,3)*dirprv(k,1,3)*sv(3)
147 sig(i,2) = dirprv(k,2,2)*dirprv(k,2,2)*sv(2)
148 . + dirprv(k,2,3)*dirprv(k,2,3)*sv(3)
149 . + dirprv(k,2,1)*dirprv(k,2,1)*sv(1)
150 sig(i,3) = dirprv(k,3,3)*dirprv(k,3,3)*sv(3)
151 . + dirprv(k,3,1)*dirprv(k,3,1)*sv(1)
152 . + dirprv(k,3,2)*dirprv(k,3,2)*sv(2)
153 sig(i,4) = dirprv(k,1,1)*dirprv(k,2,1)*sv(1)
154 . + dirprv(k,1,2)*dirprv(k,2,2)*sv(2)
155 . + dirprv(k,1,3)*dirprv(k,2,3)*sv(3)
156 sig(i,5) = dirprv(k,2,2)*dirprv(k,3,2)*sv(2)
157 . + dirprv(k,2,3)*dirprv(k,3,3)*sv(3)
158 . + dirprv(k,2,1)*dirprv(k,3,1)*sv(1)
159 sig(i,6) = dirprv(k,3,3)*dirprv(k,1,3)*sv(3)
160 . + dirprv(k,3,1)*dirprv(k,1,1)*sv(1)
161 . + dirprv(k,3,2)*dirprv(k,1,2)*sv(2)
162 ENDDO
163 END IF
164C
165 RETURN
166 END
m1ismstr10_pon
subroutine m1ismstr10_pon(nel, es1, es2, es3, es4, es5, es6, epsth, c1, g, sig)
Definition m1ismstr10_pon.F:33
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
princ_u
subroutine princ_u(nel, es1, es2, es3, es4, es5, es6, ev, dirprv)
Definition princ_u.F:33