1 : C PERMAO SOURCE CHAT 05/01/13 02:12:57 5004 2 : SUBROUTINE PERMAO(WRK4,IFOUR,MATE,EREF,KERRE) 3 : C 4 : C----------------------------------------------------------------------- 5 : C 6 : C MATRICE DE PERMEABILITE DES ELEMENTS MASSIFS ORTHOTROPES 7 : C OU ANISOTROPES 8 : C SPECIAL POUR MILIEU POREUX 9 : C 10 : C WRK4 = POINTEUR SUR SEGMENT ACTIF, CONTENANT : 11 : * VALMAT VALEURS DES COMPOSANTES DE CONDUCTIBILITE ET 12 : * COS.DIRECTEURS DES AXES ORTHOTROPIE/REPERE LOCAL 13 : * XGLOB COS.DIRECTEURS DES AXES 1, 2 ET 3 D'ORTH./REPERE GLOBAL 14 : * XLOC COS.DIRECTEURS DES AXES 1, 2 ET 3 D'ORTH./REPERE LOCAL 15 : * TXR COS.DIRECTEURS DES AXES LOCAUX /REPERE GLOBAL 16 : * PMAT MATRICE DE PERMEABILITE 17 : * 18 : * IFOUR = CF CCOPTIO 19 : C MATE = NUMERO DU MATERIAU 20 : C EREF = VALEUR DE REFERENCE 21 : C KERRE = 0 SI OK 22 : C 1 SI OPTION NON DISPONIBLE 23 : C 2 SI XMU=0. 24 : C 25 : C----------------------------------------------------------------------- 26 : C 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8(A-H,O-Z) 29 : * 30 : SEGMENT WRK4 31 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM),TXR(IDIM,IDIM) 32 : REAL*8 VALMAT(NMATT) 33 : REAL*8 PMAT(NSTB,NSTB),PMAT1(IDIM,IDIM),PMAT2(IDIM,IDIM) 34 : ENDSEGMENT 35 : * 36 : KERRE=0 37 : NSTB=PMAT(/1) 38 : IDIM=PMAT1(/1) 39 : * 40 : * MISE A ZERO DES TABLEAUX 41 : * 41 : CALL ZERO(PMAT,NSTB,NSTB) 41 : CALL ZERO(PMAT1,IDIM,IDIM) 41 : CALL ZERO(PMAT2,IDIM,IDIM) 41 : CALL ZERO(XGLOB,IDIM,IDIM) 42 : * 43 : * TRAITEMENT DES CAS BIDIMENSIONNELS ( CP, DP, AXI, FOURIER) 44 : * 45 : IF(IDIM.EQ.2) THEN 46 : * cas orthotrope 47 : IF(MATE.EQ.2)THEN 48 : IF(IFOUR.LE.0) THEN 49 : PMAT1(1,1)=VALMAT(1) 50 : PMAT1(2,2)=VALMAT(2) 51 : XMU =VALMAT(3) 52 : XLOC(1,1) =VALMAT(4) 53 : XLOC(2,1) =VALMAT(5) 54 : XLOC(1,2) =-VALMAT(5) 55 : XLOC(2,2) =VALMAT(4) 56 : ELSE IF(IFOUR.EQ.1) THEN 57 : PMAT1(1,1)=VALMAT(1) 58 : PMAT1(2,2)=VALMAT(2) 59 : XMU =VALMAT(4) 60 : XLOC(1,1) =VALMAT(5) 61 : XLOC(2,1) =VALMAT(6) 62 : XLOC(1,2) =-VALMAT(6) 63 : XLOC(2,2) =VALMAT(5) 64 : ENDIF 65 : * cas anisotrope 66 : ELSE IF(MATE.EQ.3)THEN 67 : IF(IFOUR.LE.0) THEN 68 : PMAT1(1,1)=VALMAT(1) 69 : PMAT1(2,2)=VALMAT(2) 70 : PMAT1(2,1)=VALMAT(3) 71 : PMAT1(1,2)=PMAT1(2,1) 72 : XMU =VALMAT(4) 73 : XLOC(1,1) =VALMAT(5) 74 : XLOC(2,1) =VALMAT(6) 75 : XLOC(1,2) =-VALMAT(6) 76 : XLOC(2,2) =VALMAT(5) 77 : ELSE IF(IFOUR.EQ.1) THEN 78 : PMAT1(1,1)=VALMAT(1) 79 : PMAT1(2,2)=VALMAT(2) 80 : PMAT1(2,1)=VALMAT(3) 81 : PMAT1(1,2)=PMAT1(2,1) 82 : XMU =VALMAT(5) 83 : XLOC(1,1) =VALMAT(6) 84 : XLOC(2,1) =VALMAT(7) 85 : XLOC(1,2) =-VALMAT(7) 86 : XLOC(2,2) =VALMAT(6) 87 : ENDIF 88 : * cas unidirectionnel 89 : ELSE IF(MATE.EQ.4)THEN 90 : PMAT1(1,1)=VALMAT(1) 91 : XMU =VALMAT(2) 92 : XLOC(1,1) =VALMAT(3) 93 : XLOC(2,1) =VALMAT(4) 94 : XLOC(1,2) =-VALMAT(4) 95 : XLOC(2,2) =VALMAT(3) 96 : ENDIF 97 : * 98 : IF(XMU.EQ.0.D0) THEN 99 : KERRE=2 100 : RETURN 101 : ENDIF 102 : FAC=EREF*EREF/XMU 103 : DO 30 I=1,IDIM 104 : DO 30 J=1,IDIM 105 : PMAT1(I,J)=PMAT1(I,J)*FAC 106 : 30 CONTINUE 107 : * 108 : * CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL 109 : * XGLOB=TXR*XLOC 110 : * 111 : DO 40 K=1,IDIM 112 : DO 40 J=1,IDIM 113 : DO 40 I=1,IDIM 114 : XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J) 115 : 40 CONTINUE 116 : * 117 : * TRANSFORMATION DE LA MATRICE PMAT1 118 : * cas des series de fourier 119 : IF (IFOUR.EQ.1) THEN 119 : CALL PRODT(PMAT2,PMAT1,XGLOB,IDIM,IDIM) 120 : PMAT(1,1)=PMAT2(1,1) 121 : IF(MATE.EQ.2)THEN 122 : PMAT(2,2)=VALMAT(3) 123 : ELSE IF(MATE.EQ.3)THEN 124 : PMAT(2,2)=VALMAT(4) 125 : ENDIF 126 : PMAT(1,3)=PMAT2(1,2) 127 : PMAT(3,1)=PMAT(1,3) 128 : PMAT(3,3)=PMAT2(2,2) 129 : * les autres cas 130 : ELSE 130 : CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM) 131 : ENDIF 132 : * 133 : * 134 : * TRAITEMENT DES CAS TRIDIMENSIONNELS 135 : * 136 : ELSE 137 : IF(MATE.EQ.2)THEN 138 : * cas orthotrope 139 : PMAT1(1,1)=VALMAT(1) 140 : PMAT1(2,2)=VALMAT(2) 141 : PMAT1(3,3)=VALMAT(3) 142 : XMU =VALMAT(4) 143 : XLOC(1,1) =VALMAT(5) 144 : XLOC(2,1) =VALMAT(6) 145 : XLOC(3,1) =VALMAT(7) 146 : XLOC(1,2) =VALMAT(8) 147 : XLOC(2,2) =VALMAT(9) 148 : XLOC(3,2) =VALMAT(10) 149 : * cas anisotrope 150 : ELSE IF(MATE.EQ.3)THEN 151 : PMAT1(1,1)=VALMAT(1) 152 : PMAT1(2,2)=VALMAT(2) 153 : PMAT1(3,3)=VALMAT(3) 154 : PMAT1(2,1)=VALMAT(4) 155 : PMAT1(1,2)=PMAT(2,1) 156 : PMAT1(3,1)=VALMAT(5) 157 : PMAT1(1,3)=PMAT(3,1) 158 : PMAT1(3,2)=VALMAT(6) 159 : PMAT1(2,3)=PMAT(3,2) 160 : XMU =VALMAT(7) 161 : XLOC(1,1) =VALMAT(8) 162 : XLOC(2,1) =VALMAT(9) 163 : XLOC(3,1) =VALMAT(10) 164 : XLOC(1,2) =VALMAT(11) 165 : XLOC(2,2) =VALMAT(12) 166 : XLOC(3,2) =VALMAT(13) 167 : * cas unidirectionnel 168 : ELSE IF(MATE.EQ.4)THEN 169 : PMAT1(1,1)=VALMAT(1) 170 : XMU =VALMAT(2) 171 : XLOC(1,1) =VALMAT(3) 172 : XLOC(2,1) =VALMAT(4) 173 : XLOC(3,1) =VALMAT(5) 174 : XLOC(1,2) =VALMAT(6) 175 : XLOC(2,2) =VALMAT(7) 176 : XLOC(3,2) =VALMAT(8) 177 : ENDIF 178 : * 179 : IF(XMU.EQ.0.D0) THEN 180 : KERRE=2 181 : RETURN 182 : ENDIF 183 : FAC=EREF*EREF/XMU 184 : DO 35 I=1,IDIM 185 : DO 35 J=1,IDIM 186 : PMAT1(I,J)=PMAT1(I,J)*FAC 187 : 35 CONTINUE 188 : * 189 : * CALCUL DU VECTEUR 3 190 : * 190 : CALL CROSS2 (XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR) 191 : * 192 : * CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL 193 : * XGLOB=TXR*XLOC 194 : * 195 : DO 45 K=1,IDIM 196 : DO 45 J=1,IDIM 197 : DO 45 I=1,IDIM 198 : XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J) 199 : 45 CONTINUE 200 : * 201 : * TRANSFORMATION DE LA MATRICE PMAT1 202 : * 202 : CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM) 203 : ENDIF 204 : RETURN 205 : END 206 : 207 :
© Cast3M 2003 - All rights reserved.
Disclaimer