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,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.or..or. IF (IFUNC(1) /= 0 IFUNC(2) /= 0 IFUNC(3) /= 0) THEN
155 ILOAD = 1
156c
157.or..or. IF (IFUNC(4) /= 0 IFUNC(5) /= 0 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.AND. IF (FLEX1 == ZERO FLEX2 == ZERO)THEN
214 FLEX1 = FLEX
215 FLEX2 = FLEX
216.AND. ELSEIF (FLEX1 == ZERO FLEX2 /= ZERO)THEN
217 FLEX1 = FLEX2
218.AND. ELSEIF (FLEX2 == ZERO 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--- CISAGE Blocking angle
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.and. IF (GFROT == ZERO ILOAD == 0) GFROT = G0
259.and. IF (GSH == ZERO ILOAD == 0) GSH = G0
260c-----------------------------------------------------------------------
261 NUVAR = 40
262c-----------------------------------------------------------------------
263 MATPARAM%NUPARAM = 46 ! 4pts for 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:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_is_encrypted
subroutine hm_option_is_encrypted(is_encrypted)
Definition hm_option_is_encrypted.F:288
id
initmumps id
Definition multiplerhs_example.m:4
elbuftag_mod
Definition elbuftag_mod.F:230
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
unitab_mod
Definition unitab_mod.F:517