Télécharger dessin.eso

Retour à la liste

Numérotation des lignes :

  1. C DESSIN SOURCE GF238795 18/02/01 21:15:06 9724
  2. SUBROUTINE DESSIN
  3. *=============================================================
  4. *
  5. * Dessine une evolution
  6. *
  7. *=============================================================
  8. *
  9. * Modifications
  10. *
  11. * 95/02/07, Loca :
  12. * pour passer les legendes x et y de 12 a 20 caracteres:
  13. * SEGMENT AXE disparait et est appele en include: -INC TMAXE.
  14. *
  15. * 03/03/14, maugis :
  16. * correction de la position du logo en cas de zoom.
  17. *
  18. * 07/09/04, maugis :
  19. * fourniture du choix des courbes via un LISTENTI
  20. * Maintien du segment AXE actif en modification
  21. * Resolution pb de zoom en logarithmique avec des valeurs
  22. * inferieures a 0.
  23. * Resolution erreur 497 quand 2 clics zoom hors cadre
  24. *
  25. *=============================================================
  26. *
  27. * LISTE DES FONCTIONS :
  28. *
  29. * MINMAX : RETOURNE MINI ET MAXI D'UNE LISTE DE REELS
  30. * BORAXE : CALCUL DES ARRONDIS DE BORNES D'AXES
  31. * INTAXE : CALCUL POUR EFFECTUER LA GRADUATION
  32. * DAXES : DESSIN DES AXES
  33. * ICALP : FONCTION POUR CALCUL DES BORNES D'AXES
  34. * TREVOL : DESSIN D'UNE EVOLUTION
  35. * TRSEG : TRACE DUN SEGMENT DE DROITE
  36. * EXTRAC : EXTRACTION D'UN MOT DANS UNE CHAINE
  37. * LINEAX : LINEARISATION EN X
  38. * LINEAY : LINEARISATION EN Y
  39. * DMARQ : DESSINE DES MARQUEURS
  40. * TRCUR : TRACER DES NOMS EN CAS D'ABSCISSE CURVILIGNE
  41. * TRINIT ET SES FONCTIONS (definies selon la sortie graphique)
  42. *
  43. *=============================================================
  44. *
  45. * LISTE DES VARIABLES :
  46. *
  47. * --- affichage interactif ---
  48. * BMIN,BMAX HAUTEUR DE CARACTERE POUR LES E/S GRAPHIQUES
  49. * BUFFER(X) CHAINE DE CARACTERE POUR LES E/S
  50. * TX,TY TABLES POUR DESSINER UN INDEX L'AIDE DE POLRL
  51. * TXX(X),TYY(X) POSITION POUR LES E/S DES BUFFERS
  52. * ZINDEX INDEX SUR COURBE
  53. * ZLIEN LIEN SUR UN COMMENTAIRE
  54. *
  55. * --- axe ---
  56. * AXE SEGMENT AXE DE TMAXE.INC
  57. * OLDAXE AXE DE SAUVEGARDE POUR RETOUR APRES UN ZOOM
  58. * IPOSX, IPOSY position predefinie du titre des axes X, Y
  59. * TITREX, TITREY TITRE DES AXES X, Y
  60. * XINT YINT GRADUATION ELEMENTAIRE DES AXES X, Y
  61. * ZLOGX, ZLOGY AXE X, Y EN LOG
  62. * ZXFORC, ZYFORC BORNES SUR L'AXE X, Y IMPOSEES
  63. * ZXGRA, ZYGRA graduation sur l'axe X, Y imposee
  64. *
  65. * --- calcul, divers ---
  66. * YMAXI MAXIMUM EN Y SUR L'ENSEMBLE DES EVOLUTIONS
  67. * YMINI MINIMUM EN Y SUR L'ENSEMBLE DES EVOLUTIONS
  68. * ZMIMA AFFICHAGE DU MINIMUM ET DU MAXIMUM
  69. * ZARR SYSTEME D'ARRONDI NON NORMALISE
  70. * ZDATE AFFICHAGE DE LA DATE
  71. * ZHEURE AFFICHAGE DE L'HEURE
  72. * ZLOGO DESSIN DU LOGO
  73. *
  74. * --- general ---
  75. * IPTR POINTEUR UTILISE POUR EVITER LES PBS ESOPE DUS A
  76. * L'ECHANGE D'ARGUMENTS INCLUS DANS DES SEGMENTS
  77. * NOL NUMERO D'ORDRE LOGIQUE DE LA FENETRE
  78. * XDIM,YDIM PARAMETRES POUR TABT (TAILLE PAPIER)
  79. * ZSEPAR TRACE SEPARE DES COURBES
  80. *
  81. * --- evolutions courbes ---
  82. * IEV POINTEUR D'EVOLUTION
  83. * INBEVO NOMBRE TOTAL D'EVOLUTIONS
  84. * NC NUMERO DE L'EVOLUTION QUE L'ON TRAITE (OPTION SEPA)
  85. * ZCUR TABLE INDIQUANT LES EVOLUTIONS CONTENANT DES NOMS
  86. * D'ABSCISSES
  87. * ZOPTIO EXISTENCE D'UNE TABLE D'OPTION SPECIFIQUE
  88. * ZTRACE TABLE INDIQUANT LES COURBES A TRACER
  89. *
  90. * --- legende ---
  91. * IPOSI position predefinie de la legende
  92. * NCT NUMERO DE COURBE A TRACER AVEC LEGENDE SUR UN MEME GRAPHE
  93. * NLG COMPTEUR DE LEGENDES AFFICHABLES (NON VIDES)
  94. * XPOSI, YPOSI position XY de la legende fourni par l utilisateur
  95. * ZLEGEN AJOUT DES LEGENDES EN FIN DE COURBE
  96. *
  97. * --- options graphiques ---
  98. * CHOPT MOT CONTENANT LES OPTIONS SPECIFIQUES
  99. * IOPTIO POINTEUR SUR LA TABLE DES OPTIONS SPECIFIQUES
  100. * LPARAM LISTE DES PARAMETRES GENERAUX NPARAM NOMBRE DE PARAMETRES
  101. * ZAXES TRACE DES AXES OX ET OY
  102. * ZCARRE FENETRE CARREE + axes "EQUAL" depuis 2015-12-04
  103. * ZGRILL AFFICHAGE D'UNE GRILLE SUR LES AXES EN LOG
  104. *
  105. * --- titre ---
  106. * HTITRE HAUTEUR DU TITRE
  107. * TITRE TITRE GLOBAL DE L'EVOLUTION
  108. *
  109. * --- nuage ---
  110. * ZNUAG VRAI SI NUAGE, FAUX SI EVOLUTIONS
  111. *
  112. *
  113. * TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION !
  114. *
  115. *=============================================================
  116. *
  117. * REMARQUES :
  118. *
  119. * - TOUTES LES VARIABLES EN T SONT DES REELS SIMPLE PRECISION
  120. * POUR COMMUNIQUER AVEC TRINIT
  121. * - JE JOUE SUR LA COULEUR 8 POUR EFFACER DU TEXTE
  122. * - CHAQUE TRBOX CHANGEANT LA TAILLE DES CARACTERES EST SUIVI PAR
  123. * UN TRBOX RAMENANT A L'ETAT INITIAL
  124. * - LE SYSTEME DE LECTURE DES VALEURS N'EST PAS SUPER
  125. * ARRONDI DE LA MACHINE
  126. * INTERACTIVITE PEU CONVIVIAL (SANS DEVLPT. DE DEPENDANT
  127. * MACHINE)
  128. * PAS IMPLEMENTE EN GKS
  129. *
  130. *=============================================================
  131. IMPLICIT LOGICAL (Z)
  132. IMPLICIT INTEGER (I-N)
  133. IMPLICIT REAL*8 (A-H,O-S,U-Y)
  134. *
  135. -INC CCOPTIO
  136. -INC CCREEL
  137. -INC SMEVOLL
  138. -INC SMNUAGE
  139. -INC SMLREEL
  140. POINTEUR MLREEX.MLREEL,MLREEY.MLREEL
  141. -INC SMLENTI
  142. -INC CCGEOME
  143. -INC TMAXE
  144. -INC CCTRACE
  145.  
  146. *
  147. REAL*8 RA
  148. REAL LIEN(10,5)
  149.  
  150. *
  151. REAL RXDIM,RYDIM,HMIN,TCENTX,TCENTY,HTLOG
  152. dimension TZ(10)
  153. *
  154. LOGICAL VALEUR
  155. CHARACTER*13 LEGEND(8),CARDX,CARDY
  156. CHARACTER*72 TMPCAR
  157. CHARACTER*8 CTYP
  158.  
  159. POINTEUR OLDAXE.AXE
  160. *
  161. SEGMENT COM
  162. CHARACTER*30 COMMENT(10)
  163. REAL TXCOM(10),TYCOM(10)
  164. INTEGER ICOUCO(10)
  165. ENDSEGMENT
  166.  
  167. * TABLEAU DE LOGIQUE GERE EN DYNAMIQUE
  168. SEGMENT DYN
  169. LOGICAL ZTRACE(NDIMT)
  170. ENDSEGMENT
  171.  
  172. SEGMENT CUR
  173. LOGICAL ZCUR(NDIMT2)
  174. ENDSEGMENT
  175. *
  176. DIMENSION TX(2),TY(2)
  177. CHARACTER*72 TITRE,TXTIT,CHOPT,BUFFER
  178. CHARACTER*18 BUFFER1,BUFFER2,BUFFER3,BUFFER4
  179. CHARACTER*8 CTYPE,CHVIDE,ETYPE
  180. PARAMETER (NPARAM=24)
  181. cegal PARAMETER (NPARAM=25)
  182. CHARACTER*4 LPARAM(NPARAM)
  183. CHARACTER*20 TXAXE,TYAXE
  184. CHARACTER*4 MOPOSI(8),MOPOSX(2),MOGRIL(6),MOGRIS(1)
  185. CHARACTER*8 MOFMT
  186.  
  187. *
  188. DATA LPARAM/'LOGX','LOGY','XBOR','YBOR','CARR','SEPA','GRIL',
  189. # 'MIMA','LEGE','DATE','CHOI','NARR','LOGO','TITR',
  190. # 'TITX','TITY','AXES','NCLK','XGRA','YGRA',
  191. # 'POSX','POSY','XFMT','YFMT'/
  192. cegal # 'POSX','POSY','XFMT','YFMT','EGAL'/
  193. DATA MOPOSI/'NO ','NE ','SO ','SE ','EXT ','XY ',
  194. # 'NW ','SW '/
  195. DATA MOPOSX/'EXCE','CENT'/
  196. DATA MOGRIL/'LIGN','TIRR','TIRC','TIRL','TIRM','POIN'/
  197. DATA MOGRIS/'GRIS'/
  198.  
  199.  
  200. ************************************************************************
  201. * INITIALISATIONS
  202. ************************************************************************
  203.  
  204. DO II=1,10
  205. TZ(II) = 0
  206. ENDDO
  207. KCLICK = 1
  208. TXTIT = ' '
  209. TXAXE = ' '
  210. TYAXE = ' '
  211. BUFFER = ' '
  212. NCOMM = 10
  213. ICOM = 0
  214. IBON = 0
  215. ICOLOG = IDCOUL
  216. HDPLOG = 1
  217. HTLOG = 1.
  218. PASSE = 0.
  219. INDCOU=IDCOUL
  220. * limite pour le tracé des LOG
  221. c XMINLOG=1.D-30
  222. XMINLOG=DBLE(XSPETI)
  223.  
  224. c options de CCTRACE par défaut
  225. ANGLE=0.d0
  226. IALIGN=0
  227.  
  228. *
  229. * CREE L'AXE COURANT ET SA SAUVEGARDE
  230. *
  231. SEGINI AXE
  232. OLDAXE=0
  233. MXFMT(1:8)=' '
  234. MYFMT(1:8)=' '
  235. c SEGINI OLDAXE
  236. cbp : on le fait + loin
  237. SEGINI COM
  238. DYN=0
  239. CUR=0
  240. * ETYPE(1:8)='ENTIER '
  241. * CHVIDE(1:8)=' '
  242. *
  243. * INITIALISATION DES LOGIQUES ASSOCIES AUX PARAMETRES
  244. *
  245. ZLOGX = .FALSE.
  246. ZLOGY = .FALSE.
  247. ZCARRE = .FALSE.
  248. ZLEGEN = .FALSE.
  249. ZSEPAR = .FALSE.
  250. ZDATE = .FALSE.
  251. ZGRILL = .FALSE.
  252. ZHEURE = .FALSE.
  253. ZMIMA = .FALSE.
  254. ZLOGO = .FALSE.
  255. ZOPTIO = .FALSE.
  256. ZXFORC = .FALSE.
  257. ZYFORC = .FALSE.
  258. ZARR = .FALSE.
  259. ZAXES = .FALSE.
  260. ZINDEX = .FALSE.
  261. ZLOGOO = .FALSE.
  262. ZVALEUR= .FALSE.
  263. ZLIEN = .FALSE.
  264. ZXGRA = .FALSE.
  265. ZYGRA = .FALSE.
  266. ZNUAG = .FALSE.
  267. ZEGAL = .FALSE.
  268.  
  269.  
  270. ************************************************************************
  271. * LECTURE DE L'EVOLUTION (ou NUAGE)
  272. ************************************************************************
  273. *
  274. * CHARGE L'EVOLUTION
  275. *
  276. CALL LIROBJ('EVOLUTIO',IEV,0,IOK)
  277. IF (IERR.NE.0) GOTO 1000
  278. *
  279. * ou le NUAGE D'EVOLUTIONs
  280. *
  281. IF (IOK.EQ.0) THEN
  282. CALL LIROBJ('NUAGE',INUAG,0,IOK)
  283. c write(*,*) 'Nuage lu ?',IOK,INUAG
  284. IF (IOK.EQ.1) THEN
  285. ZNUAG=.TRUE.
  286. * verif du nuage :
  287. MNUAGE=INUAG
  288. SEGACT,MNUAGE
  289. NVAR=NUAPOI(/1)
  290. c write(*,*) 'Nuage constitué de ',NVAR,' n-uplets'
  291. IF(NVAR.NE.2) THEN
  292. WRITE(IOIMP,*) 'le Nuage doit contenir 2 n-uplets'
  293. CALL ERREUR(21)
  294. SEGDES,MNUAGE
  295. GOTO 1000
  296. ENDIF
  297. IF(NUATYP(1).NE.'FLOTTANT'.OR.NUATYP(2).NE.'EVOLUTIO') THEN
  298. WRITE(IOIMP,*) 'le Nuage doit contenir 2 n-uplets de type'
  299. WRITE(IOIMP,*) 'FLOTTANT et EVOLUTION'
  300. CALL ERREUR(21)
  301. SEGDES,MNUAGE
  302. GOTO 1000
  303. ENDIF
  304. * pour simplifier la suite, on met les evolutions du nuage dans
  305. * une macro evolution :
  306. NUAVIN=NUAPOI(2)
  307. SEGACT,NUAVIN
  308. NBCOUP=NUAINT(/1)
  309. N=NBCOUP
  310. SEGINI,MEVOLL
  311. IEV=MEVOLL
  312. IEVTEX(1:8)=NUANOM(2)
  313. DO IBCOUP=1,NBCOUP
  314. MEVOL1=NUAINT(IBCOUP)
  315. SEGACT,MEVOL1
  316. IF(MEVOL1.IEVOLL(/1).NE.1) THEN
  317. WRITE(IOIMP,*) 'le Nuage doit contenir des evolutions simples'
  318. CALL ERREUR(25)
  319. SEGDES,MEVOL1,NUAVIN,MNUAGE,MEVOLL
  320. GOTO 1000
  321. ENDIF
  322. IEVOLL(IBCOUP)=MEVOL1.IEVOLL(1)
  323. SEGDES,MEVOL1
  324. ENDDO
  325. c write(*,*) 'les evolutions sont :',(IEVOLL(iou),iou=1,NBCOUP)
  326. SEGDES,NUAVIN,MNUAGE,MEVOLL
  327. ELSE
  328. MOTERR(1:40)=' '
  329. MOTERR(1:16)='EVOLUTIONUAGE'
  330. CALL ERREUR(471)
  331. GOTO 1000
  332. ENDIF
  333. ENDIF
  334. *
  335. * CALCUL DU NOMBRE TOTAL D'EVOLUTIONS (COPIE DES TITRES)
  336. *
  337. MEVOLL = IEV
  338. SEGACT MEVOLL
  339. TITRE = ' '
  340. TITRE(1:72)=IEVTEX(1:72)
  341. INBEVO = IEVOLL(/1)
  342. SEGDES MEVOLL
  343.  
  344. IF (INBEVO.EQ.0) GOTO 1000
  345. *
  346. * CONSTRUCTION DES COURBES DE TYPE HISTOGRAMME
  347. *
  348. SEGACT,MEVOLL
  349. SEGINI,MEVOL1=MEVOLL
  350. NHIST=0
  351. DO I0=1,INBEVO
  352. KEVOLL=IEVOLL(I0)
  353. SEGACT,KEVOLL
  354. SEGINI,KEVOL1=KEVOLL
  355. IF (NUMEVY.EQ.'HIST') THEN
  356. MLREEX=KEVOLL.IPROGX
  357. SEGACT,MLREEX
  358. JG=2*MLREEX.PROG(/1)
  359. SEGINI,MLREE1
  360. DO J0=1,MLREEX.PROG(/1)
  361. MLREE1.PROG(2*J0-1)=MLREEX.PROG(J0)
  362. MLREE1.PROG(2*J0)=MLREEX.PROG(J0)
  363. ENDDO
  364. SEGDES,MLREEX,MLREE1
  365. KEVOL1.IPROGX=MLREE1
  366. MLREEY=KEVOLL.IPROGY
  367. SEGACT,MLREEY
  368. JG=2*MLREEY.PROG(/1)
  369. SEGINI,MLREE1
  370. MLREE1.PROG(1)=0.
  371. DO J0=1,MLREEY.PROG(/1)-1
  372. MLREE1.PROG(2*J0)=MLREEY.PROG(J0)
  373. MLREE1.PROG(2*J0+1)=MLREEY.PROG(J0)
  374. ENDDO
  375. MLREE1.PROG(JG)=0.
  376. SEGDES,MLREEY,MLREE1
  377. KEVOL1.IPROGY=MLREE1
  378. NHIST=NHIST+1
  379. ENDIF
  380. SEGDES,KEVOLL,KEVOL1
  381. MEVOL1.IEVOLL(I0)=KEVOL1
  382. ENDDO
  383. IF (NHIST.EQ.0) THEN
  384. SEGSUP,MEVOL1
  385. ELSE
  386. SEGDES,MEVOLL,MEVOL1
  387. IEV=MEVOL1
  388. ENDIF
  389. *
  390. * DEFINITION TAILLE CARACTERE
  391. *
  392. * HMIN=.2
  393.  
  394. *
  395. * DIMENSIONNE LA TABLE ZTRACE
  396. *
  397. NDIMT=INBEVO
  398. SEGINI DYN
  399. *
  400. * INITIALISATION TABLE ZTRACE
  401. *
  402. DO 1 I=1,INBEVO
  403. ZTRACE(I)=.TRUE.
  404. 1 CONTINUE
  405.  
  406.  
  407. ************************************************************************
  408. * LECTURE DES OPTIONS
  409. ************************************************************************
  410. *
  411. * CHARGEMENT DES PARAMETRES GENERAUX OPTIONNELS
  412. *
  413. 2 CONTINUE
  414. CALL LIRMOT(LPARAM,NPARAM,INDICE,0)
  415. IF (INDICE.NE.0) THEN
  416. GOTO (3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
  417. $ 221,222,223,224,225,226),INDICE
  418. cegal $ 221,222,223,224,225,226,71),INDICE
  419. *
  420. * LOGX : SELECTION ECHELLE LOG EN X
  421. *
  422. 3 CONTINUE
  423. ZLOGX=.TRUE.
  424. GOTO 2
  425. *
  426. * LOGY : SELECTION ECHELLE LOG EN Y
  427. *
  428. 4 CONTINUE
  429. ZLOGY=.TRUE.
  430. GOTO 2
  431. *
  432. * XBOR : BORNES AXE X IMPOSEES
  433. *
  434. 5 CONTINUE
  435. ZXFORC=.TRUE.
  436. CALL LIRREE(XXX,1,IOK)
  437. IF (IERR.NE.0) GOTO 1000
  438. XINF=XXX
  439. CALL LIRREE (XXX,1,IOK)
  440. IF (IERR.NE.0) GOTO 1000
  441. XSUP=XXX
  442. GOTO 2
  443. *
  444. * YBOR : BORNES AXE Y IMPOSEES
  445. *
  446. 6 CONTINUE
  447. ZYFORC=.TRUE.
  448. CALL LIRREE(XXX,1,IOK)
  449. IF (IERR.NE.0) GOTO 1000
  450. YINF=XXX
  451. CALL LIRREE (XXX,1,IOK)
  452. IF (IERR.NE.0) GOTO 1000
  453. YSUP=XXX
  454. GOTO 2
  455. *
  456. * CARR : FENETRE CARREE
  457. * depuis 2015-12-04, CARR : FENETRE CARREE + AXES "EQUAL"
  458. *
  459. 7 CONTINUE
  460. cegal ZCARRE=.TRUE.
  461. cegal GOTO 2
  462. cegal*
  463. cegal* EGAL : FENETRE CARREE + AXES "EQUAL"
  464. cegal*
  465. cegal 71 CONTINUE
  466. ZCARRE=.TRUE.
  467. ZEGAL =.TRUE.
  468. GOTO 2
  469. *
  470. * SEPA : TRACES SEPARES
  471. *
  472. 8 CONTINUE
  473. ZSEPAR=.TRUE.
  474. GOTO 2
  475. *
  476. * GRIL : UTILISATION D'UNE GRILLE SUR LES AXES EN LOG OU EN LINEAIRE
  477. *
  478. 9 CONTINUE
  479. ZGRILL=.TRUE.
  480. c type de tiret ou de pointillé
  481. CALL LIRMOT(MOGRIL,6,IGRIL,0)
  482. if(IGRIL.eq.0) IGRIL=1
  483. c couleur noir ou grise?
  484. CALL LIRMOT(MOGRIS,1,IGRIS,0)
  485. if(IGRIS.ne.0) IGRIL=-1*IGRIL
  486. GOTO 2
  487. *
  488. * MIMA : AFFICHAGE MINIMUM MAXIMUM
  489. *
  490. 10 CONTINUE
  491. ZMIMA=.TRUE.
  492. GOTO 2
  493. *
  494. * LEGE : AFFICHAGE LEGENDE EN BOUT DE COURBE
  495. *
  496. 11 CONTINUE
  497. ZLEGEN=.TRUE.
  498. * POSITION DE LA LEGENDE
  499. CALL LIRMOT(MOPOSI,8,IPOSI,0)
  500. * PAR DEFAUT EXT <=> POSLEG=5
  501. if(IPOSI.eq.0) IPOSI=5
  502. * XY suivi de la position dans le graphique
  503. if(IPOSI.eq.6) then
  504. CALL LIRREE(XPOSI,1,IRETX)
  505. CALL LIRREE(YPOSI,1,IRETY)
  506. IF(IRETX.EQ.0.OR.IRETY.EQ.0)
  507. & write(ioimp,*) 'LEGE XY doit etre suivi de Xlege Ylege !'
  508. IF (IERR.NE.0) GOTO 1000
  509. endif
  510. * NW et SW sont en fait NO et SO en anglais
  511. if(IPOSI.eq.7) IPOSI=1
  512. if(IPOSI.eq.8) IPOSI=3
  513. * FORCE CARRE POUR AVOIR LA PLACE D'AFFICHER LES LEGENDES
  514. if(IPOSI.eq.5) ZCARRE=.TRUE.
  515. GOTO 2
  516. *
  517. * DATE : AFFICHAGE DATE
  518. *
  519. 12 CONTINUE
  520. ZDATE=.TRUE.
  521. GOTO 2
  522. *
  523. * CHOI : SELECTION DE COURBE
  524. *
  525. 13 CONTINUE
  526. *
  527. * MET A FAUX TOUTES LES SELECTIONS DE TRACES
  528. *
  529. DO 85 I=1,INBEVO
  530. ZTRACE(I)=.FALSE.
  531. 85 CONTINUE
  532. *PM A-t-on un ENTIER, un LISTENTI ou rien en entree ?
  533. CALL QUETYP (CTYP,0,IRETOU)
  534. IF (IRETOU.EQ.0) GOTO 2
  535. IF (CTYP.EQ.'ENTIER ') THEN
  536. IOK = 1
  537. DO WHILE (IOK.EQ.1)
  538. CALL LIRENT (IXX,0,IOK)
  539. IF (IOK.EQ.1) ZTRACE(IXX) = .TRUE.
  540. ENDDO
  541. ENDIF
  542. IF (CTYP.EQ.'LISTENTI') THEN
  543. CALL LIROBJ('LISTENTI',ILENTI,1,IRET)
  544. IF (IRET.NE.1) RETURN
  545. MLENTI = ILENTI
  546. SEGACT, MLENTI
  547. DO I=1,LECT(/1)
  548. IXX = LECT(I)
  549. ZTRACE(IXX) = .TRUE.
  550. ENDDO
  551. ENDIF
  552. GOTO 2
  553.  
  554. *
  555. * NARR : GRADUATION NON NORMALISEE
  556. *
  557. 14 CONTINUE
  558. ZARR=.TRUE.
  559. GOTO 2
  560. *
  561. * LOGO : DESSIN DU LOGO
  562. *
  563. 15 CONTINUE
  564. ZLOGO =.TRUE.
  565. ZLOGOO=.TRUE.
  566. GOTO 2
  567. *
  568. * TITR : AFFICHAGE D'UN TITRE GENERAL
  569. *
  570. 16 CONTINUE
  571. CALL LIRCHA(TXTIT(1:72),0,IRETOU)
  572. IF (IRETOU.EQ.0) TXTIT=' '
  573. GOTO 2
  574. *
  575. * TITX : AFFICHAGE D'UN TITRE EN X
  576. *
  577. 17 CONTINUE
  578. CALL LIRCHA(TXAXE(1:20),0,IRETOU)
  579. IF (IRETOU.EQ.0) TXAXE=' '
  580. GOTO 2
  581. *
  582. * TITY : AFFICHAGE D'UN TITRE EN Y
  583. *
  584. 18 CONTINUE
  585. CALL LIRCHA(TYAXE(1:20),0,IRETOU)
  586. IF (IRETOU.EQ.0) TYAXE=' '
  587. GOTO 2
  588. *
  589. * AXES : TRACE DES AXES OX ET OY
  590. *
  591. 19 CONTINUE
  592. ZAXES=.TRUE.
  593. GOTO 2
  594. *
  595. * NCLK : OPTION NOCLICK
  596. *
  597. 20 CONTINUE
  598. KCLICK=0
  599. GOTO 2
  600. *
  601. * XGRA et YGRA : GRADUATIONS IMPOSEES
  602. *
  603. 221 CONTINUE
  604. ZXGRA = .true.
  605. CALL LIRREE(XINT1,1,IOK)
  606. IF(IOK.EQ.0) write(ioimp,*)'XGRA doit etre suivi d un flottant'
  607. IF (IERR.NE.0) GOTO 1000
  608. GOTO 2
  609. *
  610. 222 CONTINUE
  611. ZYGRA = .true.
  612. CALL LIRREE(YINT1,1,IOK)
  613. IF(IOK.EQ.0) write(ioimp,*)'YGRA doit etre suivi d un flottant'
  614. IF (IERR.NE.0) GOTO 1000
  615. GOTO 2
  616. *
  617. * POSX et POSY : GRADUATIONS IMPOSEES
  618. *
  619. 223 CONTINUE
  620. CALL LIRMOT(MOPOSX,2,IIPOS,1)
  621. IF(IIPOS.EQ.0)write(ioimp,*)'POSX doit etre suivi d un mot-clé'
  622. IPOSX=IIPOS
  623. IF(IERR.NE.0) GOTO 1000
  624. GOTO 2
  625. *
  626. 224 CONTINUE
  627. CALL LIRMOT(MOPOSX,2,IIPOS,1)
  628. IF(IIPOS.EQ.0)write(ioimp,*)'POSY doit etre suivi d un mot-clé'
  629. IPOSY=IIPOS
  630. IF(IERR.NE.0) GOTO 1000
  631. GOTO 2
  632. *
  633. * XFMT et YFMT : FORMAT DES GRADUATIONS IMPOSEES
  634. *
  635. 225 CONTINUE
  636. CALL LIRCHA(MOFMT,1,IFMT)
  637. IF(IERR.NE.0) GOTO 1000
  638. MXFMT(1:IFMT)=MOFMT
  639. if(iimpi.ge.1) write(IOIMP,*) 'MXFMT(1:',IFMT,')=',MXFMT(1:8)
  640. GOTO 2
  641. *
  642. 226 CONTINUE
  643. CALL LIRCHA(MOFMT,1,IFMT)
  644. IF(IERR.NE.0) GOTO 1000
  645. MYFMT(1:IFMT)=MOFMT
  646. if(iimpi.ge.1) write(IOIMP,*) 'MYFMT(1:',IFMT,')=',MYFMT(1:8)
  647. GOTO 2
  648. *
  649. ENDIF
  650. *
  651. ************************************************************************
  652. * LECTURE DE LA TABLE DES PARAMETRES SPECIFIQUES
  653. ************************************************************************
  654. *
  655. CALL LIROBJ('TABLE',IOPTIO,0,IOK)
  656. IF (IOK.EQ.1) THEN
  657. ZOPTIO=.TRUE.
  658. ENDIF
  659.  
  660. *
  661. ************************************************************************
  662. * PAR DEFAUT, TITRE DES AXES = NOM DES X et Y DE LA 1ERE COURBE A TRACER
  663. ************************************************************************
  664. *
  665. MEVOLL=IEV
  666. SEGACT MEVOLL
  667. I=1
  668. 22 CONTINUE
  669. IF ((.NOT.ZTRACE(I)).AND.(I.LE.INBEVO)) THEN
  670. I=I+1
  671. GOTO 22
  672. ENDIF
  673. IF (I.GT.INBEVO) GOTO 1000
  674. KEVOLL=IEVOLL(I)
  675. SEGACT KEVOLL
  676. TITREX(1:20)=NOMEVX
  677. TITREY(1:20)=NOMEVY
  678.  
  679. SEGDES KEVOLL
  680. SEGDES MEVOLL
  681.  
  682.  
  683. ************************************************************************
  684. * TRAITEMENT DES OPTIONS QUI PEUVENT L'ETRE DES A PRESENT
  685. ************************************************************************
  686.  
  687. NC=0
  688. *
  689. * DANS LE CAS DE BORNES IMPOSEES ON VERIFIE QUE LA BORNE SUPERIEURE EST
  690. * EFFECTIVEMENT PLUS PETITE QUE LA BORNE INFERIEURE
  691. *
  692. IF (ZXFORC.AND.XSUP.LT.XINF) GOTO 950
  693. IF (ZYFORC.AND.YSUP.LT.YINF) GOTO 950
  694. *
  695. * DANS LE CAS DE BORNES IMPOSEES EN LOG, ON VERIFIE
  696. * QU'ELLES NE SONT PAS NEGATIVES
  697. *
  698. IF (ZXFORC.AND.ZLOGX.AND.XINF.LT.XMINLOG) GOTO 900
  699. IF (ZYFORC.AND.ZLOGY.AND.YINF.LT.XMINLOG) GOTO 900
  700. *
  701. * TRIE LES EVOLUTIONS REFERANT DES NOMS D'ABSCISSES
  702. * (CAS DES ABSCISSES CURVILIGNES)
  703. *
  704. NDIMT2=INBEVO
  705. SEGINI CUR
  706. MEVOLL=IEV
  707. SEGACT MEVOLL
  708. DO 23 I=1,INBEVO
  709. KEVOLL=IEVOLL(I)
  710. SEGACT KEVOLL
  711. IF (TYPX(1:8).EQ.'LISTMOTS') THEN
  712. ZTRACE(I)=.FALSE.
  713. ZCUR(I)=.TRUE.
  714. GOTO 23
  715. ENDIF
  716. IF (TYPY(1:8).EQ.'LISTMOTS') THEN
  717. ZTRACE(I)=.FALSE.
  718. ZCUR(I)=.TRUE.
  719. GOTO 23
  720. ENDIF
  721. ZCUR(I)=.FALSE.
  722. SEGDES KEVOLL
  723. 23 CONTINUE
  724.  
  725. *=======================================================================
  726. *==== CAS D'UN TRACE SIMULTANE (TOUTES LES COURBES) ====================
  727. *
  728. IF (.NOT.ZSEPAR) THEN
  729. *
  730. ************************************************************************
  731. * CALCUL DES BORNES DES AXES SUR X ET SUR Y (TRACE SIMULTANE)
  732. ************************************************************************
  733. *
  734. IOKX=0
  735. IF (ZXFORC.AND.ZYFORC) IOKX=1
  736.  
  737. ******* BORNES IMPOSEES SUR Y MAIS PAS SUR X
  738. *
  739. IF(ZYFORC.AND.(.NOT.ZXFORC)) THEN
  740. *
  741. IOKX=-1
  742. *
  743. * --- BOUCLE SUR LES EVOLUTIONS A TRACER ---
  744. *
  745. DO 24 J=1,INBEVO
  746. IF (ZTRACE(J)) THEN
  747. KEVOLL=IEVOLL(J)
  748. SEGACT KEVOLL
  749. MLREEX=IPROGX
  750. MLREEY=IPROGY
  751. SEGACT MLREEX
  752. SEGACT MLREEY
  753. NG=MLREEX.PROG(/1)
  754. PGX1=MLREEX.PROG(1)
  755. PGY1=MLREEY.PROG(1)
  756. DO 25 IG=2,NG
  757. IOKMI=0
  758. IOKMA=0
  759. PGX=MLREEX.PROG(IG)
  760. PGY=MLREEY.PROG(IG)
  761. IF ((PGY1-YINF)*(PGY-YINF).LE.0.D0) THEN
  762. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  763. IOKMI=1
  764. VMIN=YINF
  765. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN)
  766. ENDIF
  767. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  768. IOKMA=1
  769. VMAX=YINF
  770. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX)
  771. ENDIF
  772. ENDIF
  773. IF ((PGY1-YSUP)*(PGY-YSUP).LE.0.D0) THEN
  774. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  775. IOKMA=1
  776. VMAX=YSUP
  777. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX)
  778. ENDIF
  779. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  780. IOKMI=1
  781. VMIN=YSUP
  782. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN)
  783. ENDIF
  784. ENDIF
  785. IF (.NOT. ((MIN(PGY1,PGY).GT.YSUP).OR.
  786. * (MAX(PGY1,PGY).LT.YINF))) THEN
  787. IF (IOKMI.EQ.0) VMIN=MIN(PGX1,PGX)
  788. IF (IOKMA.EQ.0) VMAX=MAX(PGX1,PGX)
  789. IF (IOKX.LE.0) THEN
  790. IOKX=1
  791. XINF=VMIN
  792. XSUP=VMAX
  793. ELSE
  794. XINF=MIN(XINF,VMIN)
  795. XSUP=MAX(XSUP,VMAX)
  796. ENDIF
  797. ENDIF
  798. PGX1=PGX
  799. PGY1=PGY
  800. 25 CONTINUE
  801. IF (IOKX.LE.0) THEN
  802. IPTR=MLREEX
  803. CALL MINMAX(IPTR,AMINI,AMAXI)
  804. IF (IOKX.EQ.-1) THEN
  805. XINF=AMINI
  806. XSUP=AMAXI
  807. IOKX=0
  808. ELSE
  809. XINF=MIN(XINF,AMINI)
  810. XSUP=MAX(XSUP,AMAXI)
  811. ENDIF
  812. ENDIF
  813. SEGDES MLREEX
  814. SEGDES MLREEY
  815. SEGDES KEVOLL
  816. ENDIF
  817. 24 CONTINUE
  818. *
  819. * --- FIN DE BOUCLE SUR LES EVOLUTIONS A TRACER ---
  820. *
  821. SEGDES MEVOLL
  822. ENDIF
  823.  
  824.  
  825. ******* BORNES IMPOSEES SUR X MAIS PAS SUR Y
  826. *
  827. IF (ZXFORC.AND.(.NOT.ZYFORC)) THEN
  828. *
  829. IOKY=-1
  830. *
  831. * BOUCLE SUR LES EVOLUTIONS A TRACER
  832. *
  833. DO 26 J=1,INBEVO
  834. IF (ZTRACE(J)) THEN
  835. KEVOLL=IEVOLL(J)
  836. SEGACT KEVOLL
  837. MLREEX=IPROGX
  838. MLREEY=IPROGY
  839. SEGACT MLREEX
  840. SEGACT MLREEY
  841. NG=MLREEX.PROG(/1)
  842. PGX1=MLREEX.PROG(1)
  843. PGY1=MLREEY.PROG(1)
  844. DO 27 IG=2,NG
  845. IOKMI=0
  846. IOKMA=0
  847. PGX=MLREEX.PROG(IG)
  848. PGY=MLREEY.PROG(IG)
  849. IF ((PGX1-XINF)*(PGX-XINF).LE.0.D0) THEN
  850. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  851. IOKMI=1
  852. VMIN=XINF
  853. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN)
  854. ENDIF
  855. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  856. IOKMA=1
  857. VMAX=XINF
  858. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX)
  859. ENDIF
  860. ENDIF
  861. IF ((PGX1-XSUP)*(PGX-XSUP).LE.0.D0) THEN
  862. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  863. IOKMA=1
  864. VMAX=XSUP
  865. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX)
  866. ENDIF
  867. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  868. IOKMI=1
  869. VMIN=XSUP
  870. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN)
  871. ENDIF
  872. ENDIF
  873. IF (.NOT. ((MIN(PGX1,PGX).GT.XSUP).OR.
  874. * (MAX(PGX1,PGX).LT.XINF))) THEN
  875. IF (IOKMI.EQ.0) VMIN=MIN(PGY1,PGY)
  876. IF (IOKMA.EQ.0) VMAX=MAX(PGY1,PGY)
  877. IF (IOKY.LE.0) THEN
  878. IOKY=1
  879. YINF=VMIN
  880. YSUP=VMAX
  881. ELSE
  882. YINF=MIN(YINF,VMIN)
  883. YSUP=MAX(YSUP,VMAX)
  884. ENDIF
  885. ENDIF
  886. PGX1=PGX
  887. PGY1=PGY
  888. 27 CONTINUE
  889. IF (IOKY.LE.0) THEN
  890. IPTR=MLREEY
  891. CALL MINMAX(IPTR,AMINI,AMAXI)
  892. IF (IOKY.EQ.-1) THEN
  893. YINF=AMINI
  894. YSUP=AMAXI
  895. IOKY=0
  896. ELSE
  897. YINF=MIN(YINF,AMINI)
  898. YSUP=MAX(YSUP,AMAXI)
  899. ENDIF
  900. ENDIF
  901. SEGDES MLREEX
  902. SEGDES MLREEY
  903. SEGDES KEVOLL
  904. ENDIF
  905. 26 CONTINUE
  906. *
  907. SEGDES MEVOLL
  908. ENDIF
  909.  
  910.  
  911. ******* PAS DE BORNES IMPOSEES
  912. *
  913. IF ((.NOT.ZXFORC).AND.(.NOT.ZYFORC)) THEN
  914. I=0
  915. 28 CONTINUE
  916. I=I+1
  917. IF (.NOT. ZTRACE(I)) GOTO 28
  918. *
  919. * PREMIERE EVOLUTION : INITIALISATION Des MIN ET Des MAX
  920. *
  921. MEVOLL=IEV
  922. SEGACT MEVOLL
  923. KEVOLL=IEVOLL(I)
  924. SEGACT KEVOLL
  925. MLREEL=IPROGX
  926. IPTR=IPROGX
  927. CALL MINMAX(IPTR,AMINI,AMAXI)
  928. XINF=AMINI
  929. XSUP=AMAXI
  930. MLREEL=IPROGY
  931. IPTR=IPROGY
  932. CALL MINMAX(IPTR,AMINI,AMAXI)
  933. YINF=AMINI
  934. YSUP=AMAXI
  935. c write(ioimp,*) I,'ieme evol: X,Y=',XINF,XSUP,',',YINF,YSUP
  936. SEGDES KEVOLL
  937.  
  938.  
  939. *
  940. * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER
  941. *
  942. IF (I.LT.INBEVO) THEN
  943. DO 29 J=I+1,INBEVO
  944. IF (ZTRACE(J)) THEN
  945. KEVOLL=IEVOLL(J)
  946. SEGACT KEVOLL
  947. IPTR=IPROGX
  948. CALL MINMAX(IPTR,AMINI,AMAXI)
  949. IF (AMINI.LT.XINF) XINF=AMINI
  950. IF (AMAXI.GT.XSUP) XSUP=AMAXI
  951. IPTR=IPROGY
  952. CALL MINMAX(IPTR,AMINI,AMAXI)
  953. IF (AMINI.LT.YINF) YINF=AMINI
  954. IF (AMAXI.GT.YSUP) YSUP=AMAXI
  955. c c write(ioimp,*) J,'ieme evol: X,Y=',XINF,XSUP,',',YINF,YSUP
  956. SEGDES KEVOLL
  957. ENDIF
  958. 29 CONTINUE
  959. ENDIF
  960. SEGDES MEVOLL
  961. ENDIF
  962.  
  963.  
  964. ************************************************************************
  965. * CALCUL DES MINI MAXI (TRACE SIMULTANE)
  966. ************************************************************************
  967.  
  968. IF (ZMIMA) THEN
  969. *
  970. * SAUVEGARDE VALEUR AXE POUR CHERCHER MAXI
  971. *
  972. I=0
  973. 32 CONTINUE
  974. I=I+1
  975. IF (.NOT. ZTRACE(I)) GOTO 32
  976. *
  977. * PREMIERE EVOLUTION : INITIALISATION DU MIN ET DU MAX
  978. *
  979. MEVOLL=IEV
  980. SEGACT MEVOLL
  981. KEVOLL=IEVOLL(I)
  982. SEGACT KEVOLL
  983. IPTR=IPROGY
  984. CALL MINMAX(IPTR,AMINI,AMAXI)
  985. YMINI=AMINI
  986. YMAXI=AMAXI
  987. SEGDES KEVOLL
  988. *
  989. * BOUCLE SUR LES AUTRES EVOLUTIONS A TRACER
  990. *
  991. DO 33 J=I+1,INBEVO
  992. IF (ZTRACE(J)) THEN
  993. KEVOLL=IEVOLL(J)
  994. SEGACT KEVOLL
  995. IPTR=IPROGY
  996. CALL MINMAX(IPTR,AMINI,AMAXI)
  997. SEGDES KEVOLL
  998. IF (AMINI.LT.YMINI) YMINI=AMINI
  999. IF (AMAXI.GT.YMAXI) YMAXI=AMAXI
  1000. ENDIF
  1001. 33 CONTINUE
  1002. SEGDES MEVOLL
  1003. ENDIF
  1004.  
  1005.  
  1006. ************************************************************************
  1007. * PETITS TRAVAUX SUR LES AXES X et Y (TRACE SIMULTANE)
  1008. ************************************************************************
  1009. *
  1010. * DANS LE CAS D'AXES EN LOG,
  1011. * ON VERIFIE QUE LES BORNES NE SONT PAS NEGATIVES
  1012. *
  1013. IF (ZLOGX.AND.XINF.LT.XMINLOG) GOTO 900
  1014. IF (ZLOGY.AND.YINF.LT.XMINLOG) GOTO 900
  1015. *
  1016. * CALCUL DES ARRONDIS,
  1017. * Les bornes passent eventuellement en log10
  1018. *
  1019. CALL BORAXE(XINF,XSUP,ZLOGX)
  1020. CALL BORAXE(YINF,YSUP,ZLOGY)
  1021. *
  1022. * CALCUL DU PAS DE GRADUATION
  1023.  
  1024. c VERIFICATION COMPATIBILITE OPTION EQUAL ('EGAL')
  1025. IF(ZEGAL) THEN
  1026. XLON = XSUP-XINF
  1027. YLON = YSUP-YINF
  1028. XSURY = XLON / YLON
  1029. c write(6,*) 'DESSIN EGAL :',XINF,XSUP,YINF,YSUP,'XSURY=',XSURY
  1030. IF(ZLOGX.OR.ZLOGY) THEN
  1031. cegal write(ioimp,*) 'Option EGAL incompatible avec LOGX, LOGY'
  1032. write(ioimp,*) 'Option CARRE incompatible avec LOGX, LOGY'
  1033. ZEGAL=.FALSE.
  1034. ELSEIF(XSURY.GE.1.0D0.AND.ZYFORC.OR.ZYGRA) THEN
  1035. cegal write(ioimp,*) 'Option EGAL incompatible avec YBOR, YGRA'
  1036. write(ioimp,*) 'Option CARRE incompatible avec YBOR, YGRA'
  1037. ZEGAL=.FALSE.
  1038. ELSEIF(XSURY.LT.1.0D0.AND.ZXFORC.OR.ZXGRA) THEN
  1039. cegal write(ioimp,*) 'Option EGAL incompatible avec XBOR, XGRA'
  1040. write(ioimp,*) 'Option CARRE incompatible avec XBOR, XGRA'
  1041. ZEGAL=.FALSE.
  1042. ENDIF
  1043. ENDIF
  1044.  
  1045. c ---OPTION EQUAL ('EGAL')
  1046. IF(ZEGAL) THEN
  1047.  
  1048. IF(XSURY.GE.1.0D0) THEN
  1049. * PAS DE GRADUATION en X
  1050. CALL INTAXE(XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC)
  1051. * PAS en Y = celui en X --> on change les bornes YINF et YSUP
  1052. YINT=XINT
  1053. YMIL=0.5D0*(YINF+YSUP)
  1054. c write(6,*) 'DESSIN EGAL : X',XINT,INX,'YMIL=',YMIL
  1055. 711 CONTINUE
  1056. YINF=XINT*DBLE(FLOOR(YINF/YINT+1.D-8))
  1057. YSUP=XINT*DBLE(CEILING(YSUP/YINT-1.D-8))
  1058. INY = INT((YSUP-YINF)/YINT+5.D-3)
  1059. c write(6,*) 'DESSIN EGAL :',XINF,XSUP,YINF,YSUP,INX,INY
  1060. IF(INY.GT.INX) THEN
  1061. c cas rare mais qu'il faut prevoir
  1062. XMIL=0.5D0*(XINF+XSUP)
  1063. IF(ABS(XMIL-XINF).GE.ABS(XSUP-XMIL)) THEN
  1064. XSUP=XSUP+XINT
  1065. ELSE
  1066. XINF=XINF-XINT
  1067. ENDIF
  1068. INX = INX + 1
  1069. ELSEIF(INY.LT.INX) THEN
  1070. c on cherche a avoir le meme nombre de graduations
  1071. IF(ABS(YMIL-YINF).GE.ABS(YSUP-YMIL)) THEN
  1072. YSUP=YSUP+YINT
  1073. ELSE
  1074. YINF=YINF-YINT
  1075. ENDIF
  1076. GOTO 711
  1077. ENDIF
  1078. ELSE
  1079. * PAS DE GRADUATION en Y
  1080. CALL INTAXE(YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC)
  1081. * PAS en X = celui en Y --> on change les bornes XINF et XSUP
  1082. XINT=YINT
  1083. XMIL=0.5D0*(XINF+XSUP)
  1084. c write(6,*) 'DESSIN EGAL : Y',YINT,INY,'XMIL=',XMIL
  1085. iterx=0
  1086. c write(6,*) 'DESSIN EGAL :',XINF,XSUP,YINF,YSUP,INX,INY
  1087. 712 CONTINUE
  1088. iterx=iterx+1
  1089. XINF=XINT*DBLE(FLOOR(XINF/XINT+1.D-8))
  1090. XSUP=XINT*DBLE(CEILING(XSUP/XINT-1.D-8))
  1091. INX = INT((XSUP-XINF)/XINT+5.D-3)
  1092. c write(6,*) 'DESSIN EGAL :',XINF,XSUP,YINF,YSUP,INX,INY
  1093. IF(INX.GT.INY) THEN
  1094. c cas rare mais qu'il faut prevoir
  1095. YMIL=0.5D0*(YINF+YSUP)
  1096. IF(ABS(YMIL-YINF).GE.ABS(YSUP-YMIL)) THEN
  1097. YSUP=YSUP+YINT
  1098. ELSE
  1099. YINF=YINF-YINT
  1100. ENDIF
  1101. INY = INY + 1
  1102. ELSEIF(INX.LT.INY) THEN
  1103. c on cherche a avoir le meme nombre de graduations
  1104. IF(ABS(XMIL-XINF).GE.ABS(XSUP-XMIL)) THEN
  1105. XSUP=XSUP+XINT
  1106. ELSE
  1107. XINF=XINF-XINT
  1108. ENDIF
  1109. GOTO 712
  1110. ENDIF
  1111. ENDIF
  1112.  
  1113. c ---CAS non-EQUAL
  1114. ELSE
  1115.  
  1116. * PAS DE GRADUATION en X
  1117. CALL INTAXE(XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC)
  1118. if(ZXGRA) then
  1119. if(ZLOGX) then
  1120. write(ioimp,*) 'Option XGRA non compatible avec LOGX'
  1121. else
  1122. XINT=XINT1
  1123. INX=INT((XSUP-XINF)/XINT+5.D-3)
  1124. endif
  1125. endif
  1126. * PAS DE GRADUATION en Y
  1127. CALL INTAXE(YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC)
  1128. if(ZYGRA) then
  1129. if(ZLOGY) then
  1130. write(ioimp,*) 'Option YGRA non compatible avec LOGY'
  1131. else
  1132. YINT=YINT1
  1133. INY=INT((YSUP-YINF)/YINT+5.D-3)
  1134. endif
  1135. endif
  1136.  
  1137. ENDIF
  1138. c ---FIN OPTION EQUAL ('EGAL') OU non-EQUAL
  1139.  
  1140. ENDIF
  1141. *==== CAS D'UN TRACE SIMULTANE (TOUTES LES COURBES) ====================
  1142. *=======================================================================
  1143.  
  1144.  
  1145. * PREPARATION AU CAS D'UN TRACE SEPARE (COURBE PAR COURBE)
  1146. *
  1147. IF (ZSEPAR.AND.ZLOGX.AND.ZXFORC) THEN
  1148. X1=XINF
  1149. X2=XSUP
  1150. ENDIF
  1151. IF (ZSEPAR.AND.ZLOGY.AND.ZYFORC) THEN
  1152. Y1=YINF
  1153. Y2=YSUP
  1154. ENDIF
  1155.  
  1156. 34 CONTINUE
  1157.  
  1158.  
  1159. *=======================================================================
  1160. *==== CAS D'UN TRACE SEPARE (COURBE PAR COURBE) ========================
  1161.  
  1162. IF (ZSEPAR) THEN
  1163. *
  1164. ************************************************************************
  1165. * CALCUL DES BORNES DES AXES SUR X ET SUR Y (TRACES SEPARES)
  1166. ************************************************************************
  1167. *
  1168. 35 CONTINUE
  1169. IF (ZLOGX.AND.ZXFORC) THEN
  1170. XINF=X1
  1171. XSUP=X2
  1172. ENDIF
  1173. IF (ZLOGY.AND.ZYFORC) THEN
  1174. YINF=Y1
  1175. YSUP=Y2
  1176. ENDIF
  1177. NC=NC+1
  1178. IF (NC.GT.INBEVO) GOTO 1000
  1179. IF (.NOT.ZTRACE(NC)) GOTO 35
  1180. MEVOLL=IEV
  1181. SEGACT MEVOLL
  1182. KEVOLL=IEVOLL(NC)
  1183. SEGACT KEVOLL
  1184. *
  1185. * SURCHARGE DES TITRES
  1186. *
  1187. TITREX(1:20)=NOMEVX
  1188. TITREY(1:20)=NOMEVY
  1189.  
  1190. IOKX=0
  1191. IF (ZXFORC.AND.ZYFORC) IOKX=1
  1192. *
  1193. ******* BORNES IMPOSEES SUR Y MAIS PAS SUR X
  1194. *
  1195. IF(ZYFORC.AND.(.NOT.ZXFORC)) THEN
  1196. *
  1197. IOKX=-1
  1198. MLREEX=IPROGX
  1199. MLREEY=IPROGY
  1200. SEGACT MLREEX
  1201. SEGACT MLREEY
  1202. NG=MLREEX.PROG(/1)
  1203. PGX1=MLREEX.PROG(1)
  1204. PGY1=MLREEY.PROG(1)
  1205. DO 36 IG=2,NG
  1206. IOKMI=0
  1207. IOKMA=0
  1208. PGX=MLREEX.PROG(IG)
  1209. PGY=MLREEY.PROG(IG)
  1210. IF ((PGY1-YINF)*(PGY-YINF).LE.0.D0) THEN
  1211. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  1212. IOKMI=1
  1213. VMIN=YINF
  1214. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN)
  1215. ENDIF
  1216. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  1217. IOKMA=1
  1218. VMAX=YINF
  1219. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX)
  1220. ENDIF
  1221. ENDIF
  1222. IF ((PGY1-YSUP)*(PGY-YSUP).LE.0.D0) THEN
  1223. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  1224. IOKMA=1
  1225. VMAX=YSUP
  1226. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMAX)
  1227. ENDIF
  1228. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  1229. IOKMI=1
  1230. VMIN=YSUP
  1231. CALL INTEXT(PGY1,PGY,PGX1,PGX,VMIN)
  1232. ENDIF
  1233. ENDIF
  1234. IF (.NOT. ((MIN(PGY1,PGY).GT.YSUP).OR.
  1235. * (MAX(PGY1,PGY).LT.YINF))) THEN
  1236. IF (IOKMI.EQ.0) VMIN=MIN(PGX1,PGX)
  1237. IF (IOKMA.EQ.0) VMAX=MAX(PGX1,PGX)
  1238. IF (IOKX.LE.0) THEN
  1239. IOKX=1
  1240. XINF=VMIN
  1241. XSUP=VMAX
  1242. ELSE
  1243. XINF=MIN(XINF,VMIN)
  1244. XSUP=MAX(XSUP,VMAX)
  1245. ENDIF
  1246. ENDIF
  1247. PGX1=PGX
  1248. PGY1=PGY
  1249. 36 CONTINUE
  1250. IF (IOKX.LE.0) THEN
  1251. IPTR=MLREEX
  1252. CALL MINMAX(IPTR,AMINI,AMAXI)
  1253. IF (IOKX.EQ.-1) THEN
  1254. XINF=AMINI
  1255. XSUP=AMAXI
  1256. IOKX=0
  1257. ELSE
  1258. XINF=MIN(XINF,AMINI)
  1259. XSUP=MAX(XSUP,AMAXI)
  1260. ENDIF
  1261. ENDIF
  1262. SEGDES MLREEX
  1263. SEGDES MLREEY
  1264.  
  1265. ENDIF
  1266.  
  1267.  
  1268. ******* BORNES IMPOSEES SUR X MAIS PAS SUR Y
  1269. *
  1270. IF (ZXFORC.AND.(.NOT.ZYFORC)) THEN
  1271. *
  1272. IOKY=-1
  1273. MLREEX=IPROGX
  1274. MLREEY=IPROGY
  1275. SEGACT MLREEX
  1276. SEGACT MLREEY
  1277. NG=MLREEX.PROG(/1)
  1278. PGX1=MLREEX.PROG(1)
  1279. PGY1=MLREEY.PROG(1)
  1280. DO 37 IG=2,NG
  1281. IOKMI=0
  1282. IOKMA=0
  1283. PGX=MLREEX.PROG(IG)
  1284. PGY=MLREEY.PROG(IG)
  1285. IF ((PGX1-XINF)*(PGX-XINF).LE.0.D0) THEN
  1286. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  1287. IOKMI=1
  1288. VMIN=XINF
  1289. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN)
  1290. ENDIF
  1291. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  1292. IOKMA=1
  1293. VMAX=XINF
  1294. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX)
  1295. ENDIF
  1296. ENDIF
  1297. IF ((PGX1-XSUP)*(PGX-XSUP).LE.0.D0) THEN
  1298. IF ((PGX-PGX1)*(PGY-PGY1).GT.0.D0) THEN
  1299. IOKMA=1
  1300. VMAX=XSUP
  1301. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMAX)
  1302. ENDIF
  1303. IF ((PGX-PGX1)*(PGY-PGY1).LT.0.D0) THEN
  1304. IOKMI=1
  1305. VMIN=XSUP
  1306. CALL INTEXT(PGX1,PGX,PGY1,PGY,VMIN)
  1307. ENDIF
  1308. ENDIF
  1309. IF (.NOT. ((MIN(PGX1,PGX).GT.XSUP).OR.
  1310. * (MAX(PGX1,PGX).LT.XINF))) THEN
  1311. IF (IOKMI.EQ.0) VMIN=MIN(PGY1,PGY)
  1312. IF (IOKMA.EQ.0) VMAX=MAX(PGY1,PGY)
  1313. IF (IOKY.LE.0) THEN
  1314. IOKY=1
  1315. YINF=VMIN
  1316. YSUP=VMAX
  1317. ELSE
  1318. YINF=MIN(YINF,VMIN)
  1319. YSUP=MAX(YSUP,VMAX)
  1320. ENDIF
  1321. ENDIF
  1322. PGX1=PGX
  1323. PGY1=PGY
  1324. 37 CONTINUE
  1325. IF (IOKY.LE.0) THEN
  1326. IPTR=MLREEY
  1327. CALL MINMAX(IPTR,AMINI,AMAXI)
  1328. IF (IOKY.EQ.-1) THEN
  1329. YINF=AMINI
  1330. YSUP=AMAXI
  1331. IOKY=0
  1332. ELSE
  1333. YINF=MIN(YINF,AMINI)
  1334. YSUP=MAX(YSUP,AMAXI)
  1335. ENDIF
  1336. ENDIF
  1337. SEGDES MLREEX
  1338. SEGDES MLREEY
  1339.  
  1340. ENDIF
  1341.  
  1342.  
  1343. ******* PAS DE BORNES IMPOSEES
  1344. *
  1345. IF ((.NOT.ZXFORC).AND.(.NOT.ZYFORC)) THEN
  1346. IPTR=IPROGX
  1347. CALL MINMAX(IPTR,AMINI,AMAXI)
  1348. XINF=AMINI
  1349. XSUP=AMAXI
  1350. IPTR=IPROGY
  1351. CALL MINMAX(IPTR,AMINI,AMAXI)
  1352. YINF=AMINI
  1353. YSUP=AMAXI
  1354. ENDIF
  1355.  
  1356.  
  1357. ************************************************************************
  1358. * CALCUL DES MINI MAXI (TRACES SEPARES)
  1359. ************************************************************************
  1360.  
  1361. IF (ZMIMA) THEN
  1362. * SAUVEGARDE VALEUR AXE POUR CHERCHER MAXI
  1363. IPTR=IPROGY
  1364. CALL MINMAX(IPTR,YMINI,YMAXI)
  1365. ENDIF
  1366.  
  1367. SEGDES KEVOLL
  1368. SEGDES MEVOLL
  1369.  
  1370.  
  1371. ************************************************************************
  1372. * PETITS TRAVAUX SUR LES AXES X et Y (TRACES SEPARES)
  1373. ************************************************************************
  1374. *
  1375. * DANS LE CAS D'AXES EN LOG,
  1376. * ON VERIFIE QUE LES BORNES NE SONT PAS NEGATIVES
  1377. *
  1378. IF (ZLOGX.AND.XINF.LT.XMINLOG) GOTO 900
  1379. IF (ZLOGY.AND.YINF.LT.XMINLOG) GOTO 900
  1380. *
  1381. * CALCUL DES ARRONDIS
  1382. * Les bornes passent eventuellement en log10
  1383. *
  1384. CALL BORAXE(XINF,XSUP,ZLOGX)
  1385. CALL BORAXE(YINF,YSUP,ZLOGY)
  1386. *
  1387. * CALCUL DU PAS DE GRADUATION
  1388. *
  1389. CALL INTAXE (XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC)
  1390. CALL INTAXE (YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC)
  1391. *
  1392. ENDIF
  1393.  
  1394. *==== FIN DU CAS D'UN TRACE SEPARE (COURBE PAR COURBE) =================
  1395. *=======================================================================
  1396.  
  1397.  
  1398. ************************************************************************
  1399. * SAUVEGARDE DE L'AXE POUR RETOUR GRAPHE INITIAL
  1400. ************************************************************************
  1401. *
  1402. SEGINI,OLDAXE=AXE
  1403.  
  1404.  
  1405. ************************************************************************
  1406. * TRAITEMENT TRACE
  1407. ************************************************************************
  1408. *
  1409. * INITIALISATION DU GRAPHIQUE ******************************************
  1410. *
  1411. 38 CONTINUE
  1412. CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX,
  1413. & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC
  1414. & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL)
  1415. IF (IERR.NE.0) GOTO 1000
  1416. IF (PASSE.LT.0.5) THEN
  1417. TDX = ((TTXXX-TTXX)/10.)*3./4.
  1418. TDY = ((TTYYY-TTYY)/10.)*15./14.
  1419. TCENTX = TTXXX-(TDX/2.)
  1420. TCENTY = TTYYY-(TDY/2.)
  1421. OLDLOGX= TCENTX
  1422. OLDLOGY= TCENTY
  1423. OLDTX1 = TTXX
  1424. OLDTY1 = TTYY
  1425. OLDTX2 = TTXXX
  1426. OLDTY2 = TTYYY
  1427. PASSE = 1.
  1428. ENDIF
  1429.  
  1430. *
  1431. * MEMORISATION POUR IMPRESSION DU DESSIN
  1432. *
  1433. * CALL MAJSEG(1,0,0,0,0)
  1434.  
  1435. ***********************************************
  1436. * APPEL DE NLOGO
  1437. IF (ZLOGO) THEN
  1438. CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE,
  1439. & tcentx,tcenty,htlog,icolog)
  1440. CALL CHCOUL(IDCOUL)
  1441. ENDIF
  1442. *
  1443. * COMMENTAIRES SI IL Y EN A
  1444. * SEGACT COM
  1445. IF (ICOM.NE.0) THEN
  1446. DO JK=1,ICOM
  1447. CALL CHCOUL(ICOUCO(JK))
  1448. CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN)
  1449. ENDDO
  1450. CALL CHCOUL(IDCOUL)
  1451. ENDIF
  1452.  
  1453. * BERTIN: Redessiner le lien
  1454. IF(ZLIEN) THEN
  1455. DO JK=1, ICOM
  1456. TX(1)=LIEN(JK,1)
  1457. TY(1)=LIEN(JK,2)
  1458. TX(2)=LIEN(JK,3)
  1459. TY(2)=LIEN(JK,4)
  1460. CALL POLRL(2,TX,TY,tz)
  1461. ENDDO
  1462. ENDIF
  1463. *
  1464. * INDEX
  1465. *
  1466. IF (ZINDEX) THEN
  1467. CALL CHCOUL(INDCOU)
  1468. C (fdp) Affichage de la ligne horizontale de la croix
  1469. TX(1)=XINF
  1470. TX(2)=XSUP
  1471. IF (ZLOGY) THEN
  1472. TY(1)=LOG10(TLACY)
  1473. ELSE
  1474. TY(1)=TLACY
  1475. ENDIF
  1476. TY(2)=TY(1)
  1477. CALL POLRL(2,TX,TY,tz)
  1478. C (fdp) Affichage de la ligne verticale de la croix
  1479. TY(1)=YINF
  1480. TY(2)=YSUP
  1481. IF (ZLOGX) THEN
  1482. TX(1)=LOG10(TLACX)
  1483. ELSE
  1484. TX(1)=TLACX
  1485. ENDIF
  1486. TX(2)=TX(1)
  1487. CALL POLRL(2,TX,TY,tz)
  1488. C (fdp) Affichage des valeurs X et Y pointees
  1489. IF (ZLOGX) THEN
  1490. TLACX0=LOG10(TLACX)
  1491. ELSE
  1492. TLACX0=TLACX
  1493. ENDIF
  1494. IF (ZLOGY) THEN
  1495. TLACY0=LOG10(TLACY)
  1496. ELSE
  1497. TLACY0=TLACY
  1498. ENDIF
  1499. TXINF=XINF
  1500. TYINF=YINF
  1501. CALL TRLABL (TXINF,TLACY0+0.02,0.,CARDY,11,HMIN)
  1502. CALL TRLABL (TLACX0,TYINF+0.02,0.,CARDX,11,HMIN)
  1503. ENDIF
  1504.  
  1505. CALL TRCLIK(KCLICK)
  1506. *
  1507. * MEMORISATION POUR IMPRESSION DU DESSIN
  1508. *
  1509. * CALL MAJSEG(1,0,0,0,0)
  1510. *
  1511. * EN INTERACTIF CREATION MENU PRINCIPAL
  1512. * EN BATCH LOCAL CREATION FICHIER PUN
  1513. * EN BATCH AUCUN EFFET
  1514. *
  1515. 50 CONTINUE
  1516. LEGEND(1)=' Fin dessin'
  1517. LEGEND(2)=' Zoom '
  1518. LEGEND(3)=' Initial '
  1519. LEGEND(4)=' Valeur '
  1520. LEGEND(5)=' Presenter '
  1521. LEGEND(6)=' Options '
  1522. CALL MENU(LEGEND,6,13)
  1523. *
  1524. CALL TRAFF (ICLE)
  1525. IF ((ICLE.GT.5).OR.(ICLE.LT.0)) GOTO 50
  1526. *
  1527. * GESTION DU ZOOM
  1528. *
  1529. IF (ICLE.EQ.1) THEN
  1530.  
  1531. 51 CONTINUE
  1532. BUFFER='Cliquez 2 coins opposes '
  1533. CALL TRMESS(BUFFER)
  1534. * Premier clic
  1535. CALL TRDIG (TXX1,TYY1,INOUSE)
  1536. * Deuxieme clic
  1537. CALL TRDIG (TXX2,TYY2,INOUSE)
  1538. *
  1539. * Test position des deux coins l'un par rapport a l'autre
  1540. * Superieur gauche
  1541. TXX=MIN(TXX1,TXX2)
  1542. TYY=MAX(TYY1,TYY2)
  1543. * Inferieur droit
  1544. TXXX=MAX(TXX1,TXX2)
  1545. TYYY=MIN(TYY1,TYY2)
  1546. *PM IF ((ZLOGX).AND.(TXX .LT.1.E-30)) GOTO 51 ?????????????
  1547. *PM IF ((ZLOGY).AND.(TYYY.LT.1.E-30)) GOTO 51 ?????????????
  1548. *
  1549. * Restriction de la fenetre aux nouvelles bornes
  1550. * On n'intervient sur les bornes que s'il n'y a pas eu deux clics
  1551. * en dehors du cadre du meme cote : on ignore alors le zoom
  1552. * sur la coordonnee hors cadre.
  1553. XINFN = XINF
  1554. XSUPN = XSUP
  1555. YINFN = YINF
  1556. YSUPN = YSUP
  1557. IF ((TXX.GT.REAL(XINF)).AND.(TXX.LT.REAL(XSUP))) THEN
  1558. XINFN=DBLE(TXX)
  1559. ENDIF
  1560. IF ((TYY.LT.REAL(YSUP)).AND.(TYY.GT.REAL(YINF))) THEN
  1561. YSUPN=DBLE(TYY)
  1562. ENDIF
  1563. IF ((TXXX.LT.REAL(XSUP)).AND.(TXXX.GT.REAL(XINF))) THEN
  1564. XSUPN=DBLE(TXXX)
  1565. ENDIF
  1566. IF ((TYYY.GT.REAL(YINF)).AND.(TYYY.LT.REAL(YSUP))) THEN
  1567. YINFN=DBLE(TYYY)
  1568. ENDIF
  1569.  
  1570.  
  1571. * XINF, XSUP, YINF, YSUP sont eventuellement log10
  1572. * on determine les nouvelles valeurs non transformees.
  1573. IF (ZLOGX) THEN
  1574. XINF = 10.D0**XINFN
  1575. XSUP = 10.D0**XSUPN
  1576. ELSE
  1577. XINF = XINFN
  1578. XSUP = XSUPN
  1579. ENDIF
  1580. IF (ZLOGY) THEN
  1581. YINF = 10.D0**YINFN
  1582. YSUP = 10.D0**YSUPN
  1583. ELSE
  1584. YINF = YINFN
  1585. YSUP = YSUPN
  1586. ENDIF
  1587. *
  1588. * CALCUL POUR LE NOUVEL AXE
  1589. * Les bornes repassent eventuellement en log10
  1590. *
  1591. CALL BORAXE(XINF,XSUP,ZLOGX)
  1592. CALL BORAXE(YINF,YSUP,ZLOGY)
  1593. CALL INTAXE(XINF,XSUP,XINT,INX,ZLOGX,ZARR.OR.ZXFORC)
  1594. CALL INTAXE(YINF,YSUP,YINT,INY,ZLOGY,ZARR.OR.ZYFORC)
  1595. *
  1596. * Calcul nouvelles coordonnees logo
  1597. *
  1598. DELTX1 = OLDAXE.XSUP - OLDAXE.XINF
  1599. DELTX2 = XSUP - XINF
  1600.  
  1601. DELTY1 = OLDAXE.YSUP - OLDAXE.YINF
  1602. DELTY2 = YSUP - YINF
  1603.  
  1604. DELTX = DELTX1 / DELTX2
  1605. DELTY = DELTY1 / DELTY2
  1606. TCENTX = ((OLDLOGX - OLDAXE.XINF) / DELTX) + XINF
  1607. TCENTY = ((OLDLOGY - OLDAXE.YINF) / DELTY) + YINF
  1608. GOTO 38
  1609. ENDIF
  1610. *
  1611. * GESTION RETOUR AU GRAPHE ORIGINAL
  1612. *
  1613. IF (ICLE.NE.2) GOTO 7654
  1614. 125 CONTINUE
  1615. tcexx= (TCENTX -XSUP )/ ( XSUP-XINF)
  1616. tceyy= (TCENTY -YSUP )/ ( YSUP-YINF)
  1617.  
  1618. XINF = OLDAXE.XINF
  1619. XSUP = OLDAXE.XSUP
  1620. YSUP = OLDAXE.YSUP
  1621. YINF = OLDAXE.YINF
  1622. XINT = OLDAXE.XINT
  1623. YINT = OLDAXE.YINT
  1624. INX = OLDAXE.INX
  1625. INY = OLDAXE.INY
  1626. TTXX = OLDTX1
  1627. TTYY = OLDTY1
  1628. TTXXX = OLDTX2
  1629. TTYYY = OLDTY2
  1630. TDX = ((TTXXX-TTXX)/10.)* 3./4.
  1631. TDY = ((TTYYY-TTYY)/10.)*15./14.
  1632. TCENTX=tcexx *(XSUP-XINF) +XSUP
  1633. TCENTY=tceyy *(ySUP-yINF) +ySUP
  1634. * TCENTX = TTXXX-(TDX/2.)
  1635. * TCENTY = TTYYY-(TDY/2.)
  1636. OLDLOGX= TCENTX
  1637. OLDLOGY= TCENTY
  1638. GOTO 38
  1639. 7654 CONTINUE
  1640. *
  1641. * GESTION AFFICHAGE DE VALEUR
  1642. *
  1643. IF (ICLE.NE.3) GOTO 7657
  1644. ZVALEUR=.TRUE.
  1645. ICOURB=1
  1646. TXXX=REAL(XINF+(XSUP-XINF)/2.D0)
  1647. TYYY=REAL(YINF+(YSUP-YINF)/2.D0)
  1648. C Acquisition des coordonnees X Y du pointeur de la souris dans la
  1649. C fenetre par click de l'utilisateur
  1650. 52 CONTINUE
  1651. CALL TRDIG (TXXX,TYYY,INOUSE)
  1652. TXXA=TXXX
  1653. TYYA=TYYY
  1654. C Recheche du numero JKNUM du point de l'evolution ICOURB le plus
  1655. C proche du point clicke
  1656. MEVOLL=IEV
  1657. SEGACT MEVOLL
  1658. KEVOLL=IEVOLL(ICOURB)
  1659. SEGACT KEVOLL
  1660. MLREEL=IPROGX
  1661. SEGACT MLREEL
  1662. CALL CHCOUL (IDCOUL)
  1663. 77 CONTINUE
  1664. C Numero de couleur de l'evolution ICOURB
  1665. INDCOU=NUMEVX
  1666. JKNUM=1
  1667. IF(PROG(PROG(/1)).LE.TXXA) THEN
  1668. JKNUM=PROG(/1)
  1669. GOTO 777
  1670. ENDIF
  1671. DO JK=1,PROG(/1)
  1672. IF(PROG(JK).GT.TXXA) THEN
  1673. IF(JK.GT.1) THEN
  1674. IF(ABS(PROG(JK)-TXXA).GT.ABS(PROG(JK-1)-TXXA)) THEN
  1675. JKNUM=JK-1
  1676. ELSE
  1677. JKNUM=JK
  1678. ENDIF
  1679. ELSE
  1680. JKNUM=JK
  1681. ENDIF
  1682. GOTO 777
  1683. ENDIF
  1684. ENDDO
  1685. 777 CONTINUE
  1686. BUFFER4=' Courbe : '
  1687. BUFFER3='Point : '
  1688. C Recuperation des abscisses et ordonnees du curseur, il s'agit du
  1689. C point numero JKNUM de l'evolution ICOURB
  1690. TXXA=PROG(JKNUM)
  1691. BUFFER1='X : '
  1692. SEGDES MLREEL
  1693. 7773 WRITE (BUFFER4(12:18),FMT='(I6)') ICOURB
  1694. WRITE (BUFFER3(9:15),FMT='(I6)') JKNUM
  1695. WRITE (BUFFER1(4:14),FMT='(G11.4)') TXXA
  1696. BUFFER2='Y : '
  1697. MLREEL=IPROGY
  1698. SEGACT MLREEL
  1699. TYYA=PROG(JKNUM)
  1700. SEGDES MLREEL,KEVOLL,MEVOLL
  1701. WRITE (BUFFER2(4:14),FMT='(G11.4)') TYYA
  1702. C Pour l'affichage d'une croix au point correspondant au curseur
  1703. C et avec la couleur de la courbe choisie s'il vous plait !
  1704. ZINDEX=.TRUE.
  1705. TLACX=TXXA
  1706. TLACY=TYYA
  1707. IF (ZVALEUR) THEN
  1708. C test sur les bornes de la fenetre de trace
  1709. C attention, en ca sd'echelle logarithmique, il ne faut pas
  1710. C raisonner sur la valeur X mais sur la valeur p telle que X=10^p
  1711. IF (ZLOGX) THEN
  1712. TLACX0=LOG10(TLACX)
  1713. ELSE
  1714. TLACX0=TLACX
  1715. ENDIF
  1716. IF (ZLOGY) THEN
  1717. TLACY0=LOG10(TLACY)
  1718. ELSE
  1719. TLACY0=TLACY
  1720. ENDIF
  1721. IF (TLACY0.GT.REAL(YSUP)) THEN
  1722. TLACY0=REAL(YSUP)
  1723. ENDIF
  1724. IF (TLACY0.LT.REAL(YINF)) THEN
  1725. TLACY0=REAL(YINF)
  1726. ENDIF
  1727. IF (TLACX0.GT.REAL(XSUP)) THEN
  1728. TLACX0=REAL(XSUP)
  1729. ENDIF
  1730. IF (TLACX0.LT.REAL(XINF)) THEN
  1731. TLACX0=REAL(XINF)
  1732. ENDIF
  1733. WRITE (CARDX(1:11),FMT='(G11.4)') TLACX
  1734. WRITE (CARDY(1:11),FMT='(G11.4)') TLACY
  1735. GOTO 5000
  1736. ENDIF
  1737. 7772 CONTINUE
  1738. C Affichage du texte en bas de la fenetre et du menu de deplacement
  1739. C du curseur
  1740. ZVALEUR=.TRUE.
  1741. CALL TRMESS(BUFFER1//BUFFER2//BUFFER3//BUFFER4)
  1742. LEGEND(1)=' Retour '
  1743. LEGEND(2)=' <-- '
  1744. LEGEND(3)=' --> '
  1745. LEGEND(4)=' Courbe prec.'
  1746. LEGEND(5)=' Courbe suiv.'
  1747. CALL MENU(LEGEND,5,13)
  1748. CALL TRAFF(ICLE9)
  1749. C Gestion du deplacement du curseur
  1750. C - cas du click sur la case "Retour"
  1751. IF (ICLE9.EQ.0) THEN
  1752. ZVALEUR=.FALSE.
  1753. GOTO 50
  1754. C - cas du click sur la case "<--" (point precedant)
  1755. ELSEIF (ICLE9.EQ.1) THEN
  1756. JKNUM=JKNUM-1
  1757. SEGACT MEVOLL
  1758. KEVOLL=IEVOLL(ICOURB)
  1759. SEGACT KEVOLL
  1760. MLREEL=IPROGX
  1761. SEGACT MLREEL
  1762. JKNUM=MAX(1,JKNUM)
  1763. TXXA=PROG(JKNUM)
  1764. SEGDES MLREEL,KEVOLL,MEVOLL
  1765. GOTO 7773
  1766. C - cas du click sur la case "-->" (point suivant)
  1767. ELSEIF (ICLE9.EQ.2) THEN
  1768. JKNUM=JKNUM+1
  1769. SEGACT MEVOLL
  1770. KEVOLL=IEVOLL(ICOURB)
  1771. SEGACT KEVOLL
  1772. MLREEL=IPROGX
  1773. SEGACT MLREEL
  1774. JKNUM=MIN(JKNUM,PROG(/1))
  1775. TXXA=PROG(JKNUM)
  1776. SEGDES MLREEL,KEVOLL,MEVOLL
  1777. GOTO 7773
  1778. C - cas du click sur la case "Courbe precedente"
  1779. ELSEIF (ICLE9.EQ.3) THEN
  1780. IF (ICOURB.EQ.1) THEN
  1781. ICOURB=INBEVO
  1782. ELSE
  1783. ICOURB=ICOURB-1
  1784. ENDIF
  1785. MEVOLL=IEV
  1786. SEGACT MEVOLL
  1787. KEVOLL=IEVOLL(ICOURB)
  1788. SEGACT KEVOLL
  1789. MLREEL=IPROGX
  1790. SEGACT MLREEL
  1791. GOTO 77
  1792. C - cas du click sur la case "Courbe suivante"
  1793. ELSEIF (ICLE9.EQ.4) THEN
  1794. IF (ICOURB.EQ.INBEVO) THEN
  1795. ICOURB=1
  1796. ELSE
  1797. ICOURB=ICOURB+1
  1798. ENDIF
  1799. MEVOLL=IEV
  1800. SEGACT MEVOLL
  1801. KEVOLL=IEVOLL(ICOURB)
  1802. SEGACT KEVOLL
  1803. MLREEL=IPROGX
  1804. SEGACT MLREEL
  1805. GOTO 77
  1806. C - dans les autres cas, on repart a l'acquisition des coordonnees
  1807. C du pointeur de souris
  1808. ELSE
  1809. GOTO 52
  1810. ENDIF
  1811. 7657 CONTINUE
  1812. *
  1813. * IMPRESSION PAR CREATION D'UN FICHIER LGI
  1814. *
  1815. IF (ICLE .EQ. 11) THEN
  1816. CALL FLGI
  1817. GOTO 50
  1818. ENDIF
  1819. *
  1820. * GESTION DES OPTIONS
  1821. *
  1822. IF (ICLE.EQ.5) THEN
  1823. 123 LEGEND(1)=' Retour '
  1824. LEGEND(2)=' Fonts>> '
  1825. IF (ICOSC.EQ.1) THEN
  1826. LEGEND(3)='Ecran>> Blanc'
  1827. ELSE IF (ICOSC.EQ.2) THEN
  1828. LEGEND(3)='Ecran>> Noir'
  1829. ENDIF
  1830. IF (ZDATE) THEN
  1831. LEGEND(4)=' (X) Date '
  1832. ELSE
  1833. LEGEND(4)=' ( ) Date '
  1834. ENDIF
  1835. IF (ZGRILL) THEN
  1836. LEGEND(5)=' (X)Grille '
  1837. ELSE
  1838. LEGEND(5)=' ( )Grille '
  1839. ENDIF
  1840. CALL MENU(LEGEND,5,13)
  1841. CALL TRAFF (ICLE2)
  1842. IF (ICLE2.EQ.0) GOTO 38
  1843. IF (ICLE2.EQ.1) THEN
  1844. 124 LEGEND(1)=' Retour '
  1845. LEGEND(2)=' 8_BY_13 '
  1846. LEGEND(3)=' 9_BY_15 '
  1847. LEGEND(4)=' TIMES_10 '
  1848. LEGEND(5)=' TIMES_24 '
  1849. LEGEND(6)=' HELV_10 '
  1850. LEGEND(7)=' HELV_12 '
  1851. LEGEND(8)=' HELV_18 '
  1852. CALL MENU(LEGEND,8,13)
  1853. CALL TRAFF(ICLE3)
  1854. IF (ICLE3.EQ.0) GOTO 38
  1855. IOPOLI=ICLE3
  1856. GOTO 38
  1857. ELSEIF (ICLE2.EQ.2) THEN
  1858. IF (ICOSC.EQ.1) THEN
  1859. ICOSC=2
  1860. ELSE IF (ICOSC.EQ.2) THEN
  1861. ICOSC=1
  1862. ENDIF
  1863. GOTO 38
  1864. ELSEIF (ICLE2.EQ.3) THEN
  1865. IF (ZDATE) THEN
  1866. ZDATE=.FALSE.
  1867. ELSE
  1868. ZDATE=.TRUE.
  1869. ENDIF
  1870. GOTO 38
  1871. ELSEIF (ICLE2.EQ.4) THEN
  1872. IF (ZGRILL) THEN
  1873. ZGRILL=.FALSE.
  1874. ELSE
  1875. ZGRILL=.TRUE.
  1876. ENDIF
  1877. GOTO 38
  1878. ENDIF
  1879. ENDIF
  1880.  
  1881. *
  1882. * GESTION PRESENTATION
  1883. *
  1884. **TC IF (ICLE.EQ.4) THEN
  1885. IF( ICLE.ne.4) go to 7659
  1886.  
  1887.  
  1888. * TRACE GRAPHIQUE ******************************************************
  1889.  
  1890. 5000 CONTINUE
  1891. CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX,
  1892. & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC
  1893. & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL)
  1894. IF (IERR.NE.0) GOTO 1000
  1895.  
  1896. * APPEL DE NLOGO
  1897. IF (ZLOGO) THEN
  1898. CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE,
  1899. & TCENTX,TCENTY,HTLOG,ICOLOG)
  1900. CALL CHCOUL(IDCOUL)
  1901. ENDIF
  1902. *
  1903. * COMMENTAIRES SI IL Y EN A
  1904. * SEGACT COM
  1905. IF (ICOM.NE.0) THEN
  1906. DO JK=1,ICOM
  1907. CALL CHCOUL(ICOUCO(JK))
  1908. CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN)
  1909. ENDDO
  1910. CALL CHCOUL(IDCOUL)
  1911. ENDIF
  1912.  
  1913. * BERTIN: Redessiner le lien
  1914. IF(ZLIEN) THEN
  1915. DO JK=1, ICOM
  1916. TX(1)=LIEN(JK,1)
  1917. TY(1)=LIEN(JK,2)
  1918. TX(2)=LIEN(JK,3)
  1919. TY(2)=LIEN(JK,4)
  1920. CALL POLRL(2,TX,TY,tz)
  1921. ENDDO
  1922. ENDIF
  1923. *
  1924. * INDEX
  1925. *
  1926. IF (ZINDEX) THEN
  1927. CALL CHCOUL(INDCOU)
  1928. C (fdp) Affichage de la ligne horizontale de la croix
  1929. TX(1)=XINF
  1930. TX(2)=XSUP
  1931. IF (ZLOGY) THEN
  1932. TY(1)=LOG10(TLACY)
  1933. ELSE
  1934. TY(1)=TLACY
  1935. ENDIF
  1936. TY(2)=TY(1)
  1937. CALL POLRL(2,TX,TY,tz)
  1938. C (fdp) Affichage de la ligne verticale de la croix
  1939. TY(1)=YINF
  1940. TY(2)=YSUP
  1941. IF (ZLOGX) THEN
  1942. TX(1)=LOG10(TLACX)
  1943. ELSE
  1944. TX(1)=TLACX
  1945. ENDIF
  1946. TX(2)=TX(1)
  1947. CALL POLRL(2,TX,TY,tz)
  1948. C (fdp) Affichage des valeurs X et Y pointees
  1949. IF (ZLOGX) THEN
  1950. TLACX0=LOG10(TLACX)
  1951. ELSE
  1952. TLACX0=TLACX
  1953. ENDIF
  1954. IF (ZLOGY) THEN
  1955. TLACY0=LOG10(TLACY)
  1956. ELSE
  1957. TLACY0=TLACY
  1958. ENDIF
  1959. TXINF=XINF
  1960. TYINF=YINF
  1961. CALL TRLABL (TXINF,TLACY0+0.02,0.,CARDY,11,HMIN)
  1962. CALL TRLABL (TLACX0,TYINF+0.02,0.,CARDX,11,HMIN)
  1963. ENDIF
  1964. ************************************************************************
  1965. IF (ZVALEUR) THEN
  1966. ZVALEUR=.FALSE.
  1967. GOTO 7772
  1968. END IF
  1969. LEGEND(1)='Retour'
  1970. LEGEND(2)='Index'
  1971. LEGEND(3)='Enleve index'
  1972. LEGEND(4)='Comment>> '
  1973. LEGEND(5)='Logo>> '
  1974. LEGEND(6)='Titres>> '
  1975. CALL MENU(LEGEND,6,13)
  1976. CALL TRAFF(ICLE3)
  1977. C - cas du click sur la case "Retour"
  1978. IF (ICLE3.EQ.0) THEN
  1979. GOTO 38
  1980. C - cas du click sur la case "Index"
  1981. ELSEIF (ICLE3.EQ.1) THEN
  1982. ZINDEX=.TRUE.
  1983. C acquisition des coordonnees X Y du pointeur de la souris dans
  1984. C la fenetre par click de l'utilisateur
  1985. BUFFER='Pointez index'
  1986. CALL TRMESS(BUFFER)
  1987. CALL TRDIG (TLACX,TLACY,INOUSE)
  1988. INDCOU=IDCOUL
  1989. C test sur les bornes de la fenetre de trace
  1990. IF (TLACY.GT.REAL(YSUP)) THEN
  1991. TLACY=REAL(YSUP)
  1992. ENDIF
  1993. IF (TLACY.LT.REAL(YINF)) THEN
  1994. TLACY=REAL(YINF)
  1995. ENDIF
  1996. IF (TLACX.GT.REAL(XSUP)) THEN
  1997. TLACX=REAL(XSUP)
  1998. ENDIF
  1999. IF (TLACX.LT.REAL(XINF)) THEN
  2000. TLACX=REAL(XINF)
  2001. ENDIF
  2002. C convertion si echelles logarithmiques
  2003. IF (ZLOGX) TLACX=10D0**TLACX
  2004. IF (ZLOGY) TLACY=10D0**TLACY
  2005. WRITE (CARDX(1:11),FMT='(G11.4)') TLACX
  2006. WRITE (CARDY(1:11),FMT='(G11.4)') TLACY
  2007. GOTO 5000
  2008. C - cas du click sur la case "Enleve index"
  2009. ELSEIF (ICLE3.EQ.2) THEN
  2010. ZINDEX=.FALSE.
  2011. GOTO 5000
  2012. C - cas du click sur la case "Comment>>"
  2013. ELSEIF (ICLE3.EQ.3) THEN
  2014. GOTO 6800
  2015. C - cas du click sur la case "Logo>>"
  2016. ELSEIF (ICLE3.EQ.4) THEN
  2017. GOTO 6000
  2018. C - cas du click sur la case "Titres>>"
  2019. ELSEIF (ICLE3.EQ.5) THEN
  2020. GOTO 6500
  2021. ENDIF
  2022.  
  2023. * TRACE GRAPHIQUE ******************************************************
  2024.  
  2025. 6000 CONTINUE
  2026. CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX,
  2027. & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC
  2028. & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL)
  2029. IF (IERR.NE.0) GOTO 1000
  2030.  
  2031. * APPEL DE NLOGO
  2032. IF (ZLOGO) THEN
  2033. CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE,
  2034. & TCENTX,TCENTY,HTLOG,ICOLOG)
  2035. CALL CHCOUL(IDCOUL)
  2036. ENDIF
  2037. *
  2038. * COMMENTAIRES SI IL Y EN A
  2039. * SEGACT COM
  2040. IF (ICOM.NE.0) THEN
  2041. DO JK=1,ICOM
  2042. CALL CHCOUL(ICOUCO(JK))
  2043. CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN)
  2044. ENDDO
  2045. CALL CHCOUL(IDCOUL)
  2046. ENDIF
  2047.  
  2048. * BERTIN: Redessiner le lien
  2049. IF(ZLIEN) THEN
  2050. DO JK=1, ICOM
  2051. TX(1)=LIEN(JK,1)
  2052. TY(1)=LIEN(JK,2)
  2053. TX(2)=LIEN(JK,3)
  2054. TY(2)=LIEN(JK,4)
  2055. CALL POLRL(2,TX,TY,tz)
  2056. ENDDO
  2057. ENDIF
  2058. *
  2059. * INDEX
  2060. *
  2061. IF (ZINDEX) THEN
  2062. CALL CHCOUL(INDCOU)
  2063. C (fdp) Affichage de la ligne horizontale de la croix
  2064. TX(1)=XINF
  2065. TX(2)=XSUP
  2066. IF (ZLOGY) THEN
  2067. TY(1)=LOG10(TLACY)
  2068. ELSE
  2069. TY(1)=TLACY
  2070. ENDIF
  2071. TY(2)=TY(1)
  2072. CALL POLRL(2,TX,TY,tz)
  2073. C (fdp) Affichage de la ligne verticale de la croix
  2074. TY(1)=YINF
  2075. TY(2)=YSUP
  2076. IF (ZLOGX) THEN
  2077. TX(1)=LOG10(TLACX)
  2078. ELSE
  2079. TX(1)=TLACX
  2080. ENDIF
  2081. TX(2)=TX(1)
  2082. CALL POLRL(2,TX,TY,tz)
  2083. C (fdp) Affichage des valeurs X et Y pointees
  2084. IF (ZLOGX) THEN
  2085. TLACX0=LOG10(TLACX)
  2086. ELSE
  2087. TLACX0=TLACX
  2088. ENDIF
  2089. IF (ZLOGY) THEN
  2090. TLACY0=LOG10(TLACY)
  2091. ELSE
  2092. TLACY0=TLACY
  2093. ENDIF
  2094. TXINF=XINF
  2095. TYINF=YINF
  2096. CALL TRLABL (TXINF,TLACY0+0.02,0.,CARDY,11,HMIN)
  2097. CALL TRLABL (TLACX0,TYINF+0.02,0.,CARDX,11,HMIN)
  2098. ENDIF
  2099.  
  2100. LEGEND (1)=' << Logo'
  2101. LEGEND (2)='Position'
  2102. LEGEND (3)='Couleur'
  2103. LEGEND (4)='Taille'
  2104. IF (ZLOGO) THEN
  2105. LEGEND (5)=' (X) Logo'
  2106. ELSE
  2107. LEGEND (5)=' ( ) Logo'
  2108. ENDIF
  2109.  
  2110. CALL MENU (LEGEND,5,13)
  2111. CALL TRAFF (ICLE4)
  2112. * REVENIR
  2113. IF (ICLE4.EQ.0) GOTO 5000
  2114. * POSITION
  2115. IF (ICLE4.EQ.1) THEN
  2116. CALL TRMESS ('Cliquer sur la nouvelle position')
  2117. CALL TRDIG (TCENTX,TCENTY,inouse)
  2118. OLDLOGX=TCENTX
  2119. OLDLOGY=TCENTY
  2120. ENDIF
  2121. * COULEUR
  2122. IF (ICLE4.EQ.2) THEN
  2123. NUM=NBCOUL
  2124. CALL TRGETC (NUM)
  2125. ICOLOG = NUM
  2126. ENDIF
  2127. * TAILLE
  2128. IF (ICLE4.EQ.3) THEN
  2129. CALL TRGET ('Entrer la nouvelle taille du logo 1 a 9:',TMPCAR)
  2130. READ(TMPCAR,'(I1)') IRA
  2131. ra=IRA
  2132. IF ( (RA.LT.1).OR. (RA.GT.10.0)) THEN
  2133. CALL TRMESS ('Taille incorrecte')
  2134. ELSE
  2135. HTLOG = REAL (RA * HDPLOG)
  2136. ENDIF
  2137. ENDIF
  2138. * ON/OFF
  2139. IF (ICLE4.EQ.4) THEN
  2140. IF (ZLOGO) THEN
  2141. ZLOGO = .FALSE.
  2142. ELSE
  2143. ZLOGO = .TRUE.
  2144. ENDIF
  2145. ENDIF
  2146. * RETOUR
  2147. GOTO 6000
  2148. * ENDIF
  2149.  
  2150.  
  2151. * TRACE GRAPHIQUE ******************************************************
  2152.  
  2153. 6500 CONTINUE
  2154. CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX,
  2155. & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC
  2156. & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL)
  2157. IF (IERR.NE.0) GOTO 1000
  2158.  
  2159. * APPEL DE NLOGO
  2160. IF (ZLOGO) THEN
  2161. CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE,
  2162. & TCENTX,TCENTY,HTLOG,ICOLOG)
  2163. CALL CHCOUL(IDCOUL)
  2164. ENDIF
  2165. *
  2166. * COMMENTAIRES SI IL Y EN A
  2167. * SEGACT COM
  2168. IF (ICOM.NE.0) THEN
  2169. DO JK=1,ICOM
  2170. CALL CHCOUL(ICOUCO(JK))
  2171. CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN)
  2172. ENDDO
  2173. CALL CHCOUL(IDCOUL)
  2174. ENDIF
  2175.  
  2176. * BERTIN: Redessiner le lien
  2177. IF(ZLIEN) THEN
  2178. DO JK=1, ICOM
  2179. TX(1)=LIEN(JK,1)
  2180. TY(1)=LIEN(JK,2)
  2181. TX(2)=LIEN(JK,3)
  2182. TY(2)=LIEN(JK,4)
  2183. CALL POLRL(2,TX,TY,tz)
  2184. ENDDO
  2185. ENDIF
  2186. *
  2187. * INDEX
  2188. *
  2189. IF (ZINDEX) THEN
  2190. CALL CHCOUL(INDCOU)
  2191. C (fdp) Affichage de la ligne horizontale de la croix
  2192. TX(1)=XINF
  2193. TX(2)=XSUP
  2194. IF (ZLOGY) THEN
  2195. TY(1)=LOG10(TLACY)
  2196. ELSE
  2197. TY(1)=TLACY
  2198. ENDIF
  2199. TY(2)=TY(1)
  2200. CALL POLRL(2,TX,TY,tz)
  2201. C (fdp) Affichage de la ligne verticale de la croix
  2202. TY(1)=YINF
  2203. TY(2)=YSUP
  2204. IF (ZLOGX) THEN
  2205. TX(1)=LOG10(TLACX)
  2206. ELSE
  2207. TX(1)=TLACX
  2208. ENDIF
  2209. TX(2)=TX(1)
  2210. CALL POLRL(2,TX,TY,tz)
  2211. C (fdp) Affichage des valeurs X et Y pointees
  2212. IF (ZLOGX) THEN
  2213. TLACX0=LOG10(TLACX)
  2214. ELSE
  2215. TLACX0=TLACX
  2216. ENDIF
  2217. IF (ZLOGY) THEN
  2218. TLACY0=LOG10(TLACY)
  2219. ELSE
  2220. TLACY0=TLACY
  2221. ENDIF
  2222. TXINF=XINF
  2223. TYINF=YINF
  2224. CALL TRLABL (TXINF,TLACY0+0.02,0.,CARDY,11,HMIN)
  2225. CALL TRLABL (TLACX0,TYINF+0.02,0.,CARDX,11,HMIN)
  2226. ENDIF
  2227.  
  2228. LEGEND (1)=' << Titres'
  2229. LEGEND (2)='Titre gene.'
  2230. LEGEND (3)='Titre X'
  2231. LEGEND (4)='Titre Y'
  2232.  
  2233. CALL MENU (LEGEND,4,13)
  2234. CALL TRAFF (ICLE5)
  2235. * REVENIR
  2236. IF (ICLE5.EQ.0) GOTO 5000
  2237. * TITRE GENERAL
  2238. IF (ICLE5.EQ.1) THEN
  2239. CALL TRGET ('Entrez le nouveau titre general :',TMPCAR)
  2240. TXTIT=TMPCAR
  2241. ENDIF
  2242. * TITRE EN X
  2243. IF (ICLE5.EQ.2) THEN
  2244. CALL TRGET ('Entrez le nouveau titre en X :',TMPCAR)
  2245. TXAXE=TMPCAR
  2246. ENDIF
  2247. * TITRE EN Y
  2248. IF (ICLE5.EQ.3) THEN
  2249. CALL TRGET ('Entrez le nouveau titre en Y :',TMPCAR)
  2250. TYAXE=TMPCAR
  2251. ENDIF
  2252. * RETOUR
  2253. GOTO 6500
  2254. * ENDIF
  2255.  
  2256.  
  2257. * TRACE GRAPHIQUE ******************************************************
  2258.  
  2259. 6800 CONTINUE
  2260. CALL OPTDES (IOPTIO,NOL,AXE,TITRE,TXTIT,TXAXE,TYAXE,TTXX,TTXXX,
  2261. & TTYY,TTYYY,ZAXES,ZSEPAR,ZOPTIO,ZLEGEN,IEV,DYN,NDIMT,CUR,NDIMT2,NC
  2262. & ,INBEVO,ZMIMA,ZDATE,YMINI,YMAXI,IPOSI,XPOSI,YPOSI,IGRIL)
  2263. IF (IERR.NE.0) GOTO 1000
  2264.  
  2265. * APPEL DE NLOGO
  2266. IF (ZLOGO) THEN
  2267. CALL LOGDES (TTXXX,TTYYY,TTXX,TTYY,AXE,
  2268. & TCENTX,TCENTY,HTLOG,ICOLOG)
  2269. CALL CHCOUL(IDCOUL)
  2270. ENDIF
  2271. *
  2272. * COMMENTAIRES SI IL Y EN A
  2273. * SEGACT COM
  2274. IF (ICOM.NE.0) THEN
  2275. DO JK=1,ICOM
  2276. CALL CHCOUL(ICOUCO(JK))
  2277. CALL TRLABL (TXCOM(JK),TYCOM(JK),0.,COMMENT(JK),30,HMIN)
  2278. ENDDO
  2279. CALL CHCOUL(IDCOUL)
  2280. ENDIF
  2281. *
  2282. * INDEX
  2283. *
  2284. IF (ZINDEX) THEN
  2285. CALL CHCOUL(INDCOU)
  2286. C (fdp) Affichage de la ligne horizontale de la croix
  2287. TX(1)=XINF
  2288. TX(2)=XSUP
  2289. IF (ZLOGY) THEN
  2290. TY(1)=LOG10(TLACY)
  2291. ELSE
  2292. TY(1)=TLACY
  2293. ENDIF
  2294. TY(2)=TY(1)
  2295. CALL POLRL(2,TX,TY,tz)
  2296. C (fdp) Affichage de la ligne verticale de la croix
  2297. TY(1)=YINF
  2298. TY(2)=YSUP
  2299. IF (ZLOGX) THEN
  2300. TX(1)=LOG10(TLACX)
  2301. ELSE
  2302. TX(1)=TLACX
  2303. ENDIF
  2304. TX(2)=TX(1)
  2305. CALL POLRL(2,TX,TY,tz)
  2306. C (fdp) Affichage des valeurs X et Y pointees
  2307. IF (ZLOGX) THEN
  2308. TLACX0=LOG10(TLACX)
  2309. ELSE
  2310. TLACX0=TLACX
  2311. ENDIF
  2312. IF (ZLOGY) THEN
  2313. TLACY0=LOG10(TLACY)
  2314. ELSE
  2315. TLACY0=TLACY
  2316. ENDIF
  2317. TXINF=XINF
  2318. TYINF=YINF
  2319. CALL TRLABL (TXINF,TLACY0+0.02,0.,CARDY,11,HMIN)
  2320. CALL TRLABL (TLACX0,TYINF+0.02,0.,CARDX,11,HMIN)
  2321. ENDIF
  2322.  
  2323. * BERTIN: Redessiner le lien
  2324. IF(ZLIEN) THEN
  2325. DO JK=1, ICOM
  2326. TX(1)=LIEN(JK,1)
  2327. TY(1)=LIEN(JK,2)
  2328. TX(2)=LIEN(JK,3)
  2329. TY(2)=LIEN(JK,4)
  2330. CALL POLRL(2,TX,TY,tz)
  2331. ENDDO
  2332. ENDIF
  2333.  
  2334. LEGEND (1)='Comment <<'
  2335. LEGEND (2)='Ajout'
  2336. LEGEND (3)='Enleve/Modif'
  2337. LEGEND (4)='Deplacement'
  2338. LEGEND (5)='Couleur'
  2339. LEGEND (6)='Lien'
  2340.  
  2341. CALL MENU (LEGEND,6,13)
  2342. CALL TRAFF (ICLE6)
  2343. * REVENIR
  2344. IF (ICLE6.EQ.0) GOTO 5000
  2345.  
  2346. * AJOUT
  2347. IF (ICLE6.EQ.1) THEN
  2348. IF (ICOM.EQ.10) THEN
  2349. BUFFER='10 commentaires maxi - Pointer'
  2350. CALL TRMESS(BUFFER)
  2351. CALL TRDIG (TXXX,TYYY,INOUSE)
  2352. GOTO 6800
  2353. ELSE
  2354. ICOM=ICOM+1
  2355. TXXX=REAL(XINF+(XSUP-XINF)/2.D0)
  2356. TYYY=REAL(YINF+(YSUP-YINF)/2.D0)
  2357. BUFFER='Pointez commentaire'
  2358. CALL TRMESS(BUFFER)
  2359. CALL TRDIG (TXXX,TYYY,INOUSE)
  2360. CALL TRGET ('Entrez le commentaire :',TMPCAR)
  2361. COMMENT(ICOM)=TMPCAR
  2362. TXCOM(ICOM)=TXXX
  2363. TYCOM(ICOM)=TYYY
  2364. ICOUCO(ICOM)=IDCOUL
  2365. GOTO 6800
  2366. ENDIF
  2367. ENDIF
  2368.  
  2369. * SUPRESSION
  2370. IF (ICLE6.EQ.2) THEN
  2371. IF (ICOM.NE.0) THEN
  2372. BUFFER='Pointez commentaire'
  2373. CALL TRMESS(BUFFER)
  2374. CALL TRDIG (TXXX,TYYY,INOUSE)
  2375. CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM)
  2376. IF (IBON.NE.0) THEN
  2377. TMPCAR=' '
  2378. CALL TRGET ('Entrez le commentaire :',TMPCAR)
  2379. IF (TMPCAR.NE.' ') THEN
  2380. COMMENT(IBON)=TMPCAR
  2381. ELSE
  2382. IF (IBON.EQ.ICOM) THEN
  2383. ICOM=ICOM - 1
  2384. TXCOM(IBON)=0.
  2385. TYCOM(IBON)=0.
  2386. ICOUCO(IBON)=0
  2387. LIEN(IBON,1)=0.
  2388. LIEN(IBON,2)=0.
  2389. LIEN(IBON,3)=0.
  2390. LIEN(IBON,4)=0.
  2391. ELSE
  2392. DO J=IBON+1,ICOM
  2393. TXCOM(J-1)=TXCOM(J)
  2394. TYCOM(J-1)=TYCOM(J)
  2395. COMMENT(J-1)=COMMENT(J)
  2396. ICOUCO(J-1)=ICOUCO(J)
  2397. LIEN(J-1,1)=LIEN(J,1)
  2398. LIEN(J-1,2)=LIEN(J,2)
  2399. LIEN(J-1,3)=LIEN(J,3)
  2400. LIEN(J-1,4)=LIEN(J,4)
  2401. ENDDO
  2402. TXCOM(ICOM)=0.
  2403. TYCOM(ICOM)=0.
  2404. ICOUCO(ICOM)=0
  2405. COMMENT(ICOM)=' '
  2406. ICOM=ICOM - 1
  2407. * LIEN(ICOM,1)=0.
  2408. * LIEN(ICOM,2)=0.
  2409. * LIEN(ICOM,3)=0.
  2410. * LIEN(ICOM,4)=0.
  2411. ENDIF
  2412. GOTO 6800
  2413. ENDIF
  2414. ELSE
  2415. GOTO 6800
  2416. ENDIF
  2417. ENDIF
  2418. GOTO 6800
  2419. ENDIF
  2420. * DEPLACEMENT
  2421. IF (ICOM.NE.0) THEN
  2422. IF (ICLE6.EQ.3) THEN
  2423. BUFFER='Pointez commentaire'
  2424. CALL TRMESS(BUFFER)
  2425. CALL TRDIG (TXXX,TYYY,INOUSE)
  2426. CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM)
  2427. IF (IBON.NE.0) THEN
  2428. BUFFER='Nouvelle position ?'
  2429. CALL TRMESS(BUFFER)
  2430. CALL TRDIG (TXXX,TYYY,INOUSE)
  2431. TXCOM(IBON)=TXXX
  2432. TYCOM(IBON)=TYYY
  2433. GOTO 38
  2434. ENDIF
  2435. GOTO 6800
  2436. ENDIF
  2437. ENDIF
  2438.  
  2439. *COULEUR
  2440. IF (ICOM.NE.0) THEN
  2441. IF (ICLE6.EQ.4) THEN
  2442. BUFFER='Pointez commentaire'
  2443. CALL TRMESS(BUFFER)
  2444. CALL TRDIG (TXXX,TYYY,INOUSE)
  2445. CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM)
  2446. IF (IBON.NE.0) THEN
  2447. NUM=NBCOUL
  2448. CALL TRGETC (NUM)
  2449. ICOUCO(IBON) = NUM
  2450. ENDIF
  2451. GOTO 6800
  2452. ENDIF
  2453. ENDIF
  2454.  
  2455. * BERTIN: Creation d'un trait entre un commentaire et une zone
  2456. * LIEN
  2457.  
  2458. IF (ICOM.NE.0) THEN
  2459. IF (ICLE6.EQ.5) THEN
  2460. ZLIEN=.TRUE.
  2461. BUFFER='Pointez commentaire'
  2462. CALL TRMESS(BUFFER)
  2463. CALL TRDIG (TXXX,TYYY,INOUSE)
  2464. CALL CHERCO (TXXX,TYYY,ICOM,AXE,IBON,COM)
  2465. LIEN(IBON,1)=TXCOM(IBON)
  2466. LIEN(IBON,2)=TYCOM(IBON)
  2467.  
  2468. IF (IBON.NE.0) THEN
  2469. BUFFER='Zone a annoter ?'
  2470. CALL TRMESS(BUFFER)
  2471. CALL TRDIG (TXXX,TYYY,INOUSE)
  2472. LIEN(IBON,3)=TXXX
  2473. LIEN(IBON,4)=TYYY
  2474. LIEN(IBON,5)=1.
  2475. TX(1)=LIEN(IBON,1)
  2476. TY(1)=LIEN(IBON,2)
  2477. TX(2)=LIEN(IBON,3)
  2478. TY(2)=LIEN(IBON,4)
  2479. CALL POLRL(2,TX,TY,tz)
  2480. ENDIF
  2481. GOTO 6800
  2482. ENDIF
  2483. ENDIF
  2484. * BERTIN: Fin creation lien commentaire
  2485.  
  2486. * RETOUR
  2487. GOTO 6800
  2488. **TC ENDIF
  2489. 7659 continue
  2490. *
  2491. * RETOUR EVOLUTION SUIVANTE EN MODE SEPARE
  2492. *
  2493. IF (ZSEPAR) THEN
  2494. PASSE = 0.
  2495. HTLOG = 1.
  2496. ICOLOG = IDCOUL
  2497. ZLOGO = ZLOGOO
  2498. IF (ICOM.NE.0) THEN
  2499. DO JK=1,ICOM
  2500. TXCOM(JK)=0.
  2501. TYCOM(JK)=0.
  2502. COMMENT(JK)=' '
  2503. ENDDO
  2504. ICOM=0
  2505. ENDIF
  2506. ZINDEX= .FALSE.
  2507. GOTO 34
  2508. ENDIF
  2509. GOTO 1000
  2510.  
  2511. * On limite la precision a XMINLOG pour les logarithmes
  2512. 900 REAERR(1)=XMINLOG
  2513. CALL ERREUR(434)
  2514. GOTO 1000
  2515.  
  2516. * L'intervalle entre les bornes est trop faible.
  2517. 950 CALL ERREUR (497)
  2518. GOTO 1000
  2519. *
  2520. IF (NHIST.NE.0) SEGSUP,MEVOLL
  2521. *
  2522. 1000 CONTINUE
  2523. *
  2524. SEGSUP AXE
  2525. IF (OLDAXE.NE.0) SEGSUP OLDAXE
  2526. SEGSUP COM
  2527. IF (DYN.NE.0) SEGSUP DYN
  2528. IF (CUR.NE.0) SEGSUP CUR
  2529. *
  2530. END
  2531.  
  2532.  
  2533.  
  2534.  
  2535.  
  2536.  
  2537.  
  2538.  
  2539.  
  2540.  

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