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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_leak (ipm, pm, unitab, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_leak()

subroutine hm_read_leak ( integer, dimension(npropmi,*) ipm,
pm,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 39 of file hm_read_leak.F.

40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE unitab_mod
44 USE message_mod
45 USE submodel_mod
46 USE hm_option_read_mod
47 USE names_and_titles_mod , ONLY : nchartitle, nchartitle
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"
56#include "com04_c.inc"
57#include "param_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
62 TYPE(SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
63 INTEGER IPM(NPROPMI,*)
64 my_real pm(npropm,*)
65C-----------------------------------------------
66C L o c a l V a r i a b l e s
67C-----------------------------------------------
68 INTEGER UID,HM_NLEAK,IFLAGUNIT,IUNIT
69 INTEGER I, K, ILAW, IMID, IMAT, ILEAKAGE, IFTLC, IFTAC, IFTACP,
70 . NFUNC
71 my_real ascalet, ascalep, scalelc, scaleac, flc, fac,
72 . x0, x1, x2, x3, lr1, fthk, c1, c2, c3, facp, scaleacp
73
74 CHARACTER(len=nchartitle) :: TITR
75 LOGICAL :: IS_AVAILABLE
76 is_available = .false.
77C=================================================================================
78C START READING
79C=================================================================================
80
81 ! Count number of /LEAK
82 CALL hm_option_count('/LEAK/MAT',hm_nleak)
83
84 ! Start reading /LEAK
85 CALL hm_option_start('/LEAK/MAT')
86
87 ! Loop over /LEAK cards
88 DO k = 1, hm_nleak
89c
90 ! Read keys
91 titr = ''
92 CALL hm_option_read_key(lsubmodel, option_id=imat, option_titr=titr, unit_id=uid)
93c
94 ! Checking unit IDs
95 iflagunit = 0
96 DO iunit=1,unitab%NUNITS
97 IF (unitab%UNIT_ID(iunit) == uid) THEN
98 iflagunit = 1
99 EXIT
100 ENDIF
101 ENDDO
102 IF (uid/=0.AND.iflagunit==0) THEN
103 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
104 . i2=uid,i1=imat,
105 . c1='leak',C2='leak',
106 . C3=TITR)
107 ENDIF
108c
109 ! Initialization of Material ID
110 IMID=0
111 ! Loop over all materials
112 DO I=1,NUMMAT-1
113 ! If the material exist, the reading pursue
114 IF(IPM(1,I)==IMAT)THEN
115 IMID=IMAT
116 WRITE(IOUT,1000)TRIM(TITR),IMID
117 ILAW = IPM(2,I)
118c
119 ! Material law must be /MAT/LAW19 or /MAT/LAW58
120.OR. IF(ILAW==19ILAW==58)THEN
121c
122 ! Read first card
123 CALL HM_GET_INTV ('ileakage' ,ILEAKAGE ,IS_AVAILABLE, LSUBMODEL)
124 CALL HM_GET_FLOATV('scale1' ,ASCALET ,IS_AVAILABLE, LSUBMODEL, UNITAB)
125 CALL HM_GET_FLOATV('scale2' ,ASCALEP ,IS_AVAILABLE, LSUBMODEL, UNITAB)
126 ! Checking, writing and saving the values
127 IF(ASCALET == ZERO) ASCALET=ONE
128 IF(ASCALEP == ZERO) ASCALEP=ONE
129 WRITE(IOUT,1010)ILEAKAGE, ASCALET, ASCALEP
130 IPM(4,I)=ILEAKAGE
131 PM(160,I)= ASCALET
132 PM(161,I)= ASCALEP
133 IPM(6,I)=IPM(6,I)+3
134 NFUNC=IPM(10,I)+IPM(6,I)
135c
136 ! Read second card
137 CALL HM_GET_FLOATV('acoeft1' ,FACP ,IS_AVAILABLE, LSUBMODEL, UNITAB)
138 CALL HM_GET_INTV ('mat_fct_ide' ,IFTACP ,IS_AVAILABLE, LSUBMODEL)
139 CALL HM_GET_FLOATV('fscale11' ,SCALEACP ,IS_AVAILABLE, LSUBMODEL, UNITAB)
140 ! Checking, writing and saving the values
141 IF(SCALEACP == ZERO) SCALEACP=ONE
142 IF(FACP > 0) IFTACP=0
143 IF(FACP > ONE) FACP=ONE
144 IF(FACP < ZERO) FACP=ZERO
145 PM(162,I)= FACP
146 PM(163,I)= SCALEACP
147 IPM(10+NFUNC,I)=IFTACP
148 WRITE(IOUT,1020) FACP, IFTACP, SCALEACP
149C
150 ! First case
151 IF(ILEAKAGE==1) THEN
152 ! Read third card
153 CALL HM_GET_FLOATV('bcoeft1' ,FLC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
154 CALL HM_GET_FLOATV('acoeft2' ,FAC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
155 ! Checking, writing and saving the values
156 PM(164,I)= FLC
157 PM(165,I)= FAC
158 WRITE(IOUT,2010) FLC, FAC
159 ! Second, third and fourth case
160.OR..OR. ELSEIF(ILEAKAGE==2ILEAKAGE==3ILEAKAGE==4) THEN
161 ! Read third card
162 CALL HM_GET_INTV ('leak_fct_idlc' ,IFTLC ,IS_AVAILABLE, LSUBMODEL)
163 CALL HM_GET_INTV ('fun_b1' ,IFTAC ,IS_AVAILABLE, LSUBMODEL)
164 CALL HM_GET_FLOATV('fscale22' ,SCALELC ,IS_AVAILABLE, LSUBMODEL, UNITAB)
165 CALL HM_GET_FLOATV('fscale33' ,scaleac ,is_available, lsubmodel, unitab)
166 ! Checking, writing and saving the values
167 IF(scalelc == zero) scalelc=one
168 IF(scaleac == zero) scaleac=one
169 pm(164,i)= scalelc
170 pm(165,i)= scaleac
171 ipm(10+nfunc-1,i)=iftlc
172 ipm(10+nfunc-2,i)=iftac
173 WRITE(iout,2020) ileakage,iftlc,scalelc,iftac,scaleac
174 ! Fifth case
175 ELSEIF(ileakage==5) THEN
176 ! Read third card
177 CALL hm_get_floatv('LENGTH' ,lr1 ,is_available, lsubmodel, unitab)
178 CALL hm_get_floatv('THICK1' ,fthk ,is_available, lsubmodel, unitab)
179 ! Read fourth card
180 CALL hm_get_floatv('C1' ,c1 ,is_available, lsubmodel, unitab)
181 CALL hm_get_floatv('C2' ,c2 ,is_available, lsubmodel, unitab)
182 CALL hm_get_floatv('C3' ,c3 ,is_available, lsubmodel, unitab)
183 ! Checking, writing and saving the values
184 IF (fthk > lr1) THEN
185 fthk = lr1
186 CALL ancmsg(msgid=885,
187 . msgtype=msgwarning,
188 . anmode=aninfo_blind_1,
189 . i1=imat,
190 . c1=titr)
191 END IF
192 IF (lr1 == zero) lr1 = one
193 IF (fthk == zero) fthk = lr1
194 IF (c2 == zero) c2 = one
195 pm(164,i)= lr1
196 pm(166,i)= fthk
197 pm(167,i)= c1
198 pm(168,i)= c2
199 pm(169,i)= c3
200 WRITE(iout,2050) lr1,fthk,c1,c2,c3
201 ! Sixth case
202 ELSEIF(ileakage==6) THEN
203 ! Read third case
204 CALL hm_get_floatv('X0' ,x0 ,is_available, lsubmodel, unitab)
205 CALL hm_get_floatv('VX1' ,x1 ,is_available, lsubmodel, unitab)
206 CALL hm_get_floatv('ex2' ,x2 ,is_available, lsubmodel, unitab)
207 CALL hm_get_floatv('VX3' ,x3 ,is_available, lsubmodel, unitab)
208 ! Checking, writing and saving the values
209 pm(164,i)= x0
210 pm(165,i)= x1
211 pm(166,i)= x2
212 pm(167,i)= x3
213 WRITE(iout,2060) x0,x1,x2,x3
214 ELSE
215 ipm(4,i)=0
216 ENDIF
217 ELSE
218 CALL ancmsg(msgid=923,
219 . msgtype=msgerror,
220 . anmode=aninfo,
221 . i1=imat,
222 . c1=titr)
223 ENDIF
224 ENDIF
225 ENDDO
226 IF (imid == 0) THEN
227 CALL ancmsg(msgid=924,
228 . msgtype=msgerror,
229 . anmode=aninfo,
230 . i1=imat,
231 . c1=titr)
232 ENDIF
233 ENDDO
234C
235 RETURN
236C
237 1000 FORMAT(//
238 & 5x,' FABRIC LEAKAGE MODEL ',/,
239 & 5x,' -------------------- ',/,
240 & 5x, a ,/,
241 & 5x,'MATERIAL NUMBER . . . . . . . . . . . .=',i10)
242 1010 FORMAT(
243 & 5x,'MODEL NUMBER . . . . . . . . .. . . . .=',i10/
244 & 5x,'ABCISSA TIME SCALE FACTOR . . . . . . .=',1pg20.13/
245 & 5x,'ABCISSA PRESSURE SCALE FACTOR . . . . .=',1pg20.13/)
246 1020 FORMAT(
247 & 5x,'AREA COEFFICIENT FOR FABRIC IN CONTACT: ',/,
248 & 5x,'CONSTANT COEFFICIENT FOR FABRIC IN CONTACT. .=',1pg20.13/
249 & 5x,'COEFFICIENT TIME FUNCTION NUMBER. . . . . . .=',i10/
250 & 5x,' FUNCTION SCALE FACTOR. . . .=',1pg20.13/)
251 2010 FORMAT(
252 & 5x,' MODEL # 1 ',/,
253 & 5x,' --------- ',/,
254 & 5x,'FABRIC LEAKAGE COEFFICIENT LC . . . . .=',1pg20.13/
255 & 5x,'FABRIC AREA COEFFICIENT AC. . . . . . .=',1pg20.13/)
256 2020 FORMAT(
257 & 5x,' MODEL #', i2 /,
258 & 5x,' ------------',/,
259 & 5x,'FABRIC LEAKAGE COEFFICIENT FUNCTION OF TIME . .=',i10/
260 & 5x,' FUNCTION SCALE FACTOR. . . .=',1pg20.13/
261 & 5x,'FABRIC AREA COEFFICIENT FUNCTION OF PRESSURE. .=',i10/
262 & 5x,' FUNCTION SCALE FACTOR. . . .=',1pg20.13)
263 2050 FORMAT(
264 & 5x,' AUTOLIV MODEL ',/,
265 & 5x,' ------------- ',/,
266 & 5x,'MESH SIZE L . . . . . . . . . . . . . .=',1pg20.13/
267 & 5x,'FIBER THICKNESS R . . . . . . . . . . .=',1pg20.13/
268 & 5x,'FABRIC LEAKAGE COEFFICIENT C1 . . . . .=',1pg20.13/
269 & 5x,'FABRIC LEAKAGE COEFFICIENT C2 . . . . .=',1pg20.13/
270 & 5x,'FABRIC LEAKAGE COEFFICIENT C3 . . . . .=',1pg20.13/)
271 2060 FORMAT(
272 & 5x,' ANAGONYE WANG MODEL ',/,
273 & 5x,' ------------------- ',/,
274 & 5x,'FABRIC LEAKAGE COEFFICIENT X0 . . . . .=',1pg20.13/
275 & 5x,'FABRIC LEAKAGE COEFFICIENT X1 . . . . .=',1pg20.13/
276 & 5x,'FABRIC LEAKAGE COEFFICIENT X2 . . . . .=',1pg20.13/
277 & 5x,'FABRIC LEAKAGE COEFFICIENT X3 . . . . .=',1pg20.13/)
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_option_count
subroutine hm_option_count(entity_type, hm_option_number)
Definition hm_option_count.F:105
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
hm_option_read_mod
Definition hm_option_read_mod.F:408
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