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    CB215821  25/09/01    21:15:03     12344          
  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.       SEGSUP AXE
  3027.       IF (OLDAXE.NE.0) SEGSUP OLDAXE
  3028.       SEGSUP COM
  3029.       IF (DYN.NE.0) SEGSUP DYN
  3030.       IF (CUR.NE.0) SEGSUP CUR
  3031. *
  3032.       RETURN
  3033.       END
  3034.  
  3035.  
  3036.  
  3037.  
  3038.  
  3039.  
  3040.  

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