Télécharger la plaquette Cast3M


fr en

Télécharger vect.eso

Retour à la liste

Numérotation des lignes : 

vect

  1. C VECT      SOURCE    CB215821  26/08/24    21:18:50     12622          
  2.       SUBROUTINE VECT(TENS,VAL,VP,P,S,TAMP)
  3. C======================================================================
  4. C
  5. C                     SOUS PROGRAMME DE CALCUL
  6. C                               POUR
  7. C                     TENSEUR DE DEFORMATION
  8. C
  9. C                            VERSION 1.0
  10. C                            -----------
  11. C
  12. C
  13. C                            CALCUL DE :
  14. C
  15. C                 1- Valeurs et vecteurs propres
  16. C                 2- Tenseur Q
  17. C
  18. C======================================================================
  19. C
  20. C     CREATION : F.CORMERY
  21. C                E.N.S.M.A  -  LMPM
  22. C                JUILLET 1993
  23. C
  24. C======================================================================
  25.       IMPLICIT INTEGER(I-N)
  26.       IMPLICIT REAL*8 (A-H,O-Z)
  27. C**********************************************************************
  28. C                      DIMENSIONS ET DATA
  29. C**********************************************************************
  30. C
  31. CC      DIMENSION TENS(6),VP(3)
  32. C                  N9    N15
  33. CC     *          ,P(3,3),S(6),
  34. C                          N24
  35. CC     *          VAL(3,3),TAMP(3,3)
  36. C
  37.       DIMENSION TENS(*),VP(*)
  38.      *          ,P(3,*),S(*),
  39.      *          VAL(3,*),TAMP(3,*)
  40.       DATA ZERO/0.D0/,UN/1.D0/,
  41.      *     PRECIS/1.D-08/,DPRECS/1.D-08/
  42. C----------------------------------------------------------------------
  43.       AMAX1(X,Y,Z,U,V,W)= MAX(X,Y,Z,U,V,W)
  44. C------------------
  45.       MT=10
  46. C**********************************************************************
  47. C                          INITIALISATION
  48. C**********************************************************************
  49. *      DO 5 J=1,6
  50. *         DO 6 K=1,6
  51. *            P(J,K)=ZERO
  52. *            Q(J,K)=ZERO
  53. *            QPLUS(J,K)=ZERO
  54. *6        CONTINUE
  55. 5     CONTINUE
  56.       DO 1011 J=1,3
  57.        DO 55 K=1,3
  58.       P(J,K)=ZERO
  59.    55  CONTINUE
  60.  1011 CONTINUE
  61. C----------------------------------------------------------------------
  62. C**********************************************************************
  63. C                     NORMALISATION DU TENSEUR A
  64. C**********************************************************************
  65. C
  66. C----------------------------------------------------------------------
  67. C                  Trouver la valeur max de TENS(I)
  68. C----------------------------------------------------------------------
  69.       DO 3 I=1,6
  70.          S(I)=ABS(TENS(I))
  71. 3     CONTINUE
  72. C--------------
  73.       TMAX=AMAX1(S(1),S(2),S(3),S(4),S(5),S(6))
  74.       IF(TMAX.EQ.0.D0)TMAX=UN
  75. C----------------------------------------------------------------------
  76. C       Normaliser a un la composante de TENS(I) la plus grande
  77. C----------------------------------------------------------------------
  78.       DO 4 I=1,6
  79.          TENS(I)=TENS(I)/TMAX
  80.          IF(ABS(TENS(I)).LE.1E-15) TENS(I)=0.D0
  81. 4     CONTINUE
  82. C------------------------ cas axes principaux -------------------------
  83.       NN=0
  84.       DO 234 IV=4,6
  85.          IF(ABS(TENS(IV)).LE.1E-15) NN=NN+1
  86. 234   CONTINUE
  87.       IF(NN.EQ.3)THEN
  88.       VP(1)=TENS(1)
  89.       VP(2)=TENS(2)
  90.       VP(3)=TENS(3)
  91.       DO 235 I=1,3
  92.                P(I,1)=0
  93.                P(I,2)=0
  94.                P(I,3)=0
  95.                P(I,I)=1
  96. 235   CONTINUE
  97.       goto 98
  98.       ENDIF
  99. C***********************************************************************
  100. C                   CALCUL DES VALEURS  PROPRES
  101. C***********************************************************************
  102.       CALL VALPRP(TENS(1),TENS(2),TENS(3),TENS(6),TENS(4),TENS(5),
  103.      *            VP(1),VP(2),VP(3))
  104. C***********************************************************************
  105. C                   CALCUL DES VECTEURS PROPRES
  106. C***********************************************************************
  107.          IM=2
  108.          IF(ABS(VP(1)-VP(2)).LT.1E-8)THEN
  109.          VP(1)=VP(3)
  110.          VP(2)=VP(2)
  111.          VP(3)=VP(2)
  112.          IM=2
  113.          ENDIF
  114.          IF(ABS(VP(1)-VP(3)).LT.1E-8)THEN
  115.          VP(1)=VP(2)
  116.          VP(2)=VP(3)
  117.          IM=2
  118.          ENDIF
  119.          IF(ABS(VP(2)-VP(3)).LT.1E-8)THEN
  120.          IM=2
  121.          ENDIF
  122. C----------------------------------------------------------------------
  123.          IMM=0
  124. C----------------------------------------------------------------------
  125.        DO 10 I=1,IM
  126. C-------------------
  127.          SDET1=(TENS(2)-VP(I))*(TENS(3)-VP(I))-TENS(4)**2
  128.          SDET2=(TENS(1)-VP(I))*(TENS(3)-VP(I))-TENS(5)**2
  129.          SDET3=(TENS(1)-VP(I))*(TENS(2)-VP(I))-TENS(6)**2
  130.          SDET4=TENS(6)*(TENS(3)-VP(I))-TENS(4)*TENS(5)
  131.          SDET5=-TENS(5)*(TENS(2)-VP(I))+TENS(6)*TENS(4)
  132.          SDET6=TENS(4)*(TENS(1)-VP(I))-TENS(6)*TENS(5)
  133. C----------------------------------------------------------------------
  134. C       WRITE(10,*)'MINEURS :'
  135. C       WRITE(10,*)SDET1,SDET2,SDET3,SDET4,SDET5,SDET6
  136. C----------------------------------------------------------------------
  137.  
  138.              IF (ABS(SDET1).GT.DPRECS) THEN
  139.                P(I,1)=UN
  140.                P(I,2)=((-TENS(6)*(TENS(3)-VP(I)))+TENS(4)*TENS(5))/SDET1
  141.                P(I,3)=((-TENS(5)*(TENS(2)-VP(I)))+TENS(4)*TENS(6))/SDET1
  142.                GOTO 96
  143. C-------------------
  144.              ENDIF
  145.              IF (ABS(SDET2).GT.DPRECS) THEN
  146.                P(I,2)=UN
  147.                P(I,1)=((-TENS(6)*(TENS(3)-VP(I)))+TENS(4)*TENS(5))/SDET2
  148.                P(I,3)=((-TENS(4)*(TENS(1)-VP(I)))+TENS(5)*TENS(6))/SDET2
  149.                GOTO 96
  150. C-------------------
  151.              ENDIF
  152.              IF (ABS(SDET3).GT.DPRECS) THEN
  153.                P(I,3)=UN
  154.                P(I,1)=((-TENS(5)*(TENS(2)-VP(I)))+TENS(4)*TENS(6))/SDET3
  155.                P(I,2)=((-TENS(4)*(TENS(1)-VP(I)))+TENS(5)*TENS(6))/SDET3
  156.                GOTO 96
  157. C--------------------
  158.              ENDIF
  159.              IF (ABS(SDET4).GT.DPRECS) THEN
  160.                P(I,1)=UN
  161.            P(I,2)=((-(TENS(3)-vp(i))*(TENS(1)-VP(I)))+TENS(5)**2)/SDET4
  162.                P(I,3)=((TENS(4)*(TENS(1)-VP(I)))-TENS(5)*TENS(6))/SDET4
  163.                GOTO 96
  164. C--------------------
  165.              ENDIF
  166.              IF (ABS(SDET5).GT.DPRECS) THEN
  167.                P(I,1)=(-(tens(4)**2)+(tens(2)-vp(i)))/sdet5
  168.                P(I,2)=(-tens(6)*(tens(3)-vp(i))+tens(5)*tens(4))/sdet5
  169.                P(I,3)=1
  170.                GOTO 96
  171. C--------------------
  172.              ENDIF
  173.              IF (ABS(SDET6).GT.DPRECS) THEN
  174.                P(I,3)=UN
  175.                P(I,1)=((-TENS(5)*TENS(4))+(TENS(3)-vp(i))*TENS(6))/SDET6
  176.             P(I,2)=((-(TENS(3)-vp(i))*(TENS(1)-VP(I)))+TENS(5)**2)/SDET6
  177.              ENDIF
  178. C-----------------------------------------------------------------------
  179.             SSDET1=TENS(1)-VP(I)
  180.             SSDET2=TENS(2)-VP(I)
  181.             SSDET3=TENS(3)-VP(I)
  182. C-------------------CAS PARTICULIERS------------------------------------
  183.             IF (ABS(SSDET1).LE.PRECIS) THEN
  184.                                      P(I,1)=1
  185.                                      P(I,2)=0
  186.                                      P(I,3)=0
  187.             GOTO 96
  188.             ENDIF
  189.             IF (ABS(SSDET2).LE.PRECIS) THEN
  190.                                      P(I,1)=0
  191.                                      P(I,2)=1
  192.                                      P(I,3)=0
  193.             GOTO 96
  194.             ENDIF
  195.             IF (ABS(SSDET3).LE.PRECIS) THEN
  196.                                      P(I,1)=0
  197.                                      P(I,2)=0
  198.                                      P(I,3)=1
  199.             GOTO 96
  200.             ENDIF
  201.             IF (ABS(SSDET1).GT.PRECIS) THEN
  202.                                      P(I,1)=-(TENS(6)+TENS(5))/SSDET1
  203.                                      P(I,2)=1
  204.                                      P(I,3)=1
  205. C-------------------
  206.             GOTO 96
  207.             ENDIF
  208.             IF (ABS(SSDET2).GT.PRECIS) THEN
  209.                                      P(I,1)=1
  210.                                      P(I,2)=-(TENS(6)+TENS(4))/SSDET2
  211.                                      P(I,3)=1
  212.             GOTO 96
  213. C-------------------
  214.             ENDIF
  215.             IF (ABS(SSDET3).GT.PRECIS) THEN
  216.                                      P(I,1)=1
  217.                                      P(I,2)=1
  218.                                      P(I,3)=-(TENS(5)+TENS(4))/SSDET3
  219.            GOTO 96
  220.            ENDIF
  221. C-----------------------------------------------------------------------
  222.          WRITE(MT,*)'ERREUR DANS VPROP.FOR'
  223.       WRITE(MT,1010)
  224. 1010  FORMAT(1X,'TENSEUR A  SYM. D ORDRE 2 :',
  225.      *       /1X,'--------------------------'/)
  226.       WRITE(MT,1001)TENS(1),TENS(6),TENS(5)
  227. 1001  FORMAT(15X,'*  ',3e20.7,'  *')
  228.       WRITE(MT,1002)TENS(6),TENS(2),TENS(4)
  229. 1002  FORMAT(15X,'*  ',3e20.7,'  *')
  230.       WRITE(MT,1003)TENS(5),TENS(4),TENS(3)
  231. 1003  FORMAT(15X,'*  ',3e20.7,'  *'/)
  232.          STOP
  233. C-----------------------------------------------------------------------
  234. 96       CONTINUE
  235. C-----------------------------------------------------------------------
  236. 10    CONTINUE
  237. 98       CONTINUE
  238.                IF(IM.EQ.2)THEN
  239.                  P(3,1)=P(1,2)*P(2,3)-P(1,3)*P(2,2)
  240.                  P(3,2)=P(1,3)*P(2,1)-P(1,1)*P(2,3)
  241.                  P(3,3)=P(1,1)*P(2,2)-P(1,2)*P(2,1)
  242.                ENDIF
  243. C------------------------------------------------------------------------
  244. C       On verifie que la base formee est bien directe
  245. C------------------------------------------------------------------------
  246.                  DIR=P(3,1)*(P(1,2)*P(2,3)-P(1,3)*P(2,2))+
  247.      *               P(3,2)*(P(1,3)*P(2,1)-P(1,1)*P(2,3))+
  248.      *               P(3,3)*(P(1,1)*P(2,2)-P(1,2)*P(2,1))
  249.                  IF(DIR.LT.ZERO)THEN
  250.                    DO 12 J=1,3
  251.                      TAMP1=VP(2)
  252.                      VP(2)=VP(1)
  253.                      VP(1)=TAMP1
  254.                      TAMP(1,J)=P(1,J)
  255.                      P(1,J)=P(2,J)
  256.                      P(2,J)=TAMP(1,J)
  257. 12                 CONTINUE
  258.                  ENDIF
  259. C------------------------------------------------------------------------
  260. C              Normalisation des vecteurs propres
  261. C------------------------------------------------------------------------
  262.       DO 1012 J=1,5
  263.              DO 11 I=1,3
  264.                IF(ABS(P(I,1)).LT.1.E-15)P(I,1)=0.D0
  265.                IF(ABS(P(I,2)).LT.1.E-15)P(I,2)=0.D0
  266.                IF(ABS(P(I,3)).LT.1.E-15)P(I,3)=0.D0
  267.                RAC=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
  268.                P(I,1)=P(I,1)/RAC
  269.                P(I,2)=P(I,2)/RAC
  270.                P(I,3)=P(I,3)/RAC
  271. 11           CONTINUE
  272.  1012 CONTINUE
  273. C-----------------------------------------------------------------------
  274. C             Multiplication par le facteur de normalisation
  275. C-----------------------------------------------------------------------
  276.       DO 110 I=1,6
  277.          TENS(I)=TENS(I)*TMAX
  278. 110   CONTINUE
  279. C-----------------------------------------------------------------------
  280.       DO 1013 I=1,3
  281.       DO 341 J=1,3
  282.       VAL(I,J)=P(I,J)
  283. 341   CONTINUE
  284.  1013 CONTINUE
  285.       DO 342 I=1,3
  286.       VP(I)=VP(I)*tmax
  287. 342   CONTINUE
  288. C-------------------------------------------------------------------------
  289.       RETURN
  290.       END
  291. C-----------------------------------------------------------------------
  292.  
  293.  
  294.  
  295.  
  296.  

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