C FRI2T2    SOURCE    OF166741  25/02/21    21:16:46     12166          

      SUBROUTINE FRI2T2(INFIBR,MELE,IPMAIL,MINTE,NBPTEL,
     1     IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVARI,
     2     CRIGI)
***********************************************************************
*     COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE
*     BOUCLE SUR LES SS_ZONE DU MODELE DE SECTION
***********************************************************************
* ENTREES :
*
* INFIBR = NUMERO DE MATERIAU INELASTIQUE
* MELE    = NUMERO  ELEMENT FINI
* IPMAIL = POINTEUR DU MAILLAGE
* NBPTEL =NOMBRE DE POINTS PAR ELEMENT
* IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
* IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
* IVARI  =POINTEUR SUR UN SEGMENT MPTVAL DE VARIABLES INTERNES
* NMATT  =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU
* NCARR  =NOMBRE DE COMPOSANTES DE CARACTERISTIQUES GEOMETRIQUES
* NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
*
* SORTIES :
* CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
*
************************************************************************
*      Pierre Pegon (ISPRA) Juillet/Aout 1993
***********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)


-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMELEME
-INC SMCOORD
-INC SMMODEL
-INC SMINTE
-INC CCHAMP
-INC TMPTVAL

      SEGMENT WRK0
       REAL*8 XMAT(NCXMAT),XCAR(NCXCAR),XVAR(NCXVAR)
      ENDSEGMENT
*
      SEGMENT WRK2
        REAL*8 XE(3,NBBB),SHP(6,NBBB)
      ENDSEGMENT
*
      DIMENSION CRIGI(12)
*
      MFR =NUMMFR(MELE)
      MELEME=IPMAIL
      NBNN=NUM(/1)
      NBELEM=NUM(/2)
*
*    SEGMENT D'INTEGRATION
*
C*    SEGACT,MINTE           <- ACTIF EN E/S
*
*    INITIALISATION DES SEGMENTS DE TRAVAIL
*
      NCXMAT=NMATT
      NCXCAR=NCARR
      NCXVAR=NVARI
      NBBB=NBNN
      SEGINI WRK0,WRK2
*
*       BOUCLE SUR LES ELEMENTS
*
      DO 1000 IB=1,NBELEM
*
*       ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
*
         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
*
*       BOUCLE SUR LES POINTS DE GAUSS
*
         DO 1100 IGAU=1,NBPTEL
*
*       ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
*
           YY=0.D0
           DO IE1=1,NBNN
             CGAUSS=SHPTOT(1,IE1,IGAU)
             YY=YY+XE(1,IE1)*CGAUSS
           END DO
           YY2=YY*YY
*
*       ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
*
           DO IE2=1,NBNN
             DO IE1=1,6
               SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
             END DO
           END DO
C PPf      CALL JACOBI(XE,SHP,2,NBNN,DJAC)
*
*     ON RECUPERE LES CONSTANTES DU MATERIAU
*
           MPTVAL=IVAMAT
           DO IC=1,NMATT
                 MELVAL=IVAL(IC)
                 IF(IC.LT.3)THEN
                   IIC=IC
                 ELSEIF(IC.LT.(NMATT-1))THEN
                   IIC=IC+2
                 ELSE
                   IIC=4+IC-NMATT
                 ENDIF
                 IF(MELVAL.NE.0)THEN
                    IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
                       IBMN=MIN(IB,VELCHE(/2))
                      IGMN=MIN(IGAU,VELCHE(/1))
                       XMAT(IIC)=VELCHE(IGMN,IBMN)
                    ELSE
                      IBMN=MIN(IB,IELCHE(/2))
                     IGMN=MIN(IGAU,IELCHE(/1))
                      XMAT(IIC)=IELCHE(IGMN,IBMN)
                    ENDIF
                 ELSE
                    XMAT(IIC)=0.D0
c*                    IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
c*                       XMAT(IIC)=0
c*                    END IF
                 ENDIF
           END DO
