Télécharger optdes.eso

Retour à la liste

Numérotation des lignes :

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

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