C MOIN SOURCE JC220346 18/12/04 21:15:47 9991 C MODI ACQUISITION PARAMETRES POUR PROJECTION C SUBROUTINE MOIN(IREP,IP1,IP2,IP3,IP4) IMPLICIT INTEGER(I-N) -INC PPARAM -INC CCOPTIO -INC TMLNOMS SEGMENT LISENT(NTABLE) COMMON /CMODI/LIGMAX,XPREC,YPREC CHARACTER*8 ZONE,CTYP CHARACTER*8 LEGEND(7) CALL TRLABL(0.,20.,0.,'Directive MODI - Cas du 3D',26,1.) CALL TRLABL(0.,18.,0.,'Vous pouvez reprojeter en sortie de MODI' * ,40,1.) CALL TRLABL(0.,16.,0.,'les points deplaces sur une surface',35,1.) LEGEND(1)=' ' LEGEND(2)='Plan' LEGEND(3)='Sphere' LEGEND(4)='Cylindre' LEGEND(5)='Cone' LEGEND(6)='Tore' LEGEND(7)='Ignorer' 5 CONTINUE CALL MENU(LEGEND,7,8) CALL TRAFF(ICLE) IF (ICLE.GT.6) THEN CALL TRMESS('Erreur ! Recommencez') GOTO 5 ENDIF IF (ICLE.EQ.6) THEN IREP=0 RETURN ENDIF CALL REPERT('POINT ',NTABLE) SEGINI LISENT DO 5498 I=1,NTABLE CALL LIROBJ('POINT ',IP1,1,IRETOU) IF(IERR.NE.0) RETURN LISENT(I)=IP1 5498 CONTINUE CALL REPLIS('POINT ',MLNOMS) SEGACT MLNOMS LEGEND(1)=' ' LEGEND(2)='Cont' LEGEND(3)='Terminer' CALL MENU(LEGEND,3,8) IF (ICLE.EQ.1) THEN CALL TRLABL(0.,14.,0., >'Donnez le noms de trois points caracterisant le plan',52,1.) CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF 12 CONTINUE CALL TRGET('Donnez le nom du premier point :',ZONE) DO 10 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 10 IP1=LISENT(I) GOTO 11 10 CONTINUE CALL TRMESS('Premier point incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 12 11 CONTINUE CALL TRGET('Donnez le nom du deuxieme point :',ZONE) DO 13 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 13 IP2=LISENT(I) GOTO 14 13 CONTINUE CALL TRMESS('Deuxieme point incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 12 14 CONTINUE CALL TRGET('Donnez le nom du troisieme point :',ZONE) DO 15 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 15 IP3=LISENT(I) GOTO 16 15 CONTINUE CALL TRMESS('Troisieme point incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 12 16 CONTINUE IREP=1 SEGSUP LISENT,MLNOMS RETURN ENDIF IF (ICLE.EQ.2) THEN CALL TRLABL(0.,14.,0., >'Donnez les noms du centre et d un point de la sphere',51,1.) CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF 22 CONTINUE CALL TRGET('Donnez le nom du centre :',ZONE) DO 20 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 20 IP1=LISENT(I) GOTO 21 20 CONTINUE CALL TRMESS('Centre incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 22 21 CONTINUE CALL TRGET('Donnez le nom du point :',ZONE) DO 23 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 23 IP2=LISENT(I) GOTO 24 23 CONTINUE CALL TRMESS('Point incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 22 24 CONTINUE IREP=2 SEGSUP LISENT,MLNOMS RETURN ENDIF IF (ICLE.EQ.3) THEN CALL TRLABL(0.,14.,0.,'Donnez le noms de deux points de l axe' * //'et d un point courant du cylindre',71,1.) CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF 32 CONTINUE CALL TRGET('Donnez le nom du premier point :',ZONE) DO 30 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 30 IP1=LISENT(I) GOTO 31 30 CONTINUE CALL TRMESS('Premier point incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 32 31 CONTINUE CALL TRGET('Donnez le nom du deuxieme point :',ZONE) DO 33 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 33 IP2=LISENT(I) GOTO 34 33 CONTINUE CALL TRMESS('Second point incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 32 34 CONTINUE CALL TRGET('Donnez le nom du point courant:',ZONE) DO 35 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 35 IP3=LISENT(I) GOTO 36 35 CONTINUE CALL TRMESS('Point courant incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 32 36 CONTINUE IREP=3 SEGSUP LISENT,MLNOMS RETURN ENDIF IF (ICLE.EQ.4) THEN CALL TRLABL(0.,14.,0.,'Donnez les noms du sommet, d un point de' * //' l axe et d un point courant du cone',76,1.) CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF 42 CONTINUE CALL TRGET('Donnez le nom du centre :',ZONE) DO 40 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 40 IP1=LISENT(I) GOTO 41 40 CONTINUE CALL TRMESS('Centre incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 42 41 CONTINUE CALL TRGET('Donnez le nom d un point de l axe :',ZONE) DO 43 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 43 IP2=LISENT(I) GOTO 44 43 CONTINUE CALL TRMESS('Point de l axe incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 42 44 CONTINUE CALL TRGET('Donnez le nom d un point courant :',ZONE) DO 45 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 45 IP3=LISENT(I) GOTO 46 45 CONTINUE CALL TRMESS('Point courant incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 42 46 CONTINUE IREP=4 SEGSUP LISENT,MLNOMS RETURN ENDIF IF (ICLE.EQ.5) THEN CALL TRLABL(0.,14.,0., > 'Donnez les noms du centre du tore, d un point de son axe',56,1.) CALL TRLABL(0.,12.,0., >', d un centre de petit cercle et d un point courant',51,1.) CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF 52 CONTINUE CALL TRGET('Donnez le nom du centre du tore :',ZONE) DO 50 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 50 IP1=LISENT(I) GOTO 51 50 CONTINUE CALL TRMESS('Centre incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 52 51 CONTINUE CALL TRGET('Donnez le nom d un point de l axe :',ZONE) DO 53 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 53 IP2=LISENT(I) GOTO 54 53 CONTINUE CALL TRMESS('Point de l axe incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 52 54 CONTINUE CALL TRGET('Donnez le nom d un centre de petit ' * //'cercle :',ZONE) DO 55 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 55 IP3=LISENT(I) GOTO 56 55 CONTINUE CALL TRMESS('Petit cercle incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 52 56 CONTINUE CALL TRGET('Donnez le nom d un point courant :',ZONE) DO 57 I=1,LINOMS(/2) IF(ZONE.NE.LINOMS(I)) GO TO 57 IP4=LISENT(I) GOTO 58 57 CONTINUE CALL TRMESS('Point courant incorrect') CALL TRAFF(ICLE) IF (ICLE.EQ.2) THEN IREP=0 RETURN ENDIF GOTO 52 58 CONTINUE IREP=5 SEGSUP LISENT,MLNOMS RETURN ENDIF END