Sources Esope | Cast3M

hookan
C HOOKAN    SOURCE    BP208322  17/03/01    21:17:36     9325           
      SUBROUTINE HOOKAN(VALMAT,IB,IGAU,MFR,IFOU,KCAS,NBGMAT,NELMAT,
     +          SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOOK,
     +          MELE,COBMA,XMOB,IRET)
C
C----------------------------------------------------------------------
C
C   Calcul de la matrice de HOOKE dans le cas d'un
C   matériau anisotrope
C
C   Entrees:
C   --------
C   VALMAT   tableau de materiau
C   IB       numero de l'element
C   IGAU     numero du point de Gauss
C   MFR      numero de formulation
C   IFOU     numero d'harmonique de Fourier
C   KCAS     = 1 si on veut la matrice pour elle-meme
C            = 2 si on veut la matrice pour l'inverser ensuite
C   NBGMAT, NELMAT tailles des tableaux
C   SECT     SECTION DE L'ELEMENT IB (&lt;> 0 SI MFR.EQ.27)
C   LHOOK    taille de la matrice de HOOKE
C   TXR,XLOC,XGLOB,D1HOOK,ROTHOO  tableaux de travail
C
C   Sorties:
C   --------
C   DDHOOK   matrice de HOOKE
C   IRET     = 1 si option existante, 0 sinon
C
C---------------------------------------------------------------------
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER(UN=1.D0,DEUX=2.D0,UNDEMI=.5D0)
      CHARACTER*8 MATE
C
-INC CCHAMP
 
-INC PPARAM
-INC CCOPTIO
C
      DIMENSION VALMAT(*)
      DIMENSION DDHOOK(LHOOK,*)
      DIMENSION COBMA(*),COBAUX(10)
      REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,*)
      REAL*8 D1HOOK(LHOOK,*),ROTHOO(LHOOK,*)
C
C     INITIALISATIONS
C
        MATE='ANISOTRO'
        CALL ZERO(DDHOOK,LHOOK,LHOOK)
        CALL ZERO(D1HOOK,LHOOK,LHOOK)
        CALL ZERO(XGLOB,IDIM,IDIM)
        CALL ZERO(ROTHOO,LHOOK,LHOOK)
        CALL ZERO(COBMA,LHOOK,1)
        CALL ZERO(COBAUX,LHOOK,1)
C
C
C    JOINT UNIDIMENSIONNEL JOI1
C
       IF (MFR.EQ.75) THEN
        IF(IDIM.EQ.3)THEN
          DDHOOK(1,1)=VALMAT(7)
          DDHOOK(2,1)=VALMAT(13)
          DDHOOK(1,2)=DDHOOK(2,1)
          DDHOOK(2,2)=VALMAT(8)
          DDHOOK(3,1)=VALMAT(14)
          DDHOOK(1,3)=DDHOOK(3,1)
          DDHOOK(3,2)=VALMAT(15)
          DDHOOK(2,3)=DDHOOK(3,2)
          DDHOOK(3,3)=VALMAT(9)
          DDHOOK(4,1)=VALMAT(16)
          DDHOOK(1,4)=DDHOOK(4,1)
          DDHOOK(4,2)=VALMAT(17)
          DDHOOK(2,4)=DDHOOK(4,2)
          DDHOOK(4,3)=VALMAT(18)
          DDHOOK(3,4)=DDHOOK(4,3)
          DDHOOK(4,4)=VALMAT(10)
          DDHOOK(5,1)=VALMAT(19)
          DDHOOK(1,5)=DDHOOK(5,1)
          DDHOOK(5,2)=VALMAT(20)
          DDHOOK(2,5)=DDHOOK(5,2)
          DDHOOK(5,3)=VALMAT(21)
          DDHOOK(3,5)=DDHOOK(5,3)
          DDHOOK(5,4)=VALMAT(22)
          DDHOOK(4,5)=DDHOOK(5,4)
          DDHOOK(5,5)=VALMAT(11)
          DDHOOK(6,1)=VALMAT(23)
          DDHOOK(1,6)=DDHOOK(6,1)
          DDHOOK(6,2)=VALMAT(24)
          DDHOOK(2,6)=DDHOOK(6,2)
          DDHOOK(6,3)=VALMAT(25)
          DDHOOK(3,6)=DDHOOK(6,3)
          DDHOOK(6,4)=VALMAT(26)
          DDHOOK(4,6)=DDHOOK(6,4)
          DDHOOK(6,5)=VALMAT(27)
          DDHOOK(5,6)=DDHOOK(6,5)
          DDHOOK(6,6)=VALMAT(12)
        ELSE IF(IDIM.EQ.2)THEN
          DDHOOK(1,1)=VALMAT(3)
          DDHOOK(2,1)=VALMAT(6)
          DDHOOK(1,2)=DDHOOK(2,1)
          DDHOOK(2,2)=VALMAT(4)
          DDHOOK(3,1)=VALMAT(7)
          DDHOOK(1,3)=DDHOOK(3,1)
          DDHOOK(3,2)=VALMAT(8)
          DDHOOK(2,3)=DDHOOK(3,2)
          DDHOOK(3,3)=VALMAT(5)
        ENDIF
          GO TO 2035
