Sources Esope | Cast3M

mathoo
C MATHOO    SOURCE    OF166741  25/11/04    21:15:56     12349          
 
      SUBROUTINE MATHOO(D,EX,PX,NSTRS,IFOUR)
C
C        FORMATION DE LA MATRICE D ELASTICITE LINEAIRE
C-----------------------------------------------------------------------
C  IFOUR    INDICE DU TYPE DE PROBLEME
C            -2  CONTRAINTES PLANES
C            -1  DEFORMATIONS PLANES
C             0  AXISYMETRIQUE
C             1  SERIE DE FOURIER
C             2  TRIDIMENSIONNEL
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION D5(6,6),D(NSTRS,NSTRS)
C
      CALL ZERO(D5,6,6)
      CALL ZERO(D,NSTRS,NSTRS)
C
      GO TO (10,1000,30,40,50,60),NSTRS
      GOTO 1000
C
   60 CONTINUE
C
C     COMPORTEMENT TRIDIMENSIONNEL
C
         E1=EX/(1.D0+PX)/(1.D0-2.D0*PX)
         D5(1,1)=E1*(1.D0-PX)
         D5(1,2)=E1*PX
         D5(1,3)=D5(1,2)
         D5(2,1)=D5(1,2)
         D5(2,2)=D5(1,1)
         D5(2,3)=D5(1,3)
         D5(3,1)=D5(1,2)
         D5(3,2)=D5(1,2)
         D5(3,3)=D5(1,1)
         D5(4,4)=E1*(1.D0-2.D0*PX)*0.5D0
         D5(5,5)=D5(4,4)/1.2D0
         D5(6,6)=D5(5,5)
         GO TO 100
C
   50 CONTINUE
      IF(IFOUR.EQ.-2.OR.IFOUR.EQ.2) THEN
C
C     CONTRAINTES PLANES AVEC TOUS LES CISAILLEMENTS
C
         E1=EX/(1.D0-PX*PX)
         D5(1,1)=E1
         D5(1,2)=PX*E1
         D5(2,1)=PX*E1
         D5(2,2)=E1
         D5(3,3)=E1*(1.D0-PX)*0.5D0
         D5(4,4)=D5(3,3)/1.2D0
         D5(5,5)=D5(4,4)
C
      ELSE IF(IFOUR.EQ.-1) THEN
C
C     DEFORMATIONS PLANES AVEC TOUS LES CISAILLEMENTS
C
         E1=EX/(1.D0+PX)/(1.D0-2.D0*PX)
         D5(1,1)=E1*(1.D0-PX)
         D5(1,2)=PX*E1
         D5(2,1)=PX*E1
         D5(2,2)=E1*(1.D0-PX)
         D5(3,3)=E1*(1.D0-2.D0*PX)*0.5D0
         D5(4,4)=D5(3,3)/1.2D0
         D5(5,5)=D5(4,4)
      ELSE
         GO TO 1000
      ENDIF
      GO TO 100
C
   40 CONTINUE
       IF(IFOUR.EQ.0.OR.IFOUR.EQ.-1) THEN
C
C        CAS AXISYMETRIQUE OU DEFORMATION PLANES
C
         E1=EX/(1.D0+PX)/(1.D0-2.D0*PX)
         D5(1,1)=E1*(1.D0-PX)
         D5(1,2)=E1*PX
         D5(1,3)=E1*PX
         D5(2,1)=E1*PX
         D5(2,2)=E1*(1.D0-PX)
         D5(2,3)=E1*PX
         D5(3,1)=E1*PX
         D5(3,2)=E1*PX
         D5(3,3)=E1*(1.D0-PX)
         D5(4,4)=E1*(1.D0-2.D0*PX)*0.5D0
C
       ELSE IF (IFOUR.EQ.-2) THEN
C
C     CONTRAINTES PLANES
C
         E1=EX/(1.D0-PX*PX)
         D5(1,1)=E1
         D5(1,2)=PX*E1
         D5(2,1)=PX*E1
         D5(2,2)=E1
         D5(3,3)=D5(1,1)*1.D-6
         D5(4,4)=E1*(1.D0-PX)*0.5D0
C
       ENDIF
       GO TO 100
C
   30 CONTINUE
      IF(IFOUR.EQ.-2.OR.IFOUR.EQ.2) THEN
C
C     CONTRAINTES PLANES SANS CISAILLEMENTS TRANSVERSAL
C
         E1=EX/(1.D0-PX*PX)
         D5(1,1)=E1
         D5(1,2)=PX*E1
         D5(2,1)=PX*E1
         D5(2,2)=E1
         D5(3,3)=E1*(1.D0-PX)/2.D0
C
      ELSE IF(IFOUR.EQ.-1) THEN
C
C     DEFORMATIONS PLANES SANS CISAILLEMENTS TRANSVERSAL
C
         E1=EX/(1.D0+PX)/(1.D0-2.D0*PX)
         D5(1,1)=E1*(1.D0-PX)
         D5(1,2)=PX*E1
         D5(2,1)=PX*E1
         D5(2,2)=E1*(1.D0-PX)
         D5(3,3)=E1*(1.D0-2.D0*PX)*0.5D0
      ELSE
        GO TO 1000
      ENDIF
      GO TO 100
C
   10 CONTINUE
C
C     COMPORTEMENT UNIDIMENSIONNEL
C
        D5(1,1)=EX
        GO TO 100
 
 1000 CONTINUE
      WRITE(*,200) IFOUR,NSTRS
  200 FORMAT(//,5X,' CAS NON DISPONIBLE DANS MATHOOK',/,
     * 10X,'IFOUR=',I2,' NSTRS=',I2,//)
 
        CALL ERREUR(5)
        RETURN
 
  100 CONTINUE
 
      DO 300 J = 1,NSTRS
      DO 400 I = 1,NSTRS
        D(I,J) = D5(I,J)
  400 CONTINUE
  300 CONTINUE
 
      RETURN
      END