Télécharger la plaquette Cast3M


fr en

Télécharger dyne31.eso

Retour à la liste

Numérotation des lignes : 

dyne31

  1. C DYNE31    SOURCE    BP208322  20/09/18    21:16:24     10718          
  2.       SUBROUTINE DYNE31(IPOIN1,IPOIN2,IELEM1,XPALB,IPALB,XPTB,NLIAB,
  3.      &                  NPLB,I,NPOI,IND,ID1,IP1,XPP,YPP)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. *                                                                    *
  8. *     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
  9. *     ________________________________________________               *
  10. *                                                                    *
  11. *     Calcul le point d'intersection                                 *
  12. *                                                                    *
  13. *     Param}tres:                                                    *
  14. *                                                                    *
  15. * e   IPOIN1  point du profil mobile                                 *
  16. * e   IPOIN2  point du profil mobile                                 *
  17. * e   IELEM1  {l{ment du profil fixe                                 *
  18. * e   NLIAB   nombre total de liaisons                               *
  19. * e   NPOI    point support                                          *
  20. * s   XPP     1}re coordonn{e du point d'intersection                *
  21. * s   YPP     2}me coordonn{e du point d'intersection                *
  22. *                                                                    *
  23. *                                                                    *
  24. *     Auteur, date de cr{ation:                                      *
  25. *                                                                    *
  26. *     Lionel VIVAN, le 1 f{vrier 1991.                               *
  27. *                                                                    *
  28. *--------------------------------------------------------------------*
  29. *
  30.       INTEGER IPALB(NLIAB,*)
  31.       REAL*8 XPTB(NPLB,2,*),XPALB(NLIAB,*)
  32.       PARAMETER ( ZERO = 0.D0 , PRECIS = 1.D-15 )
  33. *
  34.       III = 0
  35.       XPP = ZERO
  36.       YPP = ZERO
  37.       ICOMP = 1
  38.       IDIM   = IPALB(I,3)
  39.       NOMBN1 = IPALB(I,4)
  40.       NOMBN2 = IPALB(I,5)
  41.       ID2 = ID1 + IDIM
  42.       ID3 = ID1 + 2*IDIM
  43.       ID4 = ID1 + 3*IDIM
  44.       ID6 = ID1 + 5*IDIM
  45.       ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
  46.       ID8 = ID7 + IDIM*NOMBN2
  47. *     calcul des coordonn{es dans le plan d{fini par les profils
  48.       IPN1 = ID7 + IDIM*(IPOIN1-1)
  49.       IPN2 = ID7 + IDIM*(IPOIN2-1)
  50.       X1 = ZERO
  51.       Y1 = ZERO
  52.       X2 = ZERO
  53.       Y2 = ZERO
  54.       DO 8 ID = 1,IDIM
  55.          XX1 = XPTB(NPOI,1,ID) + XPALB(I,IPN1+ID) - XPALB(I,ID2+ID)
  56.          XX2 = XPTB(NPOI,1,ID) + XPALB(I,IPN2+ID) - XPALB(I,ID2+ID)
  57.          X1 = X1 + ( XX1 * XPALB(I,ID3+ID) )
  58.          Y1 = Y1 + ( XX1 * XPALB(I,ID4+ID) )
  59.          X2 = X2 + ( XX2 * XPALB(I,ID3+ID) )
  60.          Y2 = Y2 + ( XX2 * XPALB(I,ID4+ID) )
  61.  8       CONTINUE
  62. *     end do
  63.       XXX = X2 - X1
  64.       YYY = Y2 - Y1
  65.       IE = IELEM1
  66.  20   CONTINUE
  67.       IEL1 = ID6 + IDIM*(IE-1)
  68.       IEL2 = ID6 + IDIM*IE
  69.       IF (IE.EQ.NOMBN1) IEL2 = ID6
  70.       XE1 = ZERO
  71.       YE1 = ZERO
  72.       XE2 = ZERO
  73.       YE2 = ZERO
  74.       DO 10 ID = 1,IDIM
  75.          XX1 = XPALB(I,IEL1+ID) - XPALB(I,ID2+ID)
  76.          XX2 = XPALB(I,IEL2+ID) - XPALB(I,ID2+ID)
  77.          XE1 = XE1 + ( XX1 * XPALB(I,ID3+ID) )
  78.          YE1 = YE1 + ( XX1 * XPALB(I,ID4+ID) )
  79.          XE2 = XE2 + ( XX2 * XPALB(I,ID3+ID) )
  80.          YE2 = YE2 + ( XX2 * XPALB(I,ID4+ID) )
  81.  10      CONTINUE
  82. *     end do
  83.       IEL3 = ID8 + 2*(IE - 1)
  84.       ICAS = IPALB(I,IP1+IE)
  85.       XAIJ = XPALB(I,IEL3+1)
  86.       XBIJ = XPALB(I,IEL3+2)
  87. *
  88. *   La droite cr{{e par l'{l{ment du profil fixe est verticale
  89. *
  90.       IF (ICAS.EQ.1) THEN
  91.          XPP = XAIJ
  92.          IF (ABS(YYY).LT.PRECIS) THEN
  93. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est horizontale
  94.             YPP = Y1
  95.             GOTO 30
  96.          ELSE IF (ABS(XXX).LT.PRECIS) THEN
  97. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est verticale
  98. *   alors on va chercher l'{l{ment du profil fixe suivant
  99.             GOTO 12
  100.          ELSE
  101. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est quelconque
  102.             AL2 = YYY / XXX
  103.             BL2 = ( X2*Y1 - Y2*X1 ) / XXX
  104.             YPP = ( AL2 * XPP ) + BL2
  105. *   V{rification des coordonn{es du point d'intersection
  106.             IF (YE1.LE.YE2) THEN
  107.                IF (YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
  108.                GOTO 12
  109.             ELSE
  110.                IF (YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
  111.                GOTO 12
  112.             ENDIF
  113.          ENDIF
  114. *
  115. *   La droite cr{{e par l'{l{ment du profil fixe est horizontale
  116. *
  117.       ELSE IF (ICAS.EQ.2) THEN
  118.          YPP = XBIJ
  119.          IF (ABS(XXX).LT.PRECIS) THEN
  120. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est verticale
  121.             XPP = X1
  122.             GOTO 30
  123.          ELSE IF (ABS(YYY).LT.PRECIS) THEN
  124. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est horizontale
  125. *   alors on va chercher l'{l{ment du profil fixe suivant
  126.             GOTO 12
  127.          ELSE
  128. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est quelconque
  129.             AL2 = YYY / XXX
  130.             BL2 = ( X2*Y1 - Y2*X1 ) / XXX
  131.             XPP = ( YPP - BL2 ) / AL2
  132. *   V{rification des coordonn{es du point d'intersection
  133.             IF (XE1.LE.XE2) THEN
  134.                IF (XE1.LE.XPP .AND. XPP.LE.XE2) GOTO 30
  135.                GOTO 12
  136.             ELSE
  137.                IF (XE2.LE.XPP .AND. XPP.LE.XE1) GOTO 30
  138.                GOTO 12
  139.             ENDIF
  140.          ENDIF
  141. *
  142. *   La droite cr{{e par un {l{ment du profil fixe est quelconque
  143. *
  144.       ELSE
  145.          IF (ABS(XXX).LT.PRECIS) THEN
  146. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est verticale
  147.             XPP = X1
  148.             YPP = ( XAIJ * XPP ) + XBIJ
  149. *   V{rification des coordonn{es du point d'intersection
  150.             IF (YE1.LE.YE2) THEN
  151.                IF (YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
  152.                GOTO 12
  153.             ELSE
  154.                IF (YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
  155.                GOTO 12
  156.             ENDIF
  157.          ELSE
  158. *   La droite cr{{e par les points IPOIN1 et IPOIN2 est quelconque
  159.             AL2 = YYY / XXX
  160.             BL2 = ( X2*Y1 - Y2*X1 ) / XXX
  161.             XPP = ( XBIJ - BL2 ) / ( AL2 - XAIJ )
  162.             YPP = ( AL2 * XPP ) + BL2
  163. *   V{rification des coordonn{es du point d'intersection
  164.             IF (XE1.LE.XE2 .AND. YE1.LE.YE2) THEN
  165.                IF (XE1.LE.XPP .AND. XPP.LE.XE2 .AND.
  166.      &             YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
  167.                GOTO 12
  168.             ELSE IF (XE1.LE.XE2 .AND. YE2.LE.YE1) THEN
  169.                IF (XE1.LE.XPP .AND. XPP.LE.XE2 .AND.
  170.      &             YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
  171.                GOTO 12
  172.             ELSE IF (XE2.LE.XE1 .AND. YE2.LE.YE1) THEN
  173.                IF (XE2.LE.XPP .AND. XPP.LE.XE1 .AND.
  174.      &             YE2.LE.YPP .AND. YPP.LE.YE1) GOTO 30
  175.                GOTO 12
  176.             ELSE
  177.                IF (XE2.LE.XPP .AND. XPP.LE.XE1 .AND.
  178.      &             YE1.LE.YPP .AND. YPP.LE.YE2) GOTO 30
  179.                GOTO 12
  180.             ENDIF
  181.          ENDIF
  182.       ENDIF
  183.  12   CONTINUE
  184.       IF (ICOMP.EQ.NOMBN1) RETURN
  185.       IF (III.EQ.1) THEN
  186. *        on regarde l'{l{ment pr{c{dent
  187.          IE = IELEM1 - ICOMP
  188.          IF (IE.LE.0) IE = IE + NOMBN1
  189.          III = -1
  190.          ICOMP = ICOMP + 1
  191.          GOTO 20
  192.       ELSE
  193. *        on regarde l'{l{ment suivant
  194.          IE = IELEM1 + ICOMP
  195.          IF (IE.GE.(NOMBN1+1)) IE = IE - NOMBN1
  196.          III = 1
  197.          GOTO 20
  198.       ENDIF
  199.  30   CONTINUE
  200.       IELEM1 = IE
  201. *
  202.       END
  203.  
  204.  
  205.  
  206.  

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