1 : C CREMAT SOURCE CHAT 05/01/12 22:29:25 5004 2 : SUBROUTINE CREMAT(D,EX,PX,NSTRS,IFOUR) 3 : C 4 : C FORMATION DE LA MATRICE D ELASTICITE LINEAIRE 5 : C----------------------------------------------------------------------- 6 : C VARIABLES PASSEES PAR LES COMMONS COPTIO , ECOU ET NECOU 7 : C 8 : C IFOUR INDICE DU TYPE DE PROBLEME 9 : C -2 CONTRAINTES PLANES 10 : C -1 DEFORMATIONS PLANES 11 : C 0 AXISYMETRIQUE 12 : C 1 SERIE DE FOURIER 13 : C 2 TRIDIMENSIONNEL 14 : C----------------------------------------------------------------------- 15 : IMPLICIT INTEGER(I-N) 16 : IMPLICIT REAL*8(A-H,O-Z) 17 : DIMENSION D5(6,6),D(4,4) 18 : C 18 : CALL ZERO(D5,6,6) 18 : CALL ZERO(D,4,4) 19 : C 20 : GO TO (10,1000,30,40,50,60),NSTRS 21 : GOTO 1000 22 : C 23 : 60 CONTINUE 24 : C 25 : C COMPORTEMENT TRIDIMENSIONNEL 26 : C 27 : E1=EX/(1.D0+PX)/(1.D0-2.D0*PX) 28 : D5(1,1)=E1*(1.D0-PX) 29 : D5(1,2)=E1*PX 30 : D5(1,3)=D5(1,2) 31 : D5(2,1)=D5(1,2) 32 : D5(2,2)=D5(1,1) 33 : D5(2,3)=D5(1,3) 34 : D5(3,1)=D5(1,2) 35 : D5(3,2)=D5(1,2) 36 : D5(3,3)=D5(1,1) 37 : D5(4,4)=E1*(1.D0-2.D0*PX)/2.D0 38 : D5(5,5)=D5(4,4)/1.2D0 39 : D5(6,6)=D5(5,5) 40 : GO TO 100 41 : C 42 : 50 CONTINUE 43 : IF(IFOUR.EQ.-2.OR.IFOUR.EQ.2) THEN 44 : C 45 : C CONTRAINTES PLANES AVEC TOUS LES CISAILLEMENTS 46 : C 47 : E1=EX/(1.D0-PX*PX) 48 : D5(1,1)=E1 49 : D5(1,2)=PX*E1 50 : D5(2,1)=PX*E1 51 : D5(2,2)=E1 52 : D5(3,3)=E1*(1.D0-PX)/2.D0 53 : D5(4,4)=D5(3,3)/1.2D0 54 : D5(5,5)=D5(4,4) 55 : C 56 : ELSE IF(IFOUR.EQ.-1) THEN 57 : C 58 : C DEFORMATIONS PLANES AVEC TOUS LES CISAILLEMENTS 59 : C 60 : E1=EX/(1.D0+PX)/(1.D0-2.D0*PX) 61 : D5(1,1)=E1*(1.D0-PX) 62 : D5(1,2)=PX*E1 63 : D5(2,1)=PX*E1 64 : D5(2,2)=E1*(1.D0-PX) 65 : D5(3,3)=E1*(1.D0-2.D0*PX)/2.D0 66 : D5(4,4)=D5(3,3)/1.2D0 67 : D5(5,5)=D5(4,4) 68 : ELSE 69 : GO TO 1000 70 : ENDIF 71 : GO TO 100 72 : C 73 : 40 CONTINUE 74 : IF(IFOUR.EQ.0.OR.IFOUR.EQ.-1) THEN 75 : C 76 : C CAS AXISYMETRIQUE OU DEFORMATION PLANES 77 : C 78 : E1=EX/(1.D0+PX)/(1.D0-2.D0*PX) 79 : D5(1,1)=E1*(1.D0-PX) 80 : D5(1,2)=E1*PX 81 : D5(1,3)=E1*PX 82 : D5(2,1)=E1*PX 83 : D5(2,2)=E1*(1.D0-PX) 84 : D5(2,3)=E1*PX 85 : D5(3,1)=E1*PX 86 : D5(3,2)=E1*PX 87 : D5(3,3)=E1*(1.D0-PX) 88 : D5(4,4)=E1*(1.D0-2.D0*PX)/2.D0 89 : C 90 : ELSE IF (IFOUR.EQ.-2) THEN 91 : C 92 : C CONTRAINTES PLANES 93 : C 94 : E1=EX/(1.D0-PX*PX) 95 : D5(1,1)=E1 96 : D5(1,2)=PX*E1 97 : D5(2,1)=PX*E1 98 : D5(2,2)=E1 99 : D5(3,3)=D5(1,1)*1.D-6 100 : D5(4,4)=E1*(1.D0-PX)/2.D0 101 : C 102 : ENDIF 103 : GO TO 100 104 : C 105 : 30 CONTINUE 106 : IF(IFOUR.EQ.-2.OR.IFOUR.EQ.2) THEN 107 : C 108 : C CONTRAINTES PLANES SANS CISAILLEMENTS TRANSVERSAL 109 : C 110 : E1=EX/(1.D0-PX*PX) 111 : D5(1,1)=E1 112 : D5(1,2)=PX*E1 113 : D5(2,1)=PX*E1 114 : D5(2,2)=E1 115 : D5(3,3)=E1*(1.D0-PX)/2.D0 116 : C 117 : ELSE IF(IFOUR.EQ.-1) THEN 118 : C 119 : C DEFORMATIONS PLANES SANS CISAILLEMENTS TRANSVERSAL 120 : C 121 : E1=EX/(1.D0+PX)/(1.D0-2.D0*PX) 122 : D5(1,1)=E1*(1.D0-PX) 123 : D5(1,2)=PX*E1 124 : D5(2,1)=PX*E1 125 : D5(2,2)=E1*(1.D0-PX) 126 : D5(3,3)=E1*(1.D0-2.D0*PX)/2.D0 127 : ELSE 128 : GO TO 1000 129 : ENDIF 130 : GO TO 100 131 : C 132 : 10 CONTINUE 133 : C 134 : C COMPORTEMENT UNIDIMENSIONNEL 135 : C 136 : D5(1,1)=EX 137 : GO TO 100 138 : 1000 WRITE(*,200) IFOUR,NSTRS 139 : STOP 140 : 100 CONTINUE 141 : C 142 : DO 300 I = 1,NSTRS 143 : DO 400 J = 1,NSTRS 144 : D(I,J) = D5(I,J) 145 : 400 CONTINUE 146 : 300 CONTINUE 147 : 200 FORMAT(//,5X,' CAS NON DISPONIBLE DANS CREMAT',/, 148 : * 10X,'IFOUR=',I2,' NSTRS=',I2,//) 149 : RETURN 150 : END 151 : 152 : 153 : 154 : 155 :
© Cast3M 2003 - All rights reserved.
Disclaimer