OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat158.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_mat158 ../starter/source/materials/mat/mat158/hm_read_mat158.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_mat ../starter/source/materials/mat/hm_read_mat.F90
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.f
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_option_is_encrypted ../starter/source/devtools/hm_reader/hm_option_is_encrypted.F
33!|| init_mat_keyword ../starter/source/materials/mat/init_mat_keyword.F
34!||--- uses -----------------------------------------------------
35!|| elbuftag_mod ../starter/share/modules1/elbuftag_mod.F
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_mat158(MATPARAM ,NUVAR ,NFUNC ,
40 . MAXFUNC ,IFUNC ,MTAG ,UNITAB ,
41 . LSUBMODEL,MAT_ID ,TITR )
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE elbuftag_mod
47 USE message_mod
48 USE submodel_mod
49 USE matparam_def_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C ROUTINE DESCRIPTION :
53C ===================
54C READ MAT LAW158 WITH HM READER
55C-----------------------------------------------
56C DUMMY ARGUMENTS DESCRIPTION:
57C ===================
58C UNITAB UNITS ARRAY
59C MAT_ID MATERIAL ID(INTEGER)
60C TITR MATERIAL TITLE
61C LSUBMODEL SUBMODEL STRUCTURE
62C-----------------------------------------------
63C I m p l i c i t T y p e s
64C-----------------------------------------------
65#include "implicit_f.inc"
66C-----------------------------------------------
67C C o m m o n B l o c k s
68C-----------------------------------------------
69#include "units_c.inc"
70#include "param_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
75 INTEGER, INTENT(IN) :: MAT_ID,MAXFUNC
76 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
77 INTEGER, INTENT(INOUT) :: NUVAR,NFUNC
78 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
79 TYPE(submodel_data), DIMENSION(*),INTENT(IN) :: LSUBMODEL
80 TYPE(mlaw_tag_), INTENT(INOUT) :: MTAG
81 TYPE(matparam_struct_) ,INTENT(INOUT) :: MATPARAM
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
86 INTEGER :: I,ILAW,ISENS
87 my_real :: rho0,kflex,kflex1,kflex2,embc,embt,zerostress,
88 . lc0,lt0,dc0,dt0,hc0,ht0,stress_unit
89 my_real ,DIMENSION(5) :: yfac
90C=======================================================================
91 is_encrypted = .false.
92 is_available = .false.
93 ilaw = 158
94 nfunc = 5
95c-----------------------------------------------------------------------
96c
97 CALL hm_option_is_encrypted(is_encrypted)
98c
99card1
100 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
101card2
102 CALL hm_get_floatv('S1' ,embc ,is_available, lsubmodel, unitab)
103 CALL hm_get_floatv('S2' ,embt ,is_available, lsubmodel, unitab)
104 CALL hm_get_floatv('MAT_FLEX' ,kflex ,is_available, lsubmodel, unitab)
105 CALL hm_get_floatv('MAT_FLX1' ,kflex1 ,is_available, lsubmodel, unitab)
106 CALL hm_get_floatv('MAT_FLX2' ,kflex2 ,is_available, lsubmodel, unitab)
107card3
108 CALL hm_get_floatv('Zerostress' ,zerostress,is_available, lsubmodel, unitab)
109 CALL hm_get_intv ('ISENSOR' ,isens ,is_available, lsubmodel)
110card4
111 CALL hm_get_intv ('FUN_A1' ,ifunc(1) ,is_available, lsubmodel)
112 CALL hm_get_floatv('MAT_C1' ,yfac(1) ,is_available, lsubmodel, unitab)
113card5
114 CALL hm_get_intv ('FUN_A2' ,ifunc(2) ,is_available, lsubmodel)
115 CALL hm_get_floatv('MAT_C2' ,yfac(2) ,is_available, lsubmodel, unitab)
116card6
117 CALL hm_get_intv ('FUN_A3' ,ifunc(3) ,is_available, lsubmodel)
118 CALL hm_get_floatv('MAT_C3' ,yfac(3) ,is_available, lsubmodel, unitab)
119card7
120 CALL hm_get_intv ('FUN_A4' ,ifunc(4) ,is_available, lsubmodel)
121 CALL hm_get_intv ('FUN_A5' ,ifunc(5) ,is_available, lsubmodel)
122c-----------------------------------------------------------------------
123 IF (ifunc(1) == 0) THEN
124 CALL ancmsg(msgid=1578 , msgtype=msgerror, anmode=aninfo_blind_2,
125 . i1=mat_id,
126 . c1=titr)
127 ENDIF
128 IF (ifunc(2) == 0) THEN
129 CALL ancmsg(msgid=1579 , msgtype=msgerror, anmode=aninfo_blind_2,
130 . i1=mat_id,
131 . c1=titr)
132 ENDIF
133 IF (ifunc(3) == 0) THEN
134 CALL ancmsg(msgid=1580 , msgtype=msgerror, anmode=aninfo_blind_2,
135 . i1=mat_id,
136 . c1=titr)
137 ENDIF
138c-----------------------------------------------------------------------
139c Default values
140c-----------------------------------------------------------------------
141 CALL hm_get_floatv_dim('MAT_FLEX',stress_unit ,is_available, lsubmodel, unitab)
142c
143 IF (yfac(1) == zero) yfac(1) = one * stress_unit
144 IF (yfac(2) == zero) yfac(2) = one * stress_unit
145 IF (yfac(3) == zero) yfac(3) = one * stress_unit
146 IF (kflex1 == zero) kflex1 = one * stress_unit
147 IF (kflex2 == zero) kflex2 = one * stress_unit
148 IF (kflex == zero) kflex = one * stress_unit
149 IF (embc == zero) embc = em01
150 IF (embt == zero) embt = em01
151c-----------------------------------------------------------------------
152 lc0 = one
153 lt0 = one
154 dc0 = lc0 * (one + embc)
155 dt0 = lt0 * (one + embt)
156 hc0 = sqrt(dc0*dc0 - lc0*lc0)
157 ht0 = sqrt(dt0*dt0 - lt0*lt0)
158c-----------------------------------------------------------------------
159 nuvar = 40
160 matparam%NUPARAM = 14
161 matparam%NIPARAM = 1
162 matparam%NFUNC = nfunc
163!
164 ALLOCATE (matparam%UPARAM(matparam%NUPARAM))
165 ALLOCATE (matparam%IPARAM(matparam%NIPARAM))
166c-----------------------------------------------------------------------
167 matparam%IPARAM(1) = isens
168!
169 matparam%UPARAM( 1) = dc0
170 matparam%UPARAM( 2) = dt0
171 matparam%UPARAM( 3) = hc0
172 matparam%UPARAM( 4) = ht0
173 matparam%UPARAM( 5) = kflex
174 matparam%UPARAM( 6) = kflex1
175 matparam%UPARAM( 7) = kflex2
176 matparam%UPARAM( 8) = zerostress
177 matparam%UPARAM( 9) = 0 ! not used
178 matparam%UPARAM(10) = zero ! KTMAX = max fiber stiffness
179 matparam%UPARAM(11) = zero ! GMAX = max shear stiffness
180 matparam%UPARAM(12) = yfac(1)
181 matparam%UPARAM(13) = yfac(2)
182 matparam%UPARAM(14) = yfac(3)
183c--------------------------
184 matparam%RHO = rho0
185 matparam%RHO0 = rho0
186c--------------------------
187 CALL init_mat_keyword(matparam,"ANISOTROPIC")
188c
189 ! Properties compatibility
190 CALL init_mat_keyword(matparam,"SHELL_ANISOTROPIC")
191c--------------------------
192 mtag%L_ANG = 1
193c--------------------------------------------------
194c Starter output
195c--------------------------------------------------
196 WRITE(iout,1000) trim(titr),mat_id,ilaw
197 WRITE(iout,1100)
198 IF (is_encrypted) THEN
199 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
200 ELSE
201 WRITE(iout,1200) rho0,embc,embt,kflex,kflex1,kflex2,
202 . ifunc(1),ifunc(2),ifunc(3),ifunc(4),ifunc(5),
203 . yfac(1),yfac(2),yfac(3),isens,zerostress
204 ENDIF
205c-----------------------------------------------------------------------
206 1000 FORMAT(/
207 & 5x,a,/,
208 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . . . . =',i10/,
209 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . . . . =',i10/)
210 1100 FORMAT
211 &(5x,'MATERIAL MODEL : ANISOTROPIC FABRIC (LAW158) ',/,
212 & 5x,'-------------------------------------------- ',/)
213 1200 FORMAT(
214 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . . . .=',1pg20.13/
215 & 5x,'NOMINAL WARP STRETCH. . . . . . . . . . . . . . .=',1pg20.13/
216 & 5x,'NOMINAL WEFT STRETCH. . . . . . . . . . . . . . .=',1pg20.13/
217 & 5x,'COUPLING STIFFNESS MODULUS. . . . . . . . . . . .=',1pg20.13/
218 & 5x,'FLEX MODULUS (WARP) . . . . . . . . . . . . . .=',1pg20.13/
219 & 5x,'FLEX MODULUS (WEFT) . . . . . . . . . . . . . .=',1pg20.13/
220 & 5x,'LOADING STRESS FUNCTION ID IN WARP DIRECTION. . .=',i10/
221 & 5x,'LOADING STRESS FUNCTION ID IN WEFT DIRECTION. . .=',i10/
222 & 5x,'LOADING STRESS FUNCTION ID IN SHEAR . . . . . . .=',i10/
223 & 5x,'FLEX STRESS FUNCTION ID IN WARP DIRECTION . . . .=',i10/
224 & 5x,'FLEX STRESS FUNCTION ID IN WEFT DIRECTION . . . .=',i10/
225 & 5x,'LOADING FUNCTION SCALE FACTOR (WARP). . . . . . .=',1pg20.13/
226 & 5x,'LOADING FUNCTION SCALE FACTOR (WEFT). . . . . . .=',1pg20.13/
227 & 5x,'LOADING FUNCTION SCALE FACTOR (SHEAR) . . . . . .=',1pg20.13/
228 & 5x,'SENSOR ID . . . . . . . . . . . . . . . . . . . .=',i10/
229 & 5x,'REF-STATE STRESS RELAXATION FACTOR. . . . . . . .=',1pg20.13/)
230 1250 FORMAT(
231 & 5x,'YOUNG MODULUS E1 (WARP DIRECTION) . . . . . . . .=',1pg20.13/
232 & 5x,'YOUNG MODULUS E2 (WEFT DIRECTION) . . . . . . . .=',1pg20.13/)
233c-----------------------------------------------------------------------
234 RETURN
235 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:284
hm_read_mat158
subroutine hm_read_mat158(matparam, nuvar, nfunc, maxfunc, ifunc, mtag, unitab, lsubmodel, mat_id, titr)
Definition hm_read_mat158.F:42
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
elbuftag_mod
Definition elbuftag_mod.F:227
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
starter
program starter
Definition starter.F:39
elbuftag_mod::mlaw_tag_
Definition elbuftag_mod.F:232
submodel_mod::submodel_data
Definition submodel_mod.F:723