OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
biquad_coefficients.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!|| biquad_coefficients ../starter/source/materials/fail/biquad/biquad_coefficients.F
25!||--- called by ------------------------------------------------------
26!|| cfailini ../starter/source/elements/shell/coque/cfailini.F
27!|| cfailini4 ../starter/source/elements/shell/coque/cfailini.F
28!|| failini ../starter/source/elements/solid/solide/failini.F
29!|| hm_read_fail_biquad ../starter/source/materials/fail/biquad/hm_read_fail_biquad.F
30!||--- calls -----------------------------------------------------
31!||====================================================================
32 SUBROUTINE biquad_coefficients(
33 . C1 ,C2 ,C3 ,C4 ,C5 ,L ,
34 . X_1 ,X_2 ,E1 ,E2 ,E3 ,E4 )
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39#include "scr05_c.inc"
40C-----------------------------------------------
41C D u m m y A r g u m e n t s
42C-----------------------------------------------
43 INTEGER L
44 my_real C1,C2,C3,C4,C5
45 my_real e1,e2,e3,e4
46 my_real x_1(2),x_2(3)
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I, J, K, IPIV2(2), IPIV3(3), INFO
51 my_real TRIAX_1_LIN, TRIAX_2_LIN, TRIAX_3_LIN,
52 . triax_4_lin, triax_5_lin
53 my_real triax_1_quad, triax_2_quad,
54 . triax_3_quad, triax_4_quad, triax_5_quad
55 my_real a_1(2,2), b_1(2)
56 my_real a_2(3,3), b_2(3)
57 DATA triax_1_lin, triax_2_lin, triax_3_lin, triax_4_lin,
58 . triax_5_lin
59 . / -0.33333333, 0.0, 0.33333333, 0.57735, 0.66666667 /
60 DATA triax_1_quad, triax_2_quad, triax_3_quad,
61 . triax_4_quad, triax_5_quad
62 . / 0.111111, 0.0, 0.111111, 0.333333, 0.444444 /
63#ifndef without_linalg
64C=======================================================================
65C
66C pre definition for user-input data when only
67C tension test data are provided
68C
69C=============================================
70 IF (l/=0)THEN
71 IF (l == 1) THEN ! Mild Seel (c3 = 0.6)
72 c1 = 3.5 * c3
73 c2 = 1.6 * c3
74 c4 = 0.6 * c3
75 c5 = 1.5 * c3
76 ELSEIF (l == 2) THEN ! DP600 (c3 = 0.5)
77 c1 = 4.3 * c3
78 c2 = 1.4 * c3
79 c4 = 0.6 * c3
80 c5 = 1.6 * c3
81 ELSEIF (l == 3) THEN ! Boron (c3 = 0.12)
82 c1 = 5.2 * c3
83 c2 = 3.1 * c3
84 c4 = 0.8 * c3
85 c5 = 3.5 * c3
86 ELSEIF (l == 4) THEN ! Aluminium AA5182 (c3 = 0.3)
87 c1 = 5.0 * c3
88 c2 = 1.0 * c3
89 c4 = 0.4 * c3
90 c5 = 0.8 * c3
91 ELSEIF (l == 5) THEN ! Aluminium AA6082-T6 (c3 = 0.17)
92 c1 = 7.8 * c3
93 c2 = 3.5 * c3
94 c4 = 0.6 * c3
95 c5 = 2.8 * c3
96 ELSEIF (l == 6) THEN ! Plastic light_eBody PA6GF30 (c3 = 0.1)
97 c1 = 3.6 * c3
98 c2 = 0.6 * c3
99 c4 = 0.5 * c3
100 c5 = 0.6 * c3
101 ELSEIF (l == 7) THEN ! Plastic light_eBody PP T40 ( c3=0.11 )
102 c1 = 10.0 * c3
103 c2 = 2.7 * c3
104 c4 = 0.6 * c3
105 c5 = 0.7 * c3
106 ELSEIF (l == 99) THEN ! user scalling factors
107 c1 = e1 * c3
108 c2 = e2 * c3
109 c4 = e3 * c3
110 c5 = e4 * c3
111 ELSE ! ELSE --> Mild Seel
112 c1 = 3.5 * c3
113 c2 = 1.6 * c3
114 c4 = 0.6 * c3
115 c5 = 1.5 * c3
116 ENDIF
117 ELSEIF(c1 == zero .AND. c2 == zero .AND. c4 == zero .AND. c5 == zero) THEN
118 c1 = 3.5 * c3
119 c2 = 1.6 * c3
120 c4 = 0.6 * c3
121 c5 = 1.5 * c3
122 ENDIF
123C=======================================================================
124C
125C determine coefficient matrix for parable_1
126C
127C=======================================================================
128 a_1(1,1) = triax_1_lin
129 a_1(1,2) = triax_1_quad
130 a_1(2,1) = triax_3_lin
131 a_1(2,2) = triax_3_quad
132 b_1(1) = c1 - c2
133 b_1(2) = c3 - c2
134C
135C! fitting the first quadratic function
136 IF (iresp == 0) THEN
137 CALL dgesv(2, 1, a_1, 2, ipiv2, b_1, 2, info)
138 ELSE
139 CALL sgesv(2, 1, a_1, 2, ipiv2, b_1, 2, info)
140 ENDIF
141 x_1(1:2) = b_1(1:2)
142C
143C
144C=======================================================================
145C
146C determine coefficient matrix for parable_2
147C
148C=======================================================================
149 a_2(1,1) = 1.0
150 a_2(1,2) = triax_3_lin
151 a_2(1,3) = triax_3_quad
152 a_2(2,1) = 1.0
153 a_2(2,2) = triax_4_lin
154 a_2(2,3) = triax_4_quad
155 a_2(3,1) = 1.0
156 a_2(3,2) = triax_5_lin
157 a_2(3,3) = triax_5_quad
158 b_2(1) = c3
159 b_2(2) = c4
160 b_2(3) = c5
161C
162C! fitting the second quadratic function
163 IF (iresp == 0) THEN
164 CALL dgesv(3, 1, a_2, 3, ipiv3, b_2, 3, info)
165 ELSE
166 CALL sgesv(3, 1, a_2, 3, ipiv3, b_2, 3, info)
167 ENDIF
168 x_2(1:3) = b_2(1:3)
169#else
170 WRITE(6,*) "Error: Blas/Lapack required for /FAIL/BIQUAD"
171#endif
172C
173c------------
174 RETURN
175 END
biquad_coefficients
subroutine biquad_coefficients(c1, c2, c3, c4, c5, l, x_1, x_2, e1, e2, e3, e4)
Definition biquad_coefficients.F:35
dgesv
subroutine dgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
DGESV computes the solution to system of linear equations A * X = B for GE matrices
Definition dgesv.f:122
sgesv
subroutine sgesv(n, nrhs, a, lda, ipiv, b, ldb, info)
SGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver)
Definition sgesv.f:122