Esope source files

   1 : C FRITH2    SOURCE    CHAT      11/03/16    21:23:41     6902           
   2 : C FRIGTH2    SOURCE    DJER        94/02/25    21:57:00     1061           
   3 :       SUBROUTINE FRITH2(MELE,IPMAIL,MINTE,NBPTEL,
   4 :      1     IVAMAT,IVACAR,NMATT,NCARR,CRIGI,IELA,ICONT)
   5 : ***********************************************************************
   6 : *     CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
   7 : *     BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
   8 : **********************************************************************
   9 : * ENTREES :
  10 : *
  11 : * MELE    = NUMERO  ELEMENT FINI
  12 : * IPMAIL = POINTEUR DU MAILLAGE                              (ACTIF)
  13 : * MINTE  = POINTEUR CARACTERISTIQUES INTEGRATION             (ACTIF)
  14 : * NBPTEL =NOMBRE DE POINTS PAR ELEMENT
  15 : * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  16 : * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  17 : * NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  18 : * NMATT  =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  19 : * NCARR  =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  20 : *
  21 : * SORTIES :
  22 : * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE ( SOMi (HOOKi * ALPHAi) )
  23 : *
  24 : ************************************************************************
  25 : *      Pierre Pegon (ISPRA) Juillet/Aout 1993
  26 : ***********************************************************************
  27 :       IMPLICIT INTEGER(I-N)
  28 :       IMPLICIT REAL*8(A-H,O-Z)
  29 : *
  30 : -INC CCOPTIO
  31 : -INC SMCHAML
  32 : -INC SMELEME
  33 : -INC SMCOORD
  34 : -INC SMMODEL
  35 : -INC SMINTE
  36 : -INC CCHAMP
  37 : *
  38 :       SEGMENT MPTVAL
  39 :         INTEGER IPOS(NS)    ,NSOF(NS)
  40 :         INTEGER      IVAL(NCOSOU)
  41 :         CHARACTER*16 TYVAL(NCOSOU)
  42 :       ENDSEGMENT
  43 : *
  44 :       SEGMENT WRK0
  45 :        REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
  46 :       ENDSEGMENT
  47 : *
  48 :       SEGMENT WRK2
  49 :         REAL*8 XE(3,NBBB),SHP(6,NBBB)
  50 :       ENDSEGMENT
  51 : *
  52 :       DIMENSION CRIGI(12)
  53 : *
  54 :       MFR =NUMMFR(MELE)
  55 :       MELEME=IPMAIL
  56 :       NBNN=NUM(/1)
  57 :       NBELEM=NUM(/2)
  58 : *
  59 : *    SEGMENT D'INTEGRATION
  60 : *
  61 : C**   SEGACT,MINTE           <- ACTIF EN E/S
  62 : *
  63 : *    INITIALISATION DES SEGMENTS DE TRAVAIL
  64 : *
  65 :       NCXMAT=NMATT
  66 :       NCXCAR=NCARR
  67 :       NBBB=NBNN
  68 :       SEGINI WRK0,WRK2
  69 : *
  70 : *       BOUCLE SUR LES ELEMENTS
  71 : *
  72 :       DO 1000 IB=1,NBELEM
  73 : *
  74 : *       ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  75 : *
  75 :          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  76 : *
  77 : *       BOUCLE SUR LES POINTS DE GAUSS
  78 : *
  79 :          DO 1100 IGAU=1,NBPTEL
  80 : *
  81 : *       ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  82 : *
  83 :            YY=0.D0
  84 :            ZZ=0.D0
  85 :            DO IE1=1,NBNN
  86 :              CGAUSS=SHPTOT(1,IE1,IGAU)
  87 :              YY=YY+XE(1,IE1)*CGAUSS
  88 :              ZZ=ZZ+XE(2,IE1)*CGAUSS
  89 :            END DO
  90 :            YY2=YY*YY
  91 :            ZZ2=ZZ*ZZ
  92 : *
  93 : *       ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  94 : *
  95 :            DO IE2=1,NBNN
  96 :              DO IE1=1,6
  97 :                SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  98 :              END DO
  99 :            END DO
  99 :            CALL JACOBI(XE,SHP,2,NBNN,DJAC)
 100 : *
 101 : *     ON RECUPERE LES CONSTANTES DU MATERIAU
 102 : *
 103 :            MPTVAL=IVAMAT
 104 :            DO IC=1,NMATT
 105 :                  MELVAL=IVAL(IC)
 106 :                  IF(IC.LT.3)THEN
 107 :                    IIC=IC
 108 :                  ELSEIF(IC.LT.(NMATT-1))THEN
 109 :                    IIC=IC+2
 110 :                  ELSE
 111 :                    IIC=4+IC-NMATT
 112 :                  ENDIF
 113 :                  IF(MELVAL.NE.0)THEN
 114 :                     IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
 115 :                        IBMN=MIN(IB,VELCHE(/2))
 116 :                        IGMN=MIN(IGAU,VELCHE(/1))
 117 :                        XMAT(IIC)=VELCHE(IGMN,IBMN)
 118 :                     ELSE
 119 :                       IBMN=MIN(IB,IELCHE(/2))
 120 :                       IGMN=MIN(IGAU,IELCHE(/1))
 121 :                       XMAT(IIC)=IELCHE(IGMN,IBMN)
 122 :                     ENDIF
 123 :                  ELSE
 124 :                     XMAT(IIC)=0.D0
 125 :                     IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
 126 :                        XMAT(IIC)=0
 127 :                     END IF
 128 :                  ENDIF
 129 :            END DO
 130 : *
 131 : *     ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
 132 : *
 133 :            MPTVAL=IVACAR
 134 :            DO IC=1,NCARR
 135 :               MELVAL=IVAL(IC)
 136 :               IBMN=MIN(IB,VELCHE(/2))
 137 :               IGMN=MIN(IGAU,VELCHE(/1))
 138 :               XCAR(IC)=VELCHE(IGMN,IBMN)
 139 :            END DO
 140 : *
 141 : *     CONTRIBUTION A CRIGI
 142 : *
 143 :            PGAUSS=POIGAU(IGAU)*ABS(DJAC)
 144 : *
 145 :            IF(ICONT.EQ.0) THEN
 146 :              YOUNG=1.D0
 147 :              XNU  =1.D0
 148 :            ELSE
 149 :              YOUNG=XMAT(1)
 150 :              XNU  =XMAT(2)
 151 :            ENDIF
 152 :            ALPHA=XMAT(4)
 153 :            IF(IELA.EQ.1) ALPHA=1.D0
 154 :            GAMMA=YOUNG/(2.D0*(1.+XNU))
 155 :            ALPH1=XCAR(1)
 156 :            ALPH2=XCAR(2)
 157 :            CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS*ALPHA
 158 :            CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS*ALPHA
 159 :            CRIGI( 3)=CRIGI( 3)+YOUNG*ZZ*PGAUSS*ALPHA
 160 :            CRIGI( 4)=CRIGI( 4)+YOUNG*YY2*PGAUSS*ALPHA
 161 :            CRIGI( 5)=CRIGI( 5)+YOUNG*YY*ZZ*PGAUSS*ALPHA
 162 :            CRIGI( 6)=CRIGI( 6)+YOUNG*ZZ2*PGAUSS*ALPHA
 163 : *
 164 :            CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS*ALPHA
 165 :            CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS*ALPHA
 166 :            CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS*ALPHA
 167 :            CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS*ALPHA
 168 :            CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS*ALPHA
 169 :            CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS*ALPHA
 170 : C
 171 : C    FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
 172 : C
 173 : 1100     CONTINUE
 174 : C
 175 : C     FIN DE LA BOUCLE SUR LES ELEMENTS
 176 : C
 177 : 1000  CONTINUE
 178 : *
 179 : C**   SEGDES,MINTE           <- ACTIF EN E/S (NON MODIFIE)
 180 :       SEGSUP WRK0,WRK2
 181 : *
 182 :       RETURN
 183 :       END
 184 : 
 185 :  
 186 :