Download lign.eso

Back to the list

   1 : C LIGN      SOURCE    CHAT      07/10/29    21:23:19     5940           
   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 : 
  26 :       CALL LIRMOT(MOTCLE,2,IRET,0)
  27 : 
  28 :       IF (IRET.EQ.1) THEN                                    
  28 :         CALL ROND                                 
  29 :                                    
  30 :       ELSEIF (IRET.EQ.2) THEN
  31 : 
  32 : C       Lecture du point de reference.
  32 :         CALL LIROBJ('POINT',POINT1,1,IRET)
  33 :         IF (IRET.EQ.0) RETURN
  34 : 
  35 : C       Lecture du vecteur de translation
  35 :         CALL LIROBJ('POINT',VECT,1,IRET)
  36 :         IF (IRET.EQ.0) RETURN 
  37 : 
  38 : C       On cree une place memoire pour le deuxieme point extremite
  39 :         NBPTS  = XCOOR(/1)/(IDIM + 1) + 1
  40 :         POINT2 = NBPTS      
  41 :         SEGADJ MCOORD
  42 : 
  43 : C       Calcul du 2eme point extremite
  44 :         XCOOR((POINT2-1)*(IDIM+1)+1) = XCOOR((POINT1-1)*(IDIM+1)+1)
  45 :      &                                + XCOOR((VECT-1)*(IDIM+1)+1)
  46 :         XCOOR((POINT2-1)*(IDIM+1) + 2) = XCOOR((POINT1-1)*(IDIM+1)+2)
  47 :      &                                + XCOOR((VECT-1)*(IDIM+1)+2)
  48 :         IF (IDIM.EQ.3) THEN
  49 :          XCOOR((POINT2-1)*(IDIM+1) + 3) = XCOOR((POINT1-1)*(IDIM+1)+3)
  50 :      &                                + XCOOR((VECT-1)*(IDIM+1)+3)
  51 :         ENDIF
  52 :  
  53 :         XCOOR(POINT2*(IDIM+1)) = XCOOR(POINT1*(IDIM+1))
  54 : 
  54 :         CALL ECROBJ('POINT',POINT1)
  54 :         CALL ECROBJ('POINT',POINT2)
  55 : 
  55 :         CALL LIGNE (1,1,DEN1,DEN2,INBR)
  56 : 
  57 : 
  58 :       ELSE
  58 :         CALL ERREUR (857)
  59 :       ENDIF                                                 
  60 : 
  61 :       RETURN
  62 : 
  63 :       END
  64 :  
  65 :  
  66 :  
  67 :  
  68 :  

© Cast3M 2003 - All rights reserved.
Disclaimer