Télécharger la plaquette Cast3M


fr en

Télécharger dessin.eso

Retour à la liste

Numérotation des lignes : 

dessin

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

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