Télécharger la plaquette Cast3M


fr en

Télécharger dyne29.eso

Retour à la liste

Numérotation des lignes : 

dyne29

  1. C DYNE29    SOURCE    CHAT      05/01/12    23:16:54     5004
  2.       SUBROUTINE DYNE29(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. *     Coefficient des droites form{es par les {l{ments du profil     *
  11. *     fixe.                                                          *
  12. *                                                                    *
  13. *     Param}tres:                                                    *
  14. *                                                                    *
  15. * es  IPALB   tableau de description des liaisons sur base B         *
  16. * es  XPALB   tableau de description des liaisons sur base B         *
  17. * e   NLIAB   nombre total de liaisons sur base B                    *
  18. * e   NOMBN1  nombre de points du profil fixe                        *
  19. * e   NOMBN2  nombre de points du profil mobile                      *
  20. * e   I       num{ro de liaison trait{e                              *
  21. * e   ID1     indice de tableau pour XPALB                           *
  22. * e   IP1     indice de tableau pour IPALB                           *
  23. *                                                                    *
  24. *                                                                    *
  25. *     Auteur, date de cr{ation:                                      *
  26. *                                                                    *
  27. *     Lionel VIVAN, le 1 f{vrier 1991.                               *
  28. *                                                                    *
  29. *--------------------------------------------------------------------*
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. *
  34.       INTEGER IPALB(NLIAB,*)
  35.       REAL*8 XPALB(NLIAB,*)
  36.       PARAMETER ( PRECIS = 1.D-15 , ZERO = 0.D0 )
  37. *
  38.       ID2 = ID1 + IDIM
  39.       ID3 = ID1 + 2*IDIM
  40.       ID4 = ID1 + 3*IDIM
  41.       ID6 = ID1 + 5*IDIM
  42.       ID8 = ID1 + 5*IDIM + IDIM*NOMBN1 + IDIM*NOMBN2
  43.       NUM1 = ID6
  44.       NUM2 = ID6 + IDIM
  45.       DO 10 IE = 1,NOMBN1
  46.          IF (IE.EQ.NOMBN1) THEN
  47.             NUM2 = ID6
  48.          ENDIF
  49. *        calcul des coordonn{es dans le plan d{fini par les profils
  50.          X1 = ZERO
  51.          Y1 = ZERO
  52.          X2 = ZERO
  53.          Y2 = ZERO
  54.          DO 12 ID = 1,IDIM
  55.             XX = XPALB(I,NUM1+ID) - XPALB(I,ID2+ID)
  56.             YY = XPALB(I,NUM2+ID) - XPALB(I,ID2+ID)
  57.             X1 = X1 + ( XX * XPALB(I,ID3+ID) )
  58.             Y1 = Y1 + ( XX * XPALB(I,ID4+ID) )
  59.             X2 = X2 + ( YY * XPALB(I,ID3+ID) )
  60.             Y2 = Y2 + ( YY * XPALB(I,ID4+ID) )
  61.  12         CONTINUE
  62. *        end do
  63.          XXX = X2 - X1
  64.          YYY = Y2 - Y1
  65.          IF (ABS(XXX).LT.PRECIS) THEN
  66. *           la droite est verticale
  67.             IPALB(I,IP1+IE) = 1
  68.             XPALB(I,ID8+1) = X1
  69.             XPALB(I,ID8+2) = ZERO
  70.          ELSE IF (ABS(YYY).LT.PRECIS) THEN
  71. *           la droite est horizontale
  72.             IPALB(I,IP1+IE) = 2
  73.             XPALB(I,ID8+1) = ZERO
  74.             XPALB(I,ID8+2) = Y1
  75.          ELSE
  76. *           la droite est quelconque
  77.             IPALB(I,IP1+IE) = 3
  78.             XPALB(I,ID8+1) = YYY / XXX
  79.             XPALB(I,ID8+2) = ( X2*Y1 - X1*Y2 ) / XXX
  80.          ENDIF
  81.          NUM1 = NUM2
  82.          NUM2 = NUM2 + IDIM
  83.          ID8 = ID8 + 2
  84.  10      CONTINUE
  85. *     end do
  86. *
  87.       END
  88.  
  89.  

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