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    BP208322  17/03/01    21:17:59     9325           
  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 30 I=1,IDIM
  108.           DO 30 J=1,IDIM
  109.             PMAT1(I,J)=PMAT1(I,J)*FAC
  110.    30   CONTINUE
  111. *
  112. *           CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL
  113. *           XGLOB=TXR*XLOC
  114. *
  115.          DO 40 K=1,IDIM
  116.            DO 40 J=1,IDIM
  117.              DO 40 I=1,IDIM
  118.                XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
  119.    40    CONTINUE
  120. *
  121. *           TRANSFORMATION DE LA MATRICE PMAT1
  122. *                                   cas des series de fourier
  123.          IF (IFOUR.EQ.1) THEN
  124.             CALL PRODT(PMAT2,PMAT1,XGLOB,IDIM,IDIM)
  125.             PMAT(1,1)=PMAT2(1,1)
  126.             IF(MATE.EQ.2)THEN
  127.                PMAT(2,2)=VALMAT(3)
  128.             ELSE IF(MATE.EQ.3)THEN
  129.                PMAT(2,2)=VALMAT(4)
  130.             ENDIF
  131.             PMAT(1,3)=PMAT2(1,2)
  132.             PMAT(3,1)=PMAT(1,3)
  133.             PMAT(3,3)=PMAT2(2,2)
  134. *                                  les autres cas
  135.          ELSE
  136.            CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM)
  137.          ENDIF
  138. *
  139. *
  140. *    TRAITEMENT DES CAS TRIDIMENSIONNELS
  141. *
  142.       ELSE
  143.         IF(MATE.EQ.2)THEN
  144. *                                          cas orthotrope
  145.           PMAT1(1,1)=VALMAT(1)
  146.           PMAT1(2,2)=VALMAT(2)
  147.           PMAT1(3,3)=VALMAT(3)
  148.           XMU       =VALMAT(4)
  149.           XLOC(1,1) =VALMAT(5)
  150.           XLOC(2,1) =VALMAT(6)
  151.           XLOC(3,1) =VALMAT(7)
  152.           XLOC(1,2) =VALMAT(8)
  153.           XLOC(2,2) =VALMAT(9)
  154.           XLOC(3,2) =VALMAT(10)
  155. *                                           cas anisotrope
  156.         ELSE IF(MATE.EQ.3)THEN
  157.           PMAT1(1,1)=VALMAT(1)
  158.           PMAT1(2,2)=VALMAT(2)
  159.           PMAT1(3,3)=VALMAT(3)
  160.           PMAT1(2,1)=VALMAT(4)
  161.           PMAT1(1,2)=PMAT(2,1)
  162.           PMAT1(3,1)=VALMAT(5)
  163.           PMAT1(1,3)=PMAT(3,1)
  164.           PMAT1(3,2)=VALMAT(6)
  165.           PMAT1(2,3)=PMAT(3,2)
  166.           XMU       =VALMAT(7)
  167.           XLOC(1,1) =VALMAT(8)
  168.           XLOC(2,1) =VALMAT(9)
  169.           XLOC(3,1) =VALMAT(10)
  170.           XLOC(1,2) =VALMAT(11)
  171.           XLOC(2,2) =VALMAT(12)
  172.           XLOC(3,2) =VALMAT(13)
  173. *                                           cas unidirectionnel
  174.         ELSE IF(MATE.EQ.4)THEN
  175.            PMAT1(1,1)=VALMAT(1)
  176.            XMU       =VALMAT(2)
  177.            XLOC(1,1) =VALMAT(3)
  178.            XLOC(2,1) =VALMAT(4)
  179.            XLOC(3,1) =VALMAT(5)
  180.            XLOC(1,2) =VALMAT(6)
  181.            XLOC(2,2) =VALMAT(7)
  182.            XLOC(3,2) =VALMAT(8)
  183.         ENDIF
  184. *
  185.         IF(XMU.EQ.0.D0) THEN
  186.           KERRE=2
  187.           RETURN
  188.         ENDIF
  189.         FAC=EREF*EREF/XMU
  190.         DO 35 I=1,IDIM
  191.           DO 35 J=1,IDIM
  192.             PMAT1(I,J)=PMAT1(I,J)*FAC
  193.    35   CONTINUE
  194. *
  195. *             CALCUL DU VECTEUR 3
  196. *
  197.         CALL  CROSS2 (XLOC(1,1),XLOC(1,2),XLOC(1,3),IRR)
  198. *
  199. *           CALCUL DES COS.DIRECTEURS DES AXES ORTH. /REPERE GLOBAL
  200. *           XGLOB=TXR*XLOC
  201. *
  202.         DO 45 K=1,IDIM
  203.           DO 45 J=1,IDIM
  204.             DO 45 I=1,IDIM
  205.               XGLOB(K,J)=TXR(J,I)*XLOC(I,K)+XGLOB(K,J)
  206.    45  CONTINUE
  207. *
  208. *           TRANSFORMATION DE LA MATRICE PMAT1
  209. *
  210.         CALL PRODT(PMAT,PMAT1,XGLOB,IDIM,IDIM)
  211.       ENDIF
  212.       RETURN
  213.       END
  214.  
  215.  
  216.  
  217.  

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