OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_fail_wilkins.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_wilkins ../starter/source/materials/fail/wilkins/hm_read_fail_wilkins.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!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
33!|| submodel_mod ../starter/share/modules1/submodel_mod.F
34!||====================================================================
35 SUBROUTINE hm_read_fail_wilkins(FAIL ,
36 . MAT_ID ,FAIL_ID ,IRUPT ,LSUBMODEL,UNITAB )
37C-----------------------------------------------
38C ROUTINE DESCRIPTION :
39C ===================
40C READ FAILURE WILKINS
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE fail_param_mod
45 USE unitab_mod
46 USE submodel_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "units_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER ,INTENT(IN) :: FAIL_ID ! failure model ID
60 INTEGER ,INTENT(IN) :: MAT_ID ! material law ID
61 INTEGER ,INTENT(IN) :: IRUPT ! failure model number
62 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB ! table of input units
63 TYPE (SUBMODEL_DATA),INTENT(IN) :: LSUBMODEL(*)
64 TYPE (FAIL_PARAM_) ,INTENT(INOUT) :: FAIL
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER :: IMARGIN,IENG
69 my_real :: rani,dadv,fact_margin,fact_loosemetal
70 INTEGER :: IFAIL_SH, IFAIL_SO
71 my_real :: pc,alpha,beta,df,pthkf
72 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
73C--------------------------------------------------
74C S o u r c e L i n e s
75C--------------------------------------------------
76 is_encrypted = .false.
77 is_available = .false.
78
79 CALL hm_option_is_encrypted(is_encrypted)
80
81 CALL hm_get_floatv ('Alpha' ,alpha ,is_available,lsubmodel,unitab)
82 CALL hm_get_floatv ('Beta_WILKINS' ,beta ,is_available,lsubmodel,unitab)
83 CALL hm_get_floatv ('Plim' ,pc ,is_available,lsubmodel,unitab)
84 CALL hm_get_floatv ('Df' ,df ,is_available,lsubmodel,unitab)
85
86 CALL hm_get_intv ('Ifail_sh' ,ifail_sh ,is_available,lsubmodel)
87 CALL hm_get_intv ('Ifail_so' ,ifail_so ,is_available,lsubmodel)
88
89c-----------------------------------------------------------------------
90 IF (ifail_sh==0) ifail_sh=1
91 IF (ifail_so==0) ifail_so=1
92 IF (pc == zero) pc=ep20
93 IF (df <= zero) df=ep20
94c
95 IF (ifail_sh == 1) THEN
96 pthkf = em06
97 ELSEIF (ifail_sh == 2) THEN
98 pthkf = one
99 ENDIF
100c
101 fail%KEYWORD = 'WILKINS'
102 fail%IRUPT = irupt
103 fail%FAIL_ID = fail_id
104 fail%NUPARAM = 6
105 fail%NIPARAM = 0
106 fail%NUVAR = 1
107 fail%NFUNC = 0
108 fail%NTABLE = 0
109 fail%NMOD = 0
110 fail%PTHK = pthkf
111c
112 ALLOCATE (fail%UPARAM(fail%NUPARAM))
113 ALLOCATE (fail%IPARAM(fail%NIPARAM))
114 ALLOCATE (fail%IFUNC (fail%NFUNC))
115 ALLOCATE (fail%TABLE (fail%NTABLE))
116c
117 fail%UPARAM(1) = alpha
118 fail%UPARAM(2) = beta
119 fail%UPARAM(3) = pc
120 fail%UPARAM(4) = df
121 fail%UPARAM(5) = ifail_sh
122 fail%UPARAM(6) = ifail_so
123c---------------------------
124c OUTPUT
125c---------------------------
126 IF(is_encrypted)THEN
127 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
128 ELSE
129 WRITE(iout, 1000)alpha,beta,pc,df
130 IF(ifail_sh==1)THEN
131 WRITE(iout, 1100)
132 ELSEIF(ifail_sh==2)THEN
133 WRITE(iout, 1200)
134 ENDIF
135 IF(ifail_so==1)THEN
136 WRITE(iout, 2100)
137 ELSEIF(ifail_so==2)THEN
138 WRITE(iout, 2200)
139 ENDIF
140 ENDIF
141c---------------------------
142 1000 FORMAT(
143 & 5x,40h wilkins damage model /,
144 & 5x,40h -------------------- /,
145 & 5x,40hhydrostatic pressure coefficient. . . .=,1pe20.13/,
146 & 5x,40hdeviatorc coefficient . . . . . . . .=,1pe20.13/,
147 & 5x,40hlimite pression . . . . . . . . . .=,1pe20.13/,
148 & 5x,40hcritical damage . . . . . . . . . .=,1pe20.13/ )
149 1100 FORMAT(
150 & 5x,' SHELL ELEMENT DELETION ')
151 2100 FORMAT(
152 & 5x,' SOLID ELEMENT DELETION ')
153
154 1200 FORMAT(
155 & 5x,' SHELL TENSOR STRESS OF LAYER WILL BE VANISHED ')
156 2200 FORMAT(
157 & 5x,' DEVIATORIC STRESS WILL BE VANISHED ')
158c---------------------------
159 RETURN
160 END
#define my_real
Definition cppsort.cpp:32
#define alpha
Definition eval.h:35
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_wilkins(fail, mat_id, fail_id, irupt, lsubmodel, unitab)
program starter
Definition starter.F:39