C (dip) on supprime ces lignes, sinon on ne passe jamais dans la
C       suite du programme ! (correction de l'anomalie 8036)
c       ELSE
c           IRET=0
c           GO TO 2035
       ENDIF
*
       IF ( (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) .AND.
     &      IGAU.LE.NBGMAT ) THEN
C
C  Formulation massive
C
        IF (MFR.EQ.1.OR.MFR.EQ.31) THEN
C
C      contraintes planes et KCAS=1
C
         IF(IFOU.EQ.-2.AND.KCAS.EQ.1)THEN
           D11=VALMAT(1)
           D21=VALMAT(2)
           D22=VALMAT(3)
           D31=VALMAT(9)
           D32=VALMAT(10)
           D33=VALMAT(11)
           IF (D33.EQ.0.D0) D33=D11*1.E-6
           D41=VALMAT(4)
           D42=VALMAT(5)
           D43=VALMAT(12)
           D44=VALMAT(6)
           D1HOOK(1,1)=D11 - ((D31**2)/D33)
           D1HOOK(2,1)=D21 - ((D31*D32)/D33)
           D1HOOK(1,2)=D1HOOK(2,1)
           D1HOOK(2,2)=D22 - ((D32**2)/D33)
           D1HOOK(4,1)=D41 - ((D31*D43)/D33)
           D1HOOK(1,4)=D1HOOK(4,1)
           D1HOOK(4,2)=D42 - ((D32*D43)/D33)
           D1HOOK(2,4)=D1HOOK(4,2)
           D1HOOK(4,4)=D44 - ((D43**2)/D33)
C
C     contraintes planes et KCAS=2
C
         ELSE IF(IFOU.EQ.-2.AND.KCAS.EQ.2)THEN
           D1HOOK(1,1)=VALMAT(1)
           D1HOOK(2,1)=VALMAT(2)
           D1HOOK(1,2)=D1HOOK(2,1)
           D1HOOK(2,2)=VALMAT(3)
           D1HOOK(4,1)=VALMAT(4)
           D1HOOK(1,4)=D1HOOK(4,1)
           D1HOOK(4,2)=VALMAT(5)
           D1HOOK(2,4)=D1HOOK(4,2)
           D1HOOK(4,4)=VALMAT(6)
           D1HOOK(3,3)=VALMAT(11)
           D1HOOK(3,1)=VALMAT(9)
           D1HOOK(1,3)=D1HOOK(3,1)
           D1HOOK(3,2)=VALMAT(10)
           D1HOOK(2,3)=D1HOOK(3,2)
           D1HOOK(4,3)=VALMAT(12)
           D1HOOK(3,4)=D1HOOK(4,3)
C
C  deformations planes et axisymetrie
C
        ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0.OR.IFOU.EQ.-3) THEN
           D1HOOK(1,1)=VALMAT(1)
           D1HOOK(2,1)=VALMAT(2)
           D1HOOK(1,2)=D1HOOK(2,1)
           D1HOOK(2,2)=VALMAT(3)
           D1HOOK(3,1)=VALMAT(4)
           D1HOOK(1,3)=D1HOOK(3,1)
           D1HOOK(3,2)=VALMAT(5)
           D1HOOK(2,3)=D1HOOK(3,2)
           D1HOOK(3,3)=VALMAT(6)
           D1HOOK(4,1)=VALMAT(7)
           D1HOOK(1,4)=D1HOOK(4,1)
           D1HOOK(4,2)=VALMAT(8)
           D1HOOK(2,4)=D1HOOK(4,2)
           D1HOOK(4,3)=VALMAT(9)
           D1HOOK(3,4)=D1HOOK(4,3)
           D1HOOK(4,4)=VALMAT(10)
