OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_prop10.F File Reference
#include "implicit_f.inc"
#include "units_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_prop10 (igtyp, geo, igeo, prop_tag, unitab, rtrans, lsubmodel, idtitl, ig, sub_id, iskn, defaults_shell)

Function/Subroutine Documentation

◆ hm_read_prop10()

subroutine hm_read_prop10 ( 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 41 of file hm_read_prop10.F.

44C============================================================================
45C M o d u l e s
46C-----------------------------------------------
47 USE unitab_mod
48 USE elbuftag_mod
49 USE submodel_mod
50 USE message_mod
51 USE names_and_titles_mod , ONLY : nchartitle
52 USE defaults_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "units_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,IHBE,IPLAST,ITHK,IBID,IDF,IHBEOUTP,K,N,
85 . IUNIT,ISEN,ISS,PID1,IPID1, IHBE_OLD,NSTACK,IGMAT,NN,NUMS
86 INTEGER ISH3N,ISROT,SUB_ID,NLY,IRP,IDSK,ISK,IUN
87 INTEGER NLYMAX,N1,M1,N2, N3, IPANG,IPTHK,IPPOS,IPWEIGHT,IPOS
88 INTEGER IHBE_D,IPLA_D,ISTR_D,ITHK_D,ISHEA_D,ISST_D,
89 . ISH3N_D, ISTRA_D,NPTS_D,IDRIL_D
90 my_real
91 . angl,pun,cvis,rbid,vx,vy,vz,
92 . pthk, an, phi_i,thk10,zshift
93 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
94 CHARACTER(LEN=NCHARTITLE) :: TITR
95C-----------------------------------------------
96C E x t e r n a l F u n c t i o n s
97C-----------------------------------------------
98 DATA iun/1/
99 DATA pun/0.1/
100C=======================================================================
101C------------------------
102C ORTHOTROPIC SHELL
103C------------------------
104C=======================================================================
105 ihbe_d = defaults_shell%ishell
106 ish3n_d= defaults_shell%ish3n
107 isst_d = defaults_shell%ismstr
108 ipla_d = defaults_shell%iplas
109 ithk_d = defaults_shell%ithick
110 idril_d= defaults_shell%idrill
111 ishea_d = 0
112 npts_d = 0
113 istra_d = 1
114C fixing flag and removed from input
115 istrain=1
116 ihbe=0
117 ismstr=0
118 isrot=0
119 igmat =0
120 pthk = zero
121 irp = 0
122 idsk = 0
123 ipos =0
124
125 is_encrypted = .false.
126 is_available = .false.
127
128C HIDDEN FLAGS
129C----------------------
130 ishear = 0
131C CVIS USED in coquez routines
132 cvis = one
133
134
135C--------------------------------------------------
136C EXTRACT DATA (IS OPTION CRYPTED)
137C--------------------------------------------------
138 CALL hm_option_is_encrypted(is_encrypted)
139C--------------------------------------------------
140C EXTRACT DATAS (INTEGER VALUES)
141C--------------------------------------------------
142 CALL hm_get_intv('Ishell',ihbe,is_available,lsubmodel)
143 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
144 CALL hm_get_intv('ISH3N',ish3n,is_available,lsubmodel)
145 CALL hm_get_intv('Idrill',isrot,is_available,lsubmodel)
146 CALL hm_get_intv('NIP',nly,is_available,lsubmodel)
147C CALL HM_GET_INTV('ISTRAIN',ISTRAIN,IS_AVAILABLE,LSUBMODEL)
148 CALL hm_get_intv('ITHICK',ithk,is_available,lsubmodel)
149 CALL hm_get_intv('IPLAS',iplast,is_available,lsubmodel)
150 CALL hm_get_intv('SKEW_CSID',idsk,is_available,lsubmodel)
151 CALL hm_get_intv('Ipos',ipos,is_available,lsubmodel)
152 CALL hm_get_intv('Ip',irp,is_available,lsubmodel)
153C--------------------------------------------------
154C EXTRACT DATAS (REAL VALUES)
155C--------------------------------------------------
156 CALL hm_get_floatv('P_Thick_Fail',pthk,is_available,lsubmodel,unitab)
157 CALL hm_get_floatv('Hm',geo(13),is_available,lsubmodel,unitab)
158 CALL hm_get_floatv('Hf',geo(14),is_available,lsubmodel,unitab)
159 CALL hm_get_floatv('Hr',geo(15),is_available,lsubmodel,unitab)
160 CALL hm_get_floatv('Dm',geo(16),is_available,lsubmodel,unitab)
161 CALL hm_get_floatv('Dn',geo(17),is_available,lsubmodel,unitab)
162 CALL hm_get_floatv('THICK',geo(1),is_available,lsubmodel,unitab)
163 CALL hm_get_floatv('AREA_SHEAR',geo(38),is_available,lsubmodel,unitab)
164 CALL hm_get_floatv('V_X',vx,is_available,lsubmodel,unitab)
165 CALL hm_get_floatv('V_Y',vy,is_available,lsubmodel,unitab)
166 CALL hm_get_floatv('V_Z',vz,is_available,lsubmodel,unitab)
167C----------------------
168Capply submodel transform to V (VX,VY,VZ)
169C
170 IF (sub_id /= 0)
171 . CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
172
173C------lecgeo :
174c WRITE(IOUT,'(A40)') IDTITL
175C Double stockage temporaire - supprimer GEO(12,I)=IGTYP apres tests
176 igeo(1)=ig
177 igeo(11)=igtyp
178 geo(12) =igtyp+pun
179
180 IF (pthk == zero) pthk = one-em06
181 pthk = min(pthk, one)
182 pthk = max(pthk,-one)
183 geo(42) = pthk
184C fixing flag and removed from input
185 istrain=1
186C---------IHBE,ISH3N-------------
187 IF(ihbe==0)ihbe=ihbe_d
188 ihbeoutp=ihbe
189 IF (ihbe == 4 .AND. ish3n==0 .AND. ish3n_d == 1) THEN
190 CALL ancmsg(msgid=680,
191 . msgtype=msgwarning,
192 . anmode=aninfo_blind_1,
193 . i1=ig,
194 . c1=idtitl)
195 ENDIF
196 IF (ihbe==22.OR.ihbe==23) THEN
197 CALL ancmsg(msgid=539,
198 . msgtype=msgwarning,
199 . anmode=aninfo_blind_1,
200 . i1=ig,
201 . c1=idtitl)
202 ihbe=24
203 ENDIF
204C Double stockage temporaire -
205 igeo(10)=ihbe
206 geo(171)=ihbe
207 IF(ihbe==2)THEN
208 geo(171)=0
209 ELSEIF(ihbe>=3.AND.ihbe<100.AND.ihbe/=4)THEN
210 geo(171)=ihbe-1
211 ENDIF
212 IF(geo(171)/=zero.AND.igeo(10)== 0)igeo(10)=nint(geo(171))
213 IF(ish3n==0) ish3n = ish3n_d
214 igeo(18) = ish3n
215C---------ISMSTR-------------
216 IF(ismstr==0)ismstr=isst_d
217 IF (isst_d == -2) ismstr = -1
218 IF(ismstr==0)ismstr=2
219 IF(ismstr==3.AND.ihbe/=0.AND.ihbe/=2) THEN
220 ismstr = 2
221 CALL ancmsg(msgid=319,
222 . msgtype=msgwarning,
223 . anmode=aninfo_blind_2,
224 . i1=ig,
225 . c1=idtitl)
226 ENDIF
227 geo(3)=ismstr
228 igeo(5) = ismstr
229C---------ISROT-------------
230 IF(isrot==0)isrot=idril_d
231 IF(isrot>=2) isrot = 0
232 igeo(20)=isrot
233C---------ITHK,ISHEAR,IPLAST,ISTRAIN-------------
234 IF(ithk == 0)ithk=ithk_d
235 IF(ithk_d==-2)ithk=-1
236 IF(ishear == 0)ishear=ishea_d
237 IF(iplast == 0)iplast=ipla_d
238 IF(ipla_d==-2) iplast=-1
239C IF(ISTRAIN == 0)ISTRAIN=ISTR_D
240 geo(11)=istrain
241 geo(35)=ithk
242 geo(37)=ishear
243 IF(ishear==2) geo(37)=0
244 geo(39)=iplast
245 IF(geo(39)/=zero.AND.igeo(9)== 0)igeo(9)=iplast
246C-------other initializations----
247 IF (ismstr==10.AND.isrot>0.AND.idrot==0) idrot = 1
248C
249 IF(ihbe==3)THEN
250 IF(geo(13)==zero)geo(13)=em01
251 IF(geo(14)==zero)geo(14)=em01
252 IF(geo(15)==zero)geo(15)=em02
253 ELSE
254 IF(geo(13)==zero)geo(13)=em02
255 IF(geo(14)==zero)geo(14)=em02
256 IF(geo(15)==zero)geo(15)=em02
257 ENDIF
258 IF(ismstr==3) geo(5)=ep06
259C------Dm
260 IF (geo(16) == zero) igeo(31) = 1
261C------Dn : GEO(13) in Engine
262 IF (ihbe==12) geo(13)=geo(17)
263 IF (ihbe==24) THEN
264 IF (geo(17)==zero) geo(17)=zep015
265 geo(13)=geo(17)
266 geo(17)=cvis
267 ENDIF
268C------lecgeo10 :
269 nlymax= 100
270 ipang = 200
271 ipthk = 300
272 ippos = 400
273 ipweight = 900
274 IF(geo(38) == zero) geo(38)=five_over_6
275 IF(nly == -1)nly=npts_d
276 IF(nly == 0) nly = 1
277 IF(nly == 1) geo(38)= zero
278 an=sqrt(vx*vx+vy*vy+vz*vz)
279c
280 DO i=1,nly
281 geo(ipweight+i) = one
282 ENDDO
283c
284 IF(an <em10)THEN
285 vx=one
286 vy=zero
287 vz=zero
288 IF (irp==23) THEN
289 CALL ancmsg(msgid=1922,
290 . msgtype=msgerror,
291 . anmode=aninfo,
292 . c1='PROPERTY',
293 . i1=ig,
294 . c2='PROPERTY',
295 . c3=titr,
296 . i2=irp)
297 END IF
298 ELSE
299 vx=vx/an
300 vy=vy/an
301 vz=vz/an
302 ENDIF
303 geo(7)=vx
304 geo(8)=vy
305 geo(9)=vz
306 iss=ismstr
307C----
308 isk = 0
309 IF (idsk/=0) THEN
310 DO j=0,numskw+min(iun,nspcond)*numsph+nsubmod
311 IF(idsk == iskn(4,j+1)) THEN
312 isk=j+1
313 GO TO 10
314 ENDIF
315 END DO
316 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
317 CALL ancmsg(msgid=184,
318 . msgtype=msgerror,
319 . anmode=aninfo,
320 . c1='property',
321 . I1=IG,
322 . C2='property',
323 . C3=TITR,
324 . I2=IDSK)
325 10 CONTINUE
326 ENDIF
327.OR..AND. IF ((IRP==22IRP==25)ISK==0) THEN
328 CALL ANCMSG(MSGID=1923,
329 . MSGTYPE=MSGERROR,
330 . ANMODE=ANINFO,
331 . C1='property',
332 . I1=IG,
333 . C2='property',
334 . C3=TITR,
335 . I2=IRP)
336 END IF
337 IGEO(2)=ISK
338 IGEO(14) = IRP
339
340C---+#---1----+----2----+----3----+----4----+----5----+----6----+----7-#
341 IF(IS_ENCRYPTED)THEN
342 WRITE(IOUT,1000)IG
343 1000 FORMAT(
344 & 5X,'orthotropic layered shell property set'/,
345 & 5X,'--------------------------------------'/,
346 & 5X,'property set number . . . . . . . . . .=',I10/,
347 & 5X,'confidential data'//)
348 ELSE
349.AND. IF (IHBE>11IHBE<29) THEN
350 WRITE(IOUT,2011)IG,NLY,ISTRAIN,GEO(1),ISS,IHBE,
351 . ISH3N,IGEO(20),
352 . GEO(16),GEO(13),GEO(38),GEO(42),ISHEAR,ITHK,IPLAST,
353 . GEO(7),GEO(8),GEO(9),IDSK,IGEO(14),IPOS
354 ELSE
355 WRITE(IOUT,2010)IG,NLY,ISTRAIN,GEO(1),ISS,IHBE,
356 . ISH3N,
357 . GEO(13),GEO(14),GEO(15),GEO(16),
358 . GEO(38),GEO(42),ISHEAR,ITHK,IPLAST,
359 . GEO(7),GEO(8),GEO(9),IDSK,IGEO(14),IPOS
360 ENDIF
361 ENDIF
362 IF (NLY == 0) THEN
363 CALL ANCMSG(MSGID=27,
364 . MSGTYPE=MSGERROR,
365 . ANMODE=ANINFO_BLIND_1,
366 . I1=IG,
367 . C1=IDTITL)
368 ENDIF
369 IF (NLY>NLYMAX) THEN
370 CALL ANCMSG(MSGID=28,
371 . MSGTYPE=MSGERROR,
372 . ANMODE=ANINFO_BLIND_1,
373 . I2=NLYMAX,
374 . I1=IG,
375 . C1=IDTITL)
376 ENDIF
377 IGEO(99) = IPOS
378 ZSHIFT = ZERO
379 IF (IPOS==3) THEN
380 ZSHIFT = -HALF
381 ELSEIF (IPOS==4) THEN
382 ZSHIFT = HALF
383 END IF
384 GEO(199) = ZSHIFT
385!
386 N1=MIN0(NLY,NLYMAX)
387 GEO(6) = N1+EM01
388 IGEO(4) = N1
389 THK10 = ONE/N1
390 DO K=1,N1
391 CALL HM_GET_FLOAT_ARRAY_INDEX('prop_phi',PHI_I,K,IS_AVAILABLE,LSUBMODEL,UNITAB)
392C----------------------
393 M1 = IPANG+K
394 GEO(M1) = PHI_I
395 GEO(IPTHK+K) = THK10
396 GEO(IPPOS+K) = -HALF*(ONE+THK10)+K*THK10 + ZSHIFT
397.NOT. IF(IS_ENCRYPTED)WRITE(IOUT,2020) K,GEO(M1)
398 GEO(M1)=GEO(M1)*PI/HUNDRED80
399 ENDDO
400 GEO(200)=GEO(1)
401
402
403C-------- Variables stored in element buffer
404
405c---- Shells
406 PROP_TAG(IGTYP)%G_SIG = 0
407 PROP_TAG(IGTYP)%G_FOR = 5
408 PROP_TAG(IGTYP)%G_MOM = 3
409 PROP_TAG(IGTYP)%G_THK = 1
410 PROP_TAG(IGTYP)%G_EINT= 2
411 PROP_TAG(IGTYP)%G_EINS= 0
412 PROP_TAG(IGTYP)%L_SIG = 5
413
414 PROP_TAG(IGTYP)%L_THK = 0
415 PROP_TAG(IGTYP)%L_EINT= 2
416 PROP_TAG(IGTYP)%L_EINS= 0
417 PROP_TAG(IGTYP)%G_VOL = 0
418 PROP_TAG(IGTYP)%L_VOL = 0
419 PROP_TAG(IGTYP)%LY_DMG = 2
420C
421 PROP_TAG(IGTYP)%LY_GAMA = 6
422 PROP_TAG(IGTYP)%LY_DIRA = 2
423C
424 PROP_TAG(IGTYP)%LY_PLAPT = 1
425 PROP_TAG(IGTYP)%LY_SIGPT = 5
426 PROP_TAG(IGTYP)%G_FORPG = 5
427 PROP_TAG(IGTYP)%G_MOMPG = 3
428 PROP_TAG(IGTYP)%G_STRPG = 8
429C
430
431
432C-----------
433 RETURN
434C-----------
435 2010 FORMAT(
436 & 5X,'orthotropic layered shell property set'/,
437 & 5X,'property set number . . . . . . . . . .=',I10/,
438 & 5X,'number of layers. . . . . . . . . . . .=',I10/,
439 & 5X,'post processing strain flag . . . . . .=',I10/,
440 & 5X,'shell thickness . . . . . . . . . . . .=',1PG20.13/,
441 & 5X,'small strain. . . . . . . . . . . . . .=',I10/,
442 & 5X,'shell formulation flag. . . . . . . . .=',I10/,
443 & 5X,'3node shell formulation flag. . . . . .=',I10/,
444 & 5X,'shell hourglass membrane damping. . . .=',1PG20.13/,
445 & 5X,'shell hourglass flexural damping. . . .=',1PG20.13/,
446 & 5X,'shell hourglass rotational damping. . .=',1PG20.13/,
447 & 5X,'shell membrane damping. . . . . . . . .=',1PG20.13/,
448 & 5X,'shear area reduction factor . . . . . .=',1PG20.13/,
449 & 5X,'element deletion PARAMETER. . . . . . .=',1PG20.13/,
450 & 5X,' > 0.0 : fraction of failed thickness ',/,
451 & 5X,' < 0.0 : fraction of failed layers ',/,
452 & 5X,'shear formulation flag. . . . . . . . .=',I10/,
453 & 5X,'thickness variation flag. . . . . . . .=',I10/,
454 & 5X,'plasticity formulation flag . . . . . .=',I10/,
455 & 5X,'x component of dir 1 of orthotropy. . .=',1PG20.13/,
456 & 5X,'y component of dir 1 of orthotropy. . .=',1PG20.13/,
457 & 5X,'z component of dir 1 of orthotropy. . .=',1PG20.13/,
458 & 5X,'skew of the first orthotropy direction.=',I10/,
459 & 5X,'reference direction flag in shell plane=',I10/,
460 & 5X,'shell offset position flag . . . . . . =',I10/)
461 2011 FORMAT(
462 & 5X,'orthotropic layered shell property set'/,
463 & 5X,'property set number . . . . . . . . . .=',I10/,
464 & 5X,'number of layers. . . . . . . . . . . .=',I10/,
465 & 5X,'post processing strain flag . . . . . .=',I10/,
466 & 5X,'shell thickness . . . . . . . . . . . .=',1PG20.13/,
467 & 5X,'small strain. . . . . . . . . . . . . .=',I10/,
468 & 5X,'shell formulation flag. . . . . . . . .=',I10/,
469 & 5X,'3node shell formulation flag. . . . . .=',I10/,
470 & 5X,'drilling d.o.f. flag . . . . . . . . .=',I10/,
471 & 5X,'shell membrane damping. . . . . . . . .=',1PG20.13/,
472 & 5X,'shell numerical damping . . . . . . . .=',1PG20.13/,
473 & 5X,'shear area reduction factor . . . . . .=',1PG20.13/,
474 & 5X,'element deletion PARAMETER. . . . . . .=',1PG20.13/,
475 & 5X,' > 0.0 : fraction of failed thickness ',/,
476 & 5X,' < 0.0 : fraction of failed layers ',/,
477 & 5X,'shear formulation flag. . . . . . . . .=',I10/,
478 & 5X,'thickness variation flag. . . . . . . .=',I10/,
479 & 5X,'plasticity formulation flag . . . . . .=',I10/,
480 & 5X,'x component of dir 1 of orthotropy. . .=',1PG20.13/,
481 & 5X,'y component of dir 1 of orthotropy. . .=',1PG20.13/,
482 & 5X,'z component of dir 1 of orthotropy. . .=',1PG20.13/,
483 & 5X,'skew of the first orthotropy direction.=',I10/,
484 & 5X,'reference direction flag in shell plane=',I10/,
485 & 5X,'shell offset position flag . . . . . . =',I10/)
486 2020 FORMAT(
487 & 5X,'layer,angle (dir 1,proj(dir 1 / shell).=',I10,E12.5)
488C-----------
489
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
subrotvect
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)
Definition subrot.F:54