1 : C MOIN SOURCE PV 05/09/22 21:21:00 5181 2 : C MODI ACQUISITION PARAMETRES POUR PROJECTION 3 : C 4 : SUBROUTINE MOIN(IREP,IP1,IP2,IP3,IP4) 5 : IMPLICIT INTEGER(I-N) 6 : -INC CCOPTIO 7 : -INC TMLCHA8 8 : SEGMENT LISENT(NTABLE) 9 : COMMON /CMODI/LIGMAX,XPREC,YPREC 10 : CHARACTER*8 ZONE,CTYP 11 : CHARACTER*8 LEGEND(7) 11 : CALL TRLABL(0.,20.,0.,'Directive MODI - Cas du 3D',26,1.) 11 : CALL TRLABL(0.,18.,0.,'Vous pouvez reprojeter en sortie de MODI' 12 : * ,40,1.) 12 : CALL TRLABL(0.,16.,0.,'les points deplaces sur une surface',35,1.) 13 : LEGEND(1)=' ' 14 : LEGEND(2)='Plan' 15 : LEGEND(3)='Sphere' 16 : LEGEND(4)='Cylindre' 17 : LEGEND(5)='Cone' 18 : LEGEND(6)='Tore' 19 : LEGEND(7)='Ignorer' 20 : 5 CONTINUE 20 : CALL MENU(LEGEND,7,8) 20 : CALL TRAFF(ICLE) 21 : IF (ICLE.GT.6) THEN 21 : CALL TRMESS('Erreur ! Recommencez') 22 : GOTO 5 23 : ENDIF 24 : IF (ICLE.EQ.6) THEN 25 : IREP=0 26 : RETURN 27 : ENDIF 27 : CALL REPERT('POINT ',NTABLE) 28 : SEGINI LISENT 29 : DO 5498 I=1,NTABLE 29 : CALL LIROBJ('POINT ',IP1,1,IRETOU) 30 : IF(IERR.NE.0) RETURN 31 : LISENT(I)=IP1 32 : 5498 CONTINUE 32 : CALL REPLIS('POINT ',MLCHA8) 33 : SEGACT MLCHA8 34 : LEGEND(1)=' ' 35 : LEGEND(2)='Cont' 36 : LEGEND(3)='Terminer' 36 : CALL MENU(LEGEND,3,8) 37 : IF (ICLE.EQ.1) THEN 37 : CALL TRLABL(0.,14.,0., 38 : >'Donnez le noms de trois points caracterisant le plan',52,1.) 38 : CALL TRAFF(ICLE) 39 : IF (ICLE.EQ.2) THEN 40 : IREP=0 41 : RETURN 42 : ENDIF 43 : 12 CONTINUE 43 : CALL TRGET('Donnez le nom du premier point :',ZONE) 44 : DO 10 I=1,MLCHAR(/2) 45 : IF(ZONE.NE.MLCHAR(I)) GO TO 10 46 : IP1=LISENT(I) 47 : GOTO 11 48 : 10 CONTINUE 48 : CALL TRMESS('Premier point incorrect') 48 : CALL TRAFF(ICLE) 49 : IF (ICLE.EQ.2) THEN 50 : IREP=0 51 : RETURN 52 : ENDIF 53 : GOTO 12 54 : 11 CONTINUE 54 : CALL TRGET('Donnez le nom du deuxieme point :',ZONE) 55 : DO 13 I=1,MLCHAR(/2) 56 : IF(ZONE.NE.MLCHAR(I)) GO TO 13 57 : IP2=LISENT(I) 58 : GOTO 14 59 : 13 CONTINUE 59 : CALL TRMESS('Deuxieme point incorrect') 59 : CALL TRAFF(ICLE) 60 : IF (ICLE.EQ.2) THEN 61 : IREP=0 62 : RETURN 63 : ENDIF 64 : GOTO 12 65 : 14 CONTINUE 65 : CALL TRGET('Donnez le nom du troisieme point :',ZONE) 66 : DO 15 I=1,MLCHAR(/2) 67 : IF(ZONE.NE.MLCHAR(I)) GO TO 15 68 : IP3=LISENT(I) 69 : GOTO 16 70 : 15 CONTINUE 70 : CALL TRMESS('Troisieme point incorrect') 70 : CALL TRAFF(ICLE) 71 : IF (ICLE.EQ.2) THEN 72 : IREP=0 73 : RETURN 74 : ENDIF 75 : GOTO 12 76 : 16 CONTINUE 77 : IREP=1 78 : SEGSUP LISENT,MLCHA8 79 : RETURN 80 : ENDIF 81 : IF (ICLE.EQ.2) THEN 81 : CALL TRLABL(0.,14.,0., 82 : >'Donnez les noms du centre et d un point de la sphere',51,1.) 82 : CALL TRAFF(ICLE) 83 : IF (ICLE.EQ.2) THEN 84 : IREP=0 85 : RETURN 86 : ENDIF 87 : 22 CONTINUE 87 : CALL TRGET('Donnez le nom du centre :',ZONE) 88 : DO 20 I=1,MLCHAR(/2) 89 : IF(ZONE.NE.MLCHAR(I)) GO TO 20 90 : IP1=LISENT(I) 91 : GOTO 21 92 : 20 CONTINUE 92 : CALL TRMESS('Centre incorrect') 92 : CALL TRAFF(ICLE) 93 : IF (ICLE.EQ.2) THEN 94 : IREP=0 95 : RETURN 96 : ENDIF 97 : GOTO 22 98 : 21 CONTINUE 98 : CALL TRGET('Donnez le nom du point :',ZONE) 99 : DO 23 I=1,MLCHAR(/2) 100 : IF(ZONE.NE.MLCHAR(I)) GO TO 23 101 : IP2=LISENT(I) 102 : GOTO 24 103 : 23 CONTINUE 103 : CALL TRMESS('Point incorrect') 103 : CALL TRAFF(ICLE) 104 : IF (ICLE.EQ.2) THEN 105 : IREP=0 106 : RETURN 107 : ENDIF 108 : GOTO 22 109 : 24 CONTINUE 110 : IREP=2 111 : SEGSUP LISENT,MLCHA8 112 : RETURN 113 : ENDIF 114 : IF (ICLE.EQ.3) THEN 114 : CALL TRLABL(0.,14.,0.,'Donnez le noms de deux points de l axe' 115 : * //'et d un point courant du cylindre',71,1.) 115 : CALL TRAFF(ICLE) 116 : IF (ICLE.EQ.2) THEN 117 : IREP=0 118 : RETURN 119 : ENDIF 120 : 32 CONTINUE 120 : CALL TRGET('Donnez le nom du premier point :',ZONE) 121 : DO 30 I=1,MLCHAR(/2) 122 : IF(ZONE.NE.MLCHAR(I)) GO TO 30 123 : IP1=LISENT(I) 124 : GOTO 31 125 : 30 CONTINUE 125 : CALL TRMESS('Premier point incorrect') 125 : CALL TRAFF(ICLE) 126 : IF (ICLE.EQ.2) THEN 127 : IREP=0 128 : RETURN 129 : ENDIF 130 : GOTO 32 131 : 31 CONTINUE 131 : CALL TRGET('Donnez le nom du deuxieme point :',ZONE) 132 : DO 33 I=1,MLCHAR(/2) 133 : IF(ZONE.NE.MLCHAR(I)) GO TO 33 134 : IP2=LISENT(I) 135 : GOTO 34 136 : 33 CONTINUE 136 : CALL TRMESS('Second point incorrect') 136 : CALL TRAFF(ICLE) 137 : IF (ICLE.EQ.2) THEN 138 : IREP=0 139 : RETURN 140 : ENDIF 141 : GOTO 32 142 : 34 CONTINUE 142 : CALL TRGET('Donnez le nom du point courant:',ZONE) 143 : DO 35 I=1,MLCHAR(/2) 144 : IF(ZONE.NE.MLCHAR(I)) GO TO 35 145 : IP3=LISENT(I) 146 : GOTO 36 147 : 35 CONTINUE 147 : CALL TRMESS('Point courant incorrect') 147 : CALL TRAFF(ICLE) 148 : IF (ICLE.EQ.2) THEN 149 : IREP=0 150 : RETURN 151 : ENDIF 152 : GOTO 32 153 : 36 CONTINUE 154 : IREP=3 155 : SEGSUP LISENT,MLCHA8 156 : RETURN 157 : ENDIF 158 : IF (ICLE.EQ.4) THEN 158 : CALL TRLABL(0.,14.,0.,'Donnez les noms du sommet, d un point de' 159 : * //' l axe et d un point courant du cone',76,1.) 159 : CALL TRAFF(ICLE) 160 : IF (ICLE.EQ.2) THEN 161 : IREP=0 162 : RETURN 163 : ENDIF 164 : 42 CONTINUE 164 : CALL TRGET('Donnez le nom du centre :',ZONE) 165 : DO 40 I=1,MLCHAR(/2) 166 : IF(ZONE.NE.MLCHAR(I)) GO TO 40 167 : IP1=LISENT(I) 168 : GOTO 41 169 : 40 CONTINUE 169 : CALL TRMESS('Centre incorrect') 169 : CALL TRAFF(ICLE) 170 : IF (ICLE.EQ.2) THEN 171 : IREP=0 172 : RETURN 173 : ENDIF 174 : GOTO 42 175 : 41 CONTINUE 175 : CALL TRGET('Donnez le nom d un point de l axe :',ZONE) 176 : DO 43 I=1,MLCHAR(/2) 177 : IF(ZONE.NE.MLCHAR(I)) GO TO 43 178 : IP2=LISENT(I) 179 : GOTO 44 180 : 43 CONTINUE 180 : CALL TRMESS('Point de l axe incorrect') 180 : CALL TRAFF(ICLE) 181 : IF (ICLE.EQ.2) THEN 182 : IREP=0 183 : RETURN 184 : ENDIF 185 : GOTO 42 186 : 44 CONTINUE 186 : CALL TRGET('Donnez le nom d un point courant :',ZONE) 187 : DO 45 I=1,MLCHAR(/2) 188 : IF(ZONE.NE.MLCHAR(I)) GO TO 45 189 : IP3=LISENT(I) 190 : GOTO 46 191 : 45 CONTINUE 191 : CALL TRMESS('Point courant incorrect') 191 : CALL TRAFF(ICLE) 192 : IF (ICLE.EQ.2) THEN 193 : IREP=0 194 : RETURN 195 : ENDIF 196 : GOTO 42 197 : 46 CONTINUE 198 : IREP=4 199 : SEGSUP LISENT,MLCHA8 200 : RETURN 201 : ENDIF 202 : IF (ICLE.EQ.5) THEN 202 : CALL TRLABL(0.,14.,0., 203 : > 'Donnez les noms du centre du tore, d un point de son axe',56,1.) 203 : CALL TRLABL(0.,12.,0., 204 : >', d un centre de petit cercle et d un point courant',51,1.) 204 : CALL TRAFF(ICLE) 205 : IF (ICLE.EQ.2) THEN 206 : IREP=0 207 : RETURN 208 : ENDIF 209 : 52 CONTINUE 209 : CALL TRGET('Donnez le nom du centre du tore :',ZONE) 210 : DO 50 I=1,MLCHAR(/2) 211 : IF(ZONE.NE.MLCHAR(I)) GO TO 50 212 : IP1=LISENT(I) 213 : GOTO 51 214 : 50 CONTINUE 214 : CALL TRMESS('Centre incorrect') 214 : CALL TRAFF(ICLE) 215 : IF (ICLE.EQ.2) THEN 216 : IREP=0 217 : RETURN 218 : ENDIF 219 : GOTO 52 220 : 51 CONTINUE 220 : CALL TRGET('Donnez le nom d un point de l axe :',ZONE) 221 : DO 53 I=1,MLCHAR(/2) 222 : IF(ZONE.NE.MLCHAR(I)) GO TO 53 223 : IP2=LISENT(I) 224 : GOTO 54 225 : 53 CONTINUE 225 : CALL TRMESS('Point de l axe incorrect') 225 : CALL TRAFF(ICLE) 226 : IF (ICLE.EQ.2) THEN 227 : IREP=0 228 : RETURN 229 : ENDIF 230 : GOTO 52 231 : 54 CONTINUE 231 : CALL TRGET('Donnez le nom d un centre de petit ' 232 : * //'cercle :',ZONE) 233 : DO 55 I=1,MLCHAR(/2) 234 : IF(ZONE.NE.MLCHAR(I)) GO TO 55 235 : IP3=LISENT(I) 236 : GOTO 56 237 : 55 CONTINUE 237 : CALL TRMESS('Petit cercle incorrect') 237 : CALL TRAFF(ICLE) 238 : IF (ICLE.EQ.2) THEN 239 : IREP=0 240 : RETURN 241 : ENDIF 242 : GOTO 52 243 : 56 CONTINUE 243 : CALL TRGET('Donnez le nom d un point courant :',ZONE) 244 : DO 57 I=1,MLCHAR(/2) 245 : IF(ZONE.NE.MLCHAR(I)) GO TO 57 246 : IP4=LISENT(I) 247 : GOTO 58 248 : 57 CONTINUE 248 : CALL TRMESS('Point courant incorrect') 248 : CALL TRAFF(ICLE) 249 : IF (ICLE.EQ.2) THEN 250 : IREP=0 251 : RETURN 252 : ENDIF 253 : GOTO 52 254 : 58 CONTINUE 255 : IREP=5 256 : SEGSUP LISENT,MLCHA8 257 : RETURN 258 : ENDIF 259 : END 260 : 261 :
© Cast3M 2003 - All rights reserved.
Disclaimer