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

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