Télécharger la plaquette Cast3M


fr en

Télécharger dyne30.eso

Retour à la liste

Numérotation des lignes : 

dyne30

  1. C DYNE30    SOURCE    CHAT      05/01/12    23:17:07     5004
  2.       SUBROUTINE DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. *                                                                    *
  7. *     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
  8. *     ________________________________________________               *
  9. *                                                                    *
  10. *     Position initiale du profil mobile par rapport au profil fixe  *
  11. *                                                                    *
  12. *     Param}tres:                                                    *
  13. *                                                                    *
  14. * es  IPALB   tableau de description des liaisons sur base B         *
  15. * es  XPALB   tableau de description des liaisons sur base B         *
  16. * e   NLIAB   nombre total de liaisons sur base B                    *
  17. * e   NOMBN1  nombre de points du profil fixe                        *
  18. * e   NOMBN2  nombre de points du profil mobile                      *
  19. * e   I       num{ro de liaison trait{e                              *
  20. * e   ID1     indice de tableau pour XPALB                           *
  21. * e   IP1     indice de tableau pour IPALB                           *
  22. *                                                                    *
  23. *                                                                    *
  24. *     Auteur, date de cr{ation:                                      *
  25. *                                                                    *
  26. *     Lionel VIVAN, le 1 f{vrier 1991.                               *
  27. *                                                                    *
  28. *--------------------------------------------------------------------*
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. *
  33.       INTEGER IPALB(NLIAB,*)
  34.       REAL*8 XPALB(NLIAB,*)
  35.       PARAMETER ( ZERO = 0.D0 )
  36. *
  37.       ID2 = ID1 + IDIM
  38.       ID3 = ID1 + 2*IDIM
  39.       ID4 = ID1 + 3*IDIM
  40.       ID7 = ID1 + 5*IDIM + IDIM*NOMBN1
  41.       ID8 = ID7 + IDIM*NOMBN2
  42.       NUM1 = ID7
  43.       IEL2 = IP1 + NOMBN1
  44.       DO 10 IN = 1,NOMBN2
  45. *        calcul des coordonn{es dans le plan d{fini par les profils
  46.          X1 = ZERO
  47.          Y1 = ZERO
  48.          DO 12 ID = 1,IDIM
  49.             XX = XPALB(I,NUM1+ID) - XPALB(I,ID2+ID)
  50.             X1 = X1 + ( XX * XPALB(I,ID3+ID) )
  51.             Y1 = Y1 + ( XX * XPALB(I,ID4+ID) )
  52.  12         CONTINUE
  53. *        end do
  54.          NUM2 = ID8
  55.          DO 14 IE = 1,NOMBN1
  56.             ITYP = IPALB(I,IP1+IE)
  57.             XAIJ = XPALB(I,NUM2+1)
  58.             XBIJ = XPALB(I,NUM2+2)
  59.             IF (ITYP.EQ.1) THEN
  60. *   La droite est verticale
  61.                IF (X1.GT.XAIJ) THEN
  62.                   IPALB(I,IEL2+IE) = 1
  63.                ELSE IF (X1.LT.XAIJ) THEN
  64.                   IPALB(I,IEL2+IE) = -1
  65.                ELSE
  66.                   IPALB(I,IEL2+IE) = 0
  67.                ENDIF
  68.             ELSE IF (ITYP.EQ.2) THEN
  69. *   La droite est horizontale
  70.                IF (Y1.GT.XBIJ) THEN
  71.                   IPALB(I,IEL2+IE) = 1
  72.                ELSE IF (Y1.LT.XBIJ) THEN
  73.                   IPALB(I,IEL2+IE) = -1
  74.                ELSE
  75.                   IPALB(I,IEL2+IE) = 0
  76.                ENDIF
  77.             ELSE
  78. *   La droite est quelconque
  79.                RES = ( XAIJ * X1 ) + XBIJ
  80.                IF (Y1.GT.RES) THEN
  81.                   IPALB(I,IEL2+IE) = 1
  82.                ELSE IF (Y1.LT.RES) THEN
  83.                   IPALB(I,IEL2+IE) = -1
  84.                ELSE
  85.                   IPALB(I,IEL2+IE) = 0
  86.                ENDIF
  87.             ENDIF
  88.             NUM2 = NUM2 + 2
  89.  14         CONTINUE
  90. *        end do
  91.          IEL2 = IEL2 + NOMBN1
  92.          NUM1 = NUM1 + IDIM
  93.  10      CONTINUE
  94. *     end do
  95. *
  96.       END
  97.  
  98.  

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