Sources Esope | Cast3M

cremat
C CREMAT    SOURCE    CHAT      05/01/12    22:29:25     5004
      SUBROUTINE CREMAT(D,EX,PX,NSTRS,IFOUR)
C
C        FORMATION DE LA MATRICE D ELASTICITE LINEAIRE
C-----------------------------------------------------------------------
C      VARIABLES PASSEES PAR LES COMMONS COPTIO , ECOU  ET NECOU
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(4,4)
C
      CALL ZERO(D5,6,6)
      CALL ZERO(D,4,4)
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)/2.D0
         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)/2.D0
         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)/2.D0
         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)/2.D0
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)/2.D0
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)/2.D0
      ELSE
        GO TO 1000
      ENDIF
      GO TO 100
C
   10 CONTINUE
C
C     COMPORTEMENT UNIDIMENSIONNEL
C
        D5(1,1)=EX
        GO TO 100
 1000 WRITE(*,200) IFOUR,NSTRS
      STOP
  100 CONTINUE
C
      DO 300 I = 1,NSTRS
      DO 400 J = 1,NSTRS
        D(I,J) = D5(I,J)
  400 CONTINUE
  300 CONTINUE
  200 FORMAT(//,5X,' CAS NON DISPONIBLE DANS CREMAT',/,
     * 10X,'IFOUR=',I2,' NSTRS=',I2,//)
      RETURN
      END