76 . BUFGEO,LBUFGEO ,ISKN ,IGEO ,IPM ,
77 . NPC ,PLD ,UNITAB ,RTRANS,LSUBMODEL ,
78 . PROP_TAG ,IPART ,KNOT,IDRAPEID,STACK_INFO,
79 . NUMGEO_STACK,NPROP_STACK, MULTI_FVM,IADBUF,DEFAULTS)
101#include "implicit_f.inc"
105#include "units_c.inc"
106#include "com04_c.inc"
107#include "param_c.inc"
108#include "scr17_c.inc"
109#include "tablen_c.inc"
113 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
114 INTEGER IX(*),ITABM1(*),LBUFGEO,ISKN(LISKN,*),
115 . IGEO(NPROPGI,*),IPM(NPROPMI,*),NPC(*),
116 . IPART(LIPART1,*),IDRAPEID(*),NUMGEO_STACK(NUMGEO+NUMSTACK),
119 my_real GEO(NPROPG,NUMGEO), X(*), PM(NPROPM,NUMMAT),PLD(*),RTRANS(NTRANSF,*),KNOT(*)
121 DOUBLE PRECISION BUFGEO(*)
123 TYPE(
prop_tag_) ,
DIMENSION(0:MAXPROP) :: PROP_TAG
124 TYPE(STACK_INFO_ ) ,
DIMENSION (NPROP_STACK) :: STACK_INFO
125 TYPE(multi_fvm_struct) :: MULTI_FVM
126 TYPE(DEFAULTS_),
INTENT(INOUT) :: DEFAULTS
131 INTEGER I, PROP_ID, IGTYP, ISMSTR, NIP, J, IR1X, IR1Y, , IREP,
132 . IR2X, IR2Y, IR2Z, ISHEAR, IRX, IROT, IMODE, IP, ISTRAIN,I8PT,
133 . ISK,ITU,IRB,IHON,IHBE,IPLAST,ITHK,IBID,IHBEOUTP,K,N,
134 . igflu, ids, nshell, nshsup, nshinf, flgbadi, nbadi,iunit,uid,
135 . nsst_d, nsst_ds, npsh, icpre, icstr ,npts,isen,isorth,
136 . pid1,ipid1, ihgflu, ihbe_old,nstack,nn,nums
137 INTEGER ISH3N,IFLAGUNIT,ICXFEM, IPPID,IPMAT,IPANG,IPTHK,
138 . IPPOS, JPID,N1,IPOS,ISROT,MLAWLY,MID,SUB_ID,
139 . PROP_SHELL,PROP_TSHEL,PROP_SOLID,PROP_SPH,PROP_BEAM,
140 . IAD_KNOT,IPDIR,ISTACK,PROP_TRUSS,PROP_SPRING,PROP_NSTRAND,IPINCH
142 INTEGER JPID1,JPID2,NISUB,IPISUB,IFRAM,E_TYPE,OFF_DEF(NSUBMOD),CPT,
144 my_real FN, FT, DX, ANGL,PUN,HTEST,HCLOS,CVIS,RBID,VX,VY,VZ,
145 . FAC_L,FAC_T,FAC_M, TMIN,TMAX,DT,THICKT,IERREL,DN_P,ZSHIFT,
146 CHARACTER(LEN=NCHARLINE) :: IDTITL,KEY,SOLVERKEYWORD
148 CHARACTER(LEN=NCHARKEY) :: KEY2
149 CHARACTER(LEN=NCHARFIELD) ::STRING
150 CHARACTER(LEN=NCHARTITLE) :: TITR1
152 DATA nshell /0/, nshsup /0/, nshinf /0/
157 DATA MESS/
'PID DEFINITION '/
275 IF(
ale%GLOBAL%ICAA == 1)igflu=1
290 . option_id = prop_id,
292 . submodel_id = sub_id,
293 . submodel_index = sub_index,
294 . option_titr = idtitl,
300 DO iunit=1,unitab%NUNITS
301 IF (unitab%UNIT_ID(iunit) == uid)
THEN
306 IF (uid/=0.AND.iflagunit==0)
THEN
307 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
308 . i2=uid,i1=prop_id,c1=
'PROPERTY',
315 CALL fretitl(idtitl,igeo(npropgi-ltitr+1,i),ltitr)
316 WRITE(iout,
'(A40)') idtitl
325 SELECT CASE(key(1:len_trim(key)))
326 CASE (
'TYPE0',
'VOID')
331 CALL hm_read_prop0(geo(1,i),igeo(1,i),prop_id,igtyp,unitab,lsubmodel)
333 CASE (
'TYPE1',
'TYPE01',
'SHELL')
338 CALL hm_read_prop01(geo(1,i),igeo(1,i),prop_tag ,multi_fvm,igtyp,prop_id,idtitl,unitab,lsubmodel,
341 CASE (
'TYPE2',
'TYPE02',
'TRUS',
'TRUSS')
346 CALL hm_read_prop02(igtyp ,prop_id , igeo(1,i) , geo(1,i) ,prop_tag ,unitab ,idtitl,lsubmodel )
348 CASE (
'TYPE3',
'TYPE03',
'BEAM')
355 CASE (
'TYPE4',
'TYPE04',
'SPRING')
360 CALL hm_read_prop04(geo(1,i),igeo(1,i),unitab,prop_id,igtyp,idtitl,prop_tag,lsubmodel,iunit)
362 CASE (
'TYPE6',
'TYPE06',
'SOL_ORTH')
367 CALL hm_read_prop06(geo(1,i),igeo(1,i),prop_tag ,multi_fvm,igtyp ,
368 . prop_id ,idtitl ,unitab ,lsubmodel
369 . sub_id ,iskn ,ipart ,sub_index,defaults%SOLID)
371 CASE (
'TYPE5',
'TYPE05',
'RIVET')
378 CASE (
'TYPE8',
'TYPE08',
'SPR_GENE')
387 CASE (
'TYPE9',
'TYPE09',
'SH_ORTH')
393 . rtrans,lsubmodel,idtitl ,prop_id ,sub_id,iskn,defaults%SHELL)
394 CASE (
'TYPE10',
'SH_COMP')
400 . rtrans,lsubmodel,idtitl ,prop_id ,sub_id,iskn,defaults%SHELL )
401 CASE (
'TYPE11',
'SH_SANDW')
407 . unitab ,rtrans ,lsubmodel,sub_id ,idtitl ,
408 . prop_tag ,prop_id ,igtyp ,defaults%SHELL )
410 CASE (
'TYPE12',
'SPR_PUL')
416 . prop_tag, idtitl, lsubmodel)
418 CASE (
'TYPE13',
'SPR_BEAM')
424 . idtitl ,igtyp ,prop_tag, lsubmodel,sub_index)
426 CASE (
'TYPE16',
'SH_FABR')
432 . unitab ,rtrans ,lsubmodel,sub_id ,prop_tag ,
433 . igtyp ,prop_id ,idtitl,defaults%SHELL )
435 CASE (
'TYPE17',
'STACK')
440 nums = numgeo_stack(cpt)
442 . unitab ,rtrans ,lsubmodel,sub_id ,idtitl ,
443 . prop_id ,prop_tag ,stack_info(nums),defaults%SHELL)
445 CASE (
'TYPE18',
'INT_BEAM')
450 CALL hm_read_prop18(geo(1,i),igeo(1,i),prop_tag,igtyp,prop_id,idtitl,unitab,lsubmodel)
458 CALL HM_READ_PROP19(PROP_ID, IGTYP, ISTACK, GEO(1,I),IGEO(1,I),PM,IPM,UNITAB,IDRAPEID,
464 CASE ('type14
','solid
')
466.AND.
IF (ALE%GLOBAL%ICAA == 0 IGFLU == 0) THEN
467 CALL HM_READ_PROP14(GEO(1,I),IGEO(1,I),PROP_TAG ,MULTI_FVM,IGTYP,PROP_ID,IDTITL,UNITAB,LSUBMODEL,
468 . IPART ,DEFAULTS%SOLID)
470 CALL HM_READ_PROP14F(GEO(1,I),IGEO(1,I),PROP_TAG ,MULTI_FVM,IGTYP,PROP_ID,IDTITL,UNITAB,LSUBMODEL,
476 CALL HM_READ_PROP14F(GEO(1,I),IGEO(1,I),PROP_TAG ,MULTI_FVM,IGTYP,PROP_ID,IDTITL,UNITAB,LSUBMODEL,
482 CASE ('type15
','porous
')
484 CALL HM_READ_PROP15(PROP_ID ,IGTYP , GEO(1,I) , IGEO(1,I) ,PROP_TAG ,UNITAB ,
485 . LSUBMODEL,IDTITL , ISKN ,ITABM1 ,DEFAULTS%SOLID )
487 CASE ('type20
','tshell
')
492 CALL HM_READ_PROP20(GEO(1,I),IGEO(1,I),PROP_TAG ,MULTI_FVM,IGTYP,PROP_ID,IDTITL,UNITAB,LSUBMODEL,
495 CASE ('type21
','tsh_orth
')
501 CALL HM_PROP_READ21(GEO(1,I) ,IGEO(1,I) ,PROP_ID ,ISKN ,UNITAB ,
502 . RTRANS ,LSUBMODEL ,SUB_ID,IDTITL ,IGTYP ,PROP_TAG,
504 CASE ('type22
','tsh_comp
')
510 CALL HM_READ_PROP22(GEO(1,I) ,IGEO(1,I) ,IGTYP,PROP_ID ,IDTITL ,UNITAB ,
511 . LSUBMODEL ,PM ,IPM ,RTRANS ,SUB_ID ,ISKN,PROP_TAG,
514 CASE ('type23
','spr_mat
')
520 CALL HM_READ_PROP23(GEO(1,I),IGEO(1,I),PROP_ID ,IGTYP ,UNITAB,
521 . ISKN ,IDTITL ,LSUBMODEL , PROP_TAG,SUB_INDEX)
523 CASE ('type25
','spr_axi
')
528 CALL HM_READ_PROP25(GEO(1,I), IGEO(1,I), UNITAB, ISKN,IGTYP,
529 . PROP_ID,PROP_TAG,IDTITL,LSUBMODEL,SUB_INDEX)
531 CASE ('type26
','spr_tab
')
536 CALL HM_READ_PROP26(GEO(1,I), IGEO(1,I), UNITAB, PROP_ID,IGTYP,
537 . PROP_TAG,IDTITL,LSUBMODEL)
539 CASE ('type27
','spr_bdamp
')
544 CALL HM_READ_PROP27(GEO(1,I),IGEO(1,I),PROP_TAG,IGTYP,PROP_ID,UNITAB,LSUBMODEL)
551 CALL HM_READ_INJECT1(GEO(1,I),IGEO(1,I),PROP_TAG,IGTYP,PROP_ID,IDTITL,UNITAB,LSUBMODEL,IPM,PM,NPC,PLD)
558 CALL HM_READ_INJECT2(GEO(1,I),IGEO(1,I),PROP_TAG,IGTYP,PROP_ID,IDTITL,UNITAB,LSUBMODEL,IPM,PM,NPC,PLD)
565 NUMS = NUMGEO_STACK(CPT)
567 . GEO(1,I) ,IGEO(1,I) ,PM ,IPM ,ISKN ,
568 . PROP_ID ,PROP_TAG ,RTRANS ,SUB_ID ,STACK_INFO(NUMS) ,
569 . IDTITL ,UNITAB ,LSUBMODEL,DEFAULTS%SHELL)
579 GEO (12,I) = IGTYP ! double storage
586 CALL HM_READ_PROP_GENERIC(
587 1 IGTYP ,PROP_ID ,IDTITL ,KEY ,GEO(1,I),
588 2 IGEO(1,I),LBUFGEO ,BUFGEO ,IADBUF ,UNITAB,
589 3 ISKN ,KNOT ,IAD_KNOT,PROP_TAG ,LSUBMODEL,
590 4 RTRANS ,SUB_ID ,IUNIT ,SUB_INDEX,DEFAULTS )
592 END SELECT ! SELECT CASE(IGTYP)
596.OR..OR..OR..OR.
IF (IGTYP == 1 IGTYP == 9 IGTYP == 10 IGTYP == 11
597.OR..OR..OR..OR.
. IGTYP == 16 IGTYP == 17 IGTYP == 19 IGTYP == 51
598 . IGTYP == 52 ) PROP_SHELL = 1
600 IF (PROP_SHELL == 1) THEN
602 PROP_TAG(IGTYP)%G_SIG = 0
603 PROP_TAG(IGTYP)%G_FOR = 5
604 PROP_TAG(IGTYP)%G_MOM = 3
605 PROP_TAG(IGTYP)%G_THK = 1
606 PROP_TAG(IGTYP)%G_EINT= 2
607 PROP_TAG(IGTYP)%G_EINS= 0
608 PROP_TAG(IGTYP)%L_SIG = 5
609 IF (IGTYP == 17) PROP_TAG(IGTYP)%L_SIGPLY = 3
610 PROP_TAG(IGTYP)%L_THK = 0
611 PROP_TAG(IGTYP)%L_EINT= 2
612 PROP_TAG(IGTYP)%L_EINS= 0
613 PROP_TAG(IGTYP)%G_VOL = 1
614 PROP_TAG(IGTYP)%L_VOL = 1
615 PROP_TAG(IGTYP)%LY_DMG = 2
616.OR..OR..OR.
IF (IGTYP == 9 IGTYP == 10 IGTYP == 11
617.OR..OR.
. IGTYP == 17 IGTYP == 51 IGTYP == 52 ) THEN
618 PROP_TAG(IGTYP)%LY_GAMA = 6
619 PROP_TAG(IGTYP)%LY_DIRA = 2
620 ELSEIF (IGTYP == 16) THEN
621 PROP_TAG(IGTYP)%LY_GAMA = 6
622 PROP_TAG(IGTYP)%LY_DIRA = 2
623 PROP_TAG(IGTYP)%LY_DIRB = 2
625 PROP_TAG(IGTYP)%LY_PLAPT = 1
626 PROP_TAG(IGTYP)%LY_SIGPT = 5
627 PROP_TAG(IGTYP)%G_FORPG = 5
628 PROP_TAG(IGTYP)%G_MOMPG = 3
629 PROP_TAG(IGTYP)%G_STRPG = 8
631.OR.
IF((IGTYP == 11 IGTYP == 17 ) ) PROP_TAG(IGTYP)%LY_DMG = 2
632.OR..OR..OR.
IF (IGTYP == 9 IGTYP == 10 IGTYP == 11
633.OR..OR..OR.
. IGTYP == 16 IGTYP == 17 IGTYP == 51
634 . IGTYP == 52 ) PROP_TAG(IGTYP)%L_OFF = 1
643 DO CPT = 1, HM_NUMGEO
644 IF (IGEO(11, CPT) == 19) THEN
645 NPLYMAX = NPLYMAX + 1
646 IGEO(102, CPT) = NPLYMAX
652 DO CPT = 1, HM_NUMGEO
654 NUMS= NUMGEO_STACK(CPT)
655.OR.
IF (IGTYP == 17 IGTYP == 51 ) THEN
656 ! Initialization of stack thickness
660 ZSHIFT = GEO(199, CPT)
663 ELSEIF(IPOS == 3) THEN
665 ELSEIF(IPOS == 4) THEN
668 GEO(199, CPT) = ZSHIFT
672 JPID = STACK_INFO(NUMS)%PID(J)
676.AND.
IF (IGEO(1,K) == JPID IGEO(11,K)==19) THEN
677 STACK_INFO(NUMS)%PID(J) = K
683 IGEO(200 + NSTACK ,K) = CPT
685 GEO(1,CPT) = GEO(1,CPT) + GEO(1,K)
689 CALL FRETITL2(TITR1,IGEO(NPROPGI-LTITR+1,CPT),LTITR)
690 CALL ANCMSG(MSGID=373,
692 . ANMODE=ANINFO_BLIND_1,
693 . I1=IGEO(1,CPT),C1=TITR1,
702 JPID1 = STACK_INFO(NUMS)%ISUB( 3*(J-1) + 1 )
703 JPID2 = STACK_INFO(NUMS)%ISUB( 3*(J-1) + 2 )
704.OR.
IF (JPID1 > 0 JPID2 > 0) THEN
707 IF (IGEO(1,K) == JPID1) THEN
708 STACK_INFO(NUMS)%ISUB (3*(J-1) + 1) = K
710 ELSEIF (IGEO(1,K) == JPID2) THEN
711 STACK_INFO(NUMS)%ISUB (3*(J-1) + 2) = K
715 CALL FRETITL2(TITR1,IGEO(NPROPGI-LTITR+1,CPT),LTITR)
716 CALL ANCMSG(MSGID=373,
718 . ANMODE=ANINFO_BLIND_1,
719 . I1=IGEO(1,CPT),C1=TITR1,
722 CALL FRETITL2(TITR1,IGEO(NPROPGI-LTITR+1,CPT),LTITR)
723 CALL ANCMSG(MSGID=373,
725 . ANMODE=ANINFO_BLIND_1,
726 . I1=IGEO(1,CPT),C1=TITR1,
729.OR.
ENDIF ! IF (JPID1 > 0 JPID2 > 0)
731 ENDIF ! IF (NISUB > 0)
735 JPID = STACK_INFO(NUMS)%PID(J)
736 STACK_INFO(NUMS)%THK(J) = GEO(1,JPID)
737 STACK_INFO(NUMS)%DIR(J) = GEO(212,JPID) ! angle (DIR1,DIR2) - for compatibility of law58 with PID51)
738 STACK_INFO(NUMS)%MID(J) = IGEO(101,JPID)
743 J=STACK_INFO(NUMS)%MID(1)
744 MLAWLY = NINT(PM(19,J))
745 PROP_ID = IGEO(1,CPT)
748 J = STACK_INFO(NUMS)%MID(N)
750 IF (IGTYP == 51) GOTO 350
751 IF (NINT(PM(19,J)) == MLAWLY) GOTO 350
752 WRITE(LAW_ID,'(i2)
')MLAWLY
753 IF (MLAWLY==99) LAW_ID='user
'
754 CALL ANCMSG(MSGID=899,
756 . ANMODE=ANINFO_BLIND_1,
765 IF (IGTYP == 17) THEN
767 J = STACK_INFO(NUMS)%MID(N)
769 JPID = STACK_INFO(NUMS)%PID(N)
770 MLAWLY = NINT(PM(19,J))
771.OR..OR..OR.
IF (MLAWLY == 15 MLAWLY == 25 MLAWLY == 27
772.AND..OR..OR.
. (MLAWLY >= 29 MLAWLY <= 31) MLAWLY == 36
773.OR.
. MLAWLY == 72 MLAWLY == 99) GOTO 450
775 WRITE(LAW_ID,'(i2)
')MLAWLY
776 CALL FRETITL2(IDTITL,IGEO(NPROPGI-LTITR+1,JPID),LTITR)
777 CALL ANCMSG(MSGID=1202,
786 ENDIF !IF (IGTYP == 17) THEN
787 ENDIF ! begin igtype = 17
788 ENDDO ! DO CPT = 1, HM_NUMGEO
793 GEO(100,I) = SQRT(GEO(38,I)) ! SHFSR
799 CALL VDOUBLE(IGEO(1,1),NPROPGI,NUMGEO,MESS,0,RBID)
805 & 5X,' property sets
'/,
806 & 5X,' -------------
'//)