Télécharger moin.eso

Retour à la liste

Numérotation des lignes :

  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)
  12. CALL TRLABL(0.,20.,0.,'Directive MODI - Cas du 3D',26,1.)
  13. CALL TRLABL(0.,18.,0.,'Vous pouvez reprojeter en sortie de MODI'
  14. * ,40,1.)
  15. CALL TRLABL(0.,16.,0.,'les points deplaces sur une surface',35,1.)
  16. LEGEND(1)=' '
  17. LEGEND(2)='Plan'
  18. LEGEND(3)='Sphere'
  19. LEGEND(4)='Cylindre'
  20. LEGEND(5)='Cone'
  21. LEGEND(6)='Tore'
  22. LEGEND(7)='Ignorer'
  23. 5 CONTINUE
  24. CALL MENU(LEGEND,7,8)
  25. CALL TRAFF(ICLE)
  26. IF (ICLE.GT.6) THEN
  27. CALL TRMESS('Erreur ! Recommencez')
  28. GOTO 5
  29. ENDIF
  30. IF (ICLE.EQ.6) THEN
  31. IREP=0
  32. RETURN
  33. ENDIF
  34. CALL REPERT('POINT ',NTABLE)
  35. SEGINI LISENT
  36. DO 5498 I=1,NTABLE
  37. CALL LIROBJ('POINT ',IP1,1,IRETOU)
  38. IF(IERR.NE.0) RETURN
  39. LISENT(I)=IP1
  40. 5498 CONTINUE
  41. CALL REPLIS('POINT ',MLCHA8)
  42. SEGACT MLCHA8
  43. LEGEND(1)=' '
  44. LEGEND(2)='Cont'
  45. LEGEND(3)='Terminer'
  46. CALL MENU(LEGEND,3,8)
  47. IF (ICLE.EQ.1) THEN
  48. CALL TRLABL(0.,14.,0.,
  49. >'Donnez le noms de trois points caracterisant le plan',52,1.)
  50. CALL TRAFF(ICLE)
  51. IF (ICLE.EQ.2) THEN
  52. IREP=0
  53. RETURN
  54. ENDIF
  55. 12 CONTINUE
  56. CALL TRGET('Donnez le nom du premier point :',ZONE)
  57. DO 10 I=1,MLCHAR(/2)
  58. IF(ZONE.NE.MLCHAR(I)) GO TO 10
  59. IP1=LISENT(I)
  60. GOTO 11
  61. 10 CONTINUE
  62. CALL TRMESS('Premier point incorrect')
  63. CALL TRAFF(ICLE)
  64. IF (ICLE.EQ.2) THEN
  65. IREP=0
  66. RETURN
  67. ENDIF
  68. GOTO 12
  69. 11 CONTINUE
  70. CALL TRGET('Donnez le nom du deuxieme point :',ZONE)
  71. DO 13 I=1,MLCHAR(/2)
  72. IF(ZONE.NE.MLCHAR(I)) GO TO 13
  73. IP2=LISENT(I)
  74. GOTO 14
  75. 13 CONTINUE
  76. CALL TRMESS('Deuxieme point incorrect')
  77. CALL TRAFF(ICLE)
  78. IF (ICLE.EQ.2) THEN
  79. IREP=0
  80. RETURN
  81. ENDIF
  82. GOTO 12
  83. 14 CONTINUE
  84. CALL TRGET('Donnez le nom du troisieme point :',ZONE)
  85. DO 15 I=1,MLCHAR(/2)
  86. IF(ZONE.NE.MLCHAR(I)) GO TO 15
  87. IP3=LISENT(I)
  88. GOTO 16
  89. 15 CONTINUE
  90. CALL TRMESS('Troisieme point incorrect')
  91. CALL TRAFF(ICLE)
  92. IF (ICLE.EQ.2) THEN
  93. IREP=0
  94. RETURN
  95. ENDIF
  96. GOTO 12
  97. 16 CONTINUE
  98. IREP=1
  99. SEGSUP LISENT,MLCHA8
  100. RETURN
  101. ENDIF
  102. IF (ICLE.EQ.2) THEN
  103. CALL TRLABL(0.,14.,0.,
  104. >'Donnez les noms du centre et d un point de la sphere',51,1.)
  105. CALL TRAFF(ICLE)
  106. IF (ICLE.EQ.2) THEN
  107. IREP=0
  108. RETURN
  109. ENDIF
  110. 22 CONTINUE
  111. CALL TRGET('Donnez le nom du centre :',ZONE)
  112. DO 20 I=1,MLCHAR(/2)
  113. IF(ZONE.NE.MLCHAR(I)) GO TO 20
  114. IP1=LISENT(I)
  115. GOTO 21
  116. 20 CONTINUE
  117. CALL TRMESS('Centre incorrect')
  118. CALL TRAFF(ICLE)
  119. IF (ICLE.EQ.2) THEN
  120. IREP=0
  121. RETURN
  122. ENDIF
  123. GOTO 22
  124. 21 CONTINUE
  125. CALL TRGET('Donnez le nom du point :',ZONE)
  126. DO 23 I=1,MLCHAR(/2)
  127. IF(ZONE.NE.MLCHAR(I)) GO TO 23
  128. IP2=LISENT(I)
  129. GOTO 24
  130. 23 CONTINUE
  131. CALL TRMESS('Point incorrect')
  132. CALL TRAFF(ICLE)
  133. IF (ICLE.EQ.2) THEN
  134. IREP=0
  135. RETURN
  136. ENDIF
  137. GOTO 22
  138. 24 CONTINUE
  139. IREP=2
  140. SEGSUP LISENT,MLCHA8
  141. RETURN
  142. ENDIF
  143. IF (ICLE.EQ.3) THEN
  144. CALL TRLABL(0.,14.,0.,'Donnez le noms de deux points de l axe'
  145. * //'et d un point courant du cylindre',71,1.)
  146. CALL TRAFF(ICLE)
  147. IF (ICLE.EQ.2) THEN
  148. IREP=0
  149. RETURN
  150. ENDIF
  151. 32 CONTINUE
  152. CALL TRGET('Donnez le nom du premier point :',ZONE)
  153. DO 30 I=1,MLCHAR(/2)
  154. IF(ZONE.NE.MLCHAR(I)) GO TO 30
  155. IP1=LISENT(I)
  156. GOTO 31
  157. 30 CONTINUE
  158. CALL TRMESS('Premier point incorrect')
  159. CALL TRAFF(ICLE)
  160. IF (ICLE.EQ.2) THEN
  161. IREP=0
  162. RETURN
  163. ENDIF
  164. GOTO 32
  165. 31 CONTINUE
  166. CALL TRGET('Donnez le nom du deuxieme point :',ZONE)
  167. DO 33 I=1,MLCHAR(/2)
  168. IF(ZONE.NE.MLCHAR(I)) GO TO 33
  169. IP2=LISENT(I)
  170. GOTO 34
  171. 33 CONTINUE
  172. CALL TRMESS('Second point incorrect')
  173. CALL TRAFF(ICLE)
  174. IF (ICLE.EQ.2) THEN
  175. IREP=0
  176. RETURN
  177. ENDIF
  178. GOTO 32
  179. 34 CONTINUE
  180. CALL TRGET('Donnez le nom du point courant:',ZONE)
  181. DO 35 I=1,MLCHAR(/2)
  182. IF(ZONE.NE.MLCHAR(I)) GO TO 35
  183. IP3=LISENT(I)
  184. GOTO 36
  185. 35 CONTINUE
  186. CALL TRMESS('Point courant incorrect')
  187. CALL TRAFF(ICLE)
  188. IF (ICLE.EQ.2) THEN
  189. IREP=0
  190. RETURN
  191. ENDIF
  192. GOTO 32
  193. 36 CONTINUE
  194. IREP=3
  195. SEGSUP LISENT,MLCHA8
  196. RETURN
  197. ENDIF
  198. IF (ICLE.EQ.4) THEN
  199. CALL TRLABL(0.,14.,0.,'Donnez les noms du sommet, d un point de'
  200. * //' l axe et d un point courant du cone',76,1.)
  201. CALL TRAFF(ICLE)
  202. IF (ICLE.EQ.2) THEN
  203. IREP=0
  204. RETURN
  205. ENDIF
  206. 42 CONTINUE
  207. CALL TRGET('Donnez le nom du centre :',ZONE)
  208. DO 40 I=1,MLCHAR(/2)
  209. IF(ZONE.NE.MLCHAR(I)) GO TO 40
  210. IP1=LISENT(I)
  211. GOTO 41
  212. 40 CONTINUE
  213. CALL TRMESS('Centre incorrect')
  214. CALL TRAFF(ICLE)
  215. IF (ICLE.EQ.2) THEN
  216. IREP=0
  217. RETURN
  218. ENDIF
  219. GOTO 42
  220. 41 CONTINUE
  221. CALL TRGET('Donnez le nom d un point de l axe :',ZONE)
  222. DO 43 I=1,MLCHAR(/2)
  223. IF(ZONE.NE.MLCHAR(I)) GO TO 43
  224. IP2=LISENT(I)
  225. GOTO 44
  226. 43 CONTINUE
  227. CALL TRMESS('Point de l axe incorrect')
  228. CALL TRAFF(ICLE)
  229. IF (ICLE.EQ.2) THEN
  230. IREP=0
  231. RETURN
  232. ENDIF
  233. GOTO 42
  234. 44 CONTINUE
  235. CALL TRGET('Donnez le nom d un point courant :',ZONE)
  236. DO 45 I=1,MLCHAR(/2)
  237. IF(ZONE.NE.MLCHAR(I)) GO TO 45
  238. IP3=LISENT(I)
  239. GOTO 46
  240. 45 CONTINUE
  241. CALL TRMESS('Point courant incorrect')
  242. CALL TRAFF(ICLE)
  243. IF (ICLE.EQ.2) THEN
  244. IREP=0
  245. RETURN
  246. ENDIF
  247. GOTO 42
  248. 46 CONTINUE
  249. IREP=4
  250. SEGSUP LISENT,MLCHA8
  251. RETURN
  252. ENDIF
  253. IF (ICLE.EQ.5) THEN
  254. CALL TRLABL(0.,14.,0.,
  255. > 'Donnez les noms du centre du tore, d un point de son axe',56,1.)
  256. CALL TRLABL(0.,12.,0.,
  257. >', d un centre de petit cercle et d un point courant',51,1.)
  258. CALL TRAFF(ICLE)
  259. IF (ICLE.EQ.2) THEN
  260. IREP=0
  261. RETURN
  262. ENDIF
  263. 52 CONTINUE
  264. CALL TRGET('Donnez le nom du centre du tore :',ZONE)
  265. DO 50 I=1,MLCHAR(/2)
  266. IF(ZONE.NE.MLCHAR(I)) GO TO 50
  267. IP1=LISENT(I)
  268. GOTO 51
  269. 50 CONTINUE
  270. CALL TRMESS('Centre incorrect')
  271. CALL TRAFF(ICLE)
  272. IF (ICLE.EQ.2) THEN
  273. IREP=0
  274. RETURN
  275. ENDIF
  276. GOTO 52
  277. 51 CONTINUE
  278. CALL TRGET('Donnez le nom d un point de l axe :',ZONE)
  279. DO 53 I=1,MLCHAR(/2)
  280. IF(ZONE.NE.MLCHAR(I)) GO TO 53
  281. IP2=LISENT(I)
  282. GOTO 54
  283. 53 CONTINUE
  284. CALL TRMESS('Point de l axe incorrect')
  285. CALL TRAFF(ICLE)
  286. IF (ICLE.EQ.2) THEN
  287. IREP=0
  288. RETURN
  289. ENDIF
  290. GOTO 52
  291. 54 CONTINUE
  292. CALL TRGET('Donnez le nom d un centre de petit '
  293. * //'cercle :',ZONE)
  294. DO 55 I=1,MLCHAR(/2)
  295. IF(ZONE.NE.MLCHAR(I)) GO TO 55
  296. IP3=LISENT(I)
  297. GOTO 56
  298. 55 CONTINUE
  299. CALL TRMESS('Petit cercle incorrect')
  300. CALL TRAFF(ICLE)
  301. IF (ICLE.EQ.2) THEN
  302. IREP=0
  303. RETURN
  304. ENDIF
  305. GOTO 52
  306. 56 CONTINUE
  307. CALL TRGET('Donnez le nom d un point courant :',ZONE)
  308. DO 57 I=1,MLCHAR(/2)
  309. IF(ZONE.NE.MLCHAR(I)) GO TO 57
  310. IP4=LISENT(I)
  311. GOTO 58
  312. 57 CONTINUE
  313. CALL TRMESS('Point courant incorrect')
  314. CALL TRAFF(ICLE)
  315. IF (ICLE.EQ.2) THEN
  316. IREP=0
  317. RETURN
  318. ENDIF
  319. GOTO 52
  320. 58 CONTINUE
  321. IREP=5
  322. SEGSUP LISENT,MLCHA8
  323. RETURN
  324. ENDIF
  325. END
  326.  
  327.  
  328.  

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