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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_prop_read21 (geo, igeo, ig, iskn, unitab, rtrans, lsubmodel, sub_id, idtitl, igtyp, prop_tag, defaults_solid)

Function/Subroutine Documentation

◆ hm_prop_read21()

subroutine hm_prop_read21 ( geo,
integer, dimension(npropgi) igeo,
integer ig,
integer, dimension(liskn,*) iskn,
type (unit_type_), intent(in) unitab,
rtrans,
type(submodel_data), dimension(*) lsubmodel,
integer sub_id,
character(len=nchartitle) idtitl,
integer igtyp,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(solid_defaults_), intent(in) defaults_solid )

Definition at line 39 of file hm_read_prop21.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE elbuftag_mod
47 USE submodel_mod
48 USE message_mod
49 USE defaults_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "units_c.inc"
59#include "com04_c.inc"
60#include "param_c.inc"
61#include "tablen_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
66 INTEGER IGEO(NPROPGI),IG,ISKN(LISKN,*),SUB_ID,IGTYP
67 my_real geo(npropg)
68 my_real rtrans(ntransf,*)
69 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
70 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
71 TYPE(SOLID_DEFAULTS_), INTENT(IN) :: DEFAULTS_SOLID
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER IHBE,ISMSTR,IPLAST,ICPRE,ICSTR,NPT,NPTR,NPTS,NPTT,
76 . IINT,JCVT,IP,ISK,IREP,IDSK,ISTRAIN,NLY
77 my_real
78 . cvis,qa,qb,vx,vy,vz,angle,dtmin,pun,vdefmin,vdefmax,aspmax,asptet
79 INTEGER J,IHBE_DS,ISST_DS,ICONTROL_D,ICONTROL
80 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
81 CHARACTER(LEN=NCHARTITLE)::IDTITL
82C-----------------------------------------------
83C E x t e r n a l F u n c t i o n s
84C-----------------------------------------------
85 DATA pun/0.1/
86C======================================================================|
87C----------------------
88C 21 ORTHOTROPIC THICK SHELL
89C----------------------
90C======================================================================|
91
92 is_encrypted = .false.
93 is_available = .false.
94
95C HIDDEN FLAGS
96C----------------------
97 istrain = 1
98 iplast = 2
99 jcvt = 2
100 iint = 1
101 icpre = 0
102
103!--- defaults values
104 ihbe_ds= defaults_solid%ISOLID
105 isst_ds= defaults_solid%ISMSTR
106 icontrol_d=defaults_solid%ICONTROL
107C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
108 igeo( 1)=ig
109 igeo(11)=igtyp
110 geo(12) =igtyp+pun
111
112 npt = 0
113
114C--------------------------------------------------
115C EXTRACT DATA (IS OPTION CRYPTED)
116C--------------------------------------------------
117 CALL hm_option_is_encrypted(is_encrypted)
118C--------------------------------------------------
119C EXTRACT DATAS (INTEGER VALUES)
120C--------------------------------------------------
121 CALL hm_get_intv('ISOLID',ihbe,is_available,lsubmodel)
122 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
123 CALL hm_get_intv('Icstr',icstr,is_available,lsubmodel)
124 CALL hm_get_intv('NBP',npt,is_available,lsubmodel)
125 CALL hm_get_intv('SKEW_CSID',idsk,is_available,lsubmodel)
126 CALL hm_get_intv('Iorth',irep,is_available,lsubmodel)
127 CALL hm_get_intv('Icontrol',icontrol,is_available,lsubmodel)
128C--------------------------------------------------
129C EXTRACT DATAS (REAL VALUES)
130C--------------------------------------------------
131 CALL hm_get_floatv('dn',cvis,is_available,lsubmodel,unitab)
132 CALL hm_get_floatv('VECTOR_X',vx,is_available,lsubmodel,unitab)
133 CALL hm_get_floatv('VECTOR_Y',vy,is_available,lsubmodel,unitab)
134 CALL hm_get_floatv('VECTOR_Z',vz,is_available,lsubmodel,unitab)
135 CALL hm_get_floatv('MAT_BETA',angle,is_available,lsubmodel,unitab)
136 CALL hm_get_floatv('qa',qa,is_available,lsubmodel,unitab)
137 CALL hm_get_floatv('qb',qb,is_available,lsubmodel,unitab)
138 CALL hm_get_floatv('deltaT_min',dtmin,is_available,lsubmodel,unitab)
139 CALL hm_get_floatv('vdef_min',vdefmin,is_available,lsubmodel,unitab)
140 CALL hm_get_floatv('vdef_max',vdefmax,is_available,lsubmodel,unitab)
141 CALL hm_get_floatv('ASP_max',aspmax,is_available,lsubmodel,unitab)
142 CALL hm_get_floatv('COL_min',asptet,is_available,lsubmodel,unitab)
143C----------------------
144Capply submodel transform to V (VX,VY,VZ)
145C
146 IF (sub_id /= 0)
147 . CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
148
149C-----------------------
150C--- Default values
151C
152C ihbe
153 IF (ihbe == 0) ihbe = ihbe_ds
154 IF (ihbe /= 14 .AND. ihbe /= 15) THEN
155c CALL ANSTCKI(IG)
156c CALL ANSTCKI(IHBE)
157c CALL ANCERR(175,ANINFO_BLIND_1)
158 CALL ancmsg(msgid=549,
159 . msgtype=msgerror,
160 . anmode=aninfo_blind_1,
161 . i1=ig,
162 . c1=idtitl,
163 . i2=ihbe,
164 . i3=21)
165 ENDIF
166C
167C smstr
168 IF(ismstr == 0) ismstr=isst_ds
169 IF(ismstr == 0) ismstr=4
170 IF (isst_ds == -2.OR.ismstr<0) ismstr=4
171C
172C icpre/icstr
173C
174C ICPRE = 0
175 ip = 0
176 IF (ihbe == 14 .AND. icstr == 0) icstr = 10
177 IF (ihbe == 14 .AND.
178 . (icstr /= 1.AND.icstr /= 10.AND.icstr /= 100)) THEN
179 CALL ancmsg(msgid=677,
180 . msgtype=msgerror,
181 . anmode=aninfo_blind_1,
182 . i1=ig,
183 . c1=idtitl,
184 . i2=icstr)
185 ELSE
186 SELECT CASE (icstr)
187 CASE(100)
188 ip = 2
189 CASE(10)
190 ip = 3
191 CASE(1)
192 ip = 1
193 END SELECT
194 END IF
195C
196C npt
197C
198 nly = 0
199 SELECT CASE (ihbe)
200 CASE(15)
201 IF (npt == 0) npt = 3
202 IF (npt < 1 .OR. npt > 9) THEN
203 CALL ancmsg(msgid=563,
204 . msgtype=msgerror,
205 . anmode=aninfo_blind_1,
206 . i1=ig,
207 . c1=idtitl,
208 . i2=npt,
209 . i3=ihbe)
210 ENDIF
211 nly = npt
212 CASE(14)
213 IF (npt == 0) npt = 222
214 nptr= npt/100
215 npts= mod(npt/10,10)
216 nptt= mod(npt,10)
217 SELECT CASE(icstr)
218 CASE(1)
219 nly = nptt
220 CASE(10)
221 nly = npts
222 CASE(100)
223 nly = nptr
224 END SELECT
225 IF (ihbe == 14 .AND.
226 . (nptr < 1 .OR. npts < 1 .OR. nptt < 1 .OR.
227 . nptr > 9 .OR. npts > 9 .OR. nptt > 9)) THEN
228 CALL ancmsg(msgid=563,
229 . msgtype=msgerror,
230 . anmode=aninfo_blind_1,
231 . i1=ig,
232 . c1=idtitl,
233 . i2=npt,
234 . i3=ihbe)
235 ENDIF
236 END SELECT
237!
238 IF (icontrol==0) icontrol=icontrol_d
239 IF (icontrol>1) icontrol=0
240C
241C viscosity
242C
243
244 IF (cvis == zero) THEN
245 cvis = em01
246 ENDIF
247C igeo(31) flag for default qa qb for law 70 can be used for other law
248 IF(qa == zero .AND. qb == zero) igeo(31) = 1
249 IF (qa == zero) qa = onep1
250 IF (qb == zero) qb = fiveem2
251C
252C orthotropy (plane r,t)
253C
254 IF (ihbe /= 14) ip = 3
255C
256 isk = 0
257 IF (idsk/=0) THEN
258 DO j=0,numskw
259 IF(idsk==iskn(4,j+1)) THEN
260 isk=j+1
261 GO TO 10
262 ENDIF
263 ENDDO
264 CALL ancmsg(msgid=184,
265 . msgtype=msgerror,
266 . anmode=aninfo,
267 . c1='PROPERTY',
268 . i1=ig,
269 . c2='PROPERTY',
270 . c3=idtitl,
271 . i2=idsk)
272 10 CONTINUE
273 ENDIF
274 IF (ip <= 0) THEN
275 DO j=0,numskw
276 IF(isk == iskn(4,j+1)) THEN
277 ip=-(j+1)
278 GO TO 100
279 ENDIF
280 ENDDO
281 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
282 . c1='PROPERTY',
283 . c2='PROPERTY',
284 . i2=isk,
285 . i1=ig,
286 . c3=idtitl)
287100 CONTINUE
288 ENDIF
289 igeo(2) = ip
290 igeo(4) = npt
291 igeo(5) = ismstr
292 igeo(6) = irep
293 igeo(7) = isk
294 igeo(9) = iplast-1
295 igeo(10) = ihbe
296 igeo(12) = istrain
297 igeo(13) = icpre
298 igeo(14) = icstr
299 igeo(15) = iint
300 igeo(16) = jcvt-1
301 igeo(30) = nly
302 igeo(97) = icontrol
303C
304 geo(1) = angle
305 geo(7) = vx
306 geo(8) = vy
307 geo(9) = vz
308 geo(13) = cvis
309 geo(14) = qa
310 geo(15) = qb
311 geo(172) = dtmin
312 geo(172) = dtmin
313 geo(190)= vdefmin
314 geo(191)= vdefmax
315 geo(192)= aspmax
316 geo(193)= asptet
317C----
318 IF(.NOT.is_encrypted)THEN
319 IF(igeo(31) == 1)THEN
320 WRITE(iout,1100)ig,ihbe,ismstr,npt,icstr,
321 . cvis,qa,qb,dtmin,icontrol
322 ELSE
323 WRITE(iout,1000)ig,ihbe,ismstr,npt,icstr,
324 . cvis,qa,qb,dtmin,icontrol
325 ENDIF
326 IF(isk == 0)THEN
327 WRITE(iout,1002) geo(7),geo(8),geo(9),irep,angle
328 ELSE
329 WRITE(iout,1001) idsk,irep,angle
330 ENDIF
331 ELSE
332 WRITE(iout,1099) ig
333 ENDIF
334 IF((vdefmin+vdefmax+aspmax+asptet)>zero) THEN
335 IF (vdefmax==zero) vdefmax=ep10
336 IF (aspmax==zero) aspmax=ep10
337 WRITE(iout,3000) vdefmin,vdefmax,aspmax,asptet
338 END IF
339C
340 IF(geo( 3)/=zero.AND.igeo( 5)== 0) igeo( 5)=nint(geo( 3))
341 IF(geo(39)/=zero.AND.igeo( 9)== 0) igeo( 9)=nint(geo(39))
342 IF(geo(171)/=zero.AND.igeo(10)== 0)igeo(10)=nint(geo(171))
343
344 IF (geo(16) /= zero .OR. geo(17) /= zero) THEN
345 igeo(33) = 1 ! ISVIS flag
346 ENDIF
347
348 igeo(17)=1
349
350
351C-------- Variables stored in element buffer
352c---- Thick Shells
353 prop_tag(igtyp)%G_SIG = 6
354 prop_tag(igtyp)%G_VOL = 1
355 prop_tag(igtyp)%G_EINT = 1
356 prop_tag(igtyp)%G_QVIS = 1
357 prop_tag(igtyp)%L_SIG = 6
358 prop_tag(igtyp)%L_EINT = 1
359 prop_tag(igtyp)%L_VOL = 1
360 prop_tag(igtyp)%L_QVIS = 1
361 prop_tag(igtyp)%G_FILL = 1
362
363 prop_tag(igtyp)%G_GAMA = 6
364 prop_tag(igtyp)%L_SIGL = 6
365C
366C Probably useless for PID21 (but addressed in thsol.F ...)
367 prop_tag(igtyp)%L_GAMA = 6
368
369
370C----
371 RETURN
372C---
373 1000 FORMAT(
374 & 5x,'ORTHOTROPIC THICK SHELL PROPERTY SET'/,
375 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
376 & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
377 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
378 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i10/,
379 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
380 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
381 & 5x,'QUADRATIC BULK VISCOSITY. . . . . . . .=',1pg20.13/,
382 & 5x,'LINEAR BULK VISCOSITY . . . . . . . . .=',1pg20.13/,
383 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
384 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
385 1001 FORMAT(
386 & 5x,'ORTHOTROPIC SKEW FRAME. . . . . . . . .=',i10/,
387 & 5x,'LOCAL ORTHOTROPY SYSTEM FORMULATION . .=',i10/,
388 & 5x,'ORTHOTROPIC ANGLE . . . . . . . . . . .=',1pg20.13/)
389 1002 FORMAT(
390 & 5x,'REFERENCE VECTOR VX . . . . . . . . . .=',1pg20.13/,
391 & 5x,'REFERENCE VECTOR VY . . . . . . . . . .=',1pg20.13/,
392 & 5x,'REFERENCE VECTOR VZ . . . . . . . . . .=',1pg20.13/,
393 & 5x,'LOCAL ORTHOTROPY SYSTEM FORMULATION . .=',i10/,
394 & 5x,'ORTHOTROPIC ANGLE . . . . . . . . . . .=',1pg20.13/)
395 1099 FORMAT(
396 & 5x,'ORTHOTROPIC THICK SHELL PROPERTY SET'/,
397 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i8/,
398 & 5x,'CONFIDENTIAL DATA'//)
399 1100 FORMAT(
400 & 5x,'ORTHOTROPIC THICK SHELL PROPERTY SET'/,
401 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
402 & 5x,'FORMULATION FLAG. . . . . . . . . . . .=',i10/,
403 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
404 & 5x,'NUMBER OF INTEGRATION POINTS. . . . .=',i10/,
405 & 5x,'CONSTANT STRESS FLAG. . . . . . . . . .=',i10/,
406 & 5x,'HOURGLASS NUMERICAL DAMPING . . . . . .=',1pg20.13/,
407 & 5x,'DEFAULT VALUE FOR QUADRATIC BULK. . . . ',/,
408 & 5x,' VISCOSITY (QA) WILL BE USED. . . .=',1pg20.13/,
409 & 5x,'EXCEPT IN CASE LAW 70 WHERE QA = 0. ',/,
410 & 5x,'DEFAULT VALUE FOR LINEAR BULK . . . . . ',/,
411 & 5x,' VISCOSITY (QB) WILL BE USED . . . =',1pg20.13/,
412 & 5x,'EXCEPT IN CASE LAW 70 WHERE QB = 0. ',/,
413 & 5x,'BRICK MINIMUM TIME STEP................=',1pg20.13/,
414 & 5x,'SOLID DISTORTION CONTROL FLAG . . . . .=',i10/)
415 3000 FORMAT(
416 & 5x,'SOLID MINIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
417 & 5x,'SOLID MAXIMUM VOLUMETRIC STRAIN........=',1pg20.13/,
418 & 5x,'SOLID MAXIMUM ASPECT RATIO.............=',1pg20.13/,
419 & 5x,'SOLID MINIMUM COLLAPSE RATIO...........=',1pg20.13/)
420C---
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
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
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:895
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54