Télécharger la plaquette Cast3M


fr en

Télécharger permao.eso

Retour à la liste

Numérotation des lignes : 

permao

  1. C PERMAO    SOURCE    CB215821  26/08/24    21:17:39     12622          
  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(3,3),XGLOB(3,3),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. *
  42.       CALL ZERO(PMAT,NSTB,NSTB)
  43.       CALL ZERO(PMAT1,IDIM,IDIM)
  44.       CALL ZERO(PMAT2,IDIM,IDIM)
  45.       CALL ZERO(XGLOB,IDIM,IDIM)
  46. *
  47. *  TRAITEMENT DES CAS BIDIMENSIONNELS ( CP, DP, AXI, FOURIER)
  48. *
  49.       IF(IDIM.EQ.2) THEN
  50. *                                           cas orthotrope
  51.          IF(MATE.EQ.2)THEN
  52.            IF(IFOUR.LE.0) THEN
  53.              PMAT1(1,1)=VALMAT(1)
  54.              PMAT1(2,2)=VALMAT(2)
  55.              XMU       =VALMAT(3)
  56.              XLOC(1,1) =VALMAT(4)
  57.              XLOC(2,1) =VALMAT(5)
  58.              XLOC(1,2) =-VALMAT(5)
  59.              XLOC(2,2) =VALMAT(4)
  60.            ELSE IF(IFOUR.EQ.1) THEN
  61.              PMAT1(1,1)=VALMAT(1)
  62.              PMAT1(2,2)=VALMAT(2)
  63.              XMU       =VALMAT(4)
  64.              XLOC(1,1) =VALMAT(5)
  65.              XLOC(2,1) =VALMAT(6)
  66.              XLOC(1,2) =-VALMAT(6)
  67.              XLOC(2,2) =VALMAT(5)
  68.            ENDIF
  69. *                                           cas anisotrope
  70.         ELSE IF(MATE.EQ.3)THEN
  71.            IF(IFOUR.LE.0) THEN
  72.              PMAT1(1,1)=VALMAT(1)
  73.              PMAT1(2,2)=VALMAT(2)
  74.              PMAT1(2,1)=VALMAT(3)
  75.              PMAT1(1,2)=PMAT1(2,1)
  76.              XMU       =VALMAT(4)
  77.              XLOC(1,1) =VALMAT(5)
  78.              XLOC(2,1) =VALMAT(6)
  79.              XLOC(1,2) =-VALMAT(6)
  80.              XLOC(2,2) =VALMAT(5)
  81.            ELSE IF(IFOUR.EQ.1) THEN
  82.              PMAT1(1,1)=VALMAT(1)
  83.              PMAT1(2,2)=VALMAT(2)
  84.              PMAT1(2,1)=VALMAT(3)
  85.              PMAT1(1,2)=PMAT1(2,1)
  86.              XMU       =VALMAT(5)
  87.              XLOC(1,1) =VALMAT(6)
  88.              XLOC(2,1) =VALMAT(7)
  89.              XLOC(1,2) =-VALMAT(7)
  90.              XLOC(2,2) =VALMAT(6)
  91.            ENDIF
  92. *                                           cas unidirectionnel
  93.         ELSE IF(MATE.EQ.4)THEN
  94.            PMAT1(1,1)=VALMAT(1)
  95.            XMU       =VALMAT(2)
  96.            XLOC(1,1) =VALMAT(3)
  97.            XLOC(2,1) =VALMAT(4)
  98.            XLOC(1,2) =-VALMAT(4)
  99.            XLOC(2,2) =VALMAT(3)
  100.         ENDIF
  101. *
  102.         IF(XMU.EQ.0.D0) THEN
  103.           KERRE=2
  104.           RETURN
  105.         ENDIF
  106.         FAC=EREF*EREF/XMU
  107.         DO 46 I=1,IDIM
  108.           DO 30 J=1,IDIM
  109.             PMAT1(I,J)=PMAT1(I,J)*FAC
  110.    30   CONTINUE
  111.    46   CONTINUE
  112. *
  113. *           CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL
  114. *           XGLOB=TXR*XLOC
  115. *
  116.          DO 48 K=1,IDIM
  117.            DO 47 J=1,IDIM
  118.              DO 40 I=1,IDIM
  119.                XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
  120.    40    CONTINUE
  121.    47      CONTINUE
  122.    48    CONTINUE
  123. *
  124. *           TRANSFORMATION DE LA MATRICE PMAT1
  125. *                                   cas des series de fourier
  126.          IF (IFOUR.EQ.1) THEN
  127.             CALL PRODT(PMAT2,PMAT1,XGLOB,IDIM,IDIM)
  128.             PMAT(1,1)=PMAT2(1,1)
  129.             IF(MATE.EQ.2)THEN
  130.                PMAT(2,2)=VALMAT(3)
  131.             ELSE IF(MATE.EQ.3)THEN
  132.                PMAT(2,2)=VALMAT(4)
  133.             ENDIF
  134.             PMAT(1,3)=PMAT2(1,2)
  135.             PMAT(3,1)=PMAT(1,3)
  136.             PMAT(3,3)=PMAT2(2,2)
  137. *                                  les autres cas
  138.          ELSE
  139.            CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM)
  140.          ENDIF
  141. *
  142. *
  143. *    TRAITEMENT DES CAS TRIDIMENSIONNELS
  144. *
  145.       ELSE
  146.         IF(MATE.EQ.2)THEN
  147. *                                          cas orthotrope
  148.           PMAT1(1,1)=VALMAT(1)
  149.           PMAT1(2,2)=VALMAT(2)
  150.           PMAT1(3,3)=VALMAT(3)
  151.           XMU       =VALMAT(4)
  152.           XLOC(1,1) =VALMAT(5)
  153.           XLOC(2,1) =VALMAT(6)
  154.           XLOC(3,1) =VALMAT(7)
  155.           XLOC(1,2) =VALMAT(8)
  156.           XLOC(2,2) =VALMAT(9)
  157.           XLOC(3,2) =VALMAT(10)
  158. *                                           cas anisotrope
  159.         ELSE IF(MATE.EQ.3)THEN
  160.           PMAT1(1,1)=VALMAT(1)
  161.           PMAT1(2,2)=VALMAT(2)
  162.           PMAT1(3,3)=VALMAT(3)
  163.           PMAT1(2,1)=VALMAT(4)
  164.           PMAT1(1,2)=PMAT(2,1)
  165.           PMAT1(3,1)=VALMAT(5)
  166.           PMAT1(1,3)=PMAT(3,1)
  167.           PMAT1(3,2)=VALMAT(6)
  168.           PMAT1(2,3)=PMAT(3,2)
  169.           XMU       =VALMAT(7)
  170.           XLOC(1,1) =VALMAT(8)
  171.           XLOC(2,1) =VALMAT(9)
  172.           XLOC(3,1) =VALMAT(10)
  173.           XLOC(1,2) =VALMAT(11)
  174.           XLOC(2,2) =VALMAT(12)
  175.           XLOC(3,2) =VALMAT(13)
  176. *                                           cas unidirectionnel
  177.         ELSE IF(MATE.EQ.4)THEN
  178.            PMAT1(1,1)=VALMAT(1)
  179.            XMU       =VALMAT(2)
  180.            XLOC(1,1) =VALMAT(3)
  181.            XLOC(2,1) =VALMAT(4)
  182.            XLOC(3,1) =VALMAT(5)
  183.            XLOC(1,2) =VALMAT(6)
  184.            XLOC(2,2) =VALMAT(7)
  185.            XLOC(3,2) =VALMAT(8)
  186.         ENDIF
  187. *
  188.         IF(XMU.EQ.0.D0) THEN
  189.           KERRE=2
  190.           RETURN
  191.         ENDIF
  192.         FAC=EREF*EREF/XMU
  193.         DO 49 I=1,IDIM
  194.           DO 35 J=1,IDIM
  195.             PMAT1(I,J)=PMAT1(I,J)*FAC
  196.    35   CONTINUE
  197.    49   CONTINUE
  198. *
  199. *             CALCUL DU VECTEUR 3
  200. *
  201.         CALL  CROSS2 (XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  202. *
  203. *           CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL
  204. *           XGLOB=TXR*XLOC
  205. *
  206.         DO 51 K=1,IDIM
  207.           DO 50 J=1,IDIM
  208.             DO 45 I=1,IDIM
  209.               XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
  210.    45  CONTINUE
  211.    50     CONTINUE
  212.    51   CONTINUE
  213. *
  214. *           TRANSFORMATION DE LA MATRICE PMAT1
  215. *
  216.         CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM)
  217.       ENDIF
  218.       RETURN
  219.       END
  220.  
  221.  
  222.  
  223.  
  224.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales