OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop09.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "tablen_c.inc"
#include "sphcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop09 (igtyp, geo, igeo, prop_tag, unitab, rtrans, lsubmodel, idtitl, ig, sub_id, iskn, defaults_shell)

Function/Subroutine Documentation

◆ hm_read_prop09()

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

Definition at line 40 of file hm_read_prop09.F.

43C============================================================================
44C M o d u l e s
45C-----------------------------------------------
46 USE unitab_mod
47 USE elbuftag_mod
48 USE submodel_mod
49 USE message_mod
51 USE defaults_mod
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "units_c.inc"
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "param_c.inc"
63#include "scr16_c.inc"
64#include "scr17_c.inc"
65#include "tablen_c.inc"
66#include "sphcom.inc"
67C-----------------------------------------------
68C D u m m y A r g u m e n t s
69C-----------------------------------------------
70 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
71 INTEGER
72 . IGTYP , IGEO(*),ISKN(LISKN,*), IG
73 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
74 my_real geo(*),rtrans(ntransf,*)
75
76 CHARACTER(LEN=NCHARTITLE)::IDTITL
77
78 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
79 TYPE(SHELL_DEFAULTS_), INTENT(IN) :: DEFAULTS_SHELL
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I, ISMSTR, NIP, J,
84 . ISHEAR, IP, ISTRAIN,
85 . IHBE,IPLAST,ITHK,IBID,IDF,IHBEOUTP,K,N,
86 . IUNIT,ISEN,ISS,
87 . PID1,IPID1, IHGFLU, IHBE_OLD,NSTACK,IGMAT,NN,NUMS
88 INTEGER FLAG_FMT,FLAG_FMT_TMP
89 INTEGER ISH3N,ISROT,SUB_ID,IRP,IDSK,ISK,IUN,IPOS
90 INTEGER IHBE_D,IPLA_D,ISTR_D,ITHK_D,ISHEA_D,ISST_D,
91 . ISH3N_D, ISTRA_D,NPTS_D,IDRIL_D
92
94 . angl,pun,cvis,rbid,vx,vy,vz,
95 . pthk, an, phi,zshift
96 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
97 CHARACTER(LEN=NCHARTITLE) :: TITR
98C-----------------------------------------------
99C E x t e r n a l F u n c t i o n s
100C-----------------------------------------------
101 DATA iun/1/
102 DATA pun/0.1/
103C=======================================================================
104C------------------------
105C ORTHOTROPIC SHELL
106C------------------------
107C=======================================================================
108 ihbe=0
109 ismstr=0
110 isrot=0
111 igmat =0
112 pthk = zero
113 irp = 0
114 idsk = 0
115 ipos = 0
116
117 is_encrypted = .false.
118 is_available = .false.
119
120 ihbe_d = defaults_shell%ishell
121 ish3n_d= defaults_shell%ish3n
122 isst_d = defaults_shell%ismstr
123 ipla_d = defaults_shell%iplas
124 ithk_d = defaults_shell%ithick
125 idril_d= defaults_shell%idrill
126 ishea_d = 0
127 npts_d = 0
128 istra_d = 1
129C HIDDEN FLAGS
130C----------------------
131C ISHEAR NEVER USED
132 ishear = 0
133C CVIS USED in coquez routines
134 cvis = zero
135C ISEN USED IN ENGINE call csens3.F routine
136 isen = 0
137C--------------------------------------------------
138C EXTRACT DATA (IS OPTION CRYPTED)
139C--------------------------------------------------
140 CALL hm_option_is_encrypted(is_encrypted)
141C--------------------------------------------------
142C EXTRACT DATAS (INTEGER VALUES)
143C--------------------------------------------------
144 CALL hm_get_intv('Ishell',ihbe,is_available,lsubmodel)
145 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
146 CALL hm_get_intv('ISH3N',ish3n,is_available,lsubmodel)
147 CALL hm_get_intv('Idrill',isrot,is_available,lsubmodel)
148 CALL hm_get_intv('NIP',nip,is_available,lsubmodel)
149C CALL HM_GET_INTV('ISTRAIN',ISTRAIN,IS_AVAILABLE,LSUBMODEL)
150 CALL hm_get_intv('ITHICK',ithk,is_available,lsubmodel)
151 CALL hm_get_intv('IPLAS',iplast,is_available,lsubmodel)
152 CALL hm_get_intv('SKEW_CSID',idsk,is_available,lsubmodel)
153 CALL hm_get_intv('Ipos',ipos,is_available,lsubmodel)
154 CALL hm_get_intv('Ip',irp,is_available,lsubmodel)
155C--------------------------------------------------
156C EXTRACT DATAS (REAL VALUES)
157C--------------------------------------------------
158 CALL hm_get_floatv('P_Thick_Fail',pthk,is_available,lsubmodel,unitab)
159 CALL hm_get_floatv('Hm',geo(13),is_available,lsubmodel,unitab)
160 CALL hm_get_floatv('Hf',geo(14),is_available,lsubmodel,unitab)
161 CALL hm_get_floatv('Hr',geo(15),is_available,lsubmodel,unitab)
162 CALL hm_get_floatv('Dm',geo(16),is_available,lsubmodel,unitab)
163 CALL hm_get_floatv('Dn',geo(17),is_available,lsubmodel,unitab)
164 CALL hm_get_floatv('THICK',geo(1),is_available,lsubmodel,unitab)
165 CALL hm_get_floatv('AREA_SHEAR',geo(38),is_available,lsubmodel,unitab)
166 CALL hm_get_floatv('V_X',vx,is_available,lsubmodel,unitab)
167 CALL hm_get_floatv('V_Y',vy,is_available,lsubmodel,unitab)
168 CALL hm_get_floatv('V_Z',vz,is_available,lsubmodel,unitab)
169 CALL hm_get_floatv('MAT_BETA',phi,is_available,lsubmodel,unitab)
170C----------------------
171Capply submodel transform to V (VX,VY,VZ)
172C
173 IF (sub_id /= 0)
174 . CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
175
176C----------------------
177C fixing flag and removed from input
178 istrain=1
179 IF (pthk == zero) pthk = one-em06
180 pthk = min(pthk, one)
181 pthk = max(pthk,-one)
182 geo(42) = pthk
183
184 IF(ihbe==0)ihbe=ihbe_d
185 ihbeoutp=ihbe
186 IF (ihbe == 4 .AND. ish3n==0 .AND. ish3n_d == 1) THEN
187 CALL ancmsg(msgid=680,
188 . msgtype=msgwarning,
189 . anmode=aninfo_blind_1,
190 . i1=ig,
191 . c1=idtitl)
192 ENDIF
193 IF (ihbe==22.OR.ihbe==23) THEN
194 CALL ancmsg(msgid=539,
195 . msgtype=msgwarning,
196 . anmode=aninfo_blind_1,
197 . i1=ig,
198 . c1=idtitl)
199 ihbe=24
200 ENDIF
201 IF(ish3n==0) ish3n = ish3n_d
202 igeo(18) = ish3n
203 IF (geo(16) == zero) igeo(31) = 1
204
205 IF (ihbe==24) THEN
206 IF (cvis==zero) cvis=one
207 IF (geo(17)==zero) geo(17)=zep015
208 IF (geo(16)==zero) THEN
209C--------------remove in cgrtails
210C IF (IGTYP==1.OR.IGTYP==9) GEO(16,I)=ZEP015
211 END IF
212 ENDIF
213C---
214 IF(ismstr==0)ismstr=isst_d
215 IF (isst_d == -2) ismstr = -1
216 IF(ihbe==3)THEN
217 IF(geo(13)==zero)geo(13)=em01
218 IF(geo(14)==zero)geo(14)=em01
219 IF(geo(15)==zero)geo(15)=em02
220 ELSE
221 IF(geo(13)==zero)geo(13)=em02
222 IF(geo(14)==zero)geo(14)=em02
223 IF(geo(15)==zero)geo(15)=em02
224 ENDIF
225 IF(isrot==0)isrot=idril_d
226 IF(isrot==2) isrot = 0
227 igeo(20)=isrot
228C-------to have DR----
229 IF (ismstr==10.AND.isrot>0.AND.idrot==0) idrot = 1
230
231
232 IF(n2d>0.AND.ihbe/=0.AND.ihbe/=2)THEN
233 ihbe_old=ihbe
234 ihbe=0
235 CALL ancmsg(msgid=321,
236 . msgtype=msgwarning,
237 . anmode=aninfo_blind_2,
238 . i1=ig,
239 . c1=idtitl,
240 . i2=ihbe_old,
241 . i3=ihbe)
242 ENDIF
243C
244c CALL FRETITL(IDTITL,IGEO(NPROPGI-LTITR+1),LTITR)
245c
246c WRITE(IOUT,'(A40)') IDTITL
247C
248 geo(3)=ismstr
249
250 IF(ismstr==3)THEN
251 geo(5)=ep06
252 ENDIF
253
254C double stockage temporaire - supprimer GEO(12)=IGTYP apres tests
255 igeo( 1)=ig
256 igeo(10)=ihbe
257 igeo(11)=igtyp
258 geo(12) =igtyp+pun
259 geo(171)=ihbe
260C
261 IF (ihbe>11.AND.ihbe<29) THEN
262C---------GEO(13,I) est utilise pour porte dn;GEO(17,I),CVIS se change ----
263 geo(13)=geo(17)
264 geo(17)=cvis
265C IGEO(20,I)=ISROT
266 ENDIF
267C----------------------
268
269 IF(ismstr==0)ismstr=2
270 geo(3)=ismstr
271 igeo(5) = ismstr
272
273C----------------------
274C READ LINE 3
275C----------------------
276 ish3n = igeo(18)
277
278 IF (geo(38) == zero)geo(38)=five_over_6
279 IF (nip == -1)nip=npts_d
280 IF (nip == 0) nip = 1
281 IF (nip == 1) geo(38)= zero
282 an=sqrt(vx*vx+vy*vy+vz*vz)
283 IF(an < em10)THEN
284 vx=one
285 vy=zero
286 vz=zero
287 IF (irp==23) THEN
288 CALL ancmsg(msgid=1922,
289 . msgtype=msgerror,
290 . anmode=aninfo,
291 . c1='PROPERTY',
292 . i1=ig,
293 . c2='PROPERTY',
294 . c3=titr,
295 . i2=irp)
296 END IF
297 ELSE
298 vx=vx/an
299 vy=vy/an
300 vz=vz/an
301 ENDIF
302 phi=phi/hundred80*pi
303 geo(6)=nip ! to be cleaned
304 igeo(4) = nip
305
306C
307 geo(7)=vx
308 geo(8)=vy
309 geo(9)=vz
310 geo(10)=phi
311 isk = 0
312 IF (idsk/=0) THEN
313 DO j=0,numskw+min(iun,nspcond)*numsph+nsubmod
314 IF(idsk == iskn(4,j+1)) THEN
315 isk=j+1
316 GO TO 10
317 ENDIF
318 END DO
319 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
320 CALL ancmsg(msgid=184,
321 . msgtype=msgerror,
322 . anmode=aninfo,
323 . c1='PROPERTY',
324 . i1=ig,
325 . c2='PROPERTY',
326 . c3=titr,
327 . i2=idsk)
328 10 CONTINUE
329 ENDIF
330 IF ((irp==22.OR.irp==25).AND.isk==0) THEN
331 CALL ancmsg(msgid=1923,
332 . msgtype=msgerror,
333 . anmode=aninfo,
334 . c1='PROPERTY',
335 . i1=ig,
336 . c2='PROPERTY',
337 . c3=titr,
338 . i2=irp)
339 END IF
340 igeo(2)=isk
341 igeo(14) = irp
342 IF(ithk == 0)ithk=ithk_d
343 IF(ithk_d==-2)ithk=-1
344 IF(ishear == 0)ishear=ishea_d
345 IF(iplast == 0)iplast=ipla_d
346 IF(ipla_d==-2) iplast=-1
347c IF(ISTRAIN == 0)ISTRAIN=ISTR_D
348 geo(11)=istrain
349 ihbe=igeo(10)
350 geo(35)=ithk
351 geo(37)=ishear
352 geo(39)=iplast
353 igeo(3)=isen
354 iss = int(geo(3))
355 ig = igeo(1)
356 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
357C---+#---1----+----2----+----3----+----4----+----5----+----6----+----7-#
358 IF(is_encrypted)THEN
359 WRITE(iout,1000)ig
360 1000 FORMAT(
361 & 5x,'ORTHOTROPIC SHELL PROPERTY SET'/,
362 & 5x,'------------------------------'/,
363 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
364 & 5x,'CONFIDENTIAL DATA'//)
365 ELSE
366 IF (ihbe>11.AND.ihbe<29) THEN
367 WRITE(iout,1011)ig,nip,istrain,geo(1),iss,ihbe,
368 . ish3n,igeo(20) ,
369 . geo(16),geo(13),geo(38),geo(42),ishear,ithk,iplast,
370 . geo(7),geo(8),geo(9),geo(10),idsk,igeo(14),ipos
371 ELSE
372 WRITE(iout,1010)ig,nip,istrain,geo(1),iss,ihbe,
373 . ish3n,
374 . geo(13),geo(14),geo(15),geo(16),
375 . geo(38),geo(42),ishear,ithk,iplast,
376 . geo(7),geo(8),geo(9),geo(10),idsk,igeo(14),ipos
377 ENDIF
378 ENDIF
379C
380 IF (nip>10) THEN
381 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
382 CALL ancmsg(msgid=33,
383 . msgtype=msgerror,
384 . anmode=aninfo_blind_1,
385 . i1=ig,
386 . c1=titr,
387 . i2=nip)
388 ENDIF
389
390C-----------------------------
391C IHBE IPLA ISTRAIN - shells
392C-----------------------------
393
394
395 ihbe=nint(geo(171))
396 IF(ihbe==0)THEN
397 geo(171)=0
398 ELSEIF(ihbe==1)THEN
399 geo(171)=1
400 ELSEIF(ihbe==2)THEN
401 geo(171)=0
402 ELSEIF(ihbe>=3.AND.ihbe<100.AND.ihbe/=4)THEN
403 geo(171)=ihbe-1
404 ENDIF
405
406
407 ishear = geo(37)
408 IF(ishear==0)THEN
409 geo(37)=0
410 ELSEIF(ishear==1)THEN
411 geo(37)=1
412 ELSEIF(ishear==2)THEN
413 geo(37)=0
414 ENDIF
415
416 igeo(99) = ipos
417 zshift = zero
418 IF (ipos==3) THEN
419 zshift = -half
420 ELSEIF (ipos==4) THEN
421 zshift = half
422 END IF
423 geo(199) = zshift
424
425C-------- Variables stored in element buffer
426
427c---- Shells
428 prop_tag(igtyp)%G_SIG = 0
429 prop_tag(igtyp)%G_FOR = 5
430 prop_tag(igtyp)%G_MOM = 3
431 prop_tag(igtyp)%G_THK = 1
432 prop_tag(igtyp)%G_EINT= 2
433 prop_tag(igtyp)%G_EINS= 0
434 prop_tag(igtyp)%G_AREA= 1
435 prop_tag(igtyp)%L_SIG = 5
436
437 prop_tag(igtyp)%L_THK = 0
438 prop_tag(igtyp)%L_EINT= 2
439 prop_tag(igtyp)%L_EINS= 0
440 prop_tag(igtyp)%G_VOL = 0
441 prop_tag(igtyp)%L_VOL = 0
442 prop_tag(igtyp)%LY_DMG = 2
443C
444 prop_tag(igtyp)%LY_GAMA = 6
445 prop_tag(igtyp)%LY_DIRA = 2
446C
447 prop_tag(igtyp)%LY_PLAPT = 1
448 prop_tag(igtyp)%LY_SIGPT = 5
449 prop_tag(igtyp)%G_FORPG = 5
450 prop_tag(igtyp)%G_MOMPG = 3
451 prop_tag(igtyp)%G_STRPG = 8
452C
453
454C-------------------------------
455C Double stockage temporaire : GEO() / IGEO() : a supprimer a terme
456C
457 igeo(1) =ig
458 igeo(11)=igtyp
459
460 IF(geo( 3)/=zero.AND.igeo( 5)== 0)igeo( 5)=nint(geo( 3))
461
462 IF(geo(39)/=zero.AND.igeo( 9)== 0)igeo( 9)=nint(geo(39))
463 IF(geo(171)/=zero.AND.igeo(10)== 0)
464 . igeo(10)=nint(geo(171))
465
466C-----------
467 RETURN
468C-----------
469 1010 FORMAT(
470 & 5x,'ORTHOTROPIC SHELL PROPERTY SET'/,
471 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
472 & 5x,'NUMBER OF INTEGRATION POINTS. . . . . .=',i10/,
473 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
474 & 5x,'SHELL THICKNESS . . . . . . . . . . . .=',1pg20.13/,
475 & 5x,'SMALL STRAIN . . . . . . . . . . . . .=',i10/,
476 & 5x,'SHELL FORMULATION FLAG. . . . . . . . .=',i10/,
477 & 5x,'3NODE SHELL FORMULATION FLAG. . . . . .=',i10/,
478 & 5x,'SHELL HOURGLASS MEMBRANE DAMPING. . . .=',1pg20.13/,
479 & 5x,'SHELL HOURGLASS FLEXURAL DAMPING. . . .=',1pg20.13/,
480 & 5x,'SHELL HOURGLASS ROTATIONAL DAMPING. . .=',1pg20.13/,
481 & 5x,'SHELL MEMBRANE DAMPING. . . . . . . . .=',1pg20.13/,
482 & 5x,'SHEAR AREA REDUCTION FACTOR . . . . . .=',1pg20.13/,
483 & 5x,'ELEMENT DELETION PARAMETER. . . . . . .=',1pg20.13/,
484 & 5x,' > 0.0 : FRACTION OF FAILED THICKNESS ',/,
485 & 5x,' < 0.0 : FRACTION OF FAILED INTG. POINTS',/,
486 & 5x,'SHEAR FORMULATION FLAG. . . . . . . . .=',i10/,
487 & 5x,'THICKNESS VARIATION FLAG. . . . . . . .=',i10/,
488 & 5x,'PLASTICITY FORMULATION FLAG . . . . . .=',i10/,
489 & 5x,'X COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
490 & 5x,'Y COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
491 & 5x,'Z COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
492 & 5x,'ANGLE (DIR 1,PROJ(DIR 1 / SHELL). . . .=',1pg20.13/,
493 & 5x,'SKEW OF THE FIRST ORTHOTROPY DIRECTION.=',i10/,
494 & 5x,'REFERENCE DIRECTION FLAG IN SHELL PLANE=',i10/,
495 & 5x,'SHELL OFFSET POSITION FLAG . . . . . . =',i10/)
496 1011 FORMAT(
497 & 5x,'ORTHOTROPIC SHELL PROPERTY SET'/,
498 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
499 & 5x,'NUMBER OF INTEGRATION POINTS. . . . . .=',i10/,
500 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
501 & 5x,'SHELL THICKNESS . . . . . . . . . . . .=',1pg20.13/,
502 & 5x,'SMALL STRAIN . . . . . . . . . . . . .=',i10/,
503 & 5x,'SHELL FORMULATION FLAG. . . . . . . . .=',i10/,
504 & 5x,'3NODE SHELL FORMULATION FLAG. . . . . .=',i10/,
505 & 5x,'DRILLING D.O.F. FLAG . . . . . . . . .=',i10/,
506 & 5x,'SHELL MEMBRANE DAMPING. . . . . . . . .=',1pg20.13/,
507 & 5x,'SHELL NUMERICAL DAMPING . . . . . . . .=',1pg20.13/,
508 & 5x,'SHEAR AREA REDUCTION FACTOR . . . . . .=',1pg20.13/,
509 & 5x,'ELEMENT DELETION PARAMETER. . . . . . .=',1pg20.13/,
510 & 5x,' > 0.0 : FRACTION OF FAILED THICKNESS ',/,
511 & 5x,' < 0.0 : FRACTION OF FAILED INTG. POINTS',/,
512 & 5x,'SHEAR FORMULATION FLAG. . . . . . . . .=',i10/,
513 & 5x,'THICKNESS VARIATION FLAG. . . . . . . .=',i10/,
514 & 5x,'PLASTICITY FORMULATION FLAG . . . . . .=',i10/,
515 & 5x,'X COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
516 & 5x,'Y COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
517 & 5x,'Z COMPONENT OF DIR 1 OF ORTHOTROPY. . .=',1pg20.13/,
518 & 5x,'ANGLE (DIR 1,PROJ(DIR 1 / SHELL). . . .=',1pg20.13/,
519 & 5x,'SKEW OF THE FIRST ORTHOTROPY DIRECTION.=',i10/,
520 & 5x,'REFERENCE DIRECTION FLAG IN SHELL PLANE=',i10/,
521 & 5x,'SHELL OFFSET POSITION FLAG . . . . . . =',i10/)
522C-----------
523
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
subroutine hm_option_is_encrypted(is_encrypted)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
integer, parameter nchartitle
integer nsubmod
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
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54