Télécharger la plaquette Cast3M


fr en

Télécharger dessin.eso

Retour à la liste

Numérotation des lignes : 

dessin

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

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