*
*     ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
*
           MPTVAL=IVACAR
           DO IC=1,NCARR
              MELVAL=IVAL(IC)
              IBMN=MIN(IB,VELCHE(/2))
              IGMN=MIN(IGAU,VELCHE(/1))
              XCAR(IC)=VELCHE(IGMN,IBMN)
           END DO
*
*     ON RECUPERE LES VARIABLES INTERNES
*
           MPTVAL=IVARI
           DO IC=1,NVARI
              MELVAL=IVAL(IC)
              IBMN=MIN(IB,VELCHE(/2))
              IGMN=MIN(IGAU,VELCHE(/1))
              XVAR(IC)=VELCHE(IGMN,IBMN)
           END DO
*
*     YOUNG TANGENT SELON LES MODELES
*
           IF(INFIBR.EQ.0)THEN
C
C      MODELE ELASTIQUE LINEAIRE  (EXEMPLE)
C
             YOUNGT=XMAT(1)
C
           ELSEIF(INFIBR.EQ.1)THEN
C
C      MODELE BETON_UNI
C
C PP         YOUNGT=XVAR(6)
             YOUNGT=XVAR(5)
C
           ELSEIF(INFIBR.EQ.2)THEN
C
C      MODELE ACIER_UNI
C
             YOUNGT=XVAR(4)
C
           ELSEIF(INFIBR.EQ.3)THEN
C
C      MODELE MAZARS_FIB
C
             YOUNGT=(1.-XVAR(2))*XMAT(1)
C
           ELSEIF(INFIBR.EQ.4)THEN
C
C      MODELE FRAGILE_UNI
C
             YOUNGT=XVAR(4)
C
           ELSEIF(INFIBR.EQ.5)THEN
C
C      MODELE BETON_BAEL
C
             YOUNGT=XVAR(3)
C
           ELSEIF(INFIBR.EQ.6)THEN
C
C      MODELE PARFAIT_UNI
C
             YOUNGT=XVAR(2)
C
           ELSEIF(INFIBR.EQ.7)THEN
C
C      MODELE STRUT_UNI
C
             YOUNGT=XVAR(6)
C
           ELSEIF(INFIBR.EQ.8)THEN
C
C      MODELE CISAIL_NL
C
             YOUNGT=XMAT(1)
C
        ELSEIF(INFIBR.EQ.9)THEN
C
C      MODELE  'PARFAIT_ANCRAGE'
C
             YOUNGT=XVAR(6)
C
           ELSEIF(INFIBR.EQ.10)THEN
C
C      MODELE  'ACIER_ANCRAGE'
C
             YOUNGT=XVAR(16)
C
           ELSEIF(INFIBR.EQ.11)THEN
C
C      MODELE UNILATERAL
C
             YOUNGT=XVAR(1)
C
           ENDIF
C+PPf
C
C     TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
C
           IF(MELE.EQ.167)THEN
             DJAC=XCAR(NCARR)
           ELSEIF(MELE.EQ.166)THEN
             CALL JACOBI(XE,SHP,1,NBNN,DJAC)
             DJAC=DJAC*XCAR(NCARR)
           ELSE
             CALL JACOBI(XE,SHP,2,NBNN,DJAC)
           ENDIF
C+PPf
*
*     CONTRIBUTION A CRIGI
*
           PGAUSS=POIGAU(IGAU)*ABS(DJAC)
*
           YOUNG=XMAT(1)
           GAMMA=XMAT(1)/(2.*(1.+XMAT(2)))
           ALPH1=XCAR(1)
           CRIGI( 1)=CRIGI( 1)+YOUNGT*PGAUSS
           CRIGI( 2)=CRIGI( 2)+YOUNGT*YY*PGAUSS
           CRIGI( 3)=CRIGI( 3)+YOUNGT*YY2*PGAUSS
*
           CRIGI( 4)=CRIGI( 4)+ALPH1*GAMMA*PGAUSS
C
C    FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
C
1100     CONTINUE
C
C     FIN DE LA BOUCLE SUR LES ELEMENTS
C
1000  CONTINUE
*
C*    SEGDES,MINTE           <- ACTIF EN E/S (NON MODIFIE)
      SEGSUP WRK0,WRK2

      RETURN
      END