C PERMEL    SOURCE    BP208322  17/03/01    21:18:00     9325           

C=======================================================================
C=                            P E R M E L                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=  Calcul de la matrice de PERMittivite ELectrique                    =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   MATE     (E)   Valeurs des parametres de permittivite du materiau =
C=   IDIM     (E)   Dimension du probleme (= LPERM aussi)              =
C=   IWKELT   (S)   Segment de travail (ACTIF) contenant, notamment,   =
C=                  matrice de permittivite dans le repere GLOBAL      =
C=   IWKMAT   (S)   Segment de travail (ACTIF)                         =
C=======================================================================

      SUBROUTINE PERMEL (MATE,IDIM, IWKELT,IWKMAT)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC CCREEL

      SEGMENT MWKELT
        REAL*8 DPERM(LPERM,LPERM),BGRELE(LPERM,LRE)
        REAL*8 XEL(3,NBNN),SHP(6,NBNN)
        REAL*8 VALMAT(NVMAT)
      ENDSEGMENT

      SEGMENT MWKMAT
        REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM)
        REAL*8 DPERM1(LPERM,LPERM)
      ENDSEGMENT

      MWKELT = IWKELT

C Cas ISOTROPE
C--------------
      IF (MATE.EQ.1) THEN
        DO i = 1, IDIM
          DPERM(i,i) = VALMAT(1)
        ENDDO

C Cas ORTHOTROPE et ANISOTROPE
C------------------------------
      ELSE
C- Calcul de la matrice de permittivite (DPERM1) dans le
C- repere de "tropie" et de la matrice des cosinus directeurs
C- (XLOC) des directions de "tropie" dans le repere LOCAL
        MWKMAT = IWKMAT
C- Cas des elements massifs 2D
        IF (IDIM.EQ.2) THEN
C-- Cas d'un materiau ORTHOTROPE
          IF (MATE.EQ.2) THEN
            DPERM1(1,1) = VALMAT(1)
            DPERM1(2,1) = XZERO
            DPERM1(1,2) = XZERO
            DPERM1(2,2) = VALMAT(2)
            XLOC(1,1) =  VALMAT(3)
            XLOC(2,1) =  VALMAT(4)
            XLOC(1,2) = -VALMAT(4)
            XLOC(2,2) =  VALMAT(3)
C-- Cas d'un materiau ANISOTROPE
          ELSE IF(MATE.EQ.3) THEN
            DPERM1(1,1) = VALMAT(1)
            DPERM1(2,1) = VALMAT(3)
            DPERM1(1,2) = VALMAT(3)
            DPERM1(2,2) = VALMAT(2)
            XLOC(1,1) =  VALMAT(4)
            XLOC(2,1) =  VALMAT(5)
            XLOC(1,2) = -VALMAT(5)
            XLOC(2,2) =  VALMAT(4)
          ENDIF
C- Cas des elements massifs 3D
        ELSE
C-- Cas d'un materiau ORTHOTROPE
          IF (MATE.EQ.2) THEN
            DPERM1(1,1) = VALMAT(1)
            DPERM1(2,1) = XZERO
            DPERM1(3,1) = XZERO
            DPERM1(1,2) = XZERO
            DPERM1(2,2) = VALMAT(2)
            DPERM1(3,2) = XZERO
            DPERM1(1,3) = XZERO
            DPERM1(2,3) = XZERO
            DPERM1(3,3) = VALMAT(3)
            XLOC(1,1) = VALMAT(4)
            XLOC(2,1) = VALMAT(5)
            XLOC(3,1) = VALMAT(6)
            XLOC(1,2) = VALMAT(7)
            XLOC(2,2) = VALMAT(8)
            XLOC(3,2) = VALMAT(9)
C-- Cas d'un materiau ANISOTROPE
          ELSE IF (MATE.EQ.3) THEN
            DPERM1(1,1) = VALMAT(1)
            DPERM1(2,1) = VALMAT(4)
            DPERM1(3,1) = VALMAT(5)
            DPERM1(1,2) = VALMAT(4)
            DPERM1(2,2) = VALMAT(2)
            DPERM1(3,2) = VALMAT(6)
            DPERM1(1,3) = VALMAT(5)
            DPERM1(2,3) = VALMAT(6)
            DPERM1(3,3) = VALMAT(3)
            XLOC(1,1) = VALMAT(7)
            XLOC(2,1) = VALMAT(8)
            XLOC(3,1) = VALMAT(9)
            XLOC(1,2) = VALMAT(10)
            XLOC(2,2) = VALMAT(11)
            XLOC(3,2) = VALMAT(12)
          ENDIF
C-- Calcul de la troisieme direction de "tropie"
          CALL CROSS2(XLOC(1,1),XLOC(1,2),XLOC(1,3),iOK)
C*AV test sur iOK
        ENDIF
C- Calcul de la matrice XGLOB des cosinus directeurs par rapport
C- au repere global
        DO j = 1, IDIM
          DO k = 1, IDIM
            r_z = XZERO
            DO i = 1,IDIM
              r_z = r_z + TXR(j,i)*XLOC(i,k)
            ENDDO
            XGLOB(k,j) = r_z
          ENDDO
        ENDDO
C- Calcul de la matrice de permittivite dans le repere global
        CALL PRODT(DPERM,DPERM1,XGLOB,IDIM,IDIM)
      ENDIF

      RETURN
      END