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  26/08/24    21:18:10     12622          
  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.          XU(IC) = XU(IC)/XNORU
  57.    10 CONTINUE
  58.       IF (IDIM .EQ. 3) THEN
  59.          CALL LIROBJ('POINT', IVEC2, 1, IRET)
  60.          IF (IERR.NE.0) RETURN
  61.          IREV = (IDIM + 1)*(IVEC2 - 1)
  62.          XNORV = 0.
  63.          DO 2 IC = 1, IDIM
  64.             XV(IC) = XCOOR(IREV + IC)
  65.             XNORV = XNORV + XV(IC)*XV(IC)
  66.   2      CONTINUE
  67.          XNORV = SQRT(XNORV)
  68.          DO 11 IC = 1, IDIM
  69.             XV(IC) = XV(IC)/XNORV
  70.    11    CONTINUE
  71.          XW(1) = XU(2)*XV(3) - XU(3)*XV(2)
  72.          XW(2) = XU(3)*XV(1) - XU(1)*XV(3)
  73.          XW(3) = XU(1)*XV(2) - XU(2)*XV(1)
  74.          XNORW = 0.
  75.          DO 8 IC = 1, IDIM
  76.             XNORW = XNORW + XW(IC)*XW(IC)
  77.   8      CONTINUE
  78.          XNORW = SQRT(XNORW)
  79.          DO 15 IC = 1, IDIM
  80.             XW(IC) = XW(IC)/XNORW
  81.    15    CONTINUE
  82.          XV(1) = XW(2)*XU(3) - XW(3)*XU(2)
  83.          XV(2) = XW(3)*XU(1) - XW(1)*XU(3)
  84.          XV(3) = XW(1)*XU(2) - XW(2)*XU(1)
  85.          DO 12 IC = 1, IDIM
  86.             XMATC(1, IC) = XU(IC)
  87.             XMATC(2, IC) = XV(IC)
  88.             XMATC(3, IC) = XW(IC)
  89.   12     CONTINUE
  90.       ELSE
  91.          XV(1) = -XU(2)
  92.          XV(2) = XU(1)
  93.          DO 13 IC = 1, IDIM
  94.             XMATC(1, IC) = XU(IC)
  95.             XMATC(2, IC) = XV(IC)
  96.   13     CONTINUE
  97.       ENDIF
  98. *      WRITE (*,*) 'Matrice de changement de repère :'
  99. *      DO 14 IL = 1, IDIM
  100. *         IF (IDIM .EQ. 3) THEN
  101. *            WRITE (*,*) '  ',XMATC(IL,1),'  ',XMATC(IL,2),
  102. *     #               '  ',XMATC(IL,3)
  103. *         ELSE
  104. *            WRITE (*,*) '  ',XMATC(IL,1),'  ',XMATC(IL,2)
  105. *         ENDIF
  106. *  14  CONTINUE
  107.       DO 101 II = 1, 6
  108.          DO 30 IJ = 1, 2
  109.             IDEP(II, IJ) = 0
  110.    30    CONTINUE
  111.   101 CONTINUE
  112.       SEGINI, MCHPO1 = MCHPOI
  113.       SEGACT, MCHPOI
  114.       DO 80 IMS = 1, MCHPOI.IPCHP(/1)
  115.          MSOUPO = MCHPOI.IPCHP(IMS)
  116.          SEGACT, MSOUPO
  117.          SEGINI, MSOUP1 = MSOUPO
  118.          MPOVAL = MSOUPO.IPOVAL
  119.          SEGINI, MPOVA1 = MPOVAL
  120.          MSOUP1.IPOVAL = MPOVA1
  121.          MCHPO1.IPCHP(IMS) = MSOUP1
  122.          SEGDES, MSOUPO
  123.          SEGDES, MSOUP1
  124.          SEGDES, MPOVA1
  125.   80  CONTINUE
  126.       IF (IFOMOD .EQ. 0 .OR. IFOMOD .EQ. 1) GOTO 100
  127.       SEGACT, MCHPOI
  128. *      WRITE (*,*) 'Nombre de pointeurs sur MSOUPO',MCHPO1.IPCHP(/1)
  129.       DO 3 IMS = 1, MCHPO1.IPCHP(/1)
  130. *         WRITE (*,*) '   MSOUPO # ', IMS
  131.          MSOUPO = MCHPOI.IPCHP(IMS)
  132.          SEGACT, MSOUPO
  133. *         WRITE(*,*) '       ', MSOUPO.NOHARM(/1), ' composantes'
  134.          DO 102 II = 1, 6
  135.             DO 70 IJ = 1, 2
  136.                IDEP(II, IJ) = 0
  137.    70       CONTINUE
  138.   102    CONTINUE
  139.          DO 4 IC = 1, MSOUPO.NOHARM(/1)
  140. *            WRITE (*,*) '         :',MSOUPO.NOCOMP(IC)
  141. ***-----------Pour UX
  142.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(1)) THEN
  143.                IDEP(1,1) = IMS
  144.                IDEP(1,2) = IC
  145.                IRET = 0
  146. *        WRITE (*,*) NOMDD(1),'détecté en ',IDEP(1,2),' de ',IDEP(1,1)
  147.             ELSE
  148. ***-----------Pour UY
  149.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(2)) THEN
  150.                IDEP(2,1) = IMS
  151.                IDEP(2,2) = IC
  152.                IRET = 0
  153. *         WRITE (*,*) NOMDD(2),'détecté en ',IDEP(2,2),' de ',IDEP(2,1)
  154.             ELSE
  155. ***-----------Pour UZ
  156.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(3)) THEN
  157.                IDEP(3,1) = IMS
  158.                IDEP(3,2) = IC
  159.                IRET = 0
  160. *          WRITE (*,*) NOMDD(3),'détecté en ',IDEP(3,2),' de ',IDEP(3,1)
  161.             ELSE
  162. ***-----------Pour RX
  163.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(4)) THEN
  164.                IDEP(4,1) = IMS
  165.                IDEP(4,2) = IC
  166.                IRET = 0
  167. *          WRITE (*,*) NOMDD(4),'détecté en ',IDEP(4,2),' de ',IDEP(4,1)
  168.             ELSE
  169. ***-----------Pour RY
  170.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(5)) THEN
  171.                IDEP(5,1) = IMS
  172.                IDEP(5,2) = IC
  173.                IRET = 0
  174. *          WRITE (*,*) NOMDD(5),'détecté en ',IDEP(5,2),' de ',IDEP(5,1)
  175.             ELSE
  176. ***-----------Pour RZ
  177.             IF (MSOUPO.NOCOMP(IC) .EQ. NOMDD(6)) THEN
  178.                IDEP(6,1) = IMS
  179.                IDEP(6,2) = IC
  180.                IRET = 0
  181. *          WRITE (*,*) NOMDD(6),'détecté en ',IDEP(6,2),' de ',IDEP(6,1)
  182.             ENDIF
  183.             ENDIF
  184.             ENDIF
  185.             ENDIF
  186.             ENDIF
  187.             ENDIF
  188.   4      CONTINUE
  189.          MPOVAL = MSOUPO.IPOVAL
  190.          SEGACT, MPOVAL
  191.          INP = MPOVAL.VPOCHA(/1)
  192. ***----Pour chaque composante à transformer
  193.          MSOUP1 = MCHPO1.IPCHP(IMS)
  194.          SEGACT, MSOUP1
  195.          MPOVA1 = MSOUP1.IPOVAL
  196.          SEGACT, MPOVA1*MOD
  197. *         DO 400 IC = 1, 6
  198. *            WRITE (*,*) ' '
  199. *            WRITE (*,*) '    IDEP(',IC,',1) = ', IDEP(IC,1)
  200. *            WRITE (*,*) '    IDEP(',IC,',2) = ', IDEP(IC,2)
  201. *  400    CONTINUE
  202.          DO 50 IN = 1, INP
  203.             DO 40 IC = 1, 3
  204.                IF (IDEP(IC,1) .NE. 0) THEN
  205.                   XDEP(IC) = MPOVAL.VPOCHA(IN,IDEP(IC,2))
  206. *                  WRITE (*,*) 'XDEP(',IC,') = ', XDEP(IC)
  207.                ENDIF
  208.                ICL = IC + 3
  209.                IF (IDEP(ICL,1) .NE. 0) THEN
  210.                   XROT(IC) = MPOVAL.VPOCHA(IN,IDEP(ICL,2))
  211. *                  WRITE (*,*) 'XROT(',IC,') = ', XROT(IC)
  212.                ENDIF
  213.   40        CONTINUE
  214.             DO 41 IC = 1, 3
  215.                IF (IDEP(IC,1) .NE. 0) THEN
  216.                   MPOVA1.VPOCHA(IN,IDEP(IC,2)) = 0.
  217.                   DO 42 IJ = 1, 3
  218.                      MPOVA1.VPOCHA(IN,IDEP(IC,2)) =
  219.      #      MPOVA1.VPOCHA(IN,IDEP(IC,2)) + XMATC(IC,IJ)*XDEP(IJ)
  220.   42              CONTINUE
  221.                ENDIF
  222.                ICL = IC + 3
  223.                IF (IDEP(ICL,1) .NE. 0) THEN
  224.                   MPOVA1.VPOCHA(IN,IDEP(ICL,2)) = 0.
  225.                   DO 43 IJ = 1, 3
  226.                      MPOVA1.VPOCHA(IN,IDEP(ICL,2)) =
  227.      #      MPOVA1.VPOCHA(IN,IDEP(ICL,2)) + XMATC(IC,IJ)*XROT(IJ)
  228.   43              CONTINUE
  229.                ENDIF
  230.   41        CONTINUE
  231.   50     CONTINUE
  232.          SEGDES, MPOVA1
  233.          SEGDES, MSOUP1
  234.          SEGDES, MPOVAL
  235.          SEGDES, MSOUPO
  236.   3   CONTINUE
  237.  
  238.       SEGDES, MCHPOI
  239.       SEGDES, MCHPO1
  240. C
  241. C       Ecriture du champ de déplacements
  242. C
  243.  100  CONTINUE
  244.       CALL ECROBJ('CHPOINT', MCHPO1)
  245.       RETURN
  246.       END
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  

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