OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mat119.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat119 (mtag, uparam, maxuparam, nuparam, pm, matparam, parmat, nuvar, mat_id, titr, maxtabl, numtabl, itable, unitab, lsubmodel, israte)

Function/Subroutine Documentation

◆ hm_read_mat119()

subroutine hm_read_mat119 ( type(mlaw_tag_), intent(inout) mtag,
dimension(maxuparam), intent(inout) uparam,
integer, intent(in) maxuparam,
integer, intent(inout) nuparam,
dimension(npropm), intent(inout) pm,
type(matparam_struct_), intent(inout) matparam,
dimension(100), intent(inout) parmat,
integer, intent(inout) nuvar,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr,
integer, intent(in) maxtabl,
integer, intent(inout) numtabl,
integer, dimension(maxtabl), intent(inout) itable,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(inout) israte )

Definition at line 38 of file hm_read_mat119.F.

42C-----------------------------------------------
43C D e s c r i p t i o n
44C =====================
45C READ MAT LAW119 WITH HM READER
46C-----------------------------------------------
47C DUMMY ARGUMENTS DESCRIPTION:
48C ===================
49C
50C NAME DESCRIPTION
51C
52C IPM MATERIAL ARRAY(INTEGER)
53C PM MATERIAL ARRAY(REAL)
54C UNITAB UNITS ARRAY
55C ID MATERIAL ID(INTEGER)
56C TITR MATERIAL TITLE
57C LSUBMODEL SUBMODEL STRUCTURE
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE unitab_mod
62 USE message_mod
63 USE submodel_mod
64 USE matparam_def_mod
65 USE elbuftag_mod
67C-----------------------------------------------
68C I m p l i c i t T y p e s
69C-----------------------------------------------
70#include "implicit_f.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "param_c.inc"
75#include "units_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 INTEGER ,INTENT(INOUT) :: NUPARAM,NUVAR,NUMTABL,ISRATE
80 INTEGER ,INTENT(IN) :: MAT_ID,MAXUPARAM,MAXTABL
81 INTEGER, DIMENSION(MAXTABL) ,INTENT(INOUT) :: ITABLE
82 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)::TITR
83 my_real ,INTENT(INOUT):: pm(npropm),parmat(100),uparam(maxuparam)
84 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
85 TYPE(SUBMODEL_DATA) ,INTENT(IN) :: LSUBMODEL(*)
86 TYPE(MLAW_TAG_) ,INTENT(INOUT) :: MTAG
87 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
88C-----------------------------------------------
89C L o c a l V a r i a b l e s
90C-----------------------------------------------
91 INTEGER FUNC1,FUNC2,IRELOAD
92 my_real :: nu,n12,e11,e22,g12,g23,g31,rcomp,det,c1,ssp,
93 . a11,a22,a12,a1c,a2c,gc,rho0,lmin,damp,fscale1,fscale2,fscalet,
94 . ecoat,nucoat,tcoat
95 LOGICAL IS_AVAILABLE,IS_ENCRYPTED
96C-----------------------------------------------
97C S o u r c e L i n e s
98c=======================================================================
99 is_encrypted = .false.
100 is_available = .false.
101
102 CALL hm_option_is_encrypted(is_encrypted)
103card1
104 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available,lsubmodel,unitab)
105 CALL hm_get_floatv('LMIN' ,lmin ,is_available,lsubmodel,unitab)
106card2
107 CALL hm_get_floatv('STIFF1' ,e11 ,is_available,lsubmodel,unitab)
108 CALL hm_get_floatv('DAMP1' ,damp ,is_available,lsubmodel,unitab)
109 CALL hm_get_floatv('RE' ,rcomp ,is_available,lsubmodel,unitab)
110card3
111 CALL hm_get_intv ('FUN_L' ,func1 ,is_available, lsubmodel)
112 CALL hm_get_intv ('FUN_UL' ,func2 ,is_available, lsubmodel)
113 CALL hm_get_floatv('Fcoeft1' ,fscale1 ,is_available,lsubmodel,unitab)
114 CALL hm_get_floatv('Fcoeft2' ,fscale2 ,is_available,lsubmodel,unitab)
115 CALL hm_get_intv ('Ireload' ,ireload ,is_available, lsubmodel)
116card4
117 CALL hm_get_floatv('E22' ,e22 ,is_available,lsubmodel,unitab)
118 CALL hm_get_floatv('NU12' ,n12 ,is_available,lsubmodel,unitab)
119 CALL hm_get_floatv('G12' ,g12 ,is_available,lsubmodel,unitab)
120 CALL hm_get_floatv('Fcoeft22' ,fscalet ,is_available,lsubmodel,unitab)
121card5
122 CALL hm_get_floatv('ECOAT' ,ecoat ,is_available,lsubmodel,unitab)
123 CALL hm_get_floatv('NUCOAT' ,nucoat ,is_available,lsubmodel,unitab)
124 CALL hm_get_floatv('TCOAT' ,tcoat ,is_available,lsubmodel,unitab)
125C
126 IF (func2 == func1) func2 = 0
127C
128c-----------------------------------------------------
129 pm(1) = rho0
130 pm(89)= rho0
131c
132 israte = -1
133 IF (n12 == zero) n12 = 0.19
134C-- Values are replaced in create_seatbelt.F when section is available
135 IF (e11 == zero) e11 = em20
136 IF (e22 == zero) e22 = em20
137 IF (g12 == zero) g12 = em20
138C
139 IF (fscale1 == zero) fscale1 = one
140 IF (fscale2 == zero) fscale2 = one
141 IF (fscalet == zero) fscalet = em01
142
143C-- stiffness of the shell is 1% of the total stiffness
144 fscale1 = em02*fscale1
145 fscale2 = em02*fscale2
146 fscalet = ep02*fscalet
147C
148C-----------------------------------------------------
149 IF (func1 == 0 .and. e11 == zero) THEN
150 CALL ancmsg(msgid=306, msgtype=msgerror, anmode=aninfo,
151 . i1=119,
152 . i2=mat_id,
153 . c1=titr,
154 . c2='E11')
155 ENDIF
156C-----------------------------------------
157 IF (rcomp == zero) rcomp = one
158 IF (rcomp < em03) THEN
159 CALL ancmsg(msgid=1572, msgtype=msgwarning, anmode=aninfo,
160 . i1=mat_id,
161 . c1=titr)
162 rcomp = em03
163 ENDIF
164C--------------------------------------------------------
165 IF (nucoat == zero) nucoat = n12
166 a1c = ecoat / (one - nucoat**2)
167 a2c = a1c * nucoat
168 gc = ecoat * half / (one + nucoat)
169c-----------------------------------------
170 uparam(1) = e11*em02
171 uparam(2) = e22
172 uparam(3) = n12
173 uparam(6) = g12
174 uparam(7) = zero ! A11 - calculated by seatbelt
175 uparam(8) = zero ! A22 - calculated by seatbelt
176 uparam(9) = zero ! A12 - calculated by seatbelt
177 uparam(10) = rcomp
178 uparam(11) = fscale1
179 uparam(12) = fscale2
180 uparam(13) = fscalet
181 uparam(14) = a1c ! coating
182 uparam(15) = a2c ! coating
183 uparam(16) = tcoat ! coating
184 uparam(18) = zero ! Xint
185 uparam(19) = zero ! Yint
186 uparam(20) = gc
187 uparam(21) = ireload
188c
189 nuparam = 22
190 nuvar = 10
191 numtabl = 2
192c
193 itable(1) = func1
194 itable(2) = func2
195c --------------------------
196C-- Values of C1,E11,E22 and N21 are computed in create_seatbelt.F when section is available
197C PARMAT(1) = C1
198C PARMAT(2) = MAX(E11,E22)
199C PARMAT(3) = SQRT(N12*N21)
200 parmat(4) = israte
201 parmat(5) = zero ! FCUT
202c
203c---- Definition of internal variables variables for seatbelts
204c
205 mtag%G_INTVAR = 7
206 mtag%G_SLIPRING_ID = 1
207 mtag%G_SLIPRING_FRAM_ID = 2
208 mtag%G_UPDATE = 1
209 mtag%G_ADD_NODE = 5
210 mtag%G_POSX = 2
211c
212c---------------------
213 CALL init_mat_keyword(matparam,"COMPRESSIBLE")
214 CALL init_mat_keyword(matparam,"SMALL_STRAIN")
215 CALL init_mat_keyword(matparam,"INCREMENTAL")
216c
217 ! Properties compatibility
218 CALL init_mat_keyword(matparam,"SHELL_ORTHOTROPIC")
219c----------------------------------------
220 WRITE(iout,1000) trim(titr),mat_id,119
221 WRITE(iout,1100)
222 IF (is_encrypted) THEN
223 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
224 ELSE
225 WRITE(iout,1200) rho0
226 IF (func1 == 0) THEN
227 WRITE(iout,1300) e11,e22,n12,g12,rcomp,lmin,damp
228 ELSE
229 WRITE(iout,1400) n12,g12,rcomp,lmin,damp,func1,func2,
230 . fscale1,fscale2,ireload,fscalet
231 END IF
232 IF (ecoat > zero) THEN
233 WRITE(iout,1500) ecoat,nucoat,tcoat
234 END IF
235 ENDIF
236c--------------------------------------
237 1000 FORMAT(
238 & 5x,a,/,
239 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . . . . =',i10/,
240 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . . . . =',i10/)
241 1100 FORMAT
242 &(5x,'ORTHOTROPIC MATERIAL FOR SEATBELTS (LAW119) ',/,
243 & 5x,'------------------------------------------- ',/)
244 1200 FORMAT(
245 & 5x,'MASS PER UNIT LENGTH . . . . . . . . . . . . . .=',1pg20.13/)
246 1300 FORMAT(
247 & 5x,'STIFFNESS PER UNIT LENGTH (TENSION) . . . . . . .=',1pg20.13/
248 & 5x,'YOUNG MODULUS E22 (TENSION) . . . . . . . . . . .=',1pg20.13/
249 & 5x,'POISSON RATIO NU12. . . . . . . . . . . . . . . .=',1pg20.13/
250 & 5x,'SHEAR MODULUS G12 . . . . . . . . . . . . . . . .=',1pg20.13/
251 & 5x,'COMPRESSION REDUCTION FACTOR. . . . . . . . . . . ',/
252 & 5x,' RCOMP=E11C/E11= E22C/E22 . . . . . . . . . .=',1pg20.13/
253 & 5x,'MINIMUM LENGTH LMIN. . . . . . . . .. . . . . . .=',1pg20.13/
254 & 5x,'DAMPING COEFFICIENT. . . . . . . . .. . . . . . .=',1pg20.13/)
255 1400 FORMAT(
256 & 5x,'POISSON RATIO NU12. . . . . . . . . . . . . . . .=',1pg20.13/
257 & 5x,'SHEAR MODULUS G12 . . . . . . . . . . . . . . . .=',1pg20.13/
258 & 5x,'COMPRESSION REDUCTION FACTOR. . . . . . . . . . . ',1pg20.13/
259 & 5x,'MINIMUM LENGTH LMIN. . . . . . . . .. . . . . . .=',1pg20.13/
260 & 5x,'DAMPING COEFFICIENT. . . . . . . . .. . . . . . .=',1pg20.13/
261 & 5x,'LOADING CURVE ID. . . . . . . . . . . . . . . . .=',1i10/
262 & 5x,'UNLOADING CURVE ID. . . . . . . . . . . . . . . .=',1i10/
263 & 5x,'LOADING CURVE SCALE FACTOR. . . . . . . . . . . .=',1pg20.13/
264 & 5x,'UNLOADING CURVE SCALE FACTOR. . . . . . . . . . .=',1pg20.13/
265 & 5x,'RELOADING FLAG. . . . . . . . . . . . . . . . . .=',1i10/
266 & 5x,'TRANSVERSE STIFFNESS SCALE FACTOR . . . . . . . .=',1pg20.13/)
267 1500 FORMAT(
268 & 5x,'YOUNG MODULUS OF COATING LAYER. . . . . . . . . .=',1pg20.13/
269 & 5x,'POISSON RATIO OF COATING LAYER. . . . . . . . . .=',1pg20.13/
270 & 5x,'THICKNESS OF COATING LAYER. . . . . . . . . . . .=',1pg20.13/)
271C-----------
272 RETURN
#define my_real
Definition cppsort.cpp:32
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 init_mat_keyword(matparam, keyword)
integer, parameter nchartitle
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