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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_prop01 (geo, igeo, prop_tag, multi_fvm, igtyp, ig, idtitl, unitab, lsubmodel, defaults_shell)

Function/Subroutine Documentation

◆ hm_read_prop01()

subroutine hm_read_prop01 ( geo,
integer, dimension(*) igeo,
type(prop_tag_), dimension(0:maxprop) prop_tag,
type(multi_fvm_struct) multi_fvm,
integer igtyp,
integer ig,
character(len=nchartitle) idtitl,
type (unit_type_), intent(in) unitab,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type(shell_defaults_), intent(in) defaults_shell )

Definition at line 39 of file hm_read_prop01.F.

42C============================================================================
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE elbuftag_mod
47 USE message_mod
48 USE multi_fvm_mod
49 USE submodel_mod
50 USE hm_option_read_mod
51 USE pinchtype_mod
52 USE names_and_titles_mod , ONLY : nchartitle
53 USE defaults_mod
54C-----------------------------------------------
55C I m p l i c i t T y p e s
56C-----------------------------------------------
57#include "implicit_f.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61#include "units_c.inc"
62#include "com04_c.inc"
63#include "scr16_c.inc"
64#include "tablen_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
69 INTEGER IGEO(*)
70 INTEGER IGTYP,IG,UID,SUB_ID
71 my_real
72 . geo(*)
73 CHARACTER(LEN=NCHARTITLE)::IDTITL
74 TYPE(PROP_TAG_) , DIMENSION(0:MAXPROP) :: PROP_TAG
75 TYPE(MULTI_FVM_STRUCT) :: MULTI_FVM
76 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
77 TYPE(SHELL_DEFAULTS_), INTENT(IN) :: DEFAULTS_SHELL
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER I, ISMSTR, NIP, J,
82 . ISHEAR, IP, ISTRAIN,
83 . IHBE,IPLAST,ITHK,IBID,IHBEOUTP,K,N,
84 . NSHELL, NSHSUP, NSHINF,
85 . NSST_D, NSST_DS, NPSH,ISEN,ISORTH,
86 . IHBE_OLD, ISH3N,ISROT,IPINCH,I1,I2,IPOS
87 INTEGER IHBE_D,IPLA_D,ISTR_D,ITHK_D,ISHEA_D,ISST_D,
88 . ISH3N_D, ISTRA_D,NPTS_D,IDRIL_D
89
90 my_real
91 . pun,cvis,dn_p,pthk,zshift
92 LOGICAL IS_AVAILABLE, IS_ENCRYPTED
93 DATA nshell /0/, nshsup /0/, nshinf /0/
94C-----------------------------------------------
95 DATA pun/0.1/
96C=======================================================================
97 is_encrypted = .false.
98 is_available = .false.
99
100 ihbe=0
101 ismstr=0
102 isrot=0
103 ipinch=0
104 isorth=0
105 isen=0
106 npsh=0
107 nsst_d = 0
108 nsst_ds= 0
109 pthk = zero
110 ipos =0
111C
112 ihbe_d = defaults_shell%ishell
113 ish3n_d= defaults_shell%ish3n
114 isst_d = defaults_shell%ismstr
115 ipla_d = defaults_shell%iplas
116 ithk_d = defaults_shell%ithick
117 idril_d= defaults_shell%idrill
118 ishea_d = 0
119 npts_d = 0
120 istra_d = 1
121C Double stockage temporaire - supprimer GEO(12)=IGTYP apres tests
122 igeo( 1)=ig
123 igeo(11)=igtyp
124 geo(12) =igtyp+pun
125C----------------------
126C HIDDEN FLAGS
127C----------------------
128C ISHEAR NEVER USED
129 ishear = 0
130C CVIS USED in coquez routines
131 cvis = zero
132C ISEN USED IN ENGINE call csens3.F routine
133 isen = 0
134C--------------------------------------------------
135C EXTRACT DATA (IS OPTION CRYPTED)
136C--------------------------------------------------
137 CALL hm_option_is_encrypted(is_encrypted)
138C--------------------------------------------------
139C EXTRACT DATAS (INTEGER VALUES)
140C--------------------------------------------------
141 CALL hm_get_intv('Ishell',ihbe,is_available,lsubmodel)
142 CALL hm_get_intv('Ismstr',ismstr,is_available,lsubmodel)
143 CALL hm_get_intv('Ish3',ish3n,is_available,lsubmodel)
144 CALL hm_get_intv('Idrill',isrot,is_available,lsubmodel)
145 CALL hm_get_intv('Ipinch',ipinch,is_available,lsubmodel)
146 CALL hm_get_intv('NIP',nip,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('Ipos',ipos,is_available,lsubmodel)
151C--------------------------------------------------
152C EXTRACT DATAS (REAL VALUES)
153C--------------------------------------------------
154 CALL hm_get_floatv('P_Thick_Fail',pthk,is_available,lsubmodel,unitab)
155 CALL hm_get_floatv('Hm',geo(13),is_available,lsubmodel,unitab)
156 CALL hm_get_floatv('Hf',geo(14),is_available,lsubmodel,unitab)
157 CALL hm_get_floatv('Hr',geo(15),is_available,lsubmodel,unitab)
158 CALL hm_get_floatv('Dm',geo(16),is_available,lsubmodel,unitab)
159 CALL hm_get_floatv('Dn',geo(17),is_available,lsubmodel,unitab)
160 CALL hm_get_floatv('THICK',geo(1),is_available,lsubmodel,unitab)
161 CALL hm_get_floatv('AREA_SHEAR',geo(38),is_available,lsubmodel,unitab)
162C----------------------
163C For example : apply submodel offsets units submodel transform to V (VX,VY,VZ) if needed
164C
165c IF (SUB_INDEX /= 0)
166c . CALL SUBROTVECT(VX,VY,VZ,RTRANS,SUB_INDEX,LSUBMODEL)
167C----------------------
168C
169 IF (pthk == zero) pthk = one-em06
170 pthk = min(pthk, one)
171 pthk = max(pthk,-one)
172 geo(42) = pthk
173C----------------------
174C fixing flag and removed from input
175 istrain=1
176 IF(ihbe==0)ihbe=ihbe_d
177 ihbeoutp=ihbe
178 IF (ihbe == 4 .AND. ish3n==0 .AND. ish3n_d == 1) THEN
179 CALL ancmsg(msgid=680,
180 . msgtype=msgwarning,
181 . anmode=aninfo_blind_1,
182 . i1=ig,
183 . c1=idtitl)
184 ENDIF
185 IF (ihbe==22.OR.ihbe==23) THEN
186 CALL ancmsg(msgid=539,
187 . msgtype=msgwarning,
188 . anmode=aninfo_blind_1,
189 . i1=ig,
190 . c1=idtitl)
191 ihbe=24
192 ENDIF
193 IF(ish3n==0) ish3n = ish3n_d
194 igeo(18) = ish3n
195 IF (geo(16) == zero) igeo(31) = 1
196
197 IF (ihbe==24) THEN
198 IF (cvis==zero) cvis=one
199 IF (geo(17)==zero) geo(17)=zep015
200 ENDIF
201C---
202 IF(ismstr==0)ismstr=isst_d
203 IF (isst_d == -2) ismstr = -1
204 IF(ihbe==3)THEN
205 IF(geo(13)==zero)geo(13)=em01
206 IF(geo(14)==zero)geo(14)=em01
207 IF(geo(15)==zero)geo(15)=em02
208 ELSE
209 IF(geo(13)==zero)geo(13)=em02
210 IF(geo(14)==zero)geo(14)=em02
211 IF(geo(15)==zero)geo(15)=em02
212 ENDIF
213 IF(isrot==0)isrot=idril_d
214 IF(isrot==2) isrot = 0
215 igeo(20)=isrot
216 igeo(51)=ipinch
217 IF(ipinch /= 1 .AND. ipinch /=0) THEN
218 CALL ancmsg(msgid=1700,anmode=aninfo,msgtype=msgerror,
219 . i1=ig, c1=idtitl, i2=ipinch)
220 ENDIF
221 IF(ipinch == 1) THEN
222 npinch = numnod
223 ENDIF
224C-------to have DR---- to do it in cgrtais when Ismstr=10 is recommended one day
225 IF (ismstr==10.AND.isrot>0.AND.idrot==0) idrot = 1
226C
227 IF (ihbe>11.AND.ihbe<29) THEN
228 geo(13)=geo(17)
229 geo(17)=cvis
230 ENDIF
231C----------------------
232 IF(ismstr==0)ismstr=2
233 IF(ismstr==3.AND.ihbe/=0.AND.ihbe/=2) THEN
234 ismstr = 2
235 CALL ancmsg(msgid=319,
236 . msgtype=msgwarning,
237 . anmode=aninfo_blind_2,
238 . i1=ig,
239 . c1=idtitl)
240 ENDIF
241 geo(3)=ismstr
242C----------------------
243C
244 IF(geo(38)==zero) geo(38)=five_over_6
245 IF(nip==-1)nip=npts_d
246 IF(nip==1)THEN
247 IF(ihbe==0.OR.ihbe==2) THEN
248 ihbe_old=ihbe
249 ihbe = 1
250 CALL ancmsg(msgid=322,
251 . msgtype=msgwarning,
252 . anmode=aninfo_blind_2,
253 . i1=ig,
254 . c1=idtitl,
255 . i2=ihbe_old,
256 . i3=ihbe)
257 ENDIF
258 geo(38)= zero
259 ENDIF
260 IF(nip>10) THEN
261 CALL ancmsg(msgid=788,
262 . msgtype=msgerror,
263 . anmode=aninfo,
264 . i1=ig,
265 . c1=idtitl)
266
267 ENDIF
268 IF(ithk==0) ithk=ithk_d
269 IF(ithk_d==-2) ithk=-1
270 IF(ishear==0) ishear=ishea_d
271 IF(iplast==0) iplast=ipla_d
272 IF(ipla_d==-2) iplast=-1
273C IF(ISTRAIN==0)ISTRAIN=ISTR_D
274 IF(.NOT. is_encrypted)THEN
275 IF (ihbe>11.AND.ihbe<29.OR.
276 . (ihbe==0.AND.(ish3n==1.OR.ish3n==2))) THEN
277C-------not change default dn of DKT with old define (ishel=12)
278 dn_p = geo(13)
279 IF (ihbe==12.AND.dn_p==zero) dn_p=em03
280 WRITE(iout,1112)ig,nip,istrain,geo(1),ismstr,ihbeoutp,
281 . ish3n,isrot,ipinch,geo(16),dn_p,geo(38),
282 . pthk,ishear,ithk,iplast,ipos
283 ELSE
284 WRITE(iout,1110)ig,nip,istrain,geo(1),ismstr,ihbeoutp,
285 . ish3n,
286 . geo(13),geo(14),geo(15),geo(16),geo(38),
287 . pthk,ishear,ithk,iplast,ipos
288 ENDIF
289 ELSE
290 WRITE(iout,1199)ig
291 ENDIF
292 nshell = nshell + 1
293 IF (geo(1)>=9) nshsup = nshsup +1
294 IF (geo(1)<fourth) nshinf = nshinf +1
295 geo(6) =nip+pun
296 igeo(4) =nip
297
298 geo(35) =ithk
299 geo(39) =iplast
300 igeo(3) =isen
301C-----------------------------
302C IHBE IPLA ISTRAIN
303C-----------------------------
304C Double stockage temporaire
305 geo(171)=ihbe
306 igeo(10)=ihbe
307 IF(ihbe==0)THEN
308 geo(171)=0
309 ELSEIF(ihbe==1)THEN
310 geo(171)=1
311 ELSEIF(ihbe==2)THEN
312 geo(171)=0
313 ELSEIF(ihbe>=3.AND.ihbe<100.AND.ihbe/=4)THEN
314 geo(171)=ihbe-1
315 ENDIF
316
317 geo(11) =istrain
318
319 geo(37) =ishear
320 IF(ishear==0)THEN
321 geo(37)=0
322 ELSEIF(ishear==1)THEN
323 geo(37)=1
324 ELSEIF(ishear==2)THEN
325 geo(37)=0
326 ENDIF
327
328 igeo(17)=isorth ! == 0 Isotropic property
329 igeo(99) = ipos
330 zshift = zero
331 IF (ipos==3) THEN
332 zshift = -half
333 ELSEIF (ipos==4) THEN
334 zshift = half
335 END IF
336 geo(199) = zshift
337C-------------------------------
338C Double stockage temporaire
339 igeo( 5)=nint(geo( 3))
340 igeo( 9)=nint(geo(39))
341C-----------------------------
342C PROPERTY BUFFER
343C-----------------------------
344 prop_tag(igtyp)%G_SIG = 0
345 prop_tag(igtyp)%G_FOR = 5
346 prop_tag(igtyp)%G_MOM = 3
347 prop_tag(igtyp)%G_THK = 1
348 prop_tag(igtyp)%G_EINT= 2
349 prop_tag(igtyp)%G_EINS= 0
350 prop_tag(igtyp)%G_AREA= 1
351 prop_tag(igtyp)%L_SIG = 5
352 prop_tag(igtyp)%L_THK = 0
353 prop_tag(igtyp)%L_EINT= 2
354 prop_tag(igtyp)%L_EINS= 0
355 prop_tag(igtyp)%G_VOL = 0
356 prop_tag(igtyp)%L_VOL = 0
357 prop_tag(igtyp)%LY_DMG = 2
358 prop_tag(igtyp)%LY_PLAPT = 1
359 prop_tag(igtyp)%LY_SIGPT = 5
360 prop_tag(igtyp)%G_FORPG = 5
361 prop_tag(igtyp)%G_MOMPG = 3
362 prop_tag(igtyp)%G_STRPG = 8
363C pinching for batoz shells
364 IF (igtyp == 1 .AND. ihbe == 12 .AND. ipinch == 1) THEN
365 prop_tag(igtyp)%G_FORPGPINCH = 1
366 prop_tag(igtyp)%G_MOMPGPINCH = 2
367 prop_tag(igtyp)%G_EPGPINCHXZ = 1
368 prop_tag(igtyp)%G_EPGPINCHYZ = 1
369 prop_tag(igtyp)%G_EPGPINCHZZ = 1
370 ENDIF
371C-------------------------------
372 RETURN
373C-----------
374 1110 FORMAT(
375 & 5x,'ISOTROPIC SHELL PROPERTY SET'/,
376 & 5x,'PROPERTY SET NUMBER . . . . . . . . . .=',i10/,
377 & 5x,'NUMBER OF INTEGRATION POINTS. . . . . .=',i10/,
378 & 5x,'POST PROCESSING STRAIN FLAG . . . . . .=',i10/,
379 & 5x,'SHELL THICKNESS . . . . . . . . . . . .=',1pg20.13/,
380 & 5x,'SMALL STRAIN FLAG . . . . . . . . . . .=',i10/,
381 & 5x,'SHELL FORMULATION FLAG. . . . . . . . .=',i10/,
382 & 5x,'3NODE SHELL FORMULATION FLAG. . . . . .=',i10/,
383 & 5x,'SHELL HOURGLASS MEMBRANE DAMPING. . . .=',1pg20.13/,
384 & 5x,'SHELL HOURGLASS FLEXURAL DAMPING. . . .=',1pg20.13/,
385 & 5x,'SHELL HOURGLASS ROTATIONAL DAMPING. . .=',1pg20.13/,
386 & 5x,'SHELL MEMBRANE DAMPING. . . . . . . . .=',1pg20.13/,
387 & 5x,'SHEAR AREA REDUCTION FACTOR . . . . . .=',1pg20.13/,
388 & 5x,'ELEMENT DELETION PARAMETER. . . . . . .=',1pg20.13/,
389 & 5x,' > 0.0 : fraction of failed thickness ',/,
390 & 5X,' < 0.0 : fraction of failed intg. points',/,
391 & 5X,'shear formulation flag. . . . . . . . .=',I10/,
392 & 5X,'thickness variation flag. . . . . . . .=',I10/,
393 & 5X,'plasticity formulation flag . . . . . .=',I10/,
394 & 5X,'shell offset position flag . . . . . . =',I10//)
395 1112 FORMAT(
396 & 5X,'isotropic shell property set'/,
397 & 5X,'property set number . . . . . . . . . .=',I10/,
398 & 5X,'number of integration points. . . . . .=',I10/,
399 & 5X,'post processing strain flag . . . . . .=',I10/,
400 & 5X,'shell thickness . . . . . . . . . . . .=',1PG20.13/,
401 & 5X,'small strain flag . . . . . . . . . . .=',I10/,
402 & 5X,'shell formulation flag. . . . . . . . .=',I10/,
403 & 5X,'3node shell formulation flag. . . . . .=',I10/,
404 & 5X,'drilling d.o.f. flag . . . . . . . . .=',I10/,
405 & 5X,'pinching d.o.f. flag . . . . . . . . .=',I10/,
406 & 5X,'shell membrane damping. . . . . . . . .=',1PG20.13/,
407 & 5X,'shell numerical damping . . . . . . . .=',1PG20.13/,
408 & 5X,'shear area reduction factor . . . . . .=',1PG20.13/,
409 & 5X,'element deletion PARAMETER. . . . . . .=',1PG20.13/,
410 & 5X,' > 0.0 : fraction of failed thickness ',/,
411 & 5X,' < 0.0 : fraction of failed intg. points',/,
412 & 5X,'shear formulation flag. . . . . . . . .=',I10/,
413 & 5X,'thickness variation flag. . . . . . . .=',I10/,
414 & 5X,'plasticity formulation flag . . . . . .=',I10/,
415 & 5X,'shell offset position flag . . . . . . =',I10//)
416 1199 FORMAT(
417 & 5X,'isotropic shell property set'/,
418 & 5X,'property set number . . . . . . . . . .=',I10/,
419 & 5X,'confidential data'//)
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
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
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
pinchtype_mod
Definition pinchtype_mod.F:69
pinchtype_mod::npinch
integer npinch
Definition pinchtype_mod.F:73
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