Sources Esope | Cast3M

famo22
C FAMO22    SOURCE    CB215821  24/04/12    21:15:54     11897          
      SUBROUTINE FAMO22(MELE,IPMAIL,MINTE,NBPTEL,
     1     IVAMAT,IVACAR,NMATT,NCARR,
     2     CRIGI,CMASS)
***********************************************************************
*     CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
*     CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
*     .... AU SIGNE PRES
*     BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
**********************************************************************
* ENTREES :
*
* 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
* NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
* NMATT  =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
* NCARR  =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
*
* SORTIES :
* CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
* CMASS(12) MASSE SUR LA FIBRE MOYENNE
*
*  D'APRES FRIGI2 DC 98
************************************************************************
      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
*
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
*
      SEGMENT WRK0
       REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
      ENDSEGMENT
*
      SEGMENT WRK2
        REAL*8 XE(3,NBBB),SHP(6,NBBB)
      ENDSEGMENT
*
      DIMENSION CRIGI(12),CMASS(12)
*
      MFR =NUMMFR(MELE)
      MELEME=IPMAIL
      NBNN=NUM(/1)
      NBELEM=NUM(/2)
*
*    SEGMENT D'INTEGRATION
*
C*    SEGACT,MINTE           &lt;- ACTIF EN E/S
*
*    INITIALISATION DES SEGMENTS DE TRAVAIL
*
      NCXMAT=NMATT
      NCXCAR=NCARR
      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-2))THEN
                   IIC=IC+3
                 ELSEIF(IC.LE.(NMATT))THEN
                   IIC=5+IC-NMATT
                 ELSE
                 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
                    IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
                       XMAT(IIC)=0
                    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
C+PPf
C
C     TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
C
           IF(MELE.EQ.167)THEN
             DJAC=XCAR(2)
           ELSEIF(MELE.EQ.166)THEN
C+DC on utilise le cas joi3
             CALL JACOBI(XE,SHP,86,NBNN,DJAC)
             DJAC=DJAC*XCAR(2)
           ELSE
             CALL JACOBI(XE,SHP,2,NBNN,DJAC)
           ENDIF
C+PPf
*
*     CONTRIBUTION A CRIGI
*
           PGAUSS=POIGAU(IGAU)*ABS(DJAC)
*
           YOUNG=XMAT(5)
           GAMMA=XMAT(5)/(2.*(1.+XMAT(2)))
           ALPH1=XCAR(1)
           CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS
           CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS
           CRIGI( 3)=CRIGI( 3)+YOUNG*YY2*PGAUSS
*
           CRIGI( 4)=CRIGI( 4)+ALPH1*GAMMA*PGAUSS
*
*     CONTRIBUTION A CMASS
*
           RHO=XMAT(3)
C
           CMASS( 1)=CMASS( 1)+RHO*PGAUSS
           CMASS( 2)=CMASS( 2)+RHO*YY*PGAUSS
           CMASS( 3)=CMASS( 3)+RHO*YY2*PGAUSS
*
           CMASS( 4)=CMASS( 4)+RHO*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           &lt;- ACTIF EN E/S (NON MODIFIE)
      SEGSUP WRK0,WRK2
*
      RETURN
      END