Télécharger lign.eso

Retour à la liste

Numérotation des lignes :

lign
  1. C LIGN SOURCE CB215821 20/06/08 21:15:00 10619
  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.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC CCGEOME
  19. -INC SMCOORD
  20.  
  21.  
  22. INTEGER POINT1,POINT2,VECT,INBR
  23. CHARACTER*4 MOTCLE(2)
  24.  
  25. DATA MOTCLE/'ROTA','TRAN'/
  26.  
  27.  
  28.  
  29. CALL LIRMOT(MOTCLE,2,IRET,0)
  30.  
  31. IF (IRET.EQ.1) THEN
  32. CALL ROND
  33.  
  34. ELSEIF (IRET.EQ.2) THEN
  35.  
  36. C Lecture du point de reference.
  37. CALL LIROBJ('POINT',POINT1,1,IRET)
  38. IF (IRET.EQ.0) RETURN
  39.  
  40. C Lecture du vecteur de translation
  41. CALL LIROBJ('POINT',VECT,1,IRET)
  42. IF (IRET.EQ.0) RETURN
  43.  
  44. C On cree une place memoire pour le deuxieme point extremite
  45. segact mcoord*mod
  46. NBPTS = NBPTS + 1
  47. POINT2 = NBPTS
  48. SEGADJ MCOORD
  49.  
  50. C Calcul du 2eme point extremite
  51. XCOOR((POINT2-1)*(IDIM+1)+1) = XCOOR((POINT1-1)*(IDIM+1)+1)
  52. & + XCOOR((VECT-1)*(IDIM+1)+1)
  53. XCOOR((POINT2-1)*(IDIM+1) + 2) = XCOOR((POINT1-1)*(IDIM+1)+2)
  54. & + XCOOR((VECT-1)*(IDIM+1)+2)
  55. IF (IDIM.EQ.3) THEN
  56. XCOOR((POINT2-1)*(IDIM+1) + 3) = XCOOR((POINT1-1)*(IDIM+1)+3)
  57. & + XCOOR((VECT-1)*(IDIM+1)+3)
  58. ENDIF
  59.  
  60. XCOOR(POINT2*(IDIM+1)) = XCOOR(POINT1*(IDIM+1))
  61.  
  62. CALL ECROBJ('POINT',POINT1)
  63. CALL ECROBJ('POINT',POINT2)
  64.  
  65. CALL LIGNE (1,1,DEN1,DEN2,INBR)
  66.  
  67.  
  68. ELSE
  69. CALL ERREUR (857)
  70. ENDIF
  71.  
  72. RETURN
  73.  
  74. END
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  

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