Télécharger optdes.eso

Retour à la liste

Numérotation des lignes :

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

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