Télécharger lign.eso

Retour à la liste

Numérotation des lignes :

  1. C LIGN SOURCE PV 16/06/24 13:05:31 8985
  2. C 1234567890124567890124567898012456789012345678901234567890123456
  3.  
  4. C SOURCE : L. DI VALENTIN LE 17/06/97
  5.  
  6. SUBROUTINE LIGN
  7.  
  8. C Suivant le mot cle ROTA ou TRAN, cet operateur appelle les
  9. C subroutines ROND ou LIGNE pour construire soit un arc de cercle
  10. C soit une droite de vecteur directeur donne.
  11.  
  12.  
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8 (A-H,O-Z)
  15. -INC CCOPTIO
  16. -INC CCGEOME
  17. -INC SMCOORD
  18.  
  19.  
  20. INTEGER POINT1,POINT2,VECT,INBR
  21. CHARACTER*4 MOTCLE(2)
  22.  
  23. DATA MOTCLE/'ROTA','TRAN'/
  24.  
  25.  
  26.  
  27. CALL LIRMOT(MOTCLE,2,IRET,0)
  28.  
  29. IF (IRET.EQ.1) THEN
  30. CALL ROND
  31.  
  32. ELSEIF (IRET.EQ.2) THEN
  33.  
  34. C Lecture du point de reference.
  35. CALL LIROBJ('POINT',POINT1,1,IRET)
  36. IF (IRET.EQ.0) RETURN
  37.  
  38. C Lecture du vecteur de translation
  39. CALL LIROBJ('POINT',VECT,1,IRET)
  40. IF (IRET.EQ.0) RETURN
  41.  
  42. C On cree une place memoire pour le deuxieme point extremite
  43. NBPTS = XCOOR(/1)/(IDIM + 1) + 1
  44. POINT2 = NBPTS
  45. SEGADJ MCOORD
  46.  
  47. C Calcul du 2eme point extremite
  48. XCOOR((POINT2-1)*(IDIM+1)+1) = XCOOR((POINT1-1)*(IDIM+1)+1)
  49. & + XCOOR((VECT-1)*(IDIM+1)+1)
  50. XCOOR((POINT2-1)*(IDIM+1) + 2) = XCOOR((POINT1-1)*(IDIM+1)+2)
  51. & + XCOOR((VECT-1)*(IDIM+1)+2)
  52. IF (IDIM.EQ.3) THEN
  53. XCOOR((POINT2-1)*(IDIM+1) + 3) = XCOOR((POINT1-1)*(IDIM+1)+3)
  54. & + XCOOR((VECT-1)*(IDIM+1)+3)
  55. ENDIF
  56.  
  57. XCOOR(POINT2*(IDIM+1)) = XCOOR(POINT1*(IDIM+1))
  58.  
  59. CALL ECROBJ('POINT',POINT1)
  60. CALL ECROBJ('POINT',POINT2)
  61.  
  62. CALL LIGNE (1,1,DEN1,DEN2,INBR)
  63.  
  64.  
  65. ELSE
  66. CALL ERREUR (857)
  67. ENDIF
  68.  
  69. RETURN
  70.  
  71. END
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  

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