43
44
45
51 USE defaults_mod
52
53
54
55#include "implicit_f.inc"
56
57
58
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"
67
68
69
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
80
81
82
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
98
99
100
101 DATA iun/1/
102 DATA pun/0.1/
103
104
105
106
107
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
129
130
131
132 ishear = 0
133
134 cvis = zero
135
136 isen = 0
137
138
139
141
142
143
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)
149
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)
155
156
157
158 CALL hm_get_floatv(
'P_Thick_Fail',pthk,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)
169 CALL hm_get_floatv(
'MAT_BETA',phi,is_available,lsubmodel,unitab)
170
171
172
173 IF (sub_id /= 0)
174 .
CALL subrotvect(vx,vy,vz,rtrans,sub_id,lsubmodel)
175
176
177
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
188 . msgtype=msgwarning,
189 . anmode=aninfo_blind_1,
190 . i1=ig,
191 . c1=idtitl)
192 ENDIF
193 IF (ihbe==22.OR.ihbe==23) THEN
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
209
210
211 END IF
212 ENDIF
213
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
228
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
236 . msgtype=msgwarning,
237 . anmode=aninfo_blind_2,
238 . i1=ig,
239 . c1=idtitl,
240 . i2=ihbe_old,
241 . i3=ihbe)
242 ENDIF
243
244
245
246
247
248 geo(3)=ismstr
249
250 IF(ismstr==3)THEN
251 geo(5)=ep06
252 ENDIF
253
254
255 igeo( 1)=ig
256 igeo(10)=ihbe
257 igeo(11)=igtyp
258 geo(12) =igtyp+pun
259 geo(171)=ihbe
260
261 IF (ihbe>11.AND.ihbe<29) THEN
262
263 geo(13)=geo(17)
264 geo(17)=cvis
265
266 ENDIF
267
268
269 IF(ismstr==0)ismstr=2
270 geo(3)=ismstr
271 igeo(5) = ismstr
272
273
274
275
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
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
304 igeo(4) = nip
305
306
307 geo(7)=vx
308 geo(8)=vy
309 geo(9)=vz
310 geo(10)=phi
311 isk = 0
312 IF (idsk/=0) THEN
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)
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
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
347
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)
357
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
379
380 IF (nip>10) THEN
381 CALL fretitl2(titr,igeo(npropgi-ltitr+1),ltitr)
383 . msgtype=msgerror,
384 . anmode=aninfo_blind_1,
385 . i1=ig,
386 . c1=titr,
387 . i2=nip)
388 ENDIF
389
390
391
392
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
425
426
427
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
443
444 prop_tag(igtyp)%LY_GAMA = 6
445 prop_tag(igtyp)%LY_DIRA = 2
446
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
452
453
454
455
456
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
463 IF(geo(171)/=zero.AND.igeo(10)== 0)
464 . igeo(10)=nint(geo(171))
465
466
467 RETURN
468
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/)
522
523
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)
integer, parameter nchartitle
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)
subroutine subrotvect(x, y, z, rtrans, sub_id, lsubmodel)