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