OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
table_slope.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!|| table_slope ../starter/source/materials/tools/table_slope.F
25!||--- called by ------------------------------------------------------
26!|| law163_upd ../starter/source/materials/mat/mat163/law163_upd.F90
27!|| law70_upd ../starter/source/materials/mat/mat070/law70_upd.F
28!||--- uses -----------------------------------------------------
29!|| message_mod ../starter/share/message_module/message_mod.F
30!||====================================================================
31 SUBROUTINE table_slope(TABLE,STIFFINI,STIFFMIN,STIFFMAX,XMAX)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE message_mod
36 USE table4d_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C D u m m y A r g u m e n t s
43C-----------------------------------------------
44 TYPE(table_4d_) ,INTENT(IN) :: TABLE
45 my_real ,INTENT(OUT) :: stiffini,stiffmin,stiffmax ! initial, min and max function slopes
46 my_real ,INTENT(OUT) :: xmax ! first abscissa corresponding to the max slope
47C-----------------------------------------------
48C L o c a l V a r i a b l e s
49C-----------------------------------------------
50 INTEGER I,J,K,L,NDIM,NPT,LEN2,LEN3,LEN4
51 my_real x1,x2,y1,y2,dx,dy,dydx
52C=======================================================================
53 ! COMPUTE INITIAL, MIN and MAX SLOPE OF A FUNCTION TABLE
54C=======================================================================
55 stiffini = zero
56 stiffmax = zero
57 stiffmin = ep20
58 xmax = zero
59 y1 = 0
60 ndim = table%NDIM
61 npt = SIZE(table%X(1)%VALUES)
62c
63 IF (ndim == 1) THEN
64 x1 = table%X(1)%VALUES(1)
65 y1 = table%Y1D(1)
66 IF (x1 >= zero) THEN
67 dx = table%X(1)%VALUES(2) - x1
68 dy = table%Y1D(2) - y1
69 stiffini = dy/dx
70 ENDIF
71 DO i = 2,npt
72 x2 = table%X(1)%VALUES(i)
73 y2 = table%Y1D(i)
74 dx = x2 - x1
75 dy = y2 - y1
76 dydx = dy/dx
77 IF (dydx > stiffmax) THEN
78 stiffmax = dydx
79 xmax = x1
80 END IF
81 stiffmin = min(stiffmin,dydx)
82 IF (x1 == zero .or. x2 == zero) THEN
83 stiffini = max(stiffini, dydx)
84 ENDIF
85 x1 = x2
86 y1 = y2
87 ENDDO
88c
89 ELSE IF (ndim == 2) THEN
90 len2 = SIZE(table%X(2)%VALUES)
91 x1 = table%X(1)%VALUES(1)
92 y1 = table%Y2D(1,1)
93 y2 = 0
94 DO i = 2,npt
95 x2 = table%X(1)%VALUES(i)
96 dx = x2 - x1
97 DO j = 1,len2
98 y2 = table%Y2D(i,j)
99 dy = y2 - y1
100 dydx = dy/dx
101 IF (dydx > stiffmax) THEN
102 stiffmax = dydx
103 xmax = x1
104 END IF
105 stiffmin = min(stiffmin,dydx)
106 IF (x1 == zero .or. x2 == zero) THEN
107 stiffini = max(stiffini, dydx)
108 ENDIF
109 ENDDO
110 y1 = y2
111 x1 = x2
112 ENDDO
113c
114 ELSE IF (ndim == 3) THEN
115 len2 = SIZE(table%X(2)%VALUES)
116 len3 = SIZE(table%X(3)%VALUES)
117 x1 = table%X(1)%VALUES(1)
118 DO i = 2,npt
119 x2 = table%X(1)%VALUES(i)
120 dx = x2 - x1
121 DO j = 1,len2
122 DO k = 1,len3
123 y1 = table%Y3D(i-1,j,k)
124 y2 = table%Y3D(i ,j,k)
125 dy = y2 - y1
126 dydx = dy/dx
127 IF (dydx > stiffmax) THEN
128 stiffmax = dydx
129 xmax = x1
130 END IF
131 stiffmin = min(stiffmin,dydx)
132 IF (x1 == zero .or. x2 == zero) THEN
133 stiffini = max(stiffini, dydx)
134 ENDIF
135 ENDDO
136 ENDDO
137 x1 = x2
138 ENDDO
139c
140 ELSE IF (ndim == 4) THEN
141 len2 = SIZE(table%X(2)%VALUES)
142 len3 = SIZE(table%X(3)%VALUES)
143 len4 = SIZE(table%X(4)%VALUES)
144 x1 = table%X(1)%VALUES(1)
145 DO i = 2,npt
146 x2 = table%X(1)%VALUES(i)
147 dx = x2 - x1
148 DO j = 1,len2
149 DO k = 1,len3
150 DO l = 1,len4
151 y1 = table%Y4D(i-1,j,k,l)
152 y2 = table%Y4D(i ,j,k,l)
153 dy = y2 - y1
154 dydx = dy/dx
155 IF (dydx > stiffmax) THEN
156 stiffmax = dydx
157 xmax = x1
158 END IF
159 stiffmin = min(stiffmin,dydx)
160 IF (x1 == zero .or. x2 == zero) THEN
161 stiffini = max(stiffini, dydx)
162 ENDIF
163 ENDDO
164 ENDDO
165 ENDDO
166 x1 = x2
167 ENDDO
168c
169 END IF
170c-----------
171 RETURN
172 END
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
table4d_mod
Definition table4d_mod.F:52
table4d_mod::table_4d_
Definition table4d_mod.F:60
table_slope
subroutine table_slope(table, stiffini, stiffmin, stiffmax, xmax)
Definition table_slope.F:32