Télécharger la plaquette Cast3M


fr en

Télécharger calmat.eso

Retour à la liste

Numérotation des lignes : 

calmat

  1. C CALMAT    SOURCE    CHAT      05/01/12    21:47:08     5004
  2.       SUBROUTINE CALMAT(KTRAV,IPO1,IPO2,XANG)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Calcule les vecteurs et matrices de rotation, de passage, ...  *
  9. *                                                                    *
  10. *     Param}tres:                                                    *
  11. *                                                                    *
  12. * e   KTRAV   segment de travail                                     *
  13. * e   IPO1    premier point de l'axe de rotation                     *
  14. * e   IPO2    deuxi}me point de l'axe de rotation, si 3D             *
  15. * e   XANG    angle de rotation                                      *
  16. *                                                                    *
  17. *     Auteur, date de cr{ation:                                      *
  18. *                                                                    *
  19. *     Lionel VIVAN, le 22 mai 1990.                                  *
  20. *                                                                    *
  21. *--------------------------------------------------------------------*
  22. *                                                                    *
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC CCREEL
  27. *
  28.       DIMENSION XT(3,3),XTM1(3,3),XRT(3,3),RTT(3,3),XIMPT(3,3)
  29.       PARAMETER (EPSIL = 1.E-9 , TOLER = 1.E-3 , XUN = 1.D0)
  30. *
  31.       SEGMENT MTRAV
  32.          REAL*8 XPT(IDIMB),XPTP(IDIMB),XP1PT(IDIMB),XMPT(IDIMB,IDIMB)
  33.       ENDSEGMENT
  34. *
  35.       IDIMB = IDIM
  36.       SEGINI MTRAV
  37.       KTRAV = MTRAV
  38. *
  39.       XRAD = XANG * XPI / 180.D0
  40.       XCOS = COS(XRAD)
  41.       XSIN = SIN(XRAD)
  42.       IF (IDIM.EQ.2) THEN
  43.          XMPT(1,1) = XCOS
  44.          XMPT(1,2) = - XSIN
  45.          XMPT(2,1) = XSIN
  46.          XMPT(2,2) = XCOS
  47. *
  48.          CALL EXCOO1(IPO1,X1,Y1,Z1,D1)
  49.          IF (IERR.NE.0) RETURN
  50.          XP1PT(1) = ((XUN - XCOS) * X1) + (XSIN * Y1)
  51.          XP1PT(2) = ((XUN - XCOS) * Y1) - (XSIN * X1)
  52. *
  53.       ELSE
  54.          CALL EXCOO1(IPO1,X1,Y1,Z1,D1)
  55.          CALL EXCOO1(IPO2,X2,Y2,Z2,D2)
  56.          IF (IERR.NE.0) RETURN
  57.          XP1P2 = X2 - X1
  58.          YP1P2 = Y2 - Y1
  59.          ZP1P2 = Z2 - Z1
  60. *
  61. *        Vecteur R
  62. *
  63.          PS = (XP1P2 * XP1P2) + (YP1P2 * YP1P2) + (ZP1P2 * ZP1P2)
  64.          IF (PS.LT.EPSIL) THEN
  65.             CALL ERREUR(162)
  66.             RETURN
  67.          ENDIF
  68.          PS = SQRT(PS)
  69.          XR = XP1P2 / PS
  70.          YR = YP1P2 / PS
  71.          ZR = ZP1P2 / PS
  72. *
  73. *        Vecteur A
  74. *
  75.          IF (ABS(ZR).GT.TOLER) THEN
  76.             XA1 = X1
  77.             YA1 = XR + YR + ZR
  78.             ZA1 = Z1 - (YR * (YA1 - Y1) / ZR)
  79.          ELSE IF (ABS(YR).GT.TOLER) THEN
  80.             ZA1 = Z1
  81.             XA1 = XR + YR + ZR
  82.             YA1 = Y1 - (XR * (XA1 - X1) / YR)
  83.          ELSE
  84.             YA1 = Y1
  85.             ZA1 = XR + YR + ZR
  86.             XA1 = X1 - (ZR * (ZA1 - Z1) / XR)
  87.          ENDIF
  88.          XP1A = XA1 - X1
  89.          YP1A = YA1 - Y1
  90.          ZP1A = ZA1 - Z1
  91.          PS = (XP1A * XP1A) + (YP1A * YP1A) + (ZP1A * ZP1A)
  92.          IF (PS.LT.EPSIL) THEN
  93.             CALL ERREUR(162)
  94.             RETURN
  95.          ENDIF
  96.          PS = SQRT(PS)
  97.          XA = XP1A / PS
  98.          YA = YP1A / PS
  99.          ZA = ZP1A / PS
  100. *
  101. *        Vecteur B
  102. *
  103.          XB = (YR * ZA) - (ZR * YA)
  104.          YB = (ZR * XA) - (XR * ZA)
  105.          ZB = (XR * YA) - (YR * XA)
  106. *
  107. *        Matrice de passage T
  108. *
  109.          XT(1,1) = XA
  110.          XT(1,2) = YA
  111.          XT(1,3) = ZA
  112.          XT(2,1) = XB
  113.          XT(2,2) = YB
  114.          XT(2,3) = ZB
  115.          XT(3,1) = XR
  116.          XT(3,2) = YR
  117.          XT(3,3) = ZR
  118. *
  119.          XTM1(1,1) = XA
  120.          XTM1(2,1) = YA
  121.          XTM1(3,1) = ZA
  122.          XTM1(1,2) = XB
  123.          XTM1(2,2) = YB
  124.          XTM1(3,2) = ZB
  125.          XTM1(1,3) = XR
  126.          XTM1(2,3) = YR
  127.          XTM1(3,3) = ZR
  128. *                             T
  129. *        Matrice de rotation R
  130. *
  131.          XRT(1,1) = XCOS
  132.          XRT(1,2) = - XSIN
  133.          XRT(1,3) = XZERO
  134.          XRT(2,1) = XSIN
  135.          XRT(2,2) = XCOS
  136.          XRT(2,3) = XZERO
  137.          XRT(3,1) = XZERO
  138.          XRT(3,2) = XZERO
  139.          XRT(3,3) = XUN
  140. *
  141. *        Matrice P
  142. *
  143.          DO 10 I = 1,IDIM
  144.             DO 20 J = 1,IDIM
  145.                XVAL = XZERO
  146.                DO 30 K = 1,IDIM
  147.                   XVAL = XVAL + XRT(I,K) * XT(K,J)
  148.  30               CONTINUE
  149. *              end do
  150.                RTT(I,J) = XVAL
  151.  20            CONTINUE
  152. *           end do
  153.  10         CONTINUE
  154. *        end do
  155.          DO 12 I = 1,IDIM
  156.             DO 22 J = 1,IDIM
  157.                XVAL = XZERO
  158.                DO 32 K = 1,IDIM
  159.                   XVAL = XVAL + XTM1(I,K) * RTT(K,J)
  160.  32               CONTINUE
  161. *              end do
  162.                XMPT(I,J) = XVAL
  163.  22            CONTINUE
  164. *           end do
  165.  12         CONTINUE
  166. *        end do
  167. *
  168.          XIMPT(1,1) = XUN - XMPT(1,1)
  169.          XIMPT(1,2) = - XMPT(1,2)
  170.          XIMPT(1,3) = - XMPT(1,3)
  171.          XIMPT(2,1) = - XMPT(2,1)
  172.          XIMPT(2,2) = XUN - XMPT(2,2)
  173.          XIMPT(2,3) = - XMPT(2,3)
  174.          XIMPT(3,1) = - XMPT(3,1)
  175.          XIMPT(3,2) = - XMPT(3,2)
  176.          XIMPT(3,3) = XUN - XMPT(3,3)
  177. *
  178.          DO 14 I = 1,IDIM
  179.             XP1PT(I) = (XIMPT(I,1) * X1) + (XIMPT(I,2) * Y1) +
  180.      &                 (XIMPT(I,3) * Z1)
  181.  14         CONTINUE
  182. *        end do
  183. *
  184.          IF (IIMPI.EQ.333) THEN
  185.             WRITE(IOIMP,*)'CALMAT : impression du vecteur R'
  186.             WRITE(IOIMP,*)'CALMAT :               XR =',XR
  187.             WRITE(IOIMP,*)'CALMAT :               YR =',YR
  188.             WRITE(IOIMP,*)'CALMAT :               ZR =',ZR
  189.             WRITE(IOIMP,*)'CALMAT : impression du vecteur A'
  190.             WRITE(IOIMP,*)'CALMAT :               XA =',XA
  191.             WRITE(IOIMP,*)'CALMAT :               YA =',YA
  192.             WRITE(IOIMP,*)'CALMAT :               ZA =',ZA
  193.             WRITE(IOIMP,*)'CALMAT : impression du vecteur B'
  194.             WRITE(IOIMP,*)'CALMAT :               XB =',XB
  195.             WRITE(IOIMP,*)'CALMAT :               YB =',YB
  196.             WRITE(IOIMP,*)'CALMAT :               ZB =',ZB
  197.             WRITE(IOIMP,*)'                                     T'
  198.             WRITE(IOIMP,*)'CALMAT : impression de la matrice (P)'
  199.             DO 40 I = 1,IDIM
  200.                DO 42 J = 1,IDIM
  201.             WRITE(IOIMP,*)'CALMAT : PT(',I,',',J,') =',XMPT(I,J)
  202.  42               CONTINUE
  203. *              end do
  204.  40            CONTINUE
  205. *           end do
  206.          ENDIF
  207.       ENDIF
  208. *
  209.       END
  210.  
  211.  
  212.  
  213.  

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