C PERMAO SOURCE BP208322 17/03/01 21:17:59 9325 SUBROUTINE PERMAO(WRK4,IFOUR,MATE,EREF,KERRE) C C----------------------------------------------------------------------- C C MATRICE DE PERMEABILITE DES ELEMENTS MASSIFS ORTHOTROPES C OU ANISOTROPES C SPECIAL POUR MILIEU POREUX C C WRK4 = POINTEUR SUR SEGMENT ACTIF, CONTENANT : * VALMAT VALEURS DES COMPOSANTES DE CONDUCTIBILITE ET * COS.DIRECTEURS DES AXES ORTHOTROPIE/REPERE LOCAL * XGLOB COS.DIRECTEURS DES AXES 1, 2 ET 3 D'ORTH./REPERE GLOBAL * XLOC COS.DIRECTEURS DES AXES 1, 2 ET 3 D'ORTH./REPERE LOCAL * TXR COS.DIRECTEURS DES AXES LOCAUX /REPERE GLOBAL * PMAT MATRICE DE PERMEABILITE * * IFOUR = CF CCOPTIO C MATE = NUMERO DU MATERIAU C EREF = VALEUR DE REFERENCE C KERRE = 0 SI OK C 1 SI OPTION NON DISPONIBLE C 2 SI XMU=0. C C----------------------------------------------------------------------- C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * SEGMENT WRK4 REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM) REAL*8 VALMAT(NMATT) REAL*8 PMAT(NSTB,NSTB),PMAT1(IDIM,IDIM),PMAT2(IDIM,IDIM) ENDSEGMENT * KERRE=0 NSTB=PMAT(/1) IDIM=PMAT1(/1) * * MISE A ZERO DES TABLEAUX * CALL ZERO(PMAT,NSTB,NSTB) CALL ZERO(PMAT1,IDIM,IDIM) CALL ZERO(PMAT2,IDIM,IDIM) CALL ZERO(XGLOB,IDIM,IDIM) * * TRAITEMENT DES CAS BIDIMENSIONNELS ( CP, DP, AXI, FOURIER) * IF(IDIM.EQ.2) THEN * cas orthotrope IF(MATE.EQ.2)THEN IF(IFOUR.LE.0) THEN PMAT1(1,1)=VALMAT(1) PMAT1(2,2)=VALMAT(2) XMU =VALMAT(3) XLOC(1,1) =VALMAT(4) XLOC(2,1) =VALMAT(5) XLOC(1,2) =-VALMAT(5) XLOC(2,2) =VALMAT(4) ELSE IF(IFOUR.EQ.1) THEN PMAT1(1,1)=VALMAT(1) PMAT1(2,2)=VALMAT(2) XMU =VALMAT(4) XLOC(1,1) =VALMAT(5) XLOC(2,1) =VALMAT(6) XLOC(1,2) =-VALMAT(6) XLOC(2,2) =VALMAT(5) ENDIF * cas anisotrope ELSE IF(MATE.EQ.3)THEN IF(IFOUR.LE.0) THEN PMAT1(1,1)=VALMAT(1) PMAT1(2,2)=VALMAT(2) PMAT1(2,1)=VALMAT(3) PMAT1(1,2)=PMAT1(2,1) XMU =VALMAT(4) XLOC(1,1) =VALMAT(5) XLOC(2,1) =VALMAT(6) XLOC(1,2) =-VALMAT(6) XLOC(2,2) =VALMAT(5) ELSE IF(IFOUR.EQ.1) THEN PMAT1(1,1)=VALMAT(1) PMAT1(2,2)=VALMAT(2) PMAT1(2,1)=VALMAT(3) PMAT1(1,2)=PMAT1(2,1) XMU =VALMAT(5) XLOC(1,1) =VALMAT(6) XLOC(2,1) =VALMAT(7) XLOC(1,2) =-VALMAT(7) XLOC(2,2) =VALMAT(6) ENDIF * cas unidirectionnel ELSE IF(MATE.EQ.4)THEN PMAT1(1,1)=VALMAT(1) XMU =VALMAT(2) XLOC(1,1) =VALMAT(3) XLOC(2,1) =VALMAT(4) XLOC(1,2) =-VALMAT(4) XLOC(2,2) =VALMAT(3) ENDIF * IF(XMU.EQ.0.D0) THEN KERRE=2 RETURN ENDIF FAC=EREF*EREF/XMU DO 30 I=1,IDIM DO 30 J=1,IDIM PMAT1(I,J)=PMAT1(I,J)*FAC 30 CONTINUE * * CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL * XGLOB=TXR*XLOC * DO 40 K=1,IDIM DO 40 J=1,IDIM DO 40 I=1,IDIM XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J) 40 CONTINUE * * TRANSFORMATION DE LA MATRICE PMAT1 * cas des series de fourier IF (IFOUR.EQ.1) THEN CALL PRODT(PMAT2,PMAT1,XGLOB,IDIM,IDIM) PMAT(1,1)=PMAT2(1,1) IF(MATE.EQ.2)THEN PMAT(2,2)=VALMAT(3) ELSE IF(MATE.EQ.3)THEN PMAT(2,2)=VALMAT(4) ENDIF PMAT(1,3)=PMAT2(1,2) PMAT(3,1)=PMAT(1,3) PMAT(3,3)=PMAT2(2,2) * les autres cas ELSE CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM) ENDIF * * * TRAITEMENT DES CAS TRIDIMENSIONNELS * ELSE IF(MATE.EQ.2)THEN * cas orthotrope PMAT1(1,1)=VALMAT(1) PMAT1(2,2)=VALMAT(2) PMAT1(3,3)=VALMAT(3) XMU =VALMAT(4) XLOC(1,1) =VALMAT(5) XLOC(2,1) =VALMAT(6) XLOC(3,1) =VALMAT(7) XLOC(1,2) =VALMAT(8) XLOC(2,2) =VALMAT(9) XLOC(3,2) =VALMAT(10) * cas anisotrope ELSE IF(MATE.EQ.3)THEN PMAT1(1,1)=VALMAT(1) PMAT1(2,2)=VALMAT(2) PMAT1(3,3)=VALMAT(3) PMAT1(2,1)=VALMAT(4) PMAT1(1,2)=PMAT(2,1) PMAT1(3,1)=VALMAT(5) PMAT1(1,3)=PMAT(3,1) PMAT1(3,2)=VALMAT(6) PMAT1(2,3)=PMAT(3,2) XMU =VALMAT(7) XLOC(1,1) =VALMAT(8) XLOC(2,1) =VALMAT(9) XLOC(3,1) =VALMAT(10) XLOC(1,2) =VALMAT(11) XLOC(2,2) =VALMAT(12) XLOC(3,2) =VALMAT(13) * cas unidirectionnel ELSE IF(MATE.EQ.4)THEN PMAT1(1,1)=VALMAT(1) XMU =VALMAT(2) XLOC(1,1) =VALMAT(3) XLOC(2,1) =VALMAT(4) XLOC(3,1) =VALMAT(5) XLOC(1,2) =VALMAT(6) XLOC(2,2) =VALMAT(7) XLOC(3,2) =VALMAT(8) ENDIF * IF(XMU.EQ.0.D0) THEN KERRE=2 RETURN ENDIF FAC=EREF*EREF/XMU DO 35 I=1,IDIM DO 35 J=1,IDIM PMAT1(I,J)=PMAT1(I,J)*FAC 35 CONTINUE * * CALCUL DU VECTEUR 3 * CALL CROSS2 (XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR) * * CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL * XGLOB=TXR*XLOC * DO 45 K=1,IDIM DO 45 J=1,IDIM DO 45 I=1,IDIM XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J) 45 CONTINUE * * TRANSFORMATION DE LA MATRICE PMAT1 * CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM) ENDIF RETURN END