Télécharger dessin.eso

Retour à la liste

Numérotation des lignes :

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

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