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

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