Sources Esope | Cast3M

maxrot
C MAXROT    SOURCE    BP208322  17/03/01    21:17:52     9325           
      SUBROUTINE MAXROT(WTRAV,MFR,IB,IGAU,NBGMAT,NELMAT,NPINT)
C
C  ROTATION DES TENSEURS POUR MAXWEL
C  SI MATE UNIDIRECTIONNEL
C       INSPIRE DE HOOKUN
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER(UN=1.D0,DEUX=2.D0,UNDEMI=.5D0)
C
-INC CCHAMP
 
-INC PPARAM
-INC CCOPTIO
 
 
 
      SEGMENT WTRAV
        REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
        REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
        REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
        REAL*8 XLOC(3,3),XGLOB(3,3)
        REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
      ENDSEGMENT
*
 
 
C
C     INITIALISATION
C
        CALL ZERO(XGLOB,IDIM,IDIM)
 
***********************
*    CAS MASSIF
***********************
*
      IF (MFR.EQ.1.OR.MFR.EQ.33) THEN
 
        IF(IGAU.LE.NBGMAT) THEN
 
          IF(IDIM.EQ.2)THEN
C
C    DEFINITION DES AXES ORTHO./AXES LOCAUX
C
 
            XLOC(1,1)=VALMAT(2)
            XLOC(2,1)=VALMAT(3)
            XLOC(1,2)=-XLOC(2,1)
            XLOC(2,2)=XLOC(1,1)
 
          ELSEIF(IDIM.EQ.3)THEN
            XLOC(1,1)=VALMAT(2)
            XLOC(2,1)=VALMAT(3)
            XLOC(3,1)=VALMAT(4)
            XLOC(1,2)=VALMAT(5)
            XLOC(2,2)=VALMAT(6)
            XLOC(3,2)=VALMAT(7)
C
            CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
            IF(IRR.EQ.0) THEN
               CALL ERREUR(277)
               RETURN
            ENDIF
          ENDIF
 
 
 
C
C         DEFINITION DES AXES ORTHO./AXES GLOBAUX
C
          DO 1045  K=1,IDIM
            DO 1045 J=1,IDIM
              DO 1045 I=1,IDIM
                XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
 1045     CONTINUE
 
        ENDIF
C
C
       ELSEIF (IGAU.LE.NBGMAT.AND.
     +          (IB.LE.NELMAT.OR.NBGMAT.GT.1)) THEN
C
C  MLR 12/8/99
C  POUR LE MOMENT ON BLOQUE LE RESTE
C   A BRANCHER PLUS TARD ...!
C
       IZOB=0
       IF(IZOB.EQ.0) THEN
          CALL ERREUR (251)
          RETURN
       ENDIF
 
 
 
 
C
C  Coques minces
C
         IF(MFR.EQ.3) THEN
C
C     CAS DKT INTEGRE
C
          IF (NPINT.NE.0) THEN
* CAS NON ENCORE IMPLEMENTE
            CALL ERREUR (251)
            RETURN
          ELSE
C
C     CAS TRIDIMENSIONNEL  ET FOURIER
C
          IF(IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN
*PV D3HOO1 n'existe pas !!!
*          CALL ZERO(D3HOO1,3,3)
           COSA=VALMAT(2)
           SINA=VALMAT(3)
C
           COS2 = COSA**2
           SIN2 = SINA**2
           SINCOS = SINA * COSA
C
C
C
C     CAS AXISYMETRIQUE ET DEFORMATIONS PLANES
C
          ELSE IF(IFOUR.EQ.0.OR.IFOUR.EQ.-1.OR.
     &            IFOUR.EQ.-3) THEN
           COSA=VALMAT(2)
           SINA=VALMAT(3)
            COS2 = COSA**2
            SIN2 = SINA**2
C
C
C     CAS CONTRAINTES PLANES
C
          ELSE IF(IFOUR.EQ.-2) THEN
********   DDHOOK(1,1)=YG1
********   DDHOOK(3,3)=YG1
C
          ELSE
            IRET=0
          ENDIF
          ENDIF
C
C  Coques epaisses
C
         ELSE IF(MFR.EQ.5) THEN
C
C     CAS TRIDIMENSIONNEL
C
          IF(IFOUR.EQ.2) THEN
            COSA=VALMAT(2)
            SINA=VALMAT(3)
C
            COS2 = COSA**2
            SIN2 = SINA**2
            SINCOS = SINA * COSA
C
C
          ELSE
           IRET=0
          ENDIF
C
C  Coques minces avec cisaillement transverse
C
         ELSE IF(MFR.EQ.9) THEN
C
           IF(IFOUR.EQ.2) THEN
            COSA=VALMAT(2)
            SINA=VALMAT(3)
C
            COS2 = COSA**2
            SIN2 = SINA**2
            SINCOS = SINA * COSA
C
C
           ELSE
            IRET=0
           ENDIF
C
C  Cas des barres
C
         ELSE IF(MFR.EQ.27) THEN
C
C      RIEN A FAIRE
C
         ELSE
          IRET=0
          GOTO 2035
         ENDIF
        ENDIF
C
 2035 RETURN
 
      END