OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_fail_puck.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!|| hm_read_fail_puck ../starter/source/materials/fail/puck/hm_read_fail_puck.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_fail ../starter/source/materials/fail/hm_read_fail.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
31!||--- uses -----------------------------------------------------
32!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
33!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE hm_read_fail_puck(FAIL ,
37 . MAT_ID ,FAIL_ID ,IRUPT ,
38 . LSUBMODEL,UNITAB ,FAIL_TAG )
39C-----------------------------------------------
40c ROUTINE DESCRIPTION :
41c Read Puck failure model parameters
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE fail_param_mod
46 USE unitab_mod
47 USE submodel_mod
49 USE elbuftag_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "units_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 INTEGER ,INTENT(IN) :: FAIL_ID !< failure model ID
62 INTEGER ,INTENT(IN) :: MAT_ID !< material law ID
63 INTEGER ,INTENT(IN) :: IRUPT !< failure model type number
64 TYPE(unit_type_) ,INTENT(IN) :: UNITAB !< table of input units
65 TYPE(submodel_data),INTENT(IN) :: LSUBMODEL(*) !< submodel table
66 TYPE(fail_param_) ,INTENT(INOUT) :: FAIL !< failure model data structure
67 TYPE (FAIL_TAG_) ,INTENT(INOUT) :: FAIL_TAG !< failure model tag for buffer allocation
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER IFAIL_SH ,ISOLID
72 my_real
73 . sigt1,sigt2,sigt12,sigc1,sigc2,
74 . pn12,pp12,pn22,tmax,fcut,pthkf
75 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
76C--------------------------------------------------
77C S o u r c e L i n e s
78C--------------------------------------------------
79 is_encrypted = .false.
80 is_available = .false.
81
82 CALL hm_option_is_encrypted(is_encrypted)
83
84c---------------------------
85 CALL hm_get_floatv ('Sigma_1t' ,sigt1 ,is_available,lsubmodel,unitab)
86 CALL hm_get_floatv ('Sigma_2t' ,sigt2 ,is_available,lsubmodel,unitab)
87 CALL hm_get_floatv ('Sigma_12' ,sigt12 ,is_available,lsubmodel,unitab)
88 CALL hm_get_floatv ('Sigma_1c' ,sigc1 ,is_available,lsubmodel,unitab)
89 CALL hm_get_floatv ('Sigma_2c' ,sigc2 ,is_available,lsubmodel,unitab)
90
91 CALL hm_get_floatv ('p12_Positive' ,pp12 ,is_available,lsubmodel,unitab)
92 CALL hm_get_floatv ('p12_Negative' ,pn12 ,is_available,lsubmodel,unitab)
93 CALL hm_get_floatv ('p22_Negative' ,pn22 ,is_available,lsubmodel,unitab)
94 CALL hm_get_floatv ('Tau_max' ,tmax ,is_available,lsubmodel,unitab)
95 CALL hm_get_intv ('Ifail_sh' ,ifail_sh ,is_available,lsubmodel)
96 CALL hm_get_intv ('Ifail_so' ,isolid ,is_available,lsubmodel)
97
98 CALL hm_get_floatv ('Fcut' ,fcut ,is_available,lsubmodel,unitab)
99c---------------------------
100 IF (sigt1 == zero) sigt1 = ep20
101 IF (sigt2 == zero) sigt2 = ep20
102 IF (sigt12 == zero) sigt12 = ep20
103 IF (sigc1 == zero) sigc1 = ep20
104 IF (sigc2 == zero) sigc2 = ep20
105 IF (tmax == zero) tmax = ep20
106 IF (ifail_sh == 0) ifail_sh = 1
107 IF (isolid == 0) isolid = 1
108c
109 IF (ifail_sh == 1) THEN
110 pthkf = em06
111 ELSEIF (ifail_sh == 2) THEN
112 pthkf = one
113 ENDIF
114 fcut = max(zero,fcut)
115c---------------------------
116 fail%KEYWORD = 'PUCK'
117 fail%IRUPT = irupt
118 fail%FAIL_ID = fail_id
119 fail%NUPARAM = 12
120 fail%NIPARAM = 0
121 fail%NUVAR = 14
122 fail%NFUNC = 0
123 fail%NTABLE = 0
124 fail%NMOD = 5
125 fail%PTHK = pthkf
126c
127 ALLOCATE (fail%UPARAM(fail%NUPARAM))
128 ALLOCATE (fail%IPARAM(fail%NIPARAM))
129 ALLOCATE (fail%IFUNC (fail%NFUNC))
130 ALLOCATE (fail%TABLE (fail%NTABLE))
131c
132 ! Modes of failure
133 fail_tag%LF_DAMMX = fail_tag%LF_DAMMX + fail%NMOD
134 ALLOCATE (fail%MODE(fail%NMOD))
135 fail%MODE(1) = "Tensile fiber failure"
136 fail%MODE(2) = "Compression fiber failure"
137 fail%MODE(3) = "Inter-fiber failure A"
138 fail%MODE(4) = "Inter-fiber failure B"
139 fail%MODE(5) = "Inter-fiber failure C"
140c
141 fail%UPARAM(1) = sigt1
142 fail%UPARAM(2) = sigt2
143 fail%UPARAM(3) = sigc1
144 fail%UPARAM(4) = sigc2
145 fail%UPARAM(5) = sigt12
146 fail%UPARAM(6) = pp12
147 fail%UPARAM(7) = pn12
148 fail%UPARAM(8) = pn22
149 fail%UPARAM(9) = tmax
150 fail%UPARAM(10) = ifail_sh
151 fail%UPARAM(11) = isolid
152 fail%UPARAM(12) = fcut
153c---------------------------
154 IF(is_encrypted)THEN
155
156 ELSE
157 WRITE(iout, 1000)sigt1,sigt2,sigt12,sigc1,sigc2,pp12,pn12,pn22,tmax,fcut
158 IF(ifail_sh==1)THEN
159 WRITE(iout, 1100)
160 ELSEIF(ifail_sh==2)THEN
161 WRITE(iout, 1200)
162 ENDIF
163 ENDIF
164c-----------
165 1000 FORMAT(
166 & 5x,40h modified puck failure model /,
167 & 5x,40h ------------------------ /,
168 & 5x,'Longitudinal tensile strength . . . . . . . =',e12.4/
169 & 5x,'Transversal tensile strength . . . . . . . =',e12.4/
170 & 5x,'Shear strength . . . . . . . . . . . . . . =',e12.4/
171 & 5x,'Longitudinal compressive strength . . . . . =',e12.4/
172 & 5x,'transversal compressive strength . . . . =',E12.4/
173 & 5X,'failure envelop parameter in direction 12 (-) . =',E12.4/
174 & 5X,'failure envelop parameter in direction 12 (+) . =',E12.4/
175 & 5X,'failure envelop parameter in direction 22 (-) . =',E12.4/
176 & 5X,' relaxation time . . . . . . . . . . . . . =',E12.4/
177 & 5X,'stress tensor filtering frequency . . . . . =',E12.4/)
178 1100 FORMAT(
179 & 5X,' shell is deleted IF criteria is reached for one layer ')
180 1200 FORMAT(
181 & 5X,' shell tensor stress is set to zero and shell is deleted',/
182 & 5X,' IF criteria is reached for all layers' )
183c-----------
184 RETURN
185 END
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
subroutine hm_read_fail_puck(fail, mat_id, fail_id, irupt, lsubmodel, unitab, fail_tag)
#define max(a, b)
Definition macros.h:21
for(i8=*sizetab-1;i8 >=0;i8--)