Sources Esope | Cast3M

froa3d
C FROA3D    SOURCE    OF166741  25/02/21    21:16:56     12166          
 
      SUBROUTINE FROA3D(IPOGEO,IPMATR,IPMINT,IVAMAT,
     1                  IVACAR,MELE,MFR,LRE,NDDL)
 
C***********************************************************************
C                                                                      *
C  Routine appelée par FRVISQ.                                         *
C                                                                      *
C  Calcule l'amortissement de frontière dans le cas 3D pour les        *
C  massifs de face FAC3, FAC4, FAC6 ou FAC8.                           *
C                                                                      *
C  Entrées :                                                           *
C  --------                                                            *
C                                                                      *
C     IPOGEO : pointeur sur le maillage de l'enveloppe des massifs,    *
C              type MELEME                                             *
C     IPMATR : pointeur sur le segment IMATRI, chapeau des rigidités   *
C              élémentaires                                            *
C     IPMINT : pointeur sur le segment d'intégration, type MINTE       *
C     IVAMAT : pointeur sur un segment MPTVAL de données matériau      *
C     IVACAR : pointeur sur un segment MPTVAL de caractéristiques      *
C              (épaisseur dans le cas contraintes planes)              *
C     MELE   : numéro de l'élément fini associé à la face du massif    *
C     MFR    : numéro de la formulation                                *
C     LRE    : taille de la matrice d'amortissement à construire       *
C     NDDL   : nombre de degrés de liberté                             *
C                                                                      *
C  Remplit le segment XMATRI pour chaque élément de la sous-zone.      *
C***********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMRIGID
-INC SMELEME
-INC SMCOORD
-INC SMCHAML
-INC SMINTE
 
-INC TMPTVAL
 
      SEGMENT,MWORK
        REAL*8 XE(3,NBNN)
        REAL*8 REL(LRE,LRE)
        REAL*8 SHPWRK(6,NBNN),BGENE(NDDL,LRE)
        REAL*8 VALMAT(NV1)
        REAL*8 VECN(NDDL),VECT1(NDDL),VECT2(NDDL)
        REAL*8 XNNT(NDDL,NDDL),XTTT1(NDDL,NDDL),XTTT2(NDDL,NDDL)
      ENDSEGMENT
 
      IF (IFOUR.NE.2) THEN
        CALL ERREUR(21)
        RETURN
      ENDIF
C
      MELEME=IPOGEO
c*      SEGACT MELEME
      NBNN=NUM(/1)
      NBELEM=NUM(/2)
C
      MINTE=IPMINT
c*      SEGACT,MINTE
      NBPGAU=POIGAU(/1)
C
      xMATRI=IPMATR
c*      SEGACT,xMATRI*MOD
c*      NLIGRD=LRE
c*      NLIGRP=LRE
c*
      NV1=3
      SEGINI,MWORK
C
C  boucle sur les éléments
C
      DO 1 IB=1,NBELEM
C
C  on cherche les coordonnées de l'élément IB
C
        CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
        CALL ZERO(REL,LRE,LRE)
C
C  boucle sur les points de Gauss
C
        DO 10 IGAU=1,NBPGAU
C
C  récupération des données matériau
C
          MPTVAL=IVAMAT
          DO 11 J=1,3
            MELVAL=IVAL(J)
            IGMN=MIN(IGAU,VELCHE(/1))
            IBMN=MIN(IB,VELCHE(/2))
            VALMAT(J)=VELCHE(IGMN,IBMN)
 11       CONTINUE
C
          RHO=VALMAT(1)
          E=VALMAT(2)
          XNU=VALMAT(3)
          CS=E/(RHO*2.*(1+XNU))
          CP=2*CS*(1-XNU)/(1-2*XNU)
          CP=SQRT(CP)
          CS=SQRT(CS)
C
C  coefficients d'amortissement
C
          RCP=RHO*CP
          RCS=RHO*CS
C
C  calcul des vecteurs du plan tangent
C
          VNQSI1=0.D0
          VNQSI2=0.D0
          VNQSI3=0.D0
          VNETA1=0.D0
          VNETA2=0.D0
          VNETA3=0.D0
C
          DO 20 I=1,NBNN
            VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
            VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
            VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I)
            VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I)
            VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I)
            VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I)
 20       CONTINUE
C
C  calcul de VECN,VECT1,VECT2 et du jacobien
C
          VECN(1)=VNQSI2*VNETA3-VNQSI3*VNETA2
          VECN(2)=VNQSI3*VNETA1-VNQSI1*VNETA3
          VECN(3)=VNQSI1*VNETA2-VNQSI2*VNETA1
          XNORM=VECN(1)**2+VECN(2)**2+VECN(3)**2
          XNORM=SQRT(XNORM)
C
          DJAC0=XNORM*POIGAU(IGAU)
C
          VECN(1)=VECN(1)/XNORM
          VECN(2)=VECN(2)/XNORM
          VECN(3)=VECN(3)/XNORM
C
          XNORM1=VNQSI1**2+VNQSI2**2+VNQSI3**2
          XNORM1=SQRT(XNORM1)
          VECT1(1)=VNQSI1/XNORM1
          VECT1(2)=VNQSI2/XNORM1
          VECT1(3)=VNQSI3/XNORM1
C
          VECT2(1)=VECT1(2)*VECN(3)-VECT1(3)*VECN(2)
          VECT2(2)=VECT1(3)*VECN(1)-VECT1(1)*VECN(3)
          VECT2(3)=VECT1(1)*VECN(2)-VECT1(2)*VECN(1)
C
C  calcul des matrices nnT, ttT1, et ttT2
C
          DO 30 I=1,NDDL
            DO 31 J=1,NDDL
               XNNT(I,J)=VECN(I)*VECN(J)
               XTTT1(I,J)=VECT1(I)*VECT1(J)
               XTTT2(I,J)=VECT2(I)*VECT2(J)
 31         CONTINUE
 30       CONTINUE
C
C  calcul de la matrice N des fonctions de forme
C
          XDPGE=0.D0
          YDPGE=0.D0
          CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,
     &                DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
C
C  construction de la matrice d'amortissement
C
          DJACN=DJAC0*RCP
          CALL BDBST(BGENE,DJACN,XNNT,LRE,NDDL,REL)
 
          DJACT=DJAC0*RCS
          CALL BDBST(BGENE,DJACT,XTTT1,LRE,NDDL,REL)
          CALL BDBST(BGENE,DJACT,XTTT2,LRE,NDDL,REL)
C
 10     CONTINUE
C
C  remplissage de XMATRI
C
        CALL REMPMT(REL,LRE,RE(1,1,ib))
C
 1    CONTINUE
C
      SEGSUP,MWORK
 
c*      SEGDES MELEME,MINTE,xMATRI
 
      RETURN
      END