OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
law92_upd.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!|| law92_upd ../starter/source/materials/mat/mat092/law92_upd.F
25!||--- called by ------------------------------------------------------
26!|| updmat ../starter/source/materials/updmat.f
27!||--- calls -----------------------------------------------------
28!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.f
29!|| law92_nlsqf ../starter/source/materials/mat/mat092/law92_nlsqf.F90
30!||--- uses -----------------------------------------------------
31!|| law92_nlsqf_mod ../starter/source/materials/mat/mat092/law92_nlsqf.F90
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| table_mod ../starter/share/modules1/table_mod.F
34!||====================================================================
35 SUBROUTINE law92_upd(IOUT,TITR ,MAT_ID,UPARAM,NFUNC,NFUNCT,
36 . IFUNC, FUNC_ID,NPC ,PLD ,PM,IPM)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE law92_nlsqf_mod
41 USE message_mod
42 USE table_mod
43 USE names_and_titles_mod , ONLY : nchartitle
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 "param_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 CHARACTER(LEN=NCHARTITLE) :: TITR
56 INTEGER MAT_ID,IOUT
57 INTEGER ,INTENT(IN) :: NFUNC
58 INTEGER ,INTENT(IN) :: NFUNCT
59 INTEGER NPC(*), FUNC_ID(NFUNCT), IPM(NPROPMI)
60 my_real uparam(*),pld(*),pm(npropm)
61 INTEGER, DIMENSION(NFUNC):: IFUNC
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER K,ITEST,II,JJ,NSTART,IC1,IC2,NOGD,NDATA,NMULA,IFC
66 my_real nu,gs,rbulk,d,young,errtol,ave_slope,mu,mu_max,mu_min,dx,
67 . lam,beta,lam_max,lam_min,scalefac,amula(2)
68 my_real , DIMENSION(:), ALLOCATABLE :: stress,stretch!
69 LOGICAL IS_ENCRYPTED
70C====================================================================
71! IDENTIFICATION
72!====================================================================
73 is_encrypted = .false.
74 CALL hm_option_is_encrypted(is_encrypted)
75 !!
76 nstart = 2
77 errtol = fiveem3
78 ifc = ifunc(1)
79 ic1 = npc(ifc)
80 ic2 = npc(ifc+1)
81 scalefac = uparam(14)
82 nogd=(ic2-ic1)/2
83 ndata=nogd
84c
85 ALLOCATE (stretch(nogd))
86 ALLOCATE (stress(nogd))
87c
88 ave_slope = zero
89 jj=0
90 stretch=zero
91 stress=zero
92 mu=zero
93 rbulk=zero
94 gs=zero
95 lam_max= zero
96 lam_min= zero
97c
98 DO ii = ic1,ic2-2,2
99 jj=jj+1
100 stretch(jj) = pld(ii) + one
101 stress(jj) = scalefac * pld(ii+1)
102 lam_max = max(lam_max, abs(stretch(jj)))
103 ENDDO
104c
105 nogd = jj
106 mu_max = zero
107 mu_min = 1e20
108 DO k = 1, ndata
109 dx = stretch(k) - one
110c avolid dx to be too small
111 IF (dx >= zero) THEN
112 dx = max(dx, em6)
113 ELSE
114 dx = abs(dx)
115 ENDIF
116 mu_max = max(mu_max, stress(k) / dx)
117 ave_slope = ave_slope + abs(stress(k)) / dx
118 ENDDO
119c
120 ave_slope = ave_slope / (one * ndata)
121 mu= ave_slope
122c initial value
123 lam = max(seven,three*lam_max)
124C
125 nmula = 2
126 amula(1) = max(mu,mu_max)
127 amula(2) = lam
128 itest = uparam(12)
129 !----------------
130 IF(is_encrypted)THEN
131 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
132 ELSE
133 WRITE(iout,1000)
134 WRITE(iout,1001)trim(titr),mat_id
135 ENDIF
136 !----
137c------------------------------------------------------
138 CALL law92_nlsqf(stretch,stress,nmula,nogd,amula,
139 . nstart, errtol,mat_id,titr,itest)
140c------------------------------------------------------
141 DEALLOCATE (stretch)
142 DEALLOCATE (stress)
143 nu = uparam(11)
144 mu = amula(1)
145 lam = amula(2)
146 beta = one/lam/lam
147 gs = mu*(one + three*beta /five + eighty19*beta*beta/175.
148 . + 513.*beta**3/875. + 42039.*beta**4/67375.)
149 rbulk=two*gs*(one+nu)
150 . /max(em30,three*(one-two*nu))
151 d= two/rbulk
152 uparam(1)=mu
153 uparam(2)=d
154 uparam(3)=lam
155 uparam(4)=gs
156 uparam(5)=rbulk
157c parameters
158 young = two*gs*(one + nu)
159 pm(20) = young
160 pm(21) = nu
161 pm(22) = gs
162 pm(24) = young/(one - nu**2)
163 pm(32) = rbulk
164 pm(100) = rbulk !PARMAT(1)
165C-----------
166C Formulation for solid elements time step computation.
167 ipm(252)= 2
168 pm(105) = two*gs/(rbulk + four_over_3*gs)
169C
170 IF(.NOT.is_encrypted) WRITE(iout,1100)mu,d,lam,gs,rbulk
171c----------------
172c end of optimization loop
173c----------------
174 RETURN
175c----------------
176 1000 FORMAT
177 & (//5x, 'FITTED PARAMETERS FOR HYPERELASTIC_MATERIAL LAW92 ' ,/,
178 & 5x, ' --------------------------------------------------')
179 1001 FORMAT(
180 & 5x,a,/,
181 & 5x, 'MATERIAL NUMBER =',i10,//)
182 1100 FORMAT(
183C
184 & 5x,'ARRUDA-BOYCE LAW',/,
185 & 5x,'MU . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
186 & 5x,'D. . . . . . . . . . . . . . . . . . . . .=',1pg20.13/
187 & 5x,'LAM. . . . . . . . . . . . . . . . . . . .=',1pg20.13/
188 & 5x,'INITIAL SHEAR MODULUS. . . . . . . . . . .=',1pg20.13/
189 & 5x,'BULK MODULUS . . . . . . . . . . . . . . .=',1pg20.13//)
190c-----------
191 RETURN
192 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
law92_upd
subroutine law92_upd(iout, titr, mat_id, uparam, nfunc, nfunct, ifunc, func_id, npc, pld, pm, ipm)
Definition law92_upd.F:37
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
table_mod
Definition table_mod.F:113
starter
program starter
Definition starter.F:39
updmat
subroutine updmat(bufmat, pm, ipm, table, func_id, npc, pld, sensors, nloc_dmg, mlaw_tag, mat_param)
Definition updmat.F:77