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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_mat58 (matparam, nuvar, nfunc, maxfunc, ifunc, mtag, parmat, unitab, lsubmodel, mat_id, titr)

Function/Subroutine Documentation

◆ hm_read_mat58()

subroutine hm_read_mat58 ( type(matparam_struct_), intent(inout) matparam,
integer, intent(inout) nuvar,
integer, intent(inout) nfunc,
integer, intent(in) maxfunc,
integer, dimension(maxfunc), intent(inout) ifunc,
type(mlaw_tag_), intent(inout) mtag,
intent(inout) parmat,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
integer, intent(in) mat_id,
character(len=nchartitle), intent(in) titr )

Definition at line 39 of file hm_read_mat58.F.

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 LAW58 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 INTEGER, INTENT(IN) :: MAT_ID,MAXFUNC
75 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
76 INTEGER, INTENT(INOUT) :: NUVAR,NFUNC
77 INTEGER, DIMENSION(MAXFUNC) ,INTENT(INOUT) :: IFUNC
78 my_real, DIMENSION(100) ,INTENT(INOUT) :: parmat
79 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
80 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
81 TYPE(MLAW_TAG_) ,INTENT(INOUT) :: MTAG
82 TYPE(MATPARAM_STRUCT_) ,INTENT(INOUT) :: MATPARAM
83C-----------------------------------------------
84C L o c a l V a r i a b l e s
85C-----------------------------------------------
86 LOGICAL :: IS_AVAILABLE,IS_ENCRYPTED
87 INTEGER :: I,ILAW,NC,NT,ISENS,ILOAD,ULOAD
88 my_real :: rho0,rhor,young,ec,et,bc,bt,g,g0,gt,gb,gsh,gfrot,
89 . kc,kt,kkc,kkt,kxc,kxt,kfc,kft,flex,flex1,flex2,embc,embt,
90 . lc0,lt0,dc0,dt0,hc0,ht0,cosin,tan_lock,phi_lock,
91 . visce,viscg,areamin1,areamin2,zerostress,stress_unit
92 my_real ,DIMENSION(6) :: yfac
93C=======================================================================
94 is_encrypted = .false.
95 is_available = .false.
96 ilaw = 58
97 iload = 0
98 nfunc = 3
99 areamin1 = zero
100c
101 CALL hm_option_is_encrypted(is_encrypted)
102c
103 CALL hm_get_floatv('MAT_RHO' ,rho0 ,is_available, lsubmodel, unitab)
104 CALL hm_get_floatv('Refer_Rho' ,rhor ,is_available, lsubmodel, unitab)
105c
106 CALL hm_get_floatv('MAT_E1' ,ec ,is_available, lsubmodel, unitab)
107 CALL hm_get_floatv('MAT_B1' ,bc ,is_available, lsubmodel, unitab)
108 CALL hm_get_floatv('MAT_E2' ,et ,is_available, lsubmodel, unitab)
109 CALL hm_get_floatv('MAT_B2' ,bt ,is_available, lsubmodel, unitab)
110 CALL hm_get_floatv('MAT_F' ,flex ,is_available, lsubmodel, unitab)
111c
112 CALL hm_get_floatv('MAT_G0' ,g0 ,is_available, lsubmodel, unitab)
113 CALL hm_get_floatv('MAT_GI' ,gt ,is_available, lsubmodel, unitab)
114 CALL hm_get_floatv('mat_alpha' ,PHI_LOCK ,IS_AVAILABLE, LSUBMODEL, UNITAB)
115 CALL HM_GET_FLOATV('mat_g5' ,GSH ,IS_AVAILABLE, LSUBMODEL, UNITAB)
116 CALL HM_GET_INTV ('isensor' ,ISENS ,IS_AVAILABLE,LSUBMODEL)
117c
118 CALL HM_GET_FLOATV('mat_df' ,VISCE ,IS_AVAILABLE, LSUBMODEL, UNITAB)
119 CALL HM_GET_FLOATV('mat_ds' ,VISCG ,IS_AVAILABLE, LSUBMODEL, UNITAB)
120 CALL HM_GET_FLOATV('friction_phi' ,GFROT ,IS_AVAILABLE, LSUBMODEL, UNITAB)
121 CALL HM_GET_FLOATV('m58_zerostress',ZEROSTRESS,IS_AVAILABLE, LSUBMODEL, UNITAB)
122c
123 CALL HM_GET_INTV ('n1_warp' ,NC ,IS_AVAILABLE,LSUBMODEL)
124 CALL HM_GET_INTV ('n2_weft' ,nt ,is_available,lsubmodel)
125 CALL hm_get_floatv('S1' ,embc ,is_available, lsubmodel, unitab)
126 CALL hm_get_floatv('S2' ,embt ,is_available, lsubmodel, unitab)
127 CALL hm_get_floatv('MAT_C4' ,flex1 ,is_available, lsubmodel, unitab)
128 CALL hm_get_floatv('MAT_C5' ,flex2 ,is_available, lsubmodel, unitab)
129c
130c Optional tabulated function data
131c
132 CALL hm_get_intv ('FUN_A1' ,ifunc(1) ,is_available,lsubmodel)
133 CALL hm_get_floatv('MAT_C1' ,yfac(1) ,is_available, lsubmodel, unitab)
134c
135 CALL hm_get_intv ('FUN_A2' ,ifunc(2) ,is_available,lsubmodel)
136 CALL hm_get_floatv('MAT_C2' ,yfac(2) ,is_available, lsubmodel, unitab)
137c
138 CALL hm_get_intv ('FUN_A3' ,ifunc(3) ,is_available,lsubmodel)
139 CALL hm_get_floatv('MAT_C3' ,yfac(3) ,is_available, lsubmodel, unitab)
140c
141 CALL hm_get_intv ('FUN_A4' ,ifunc(4) ,is_available,lsubmodel)
142 CALL hm_get_intv ('FUN_A5' ,ifunc(5) ,is_available,lsubmodel)
143 CALL hm_get_floatv('scale4' ,yfac(4) ,is_available, lsubmodel, unitab)
144 CALL hm_get_floatv('scale5' ,yfac(5) ,is_available, lsubmodel, unitab)
145 CALL hm_get_intv ('FUN_A6' ,ifunc(6) ,is_available,lsubmodel)
146 CALL hm_get_floatv('scale6' ,yfac(6) ,is_available, lsubmodel, unitab)
147c-----------------------------------------------------------------------
148c Check consistency of tabulated input data (loading and unloading)
149c a) there's no unloading functions => loading curves are optional
150c analytic and tabulated loading may be mixed
151c b) at least one unloading curve is defined => all loading corves must be defined
152c missing unloading curves may be created by Radioss by copying the loading ones
153c-----------------------------------------------------------------------
154 IF (ifunc(1) /= 0 .or. ifunc(2) /= 0 .or. ifunc(3) /= 0) THEN
155 iload = 1
156c
157 IF (ifunc(4) /= 0 .or. ifunc(5) /= 0 .or. ifunc(6) /= 0) THEN
158 nt = 1
159 nc = 1
160 nfunc = 6
161 iload = 2
162c if unloading is active, all unloading functions must be properly defined
163 IF (ifunc(4) == 0) THEN
164 ifunc(4) = ifunc(1)
165 yfac(4) = yfac(1)
166 ENDIF
167 IF (ifunc(5) == 0) THEN
168 ifunc(5) = ifunc(2)
169 yfac(5) = yfac(2)
170 ENDIF
171 IF (ifunc(6) == 0) THEN
172 ifunc(6) = ifunc(3)
173 yfac(6) = yfac(3)
174 ENDIF
175
176 IF (ifunc(1) == 0) THEN
177 CALL ancmsg(msgid=1578 ,
178 . msgtype=msgerror,
179 . anmode=aninfo_blind_2,
180 . i1=mat_id,
181 . c1=titr)
182 ENDIF
183 IF (ifunc(2) == 0) THEN
184 CALL ancmsg(msgid=1579 ,
185 . msgtype=msgerror,
186 . anmode=aninfo_blind_2,
187 . i1=mat_id,
188 . c1=titr)
189 ENDIF
190 IF (ifunc(3) == 0) THEN
191 CALL ancmsg(msgid=1580 ,
192 . msgtype=msgerror,
193 . anmode=aninfo_blind_2,
194 . i1=mat_id,
195 . c1=titr)
196 ENDIF
197 ENDIF
198 ENDIF
199c-----------------------------------------------------------------------
200c Default values
201c-----------------------------------------------------------------------
202 CALL hm_get_floatv_dim('MAT_E1',stress_unit ,is_available, lsubmodel, unitab)
203c
204 DO i=1,6
205 IF (yfac(i) == zero) yfac(i) = one * stress_unit
206 ENDDO
207c
208 IF (nc == 0) nc = 1
209 IF (nt == 0) nt = 1
210 IF (embc == zero) embc = em01
211 IF (embt == zero) embt = em01
212 IF (flex == zero) flex = em03
213 IF (flex1 == zero .AND. flex2 == zero)THEN
214 flex1 = flex
215 flex2 = flex
216 ELSEIF (flex1 == zero .AND. flex2 /= zero)THEN
217 flex1 = flex2
218 ELSEIF (flex2 == zero .AND. flex1 /= zero)THEN
219 flex2 = flex1
220 ENDIF
221c
222 IF (iload == 2) THEN
223 uload = 1
224 ELSE
225 uload = 0
226 ENDIF
227 IF (gt == zero) gt = fourth*(ec + et)
228c-----------------------------------------------------------------------
229 lc0 = one / nt
230 lt0 = one / nc
231 dc0 = lc0*(one+embc)
232 dt0 = lt0*(one+embt)
233 hc0 = sqrt(dc0*dc0 - lc0*lc0)
234 ht0 = sqrt(dt0*dt0 - lt0*lt0)
235c--- rigidite fil
236 kc = ec/nc
237 kt = et/nt
238 kkc = bc/nc
239 kkt = bt/nt
240c--- rigidite flexion
241 kfc = flex1*kc*hc0/dc0
242 kft = flex2*kt*ht0/dt0
243c
244c--- angle blocage cisaillement
245 IF (phi_lock == zero) THEN
246 cosin = half*(hc0/lc0 + ht0/lt0)
247 tan_lock = sqrt(one - cosin*cosin) / cosin
248 phi_lock = atan(tan_lock)
249 ELSE
250 phi_lock = phi_lock*pi/hundred80
251 tan_lock = tan(phi_lock)
252 ENDIF
253c
254 g = gt / (one + tan_lock*tan_lock)
255 IF (g0 == zero) g0 = g
256 gb = tan_lock*(g0 - g)
257c
258 IF (gfrot == zero .and. iload == 0) gfrot = g0
259 IF (gsh == zero .and. iload == 0) gsh = g0
260c-----------------------------------------------------------------------
261 nuvar = 40
262c-----------------------------------------------------------------------
263 matparam%NUPARAM = 46 ! 4pts pour l intersection +flag+PR SHEAR
264 matparam%NIPARAM = 4
265 matparam%NFUNC = nfunc
266!
267 ALLOCATE (matparam%UPARAM(matparam%NUPARAM))
268 ALLOCATE (matparam%IPARAM(matparam%NIPARAM))
269 matparam%UPARAM(:) = zero
270 matparam%IPARAM(:) = 0
271c-----------------------------------------------------------------------
272 matparam%IPARAM(1) = uload
273 matparam%IPARAM(2) = isens
274 matparam%IPARAM(3) = nc
275 matparam%IPARAM(4) = nt
276!
277 matparam%UPARAM( 1) = lc0
278 matparam%UPARAM( 2) = lt0
279 matparam%UPARAM( 3) = dc0
280 matparam%UPARAM( 4) = dt0
281 matparam%UPARAM( 5) = hc0
282 matparam%UPARAM( 6) = ht0
283 matparam%UPARAM( 7) = 0 ! moved to IPARAM (NC)
284 matparam%UPARAM( 8) = 0 ! moved to IPARAM (NT)
285 matparam%UPARAM( 9) = kc
286 matparam%UPARAM(10) = kt
287 matparam%UPARAM(11) = kfc
288 matparam%UPARAM(12) = kft
289 matparam%UPARAM(13) = g0
290 matparam%UPARAM(14) = g
291 matparam%UPARAM(15) = gb
292 matparam%UPARAM(16) = tan_lock
293 matparam%UPARAM(17) = visce
294 matparam%UPARAM(18) = viscg
295 matparam%UPARAM(19) = kkc
296 matparam%UPARAM(20) = kkt
297 matparam%UPARAM(21) = gfrot
298 matparam%UPARAM(22) = areamin1
299 areamin2 = one + half*(areamin1-one)
300 IF (areamin2 > areamin1) THEN
301 matparam%UPARAM(23)= one / (areamin2-areamin1)
302 ELSE
303 matparam%UPARAM(23)= zero
304 ENDIF
305 matparam%UPARAM(24) = zerostress
306 matparam%UPARAM(25) = 0 ! not used
307 matparam%UPARAM(26) = flex1
308 matparam%UPARAM(27) = flex2
309 matparam%UPARAM(28) = yfac(1)
310 matparam%UPARAM(29) = yfac(2)
311 matparam%UPARAM(30) = yfac(3)
312 matparam%UPARAM(31) = 0 ! not used
313 matparam%UPARAM(32) = gsh
314 matparam%UPARAM(33) = yfac(4)
315 matparam%UPARAM(34) = yfac(5)
316 matparam%UPARAM(35) = 0 ! not used
317 matparam%UPARAM(42) = yfac(6)
318c-----------------------------------------------------------------------
319 young = max(kc,kt)
320c--------------------------
321 parmat(1) = young/three
322 parmat(2) = young
323 parmat(3) = zero
324 parmat(4) = zero
325 parmat(5) = zero
326c--------------------------
327 matparam%RHO = rhor
328 matparam%RHO0 = rho0
329 matparam%YOUNG = young
330c--------------------------
331 CALL init_mat_keyword(matparam,"ANISOTROPIC")
332c
333 ! Properties compatibility
334 CALL init_mat_keyword(matparam,"SHELL_ANISOTROPIC")
335c--------------------------
336 mtag%L_ANG = 1
337c--------------------------------------------------
338c Starter output
339c--------------------------------------------------
340 WRITE(iout,1000) trim(titr),mat_id,58
341 WRITE(iout,1100)
342 IF (is_encrypted) THEN
343 WRITE(iout,'(5X,A,//)')'CONFIDENTIAL DATA'
344 ELSE
345 WRITE(iout,1200) rho0
346 WRITE(iout,1250) ec,et
347 IF (iload == 0) THEN
348 WRITE(iout,1300) bc,bt,g0,gt,phi_lock*hundred80/pi
349 ELSE
350 WRITE(iout,1400) ifunc(1),ifunc(2),ifunc(3),yfac(1),yfac(2),yfac(3)
351 IF (iload == 2)
352 . WRITE(iout,1500) ifunc(4),ifunc(5),ifunc(6),yfac(4),yfac(5),yfac(6)
353 ENDIF
354 WRITE(iout,1600) visce,viscg,gfrot,gsh,zerostress,
355 . embc,embt,nc,nt,isens,flex1,flex2
356 ENDIF
357c-----------------------------------------------------------------------
358 1000 FORMAT(/
359 & 5x,a,/,
360 & 5x,'MATERIAL NUMBER. . . . . . . . . . . . . . . . . =',i10/,
361 & 5x,'MATERIAL LAW . . . . . . . . . . . . . . . . . . =',i10/)
362 1100 FORMAT
363 &(5x,'MATERIAL MODEL : ANISOTROPIC FABRIC (LAW58) ',/,
364 & 5x,'--------------------------------------------',/)
365 1200 FORMAT(
366 & 5x,'INITIAL DENSITY . . . . . . . . . . . . . . . .=',1pg20.13/)
367 1250 FORMAT(
368 & 5x,'YOUNG MODULUS E1 (WARP DIRECTION) . . . . . . . .=',1pg20.13/
369 & 5x,'YOUNG MODULUS E2 (WEFT DIRECTION) . . . . . . . .=',1pg20.13/)
370 1300 FORMAT(
371 & 5x,'SOFTENING COEFFICIENT B1. . . . . . . . . . . . .=',1pg20.13/
372 & 5x,'SOFTENING COEFFICIENT B2. . . . . . . . . . . . .=',1pg20.13/
373 & 5x,'INITIAL SHEAR MODULUS . . . . . . . . . . . . . .=',1pg20.13/
374 & 5x,'LOCK SHEAR MODULUS. . . . . . . . . . . . . . . .=',1pg20.13/
375 & 5x,'SHEAR LOCK ANGLE. . . . . . . . . . . . . . . . .=',1pg20.13/)
376 1400 FORMAT(
377 & 5x,'LOADING STRESS FUNCTION ID IN WARP DIRECTION. . .=',i10/
378 & 5x,'LOADING STRESS FUNCTION ID IN WEFT DIRECTION. . .=',i10/
379 & 5x,'LOADING STRESS FUNCTION ID IN SHEAR . . . . . . .=',i10/
380 & 5x,'LOADING FUNCTION SCALE FACTOR (WARP). . . . . . .=',1pg20.13/
381 & 5x,'LOADING FUNCTION SCALE FACTOR (WEFT). . . . . . .=',1pg20.13/
382 & 5x,'LOADING FUNCTION SCALE FACTOR (SHEAR) . . . . . .=',1pg20.13/)
383 1500 FORMAT(
384 & 5x,'UNLOADING STRESS FUNCTION ID IN WARP DIRECTION. .=',i10/
385 & 5x,'UNLOADING STRESS FUNCTION ID IN WEFT DIRECTION. .=',i10/
386 & 5x,'UNLOADING STRESS FUNCTION ID IN SHEAR DIRECTION .=',i10/
387 & 5x,'UNLOADING FUNCTION SCALE FACTOR (WARP). . . . . .=',1pg20.13/
388 & 5x,'UNLOADING FUNCTION SCALE FACTOR (WEFT). . . . . .=',1pg20.13/
389 & 5x,'UNLOADING FUNCTION SCALE FACTOR (SHEAR) . . . . .=',1pg20.13/)
390 1600 FORMAT(
391 & 5x,'FIBER VISCOSITY COEF. . . . . . . . . . . . . . .=',1pg20.13/
392 & 5x,'SHEAR FRICTION COEF . . . . . . . . . . . . . . .=',1pg20.13/
393 & 5x,'SHEAR FRICTION MODULUS. . . . . . . . . . . . . .=',1pg20.13/
394 & 5x,'TRANSVERSE SHEAR MODULUS. . . . . . . . . . . . .=',1pg20.13/
395 & 5x,'REF-STATE STRESS RELAXATION FACTOR. . . . . . . .=',1pg20.13/
396 & 5x,'NOMINAL WARP STRETCH. . . . . . . . . . . . . . .=',1pg20.13/
397 & 5x,'NOMINAL WEFT STRETCH. . . . . . . . . . . . . . .=',1pg20.13/
398 & 5x,'FIBER DENSITY IN WARP DIRECTION . . . . . . . . .=',i10/
399 & 5x,'FIBER DENSITY IN WEFT DIRECTION . . . . . . . . .=',i10/
400 & 5x,'SENSOR ID . . . . . . . . . . . . . . . . . . . .=',i10/
401 & 5x,'FLEX MODULUS REDUCTION FACTOR (WARP). . . . . . .=',1pg20.13/
402 & 5x,'FLEX MODULUS REDUCTION FACTOR (WEFT). . . . . . .=',1pg20.13)
403c-----------------------------------------------------------------------
404 RETURN
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
init_mat_keyword
subroutine init_mat_keyword(matparam, keyword)
Definition init_mat_keyword.F:150
max
#define max(a, b)
Definition macros.h:21
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