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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop20 (geo, igeo, prop_tag, multi_fvm, igtyp, ig, titr, unitab, lsubmodel, defaults_solid)

Function/Subroutine Documentation

◆ hm_read_prop20()

subroutine hm_read_prop20 ( dimension(*), intent(inout) geo,
integer, dimension(*), intent(inout) igeo,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(multi_fvm_struct) multi_fvm,
integer, intent(in) igtyp,
integer, intent(in) ig,
character(len=nchartitle), intent(in) titr,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(solid_defaults_), intent(in) defaults_solid )

Definition at line 38 of file hm_read_prop20.F.

40C-----------------------------------------------
41C ROUTINE DESCRIPTION :
42C ===================
43C READ PROPERTY TYPE01 WITH HM READER
44C-----------------------------------------------
45C DUMMY ARGUMENTS DESCRIPTION:
46C ===================
47C
48C NAME DESCRIPTION
49C
50C IGEO PROPERTY ARRAY(INTEGER)
51C GEO PROPERTY ARRAY(REAL)
52C UNITAB UNITS ARRAY
53C IG PROPERTY ID(INTEGER)
54C TITR MATERIAL TITLE
55C LSUBMODEL SUBMODEL STRUCTURE
56C-----------------------------------------------
57C============================================================================
58C M o d u l e s
59C-----------------------------------------------
60 USE unitab_mod
61 USE message_mod
62 USE submodel_mod
63 USE elbuftag_mod
64 USE multi_fvm_mod
65 USE defaults_mod
66 USE names_and_titles_mod , ONLY : nchartitle
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 "units_c.inc"
75#include "tablen_c.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79C INPUT ARGUMENTS
80 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
81 INTEGER,INTENT(IN)::IG,IGTYP
82 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN)::TITR
83 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
84C MODIFIED ARGUMENT
85 INTEGER,INTENT(INOUT)::IGEO(*)
86 my_real,
87 . INTENT(INOUT)::geo(*)
88 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
89 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
90 TYPE(SOLID_DEFAULTS_), INTENT(IN) :: DEFAULTS_SOLID
91C-----------------------------------------------
92C L o c a l V a r i a b l e s
93C-----------------------------------------------
94C REAL
95 INTEGER IHBE,ISMSTR,IPLAST,ICPRE,ICSTR,IINT,JCVT,
96 . NPG,NPT,NPTR,NPTS,NPTT, ISTRAIN,IET,IHBE_OLD,ID,
97 . NLY
98 INTEGER IHBE_DS,ISST_DS,ICONTROL_D,ICONTROL
99 my_real
100 . cvis,qa,qb,qh,vns1,vns2,dtmin,vdefmin,vdefmax,aspmax,asptet
101 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
102C=======================================================================
103 is_encrypted = .false.
104 is_available = .false.
105C-----hide and removed flags:
106 iplast = 2
107 id = ig
108C---- will branch later
109 icpre = 0
110 istrain =1
111 jcvt = 0
112!--- defaults values
113 ihbe_ds= defaults_solid%ISOLID
114 isst_ds= defaults_solid%ISMSTR
115 icontrol_d=defaults_solid%ICONTROL
116C--------------------------------------------------
117C EXTRACT DATA (IS OPTION CRYPTED)
118C--------------------------------------------------
119 CALL hm_option_is_encrypted(is_encrypted)
120C--------------------------------------------------
121C EXTRACT DATAS (INTEGER VALUES)
122C--------------------------------------------------
123 CALL hm_get_intv('ISOLID',ihbe,is_available,lsubmodel)
124 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
125c CALL HM_GET_INTV('Icpre',ICPRE,IS_AVAILABLE,LSUBMODEL)
126c CALL HM_GET_INTV('Istrain',ISTRAIN,IS_AVAILABLE,LSUBMODEL)
127 CALL hm_get_intv('Icstr',icstr,is_available,lsubmodel)
128 CALL hm_get_intv('Inpts_R',nptr,is_available,lsubmodel)
129 CALL hm_get_intv('Inpts_S',npts,is_available,lsubmodel)
130 CALL hm_get_intv('Inpts_T',nptt,is_available,lsubmodel)
131 CALL hm_get_intv('NBP',npt,is_available,lsubmodel)
132 CALL hm_get_intv('Iint',iint,is_available,lsubmodel)
133 CALL hm_get_intv('Icontrol',icontrol,is_available,lsubmodel)
134C--------------------------------------------------
135C EXTRACT DATAS (REAL VALUES)
136C--------------------------------------------------
137 CALL hm_get_floatv('qa',qa,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv('qb',qb,is_available,lsubmodel,unitab)
139 CALL hm_get_floatv('dn',cvis,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv('deltaT_min',dtmin,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv('vdef_min',vdefmin,is_available,lsubmodel,unitab)
142 CALL hm_get_floatv('vdef_max',vdefmax,is_available,lsubmodel,unitab)
143 CALL hm_get_floatv('ASP_max',aspmax,is_available,lsubmodel,unitab)
144 CALL hm_get_floatv('COL_min',asptet,is_available,lsubmodel,unitab)
145C-------for lecture check
146c WRITE(IOUT,2100)IG,IHBE,ISMSTR,IPLAST,IINT,ICPRE,ICSTR,CVIS,QA,QB,
147c . DTMIN,ISTRAIN,NPTR,NPTS,NPTT
148C-----------------------
149C--- Default values
150C-----------------------
151C
152C ihbe
153 IF (ihbe == 0) ihbe = ihbe_ds
154 IF (ihbe /= 14 .AND. ihbe /= 15 .AND. ihbe /= 16) THEN
155 CALL ancmsg(msgid=549,
156 . msgtype=msgerror,
157 . anmode=aninfo_blind_1,
158 . i1=ig,
159 . c1=titr,
160 . i2=ihbe,
161 . i3=20)
162 ENDIF
163C
164C jcvt
165C
166 IF (ihbe == 14 .OR. ihbe == 15) jcvt = 2
167 IF (ihbe == 16) jcvt = 1
168C
169C smstr
170C
171 IF (ismstr == 0) ismstr=isst_ds
172 IF (ismstr == 0) ismstr=4
173 IF (isst_ds == -2.OR.ismstr<0) ismstr=4
174c IF(GEO( 3)/=ZERO.AND.IGEO( 5)== 0)IGEO( 5)=NINT(GEO( 3))
175C
176C icpre/icstr
177C
178C ICPRE = 0
179 IF (ihbe == 14 .AND. icstr == 0) icstr = 10
180 IF (icstr > 111) icstr=0
181 IF (ihbe == 14 .AND.
182 . (icstr /= 1.AND.icstr /= 10.AND.icstr /= 100)) THEN
183 CALL ancmsg(msgid=677,
184 . msgtype=msgerror,
185 . anmode=aninfo_blind_1,
186 . i1=ig,
187 . c1=titr,
188 . i2=icstr)
189 END IF
190C
191C iint
192C
193 IF (ihbe == 16) THEN
194 IF (iint == 0) iint = 1 ! gauss integration
195 ELSEIF (ihbe == 14 .OR. ihbe == 15) THEN
196 iint = 1
197 ENDIF
198C
199C npt
200C
201 nly = 0
202 SELECT CASE (ihbe)
203 CASE(15)
204 IF (npt == 0) npt = 3
205 IF (npt < 1 .OR. npt > 9) THEN
206 CALL ancmsg(msgid=563,
207 . msgtype=msgerror,
208 . anmode=aninfo_blind_1,
209 . i1=ig,
210 . c1=titr,
211 . i2=npt,
212 . i3=ihbe)
213 ENDIF
214 npg = npt
215 nly = npt
216 CASE(14,16)
217c NPT = NPTR*100+NPTS*10+ NPTT
218 IF (npt == 0) THEN
219 npt = 222
220 nptr = 2
221 npts = 2
222 nptt = 2
223 END IF
224 npg = nptr*npts*nptt
225 nly = 0
226 IF (ihbe == 14) THEN
227 SELECT CASE(icstr)
228 CASE(1)
229 nly = nptt
230 CASE(10)
231 nly = npts
232 CASE(100)
233 nly = nptr
234 END SELECT
235 ELSE
236 nly = npts
237 ENDIF
238
239 IF (ihbe == 14 .AND.
240 . (nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR.
241 . nptr > 9 .OR. npts > 9 .OR. nptt > 9)) THEN
242 CALL ancmsg(msgid=563,
243 . msgtype=msgerror,
244 . anmode=aninfo_blind_1,
245 . i1=ig,
246 . c1=titr,
247 . i2=npt,
248 . i3=ihbe)
249 ELSEIF (ihbe == 16 .AND.
250 . (nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR.
251 . nptr > 3 .OR. npts > 9 .OR. nptt > 3)) THEN
252 CALL ancmsg(msgid=563,
253 . msgtype=msgerror,
254 . anmode=aninfo_blind_1,
255 . i1=ig,
256 . c1=titr,
257 . i2=npt,
258 . i3=ihbe)
259 ENDIF
260 END SELECT
261!
262 IF (icontrol==0) icontrol=icontrol_d
263 IF (icontrol>1) icontrol=0
264C
265C viscosity
266C
267 IF (ihbe /= 15) THEN
268 cvis = zero
269 ELSEIF (cvis == zero) THEN
270 cvis = em01
271 ENDIF
272C igeo(31) flag for default qa qb for law 70 can be used for other law
273 IF(qa == zero .AND. qb == zero) igeo(31) = 1
274 IF (qa == zero) qa = onep1
275 IF (qb == zero) qb = fiveem2
276 igeo(4) = npt
277 igeo(5) = ismstr
278 igeo(9) = iplast-1
279 igeo(10) = ihbe
280 igeo(12) = istrain
281 igeo(13) = icpre
282 igeo(14) = icstr
283 igeo(15) = iint
284 igeo(16) = jcvt-1
285 igeo(30) = nly
286 igeo(97) = icontrol
287C
288 geo(13) = cvis
289 geo(14) = qa
290 geo(15) = qb
291 geo(172) = dtmin
292 geo(190)= vdefmin
293 geo(191)= vdefmax
294 geo(192)= aspmax
295 geo(193)= asptet
296
297C----------------------
298 IF(.NOT.is_encrypted)THEN
299 IF(igeo(31) == 1) THEN
300 WRITE(iout,1100)ig,ihbe,ismstr,iint,icstr,cvis,qa,qb,
301 . dtmin,istrain,icontrol
302 ELSE
303 WRITE(iout,1000)ig,ihbe,ismstr,iint,icstr,cvis,qa,qb,
304 . dtmin,istrain,icontrol
305 ENDIF
306 IF((vdefmin+vdefmax+aspmax+asptet)>zero) THEN
307 IF (vdefmax==zero) vdefmax=ep10
308 IF (aspmax==zero) aspmax=ep10
309 WRITE(iout,3000) vdefmin,vdefmax,aspmax,asptet
310 END IF
311 IF (npt > 200) THEN
312 WRITE(iout,1001) npg,npt
313 ELSE
314 WRITE(iout,1002) npg
315 ENDIF
316 ELSE
317 WRITE(iout,1099) ig
318 ENDIF
319
320C
321C----Initialization in lecgeo:
322 prop_tag(igtyp)%G_SIG = 6
323 prop_tag(igtyp)%L_SIG = 6
324 prop_tag(igtyp)%G_EINT = 1
325 prop_tag(igtyp)%G_QVIS = 1
326 prop_tag(igtyp)%L_EINT = 1
327 prop_tag(igtyp)%G_VOL = 1
328 prop_tag(igtyp)%L_VOL = 1
329 prop_tag(igtyp)%L_QVIS = 1
330 IF (multi_fvm%IS_USED) prop_tag(igtyp)%G_MOM = 3
331 prop_tag(igtyp)%G_FILL = 1
332 prop_tag(igtyp)%L_STRA = 6
333 igeo(1) =ig
334 igeo(11)=igtyp
335 igeo(17)=0
336 geo(12)= igtyp + 0.1
337C IF(GEO(171)/=ZERO.AND.IGEO(10)== 0)IGEO(10)=NINT(GEO(171))
338C---
339 RETURN
340C---
341 1000 FORMAT(
342 & 5x,'STANDARD THICK SHELL PROPERTY SET'/,
343 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
344 & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
345 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
346 & 5x,'INTEGRATION FORMULATION FLAG. . . . . =',i10/,
347 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
348 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
349 & 5x,'QUADRATIC BULK VISCOSITY. . . . . . . .=',1pg20.13/,
350 & 5x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13/,
351 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
352 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
353 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
354 1099 FORMAT(
355 & 5x,'STANDARD THICK SHELL PROPERTY SET'/,
356 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i8/,
357 & 5x,'CONFIDENTIAL DATA'//)
358
359 1100 FORMAT(
360 & 5x,'STANDARD THICK SHELL PROPERTY SET'/,
361 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
362 & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
363 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
364 & 5x,'INTEGRATION FORMULATION FLAG. . . . . =',i10/,
365 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
366 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
367 & 5x,'DEFAULT VALUE FOR QUADRATIC BULK. . . . ',/,
368 & 5x,' VISCOSITY (QA) WILL BE USED. . . .=',1pg20.13/,
369 & 5x,'EXCEPT IN CASE LAW 70 WHERE QA = 0. ',/,
370 & 5x,'DEFAULT VALUE FOR LINEAR BULK . . . . . ',/,
371 & 5x,' VISCOSITY (QB) WILL BE USED . . . =',1pg20.13/,
372 & 5x,'EXCEPT IN CASE LAW 70 WHERE QB = 0. ',/,
373 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
374 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
375 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
376 1001 FORMAT(
377 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i3,
378 & ' (',i3,')'/)
379 1002 FORMAT(
380 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i10/)
381 3000 FORMAT(
382 & 5x,'SOLID MINIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
383 & 5x,'SOLID MAXIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
384 & 5x,'SOLID MAXIMUM ASPECT RATIO.............=',1pg20.13/,
385 & 5x,'SOLID MINIMUM COLLAPSE RATIO...........=',1pg20.13/)
386C
387
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_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
id
initmumps id
Definition multiplerhs_example.m:4
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