Télécharger la plaquette Cast3M


fr en

Télécharger rdepla.eso

Retour à la liste

Numérotation des lignes : 

rdepla

  1. C RDEPLA    SOURCE    CB215821  20/11/25    13:38:39     10792          
  2.       SUBROUTINE RDEPLA(MCHPOI)
  3. C=====================================================================
  4. C    OPERATEUR POUR CHANGER DE REPERE SUR UN CHAMP DE DEPLACEMENTS
  5. C               (OU TOUT CHAMP PAR POINTS)
  6. C
  7. C    MCHPO1 = RDEP MCHPOI IVEC1 (IVEC2)
  8. C     Entrées : MCHPOI  : MCHPOI Champ de déplacements
  9. C               VEC1    : POINT  Premier vecteur du repère
  10. C               VEC2    : POINT  Deuxième vecteur du repère
  11. C     Sortie  : MCHPO1  : MCHPOI Champ de déplacements
  12. C
  13. C=====================================================================
  14. C
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8(A-H,O-Z)
  17.  
  18. -INC PPARAM
  19. -INC CCOPTIO
  20. -INC CCHAMP
  21. -INC SMCHPOI
  22. -INC SMCOORD
  23. C
  24. C       Déclarations
  25. C
  26. *** Vecteurs du repère
  27.       REAL*8 XU(3), XV(3), XW(3)
  28. *** Tableau de pointeurs sur des segments
  29.       INTEGER IDEP(6,2)
  30. *** Tableau des déplacements d'un noeud
  31.       REAL*8 XDEP(3), XROT(3)
  32. *** Matrice de changement de repère
  33.       REAL*8 XMATC(3,3)
  34. C
  35. C       Corps
  36. C
  37.       IRET=0
  38. C
  39. C       Lecture du champ de déplacements
  40. C
  41. *      CALL LIROBJ('CHPOINT', MCHPOI, 1, IRET)
  42. *      IF (IERR.NE.0) RETURN
  43. C
  44. C       Lecture du ou des vecteurs du repère
  45. C
  46.       CALL LIROBJ('POINT', IVEC1, 1, IRET)
  47.       IF (IERR.NE.0) RETURN
  48.       IREU = (IDIM + 1)*(IVEC1 - 1)
  49.       XNORU = 0.
  50.       DO 1 IC = 1, IDIM
  51.          XU(IC) = XCOOR(IREU + IC)
  52.          XNORU = XNORU + XU(IC)*XU(IC)
  53.   1   CONTINUE
  54.       XNORU = SQRT(XNORU)
  55.       DO 10 IC = 1, IDIM
  56.   10     XU(IC) = XU(IC)/XNORU
  57.       IF (IDIM .EQ. 3) THEN
  58.          CALL LIROBJ('POINT', IVEC2, 1, IRET)
  59.          IF (IERR.NE.0) RETURN
  60.          IREV = (IDIM + 1)*(IVEC2 - 1)
  61.          XNORV = 0.
  62.          DO 2 IC = 1, IDIM
  63.             XV(IC) = XCOOR(IREV + IC)
  64.             XNORV = XNORV + XV(IC)*XV(IC)
  65.   2      CONTINUE
  66.          XNORV = SQRT(XNORV)
  67.          DO 11 IC = 1, IDIM
  68.   11        XV(IC) = XV(IC)/XNORV
  69.          XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  70.          XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  71.          XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  72.          XNORW = 0.
  73.          DO 8 IC = 1, IDIM
  74.             XNORW = XNORW + XW(IC)*XW(IC)
  75.   8      CONTINUE
  76.          XNORW = SQRT(XNORW)
  77.          DO 15 IC = 1, IDIM
  78.   15        XW(IC) = XW(IC)/XNORW
  79.          XV(1) = XW(2)*XU(3) - XW(3)*XU(2)
  80.          XV(2) = XW(3)*XU(1) - XW(1)*XU(3)
  81.          XV(3) = XW(1)*XU(2) - XW(2)*XU(1)
  82.          DO 12 IC = 1, IDIM
  83.             XMATC(1, IC) = XU(IC)
  84.             XMATC(2, IC) = XV(IC)
  85.             XMATC(3, IC) = XW(IC)
  86.   12     CONTINUE
  87.       ELSE
  88.          XV(1) = -XU(2)
  89.          XV(2) = XU(1)
  90.          DO 13 IC = 1, IDIM
  91.             XMATC(1, IC) = XU(IC)
  92.             XMATC(2, IC) = XV(IC)
  93.   13     CONTINUE
  94.       ENDIF
  95. *      WRITE (*,*) 'Matrice de changement de repère :'
  96. *      DO 14 IL = 1, IDIM
  97. *         IF (IDIM .EQ. 3) THEN
  98. *            WRITE (*,*) '  ',XMATC(IL,1),'  ',XMATC(IL,2),
  99. *     #               '  ',XMATC(IL,3)
  100. *         ELSE
  101. *            WRITE (*,*) '  ',XMATC(IL,1),'  ',XMATC(IL,2)
  102. *         ENDIF
  103. *  14  CONTINUE
  104.       DO 30 II = 1, 6
  105.          DO 30 IJ = 1, 2
  106.   30        IDEP(II, IJ) = 0
  107.       SEGINI, MCHPO1 = MCHPOI
  108.       SEGACT, MCHPOI
  109.       DO 80 IMS = 1, MCHPOI.IPCHP(/1)
  110.          MSOUPO = MCHPOI.IPCHP(IMS)
  111.          SEGACT, MSOUPO
  112.          SEGINI, MSOUP1 = MSOUPO
  113.          MPOVAL = MSOUPO.IPOVAL
  114.          SEGINI, MPOVA1 = MPOVAL
  115.          MSOUP1.IPOVAL = MPOVA1
  116.          MCHPO1.IPCHP(IMS) = MSOUP1
  117.          SEGDES, MSOUPO
  118.          SEGDES, MSOUP1
  119.          SEGDES, MPOVA1
  120.   80  CONTINUE
  121.       IF (IFOMOD .EQ. 0 .OR. IFOMOD .EQ. 1) GOTO 100
  122.       SEGACT, MCHPOI
  123. *      WRITE (*,*) 'Nombre de pointeurs sur MSOUPO',MCHPO1.IPCHP(/1)
  124.       DO 3 IMS = 1, MCHPO1.IPCHP(/1)
  125. *         WRITE (*,*) '   MSOUPO # ', IMS
  126.          MSOUPO = MCHPOI.IPCHP(IMS)
  127.          SEGACT, MSOUPO
  128. *         WRITE(*,*) '       ', MSOUPO.NOHARM(/1), ' composantes'
  129.          DO 70 II = 1, 6
  130.             DO 70 IJ = 1, 2
  131.   70           IDEP(II, IJ) = 0
  132.          DO 4 IC = 1, MSOUPO.NOHARM(/1)
  133. *            WRITE (*,*) '         :',MSOUPO.NOCOMP(IC)
  134. ***-----------Pour UX
  135.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(1)) THEN
  136.                IDEP(1,1) = IMS
  137.                IDEP(1,2) = IC
  138.                IRET = 0
  139. *        WRITE (*,*) NOMDD(1),'détecté en ',IDEP(1,2),' de ',IDEP(1,1)
  140.             ELSE
  141. ***-----------Pour UY
  142.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(2)) THEN
  143.                IDEP(2,1) = IMS
  144.                IDEP(2,2) = IC
  145.                IRET = 0
  146. *         WRITE (*,*) NOMDD(2),'détecté en ',IDEP(2,2),' de ',IDEP(2,1)
  147.             ELSE
  148. ***-----------Pour UZ
  149.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(3)) THEN
  150.                IDEP(3,1) = IMS
  151.                IDEP(3,2) = IC
  152.                IRET = 0
  153. *          WRITE (*,*) NOMDD(3),'détecté en ',IDEP(3,2),' de ',IDEP(3,1)
  154.             ELSE
  155. ***-----------Pour RX
  156.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(4)) THEN
  157.                IDEP(4,1) = IMS
  158.                IDEP(4,2) = IC
  159.                IRET = 0
  160. *          WRITE (*,*) NOMDD(4),'détecté en ',IDEP(4,2),' de ',IDEP(4,1)
  161.             ELSE
  162. ***-----------Pour RY
  163.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(5)) THEN
  164.                IDEP(5,1) = IMS
  165.                IDEP(5,2) = IC
  166.                IRET = 0
  167. *          WRITE (*,*) NOMDD(5),'détecté en ',IDEP(5,2),' de ',IDEP(5,1)
  168.             ELSE
  169. ***-----------Pour RZ
  170.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(6)) THEN
  171.                IDEP(6,1) = IMS
  172.                IDEP(6,2) = IC
  173.                IRET = 0
  174. *          WRITE (*,*) NOMDD(6),'détecté en ',IDEP(6,2),' de ',IDEP(6,1)
  175.             ENDIF
  176.             ENDIF
  177.             ENDIF
  178.             ENDIF
  179.             ENDIF
  180.             ENDIF
  181.   4      CONTINUE
  182.          MPOVAL = MSOUPO.IPOVAL
  183.          SEGACT, MPOVAL
  184.          INP = MPOVAL.VPOCHA(/1)
  185. ***----Pour chaque composante à transformer
  186.          MSOUP1 = MCHPO1.IPCHP(IMS)
  187.          SEGACT, MSOUP1
  188.          MPOVA1 = MSOUP1.IPOVAL
  189.          SEGACT, MPOVA1*MOD
  190. *         DO 400 IC = 1, 6
  191. *            WRITE (*,*) ' '
  192. *            WRITE (*,*) '    IDEP(',IC,',1) = ', IDEP(IC,1)
  193. *            WRITE (*,*) '    IDEP(',IC,',2) = ', IDEP(IC,2)
  194. *  400    CONTINUE
  195.          DO 50 IN = 1, INP
  196.             DO 40 IC = 1, 3
  197.                IF (IDEP(IC,1) .NE. 0) THEN
  198.                   XDEP(IC) = MPOVAL.VPOCHA(IN,IDEP(IC,2))
  199. *                  WRITE (*,*) 'XDEP(',IC,') = ', XDEP(IC)
  200.                ENDIF
  201.                ICL = IC + 3
  202.                IF (IDEP(ICL,1) .NE. 0) THEN
  203.                   XROT(IC) = MPOVAL.VPOCHA(IN,IDEP(ICL,2))
  204. *                  WRITE (*,*) 'XROT(',IC,') = ', XROT(IC)
  205.                ENDIF
  206.   40        CONTINUE
  207.             DO 41 IC = 1, 3
  208.                IF (IDEP(IC,1) .NE. 0) THEN
  209.                   MPOVA1.VPOCHA(IN,IDEP(IC,2)) = 0.
  210.                   DO 42 IJ = 1, 3
  211.                      MPOVA1.VPOCHA(IN,IDEP(IC,2)) =
  212.      #      MPOVA1.VPOCHA(IN,IDEP(IC,2)) + XMATC(IC,IJ)*XDEP(IJ)
  213.   42              CONTINUE
  214.                ENDIF
  215.                ICL = IC + 3
  216.                IF (IDEP(ICL,1) .NE. 0) THEN
  217.                   MPOVA1.VPOCHA(IN,IDEP(ICL,2)) = 0.
  218.                   DO 43 IJ = 1, 3
  219.                      MPOVA1.VPOCHA(IN,IDEP(ICL,2)) =
  220.      #      MPOVA1.VPOCHA(IN,IDEP(ICL,2)) + XMATC(IC,IJ)*XROT(IJ)
  221.   43              CONTINUE
  222.                ENDIF
  223.   41        CONTINUE
  224.   50     CONTINUE
  225.          SEGDES, MPOVA1
  226.          SEGDES, MSOUP1
  227.          SEGDES, MPOVAL
  228.          SEGDES, MSOUPO
  229.   3   CONTINUE
  230.  
  231.       SEGDES, MCHPOI
  232.       SEGDES, MCHPO1
  233. C
  234. C       Ecriture du champ de déplacements
  235. C
  236.  100  CONTINUE
  237.       CALL ECROBJ('CHPOINT', MCHPO1)
  238.       RETURN
  239.       END
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  

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