C
C       serie de fourier et 3D
C
       ELSEIF(IFOU.EQ.1.OR.IFOU.EQ.2)THEN
          D1HOOK(1,1)=VALMAT(1)
          D1HOOK(2,1)=VALMAT(2)
          D1HOOK(1,2)=D1HOOK(2,1)
          D1HOOK(2,2)=VALMAT(3)
          D1HOOK(3,1)=VALMAT(4)
          D1HOOK(1,3)=D1HOOK(3,1)
          D1HOOK(3,2)=VALMAT(5)
          D1HOOK(2,3)=D1HOOK(3,2)
          D1HOOK(3,3)=VALMAT(6)
          D1HOOK(4,1)=VALMAT(7)
          D1HOOK(1,4)=D1HOOK(4,1)
          D1HOOK(4,2)=VALMAT(8)
          D1HOOK(2,4)=D1HOOK(4,2)
          D1HOOK(4,3)=VALMAT(9)
          D1HOOK(3,4)=D1HOOK(4,3)
          D1HOOK(4,4)=VALMAT(10)
          IF(IFOU.EQ.1)THEN
            D1HOOK(5,5)=VALMAT(11)
            D1HOOK(6,5)=VALMAT(12)
            D1HOOK(5,6)=D1HOOK(6,5)
            D1HOOK(6,6)=VALMAT(13)
          ELSE
            D1HOOK(5,1)=VALMAT(11)
            D1HOOK(1,5)=D1HOOK(5,1)
            D1HOOK(5,2)=VALMAT(12)
            D1HOOK(2,5)=D1HOOK(5,2)
            D1HOOK(5,3)=VALMAT(13)
            D1HOOK(3,5)=D1HOOK(5,3)
            D1HOOK(5,4)=VALMAT(14)
            D1HOOK(4,5)=D1HOOK(5,4)
            D1HOOK(5,5)=VALMAT(15)
            D1HOOK(6,1)=VALMAT(16)
            D1HOOK(1,6)=D1HOOK(6,1)
            D1HOOK(6,2)=VALMAT(17)
            D1HOOK(2,6)=D1HOOK(6,2)
            D1HOOK(6,3)=VALMAT(18)
            D1HOOK(3,6)=D1HOOK(6,3)
            D1HOOK(6,4)=VALMAT(19)
            D1HOOK(4,6)=D1HOOK(6,4)
            D1HOOK(6,5)=VALMAT(20)
            D1HOOK(5,6)=D1HOOK(6,5)
            D1HOOK(6,6)=VALMAT(21)
          ENDIF
       ENDIF
C
       ELSE
C
C  Formulation milieu poreux
*
*        elements massifs
*
         IF(MELE.GE.79.AND.MELE.LE.83) THEN
           CALL PORMAO(VALMAT,MATE,IFOU,IDIM,TXR,XLOC,XGLOB,
     &                 D1HOOK,ROTHOO,DDHOOK,LHOOK,
     &                 COBMA,XMOB,KCAS,IRET)
           GO TO 2035
*
*        elements joints
*
         ELSE IF(MELE.GE.108.AND.MELE.LE.110) THEN
           CALL DOUO88(VALMAT,MATE,IFOU,LHOOK,DDHOOK,IRET)
***********  COBMA ET XMOB PAS DEFINIS !!!!
           IRET=0
           GO TO 2035
         ELSE
           IRET=0
           GO TO 2035
         ENDIF
*
        ENDIF
C  DEFINITION DES AXES ORTHO./AXES LOCAUX
        IF(IDIM.EQ.2)THEN
         IF(IFOU.EQ.-2)THEN
          XLOC(1,1)=VALMAT(7)
          XLOC(2,1)=VALMAT(8)
         ELSEIF(IFOU.EQ.-1.OR.IFOU.EQ.0.OR.
     +          (MFR.EQ.1.AND.IFOU.EQ.-3))THEN
          XLOC(1,1)=VALMAT(11)
          XLOC(2,1)=VALMAT(12)
         ELSEIF(IFOU.EQ.1)THEN
          XLOC(1,1)=VALMAT(14)
          XLOC(2,1)=VALMAT(15)
         ENDIF
         XLOC(1,2)=-XLOC(2,1)
         XLOC(2,2)=XLOC(1,1)
        ELSEIF(IDIM.EQ.3)THEN
         XLOC(1,1)=VALMAT(22)
         XLOC(2,1)=VALMAT(23)
         XLOC(3,1)=VALMAT(24)
         XLOC(1,2)=VALMAT(25)
         XLOC(2,2)=VALMAT(26)
         XLOC(3,2)=VALMAT(27)
C
         CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
        ENDIF
C
C    DEFINITION DES AXES ORTHO./AXES GLOBAUX
C
        IF(IRET.EQ.1)THEN
