Télécharger dessin.eso

Retour à la liste

Numérotation des lignes :

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

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