Télécharger optdes.eso

Retour à la liste

Numérotation des lignes :

  1. C OPTDES SOURCE BP208322 19/12/06 21:15:08 10419
  2. SUBROUTINE OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,
  3. & TTXX,TTXXX,TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,
  4. & DYN,NDIMT,CUR,NDIMT2,NC,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,
  5. & IPOSI,XPOSI,YPOSI,IGRIL)
  6. *=============================================================
  7. *
  8. * TESTS POUR L'EVOLUTION DE DESSIN
  9. *
  10. *=============================================================
  11. *
  12. * Modifications :
  13. *
  14. * 05 sept. 2007 Maugis
  15. * Maintien du segment AXE actif en modification
  16. *
  17. *=============================================================
  18. *
  19. * Entrée : Cf. dessin.eso
  20. *
  21. *=============================================================
  22.  
  23. IMPLICIT LOGICAL (Z)
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8 (A-H,O-S,U-Y)
  26.  
  27. CHARACTER*72 TITRE,TXTIT,BUFFER,CHOPT,TIME
  28. CHARACTER*20 TXAXE,TYAXE
  29. CHARACTER*72 TITOPT
  30. c LOGICAL VALEUR
  31. REAL RXDIM,RYDIM,HMIN
  32. CHARACTER*8 CTYPE,CHVIDE,ETYPE,MTYPI,MTYPR,CHARR
  33. LOGICAL ZGRIL1,ZREMP2
  34. DATA IGRAND / 100000000 /
  35.  
  36. -INC CCOPTIO
  37. -INC SMEVOLL
  38. -INC SMLREEL
  39. -INC CCGEOME
  40. -INC TMAXE
  41. -INC SMTABLE
  42.  
  43. SEGMENT DYN
  44. LOGICAL ZTRACE(NDIMT)
  45. ENDSEGMENT
  46. SEGMENT CUR
  47. LOGICAL ZCUR(NDIMT2)
  48. ENDSEGMENT
  49. NOL =25
  50. ETYPE(1:8) ='ENTIER '
  51. CHVIDE(1:8)=' '
  52. ZREMP2 =.FALSE.
  53.  
  54.  
  55. *=============================================================
  56. * MARGE PROPORTIONNELLE A LA GRADUATION DE LA FENETRE USER
  57. *=============================================================
  58. *
  59. SEGACT AXE*MOD
  60.  
  61. D=ABS(XSUP-XINF)
  62. IF (ZCARRE) THEN
  63. BG=0.14*REAL(D)
  64. BD=0.55*REAL(D)
  65. ELSE
  66. BG=0.10*REAL(D)
  67. BD=0.10*REAL(D)
  68. ENDIF
  69.  
  70. D=ABS(YSUP-YINF)
  71. BH=0.08*REAL(D)
  72. BB=0.13*REAL(D)
  73.  
  74.  
  75. *=============================================================
  76. * DEFINITION FENETRE
  77. *=============================================================
  78. *
  79. c DIOCAD = taille du cadre include CCOPTIO
  80. XDIM = DIOCAD * .9D0*29.D0 / 30.D0 *1.134D0
  81. YDIM = DIOCAD * .9D0*21.D0 / 30.D0 *1.08D0
  82. IF (XSUP.LE.XINF) GOTO 950
  83. IF (YSUP.LE.YINF) GOTO 950
  84. RXDIM=XDIM
  85. RYDIM=YDIM
  86. IF (TXTIT.NE.' ') TITRE=TXTIT
  87. NCOUMA=NBCOUL
  88. c appel a trinit pour definir les bonnes ENTRY selon IOGRA
  89. CALL TRINIT (NOL,RXDIM,RYDIM,TITRE,.15,.false.,NCOUMA)
  90.  
  91. c definition de la fenetre
  92. TTX1=REAL(XINF)-BG
  93. TTX2=REAL(XSUP)+BD
  94. TTX3=REAL(YINF)-BB
  95. TTX4=REAL(YSUP)+BH
  96. CALL DFENET (TTX1,TTX2,TTX3,TTX4,-1.,+1.,TTXX,TTXXX,TTYY,TTYYY,
  97. > .FALSE.)
  98. XX =DBLE(TTXX)
  99. XXX=DBLE(TTXXX)
  100. YY =DBLE(TTYY)
  101. YYY=DBLE(TTYYY)
  102. IF (TXAXE.NE.' ') TITREX=TXAXE
  103. IF (TYAXE.NE.' ') TITREY=TYAXE
  104.  
  105. *=============================================================
  106. * CONSTRUCTION DE L'AXE
  107. *=============================================================
  108. CALL TRBOX(0.7,0.7)
  109. CALL DAXES(AXE,ZAXES,IGRIL)
  110. CALL TRBOX(1./0.7,1./0.7)
  111.  
  112. *=============================================================
  113. * AFFICHAGES DIVERS
  114. *=============================================================
  115. *
  116. * AFFICHAGE DU MINIMUM ET DU MAXIMUM
  117. *
  118. IF (ZMIMA) THEN
  119. CALL TRBOX(0.7,0.7)
  120. TYY=REAL(YSUP)+BH/4.
  121. TXX=REAL(XINF+(XSUP-XINF)*2.D0/3.D0)
  122. BUFFER(1:10)='MINIMUM : '
  123. WRITE (BUFFER(11:21),FMT='(G11.4)') YMINI
  124. CALL TRLABL (TXX,TYY,0.,BUFFER,21,HMIN)
  125. BUFFER(1:10)='MAXIMUM : '
  126. TYY=YSUP+(BH/1.8)
  127. TXX=XINF+(XSUP-XINF)*2/3
  128. WRITE (BUFFER(11:21),FMT='(G11.4)') YMAXI
  129. CALL TRLABL (TXX,TYY,0.,BUFFER,21,HMIN)
  130. CALL TRBOX(1./0.7,1./0.7)
  131. ENDIF
  132. *
  133. * AFFICHAGE DE LA DATE
  134. *
  135. IF (ZDATE) THEN
  136. CALL GIBDAT(JOUR,MOIS,IANNEE)
  137. iannee=mod(iannee,100)
  138. **TC TIME=FDATE()
  139. BUFFER(1:22)=' / /20 '
  140. WRITE (BUFFER(4:5),FMT='(I2)') JOUR
  141. WRITE (BUFFER(7:8),FMT='(I2)') MOIS
  142. WRITE (BUFFER(12:13),FMT='(I2)') IANNEE
  143. **TC WRITE (BUFFER(15:22),FMT='(A8)') TIME(12:20)
  144. cbp : cette position ne me semble pas tres esthetique ....
  145. c TXX=TTXXX-0.98*(TTXXX-TTXX)
  146. c TYY=TTYY +0.02*(TTYYY-TTYY)
  147. IF (ZCARRE) THEN
  148. TXX=REAL(XSUP)-(13.5*.017*(XSUP-XINF))
  149. ELSE
  150. TXX=REAL(XSUP)-(14.*.011*(XSUP-XINF))
  151. ENDIF
  152. TYY=REAL(YSUP)+(.05*(YSUP-YINF))
  153. CALL TRBOX(0.8,0.8)
  154. CALL TRLABL(TXX,TYY,0.,BUFFER(1:22),22,HMIN)
  155. CALL TRBOX(1./0.8,1./0.8)
  156. ENDIF
  157.  
  158.  
  159. *=============================================================
  160. * TRACE DES COURBES
  161. *=============================================================
  162. MEVOLL=IEV
  163. SEGACT MEVOLL
  164. CTYPE(1:8)=' '
  165. NCT=0
  166. NLG=0
  167. *
  168. * TRACES SEPARES ====================================
  169. *
  170. IF (ZSEPAR) THEN
  171.  
  172. IPTR=IEVOLL(NC)
  173. KEVOLL=IPTR
  174. segact,KEVOLL
  175. *
  176. * RECHERCHE EVENTUELLE DES PARAMETRES SPECIFIQUES
  177. *
  178. IF (ZOPTIO) THEN
  179. CALL ACCTAB(IOPTIO,ETYPE,NC,X,CHVIDE,Z,II,CTYPE,ILG,XX,CHOPT,
  180. # ZZ,III)
  181. IF (CTYPE(1:3).NE.'MOT') CHOPT=''''
  182. c valeurs par defaut
  183. c TITOPT(1:20)=' '
  184. TITOPT(1:72)=KEVTEX(1:72)
  185. IDEB1=0
  186. IFIN1=IGRAND
  187. ISTYL=0
  188. c variables bidons
  189. IVALI=0
  190. XVALI=0.D0
  191. IRETI=0
  192. IVALR=0
  193. XVALR=0.D0
  194. IRETR=0
  195. MTYPI='MOT '
  196. MTYPR=' '
  197. ITITOP=0
  198. CHARR=' '
  199. c lecture d'un titre de legende
  200. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'TITRE',.TRUE.,IRETI,
  201. * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  202. IF(MTYPR(1:5).EQ.'TABLE')THEN
  203. MTAB1=IRETR
  204. c SEGACT MTAB1
  205. CTYPE(1:8)=' '
  206. CALL ACCTAB(MTAB1,ETYPE,NC,X,CHVIDE,Z,II,CTYPE,ILG,XX,
  207. # TITOPT, ZZ,III)
  208. IF(CTYPE(1:3).NE.'MOT') TITOPT(1:72)='PAS DE LEGENDE'
  209. ENDIF
  210. c lecture des points initial et final --> IDEB1 et IFIN1
  211. MTYPR=' '
  212. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'INITIAL',.TRUE.,IRETI,
  213. * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  214. IF(MTYPR(1:5).EQ.'TABLE')THEN
  215. MTAB1=IRETR
  216. CTYPE(1:8)=' '
  217. CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,
  218. # CTYPE,IDEB1,XX,CHARR,ZZ,III)
  219. IF(CTYPE(1:6).NE.'ENTIER')IDEB1=0
  220. ENDIF
  221. MTYPR=' '
  222. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'FINAL',.TRUE.,IRETI,
  223. * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  224. IF(MTYPR(1:5).EQ.'TABLE')THEN
  225. MTAB1=IRETR
  226. CTYPE(1:8)=' '
  227. CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,
  228. # CTYPE,IFIN1,XX,CHARR,ZZ,III)
  229. IF(CTYPE(1:6).NE.'ENTIER')IFIN1=IGRAND
  230. ENDIF
  231. c lecture d un type de trait variable
  232. MTYPR=' '
  233. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'LIGNE_VARIABLE',.TRUE.
  234. * ,IRETI,MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  235. IF(MTYPR(1:5).EQ.'TABLE')THEN
  236. MTAB1=IRETR
  237. CTYPE(1:8)=' '
  238. CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,
  239. # CTYPE,IVALR,XVALR,CHARR,ZZ,ISTYL)
  240. IF(CTYPE(1:8).NE.'LISTENTI') ISTYL=0
  241. ENDIF
  242. ELSE
  243. CHOPT(1:72)=' '
  244. c TITOPT(1:20)=' '
  245. TITOPT(1:72)=KEVTEX(1:72)
  246. IDEB1=0
  247. IFIN1=IGRAND
  248. ISTYL=0
  249. ENDIF
  250. *PM SEGDES AXE
  251. CALL TRBOX(0.7,0.7)
  252. CALL TREVOL (AXE,IPTR,CHOPT,TITOPT,ZLEGEN,NCT,NLG,INBEVO
  253. & ,IPOSI,XPOSI,YPOSI,ZREMP2,IDEB1,IFIN1,ISTYL)
  254.  
  255. CALL TRBOX(1./0.7,1./0.7)
  256. *PM SEGACT AXE*MOD
  257.  
  258. *
  259. * CAS DES CURVILIGNES
  260. *
  261. IF (ZCUR(NC+1)) THEN
  262. * On affiche le long de l'axe des abscisses, avec des marqueurs,
  263. * les noms des points nommés rencontrés
  264. *PM SEGDES AXE
  265. CALL TRBOX(0.7,0.7)
  266. IPTR=IEVOLL(NC+1)
  267. CALL TRCUR(AXE,IPTR)
  268. CALL TRBOX(1./0.7,1./0.7)
  269. *PM SEGACT AXE*MOD
  270. ENDIF
  271. *
  272.  
  273. *
  274. * TRACES SIMULTANES ====================================
  275. *
  276. ELSE
  277.  
  278. KK=0
  279. DO 49 I=1,INBEVO
  280.  
  281. IF (ZTRACE(I)) THEN
  282.  
  283. KK=KK+1
  284. IPTR=IEVOLL(I)
  285. KEVOLL=IPTR
  286. segact,KEVOLL
  287. *
  288. * RECHERCHE EVENTUELLE DES PARAMETRES SPECIFIQUES
  289. *
  290. IF (ZOPTIO) THEN
  291.  
  292. c lecture des options (lign, marqueures etc...) --> CHOPT
  293. CTYPE(1:8)=' '
  294. CALL ACCTAB(IOPTIO,ETYPE,KK,X,CHVIDE,Z,II,CTYPE,ILG,XX,
  295. # CHOPT,ZZ,III)
  296.  
  297. IF (CTYPE(1:3).NE.'MOT') CHOPT=' '
  298. c TITOPT(1:20)=' '
  299. c valeurs par defaut
  300. TITOPT(1:72)=KEVTEX(1:72)
  301. IDEB1=0
  302. IFIN1=IGRAND
  303. ISTYL=0
  304. c variables bidons
  305. IVALI=0
  306. XVALI=0.D0
  307. IRETI=0
  308. IVALR=0
  309. XVALR=0.D0
  310. IRETR=0
  311. MTYPI='MOT '
  312. MTYPR=' '
  313. ITITOP=0
  314. CHARR=' '
  315. c lecture d'un titre de legende --> TITOPT
  316. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'TITRE',.TRUE.,IRETI,
  317. * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  318. IF(MTYPR(1:5).EQ.'TABLE')THEN
  319. MTAB1=IRETR
  320. c SEGACT MTAB1
  321. CTYPE(1:8)=' '
  322. CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,CTYPE,ILG,XX,
  323. # TITOPT,ZZ,III)
  324. IF(CTYPE(1:3).NE.'MOT')TITOPT(1:72)=' '
  325. ENDIF
  326. c lecture des points initial et final --> IDEB1 et IFIN1
  327. MTYPR=' '
  328. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'INITIAL',.TRUE.,IRETI,
  329. * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  330. IF(MTYPR(1:5).EQ.'TABLE')THEN
  331. MTAB1=IRETR
  332. CTYPE(1:8)=' '
  333. CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,
  334. # CTYPE,IDEB1,XX,CHARR,ZZ,III)
  335. IF(CTYPE(1:6).NE.'ENTIER')IDEB1=0
  336. ENDIF
  337. MTYPR=' '
  338. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'FINAL',.TRUE.,IRETI,
  339. * MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  340. IF(MTYPR(1:5).EQ.'TABLE')THEN
  341. MTAB1=IRETR
  342. CTYPE(1:8)=' '
  343. CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,
  344. # CTYPE,IFIN1,XX,CHARR,ZZ,III)
  345. IF(CTYPE(1:6).NE.'ENTIER')IFIN1=IGRAND
  346. ENDIF
  347. c lecture d un type de trait variable
  348. MTYPR=' '
  349. CALL ACCTAB(IOPTIO,MTYPI,IVALI,X,'LIGNE_VARIABLE',.TRUE.
  350. * ,IRETI,MTYPR,IVALR,XVALR,CHARR,ZZ,IRETR)
  351. IF(MTYPR(1:5).EQ.'TABLE')THEN
  352. MTAB1=IRETR
  353. CTYPE(1:8)=' '
  354. CALL ACCTAB(MTAB1,ETYPE,KK,X,CHVIDE,Z,II,
  355. # CTYPE,IVALR,XVALR,CHARR,ZZ,ISTYL)
  356. IF(CTYPE(1:8).NE.'LISTENTI') ISTYL=0
  357. ENDIF
  358. ELSE
  359. CHOPT(1:72)=' '
  360. c TITOPT(1:20)=' '
  361. TITOPT(1:72)=KEVTEX(1:72)
  362. IDEB1=0
  363. IFIN1=IGRAND
  364. ISTYL=0
  365. ENDIF
  366. *PM SEGDES AXE
  367. CALL TRBOX(0.7,0.7)
  368. CALL TREVOL (AXE,IPTR,CHOPT,TITOPT,ZLEGEN,NCT,NLG,INBEVO
  369. & ,IPOSI,XPOSI,YPOSI,ZREMP2,IDEB1,IFIN1,ISTYL)
  370. CALL TRBOX(1./0.7,1./0.7)
  371. *PM SEGACT AXE*MOD
  372. ENDIF
  373. *
  374. * CAS DES CURVILIGNES
  375. *
  376. IF (ZCUR(I)) THEN
  377. * On affiche le long de l'axe des abscisses, avec des marqueurs,
  378. * les noms des points nommés rencontrés
  379. *PM SEGDES AXE
  380. CALL TRBOX(0.7,0.7)
  381. IPTR=IEVOLL(I)
  382. CALL TRCUR(AXE,IPTR)
  383. CALL TRBOX(1./0.7,1./0.7)
  384. *PM SEGACT AXE*MOD
  385. ENDIF
  386. 49 CONTINUE
  387. *
  388. ENDIF
  389. SEGDES MEVOLL
  390.  
  391. *=============================================================
  392. * On redessine les axes sans grille pour repasser sur d'éventuelles
  393. * ombres
  394. *=============================================================
  395. IF(ZREMP2) THEN
  396. CALL TRBOX(0.7,0.7)
  397. ZGRIL1=ZGRILL
  398. ZGRILL=.FALSE.
  399. CALL DAXES(AXE,ZAXES,IGRIL)
  400. ZGRILL=ZGRIL1
  401. CALL TRBOX (1./0.7,1./0.7)
  402. ENDIF
  403. RETURN
  404.  
  405. * L'intervalle entre les bornes est trop faible.
  406. 950 CALL ERREUR (497)
  407. END
  408.  
  409.  
  410.  

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