C
         DO 1045  K=1,IDIM
          DO 1045 J=1,IDIM
            r_z  = 0.
            DO 1046 I=1,IDIM
              r_z = r_z + TXR(J,I)*XLOC(I,K)
 1046       CONTINUE
            XGLOB(K,J) = r_z
 1045    CONTINUE
C    MATRICE DE TRANSFORMATION
         IF(IDIM.EQ.2)THEN
           ROTHOO(1,1)=XGLOB(1,1)*XGLOB(1,1)
           ROTHOO(1,2)=XGLOB(1,2)*XGLOB(1,2)
           ROTHOO(1,4)=XGLOB(1,1)*XGLOB(1,2)
           ROTHOO(2,1)=XGLOB(2,1)*XGLOB(2,1)
           ROTHOO(2,2)=XGLOB(2,2)*XGLOB(2,2)
           ROTHOO(2,4)=XGLOB(2,1)*XGLOB(2,2)
           ROTHOO(3,3)=UN
           ROTHOO(4,1)=DEUX*XGLOB(1,1)*XGLOB(2,1)
           ROTHOO(4,2)=DEUX*XGLOB(1,2)*XGLOB(2,2)
           ROTHOO(4,4)=XGLOB(1,2)*XGLOB(2,1)+XGLOB(1,1)*XGLOB(2,2)
           IF(IFOU.EQ.1)THEN
            ROTHOO(5,5)=XGLOB(1,1)
            ROTHOO(5,6)=XGLOB(1,2)
            ROTHOO(6,5)=XGLOB(2,1)
            ROTHOO(6,6)=XGLOB(2,2)
           ENDIF
         ELSEIF(IDIM.EQ.3)THEN
           DO 1050 IC=1,3
            DO 1050 IL=1,3
             ROTHOO(IL,IC)=XGLOB(IL,IC)*XGLOB(IL,IC)
 1050      CONTINUE
C
           DO 1060 IL=1,3
            ROTHOO(IL,4)=XGLOB(IL,1)*XGLOB(IL,2)
            ROTHOO(IL,5)=XGLOB(IL,2)*XGLOB(IL,3)
            ROTHOO(IL,6)=XGLOB(IL,1)*XGLOB(IL,3)
 1060       CONTINUE
C
           DO 1065 IC=1,3
            ROTHOO(4,IC)=DEUX*XGLOB(1,IC)*XGLOB(2,IC)
            ROTHOO(5,IC)=DEUX*XGLOB(2,IC)*XGLOB(3,IC)
            ROTHOO(6,IC)=DEUX*XGLOB(1,IC)*XGLOB(3,IC)
 1065      CONTINUE
C
           DO 1070 IL=4,6
            IL1=IL-3
            IL2=IL1+1
            IF(IL2.GT.3)IL2=IL2-3
            DO 1070 IC=4,6
              IC1=IC-3
              IC2=IC1+1
              IF(IC2.GT.3)IC2=IC2-3
               ROTHOO(IL,IC)=XGLOB(IL1,IC1)*XGLOB(IL2,IC2)+
     .                       XGLOB(IL1,IC2)*XGLOB(IL2,IC1)
 1070      CONTINUE
            DO 1075 IC=1,6
              AA=ROTHOO(6,IC)
              ROTHOO(6,IC)=ROTHOO(5,IC)
              ROTHOO(5,IC)=AA
 1075       CONTINUE
            DO 1080 IL=1,6
              AA=ROTHOO(IL,6)
              ROTHOO(IL,6)=ROTHOO(IL,5)
              ROTHOO(IL,5)=AA
 1080       CONTINUE
         ENDIF
C
C    TRANSFORMATION DE LA MATRICE DE HOOKE ET DE COBAUX
C
         CALL PRODT(DDHOOK,D1HOOK,ROTHOO,LHOOK,LHOOK)
*
         IF (MFR.EQ.33) THEN
          DO 1085 IL=1,LHOOK
           r_z = 0.
           DO 1085 IC=1,LHOOK
            r_z = r_z + ROTHOO(IC,IL)*COBAUX(IC)
 1085     CONTINUE
          COBMA(IL) = r_z
         ENDIF
       ENDIF
C
       ELSEIF (IGAU.LE.NBGMAT.AND.
     +          (IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
C
C  Cas des barres
C
         IF(MFR.EQ.27) THEN
          YOU=VALMAT(1)
          DDHOOK(1,1)=YOU*SECT
C
         ELSE
C
C   option non definie
C
          IRET=0
         ENDIF
        ENDIF
C
2035  RETURN
      END