Télécharger la plaquette Cast3M


fr en

Télécharger trevol.eso

Retour à la liste

Numérotation des lignes : 

trevol

  1. C TREVOL    SOURCE    GOUNAND   26/01/09    21:16:05     12443          
  2.       SUBROUTINE TREVOL (IPTR1,IPTR2,CHAINE,TITOPT,ZLEGE,NCT,NLG,INBEVO
  3.      &      ,IPOSI,XPOSI,YPOSI,ZREMP2,IDEB1,IFIN1,ISTYL)
  4. *=============================================================
  5. * Modifications :
  6. *
  7. *   95/02/07 Loca
  8. *     passer les legendes x et y de 12 à 20 caractères:
  9. *     SEGMENT AXE disparait et est appelé en include: -INC TMAXE.
  10. *
  11. *   2004 Maugis
  12. *     Légendes à partir du haut, avec un espacement dépendant de leur nombre
  13. *     Possibilité de ne pas écrire de légende pour une courbe donnée
  14. *
  15. *   05 sept. 2007 Maugis
  16. *     Affichage de marqueurs aussi lorsqu'ils sont sur un bord
  17. *     Maintien du segment AXE actif en modification
  18. *     Mise du point en premier type de marqueur
  19. *     Ajout de formes de marqueurs, dont 2 autres triangles TRIL et TRIR
  20. *       pointant horizontalement, on garde pour compatibilité TRIA et TRIB,
  21. *       qui peuvent maintenant être invoqués avec TRID et TRIU
  22. *       respectivement.
  23. *     Correction de tracé (ou absence de tracé) illicite avec REGU
  24. *       avec marqueurs aux extrémités
  25. *
  26. *=============================================================
  27. *
  28. * Entrée :
  29. *
  30. * IPTR1  : POINTEUR SUR UN AXE                         (ACTIF)
  31. * IPTR2  : POINTEUR SUR UN KEVOLL
  32. * CHAINE : MOT CONTENANT LES OPTIONS SPECIFIQUES
  33. * ZLEGE  : INDIQUE QUE L'ON EST EN MODE LEGENDE DES COURBES
  34. * NCT    : NUMERO A AFFICHER SUR LA COURBE
  35. * NLG    : NOMBRE DE LÉGENDES À AFFICHER AU TOTAL
  36. * INBEVO : NOMBRE TOTAL D'EVOLUTIONS
  37. * IPOSI  position predefinie de la legende
  38. * XPOSI, YPOSI = position XY de la legende fourni par l utilisateur
  39. *
  40. *=============================================================
  41. *
  42. * TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION !
  43. *
  44. * MMT    : MOT EXTRAIT DE CHAINE
  45. * ZREGU  : REPERE ESPACE REGULIEREMENT
  46. * ZTIRET : TIRET ENTRE POINTS
  47. * ZNOLI  : ABSENCE DE LIGNE ENTRE POINT
  48. * ZLABEL : ECRITURE D'EN LABEL
  49. * ZPLEIN : Le marqueur doit être rempli
  50. * LTAIL  : TABLE des tailles
  51. * XTAIL  : facteur multiplicatif de taille du marqueur
  52. * IEPAI  : facteur multiplicatif (entier) de l'épaisseur des traits du marqueur
  53. * IMARQ  : NUMERO DE LA FORME DU MARQUEUR (=0 <=> PAS DE MARQUEUR)
  54. * NMARQ  : NOMBRE DE FORMES POSSIBLES DE MARQUEURS
  55. * LMARQ  : TABLE DES MARQUEURS
  56. * NREGU  : NOMBRE DE MARQUEURS PAR COURBE EN DISPOSITION REGULIERE
  57. * NLGMIN : NOMBRE MINIMAL DE LEGENDES
  58. * NLGMAX : NOMBRE MAXIMAL DE LEGENDES
  59. * INB    : NOMBRE DE POINTS A TRAITER
  60. * ZREMP2 : logique indiquant le remplissage sous une des courbes
  61. *          (false en entree)
  62. *
  63. *=============================================================
  64.       IMPLICIT INTEGER(I-N)
  65.       IMPLICIT REAL*8 (A-H,O-S,U-Y)
  66. C*?      IMPLICIT REAL*4 (T)
  67.       IMPLICIT LOGICAL (Z)
  68. *
  69. -INC SMEVOLL
  70. -INC SMLREEL
  71. -INC SMLENTI
  72.       POINTEUR MLENT0.MLENTI
  73. -INC TMAXE
  74. -INC CCREEL
  75.  
  76. -INC PPARAM
  77. -INC CCOPTIO
  78. -INC CCTRACE
  79.  
  80. C     Gestion des LISTENTI dans les EVOLUTIONS
  81.       PARAMETER    (NLIST=3)
  82.       CHARACTER*(8) CLIST(NLIST),CTYP
  83.       DATA          CLIST /'LISTREEL','LISTENTI','LISTMOTS'/
  84.       MACRO ,              (LISTREEL , LISTENTI , LISTMOTS)
  85. *
  86.       EXTERNAL LONG
  87.       PARAMETER  (NREGU=8,NLGMIN=19,NLGMAX=30,NMARQ=15,NCLEF=10,NTAIL=7)
  88.       REAL               HMIN,TYYM
  89.       REAL*8             IEPAI
  90.  
  91.       CHARACTER*(*)      CHAINE,TITOPT
  92.       CHARACTER*(LOCHAI) CHVIDE,MLABEL
  93.       CHARACTER*12       MMT,FMMT
  94.       CHARACTER*4        LMARQ(NMARQ),LCLEF(NCLEF),LTAIL(NTAIL)
  95. C      CHARACTER    CC
  96.  
  97.       DIMENSION    TX(2),TY(2)
  98.       DIMENSION    TRX(6),TRY(6),TRZ(6)
  99.  
  100. *     on garde TRIA et TRIB pour compatibilité
  101.       DATA LMARQ /'POIN','CROI','PLUS','ETOI','CARR','LOSA',
  102.      &            'TRIA','TRIB','TRIL','TRIR','TRID','TRIU',
  103.      &            'MOIN','BARR','ROND'/
  104.       DATA LCLEF /'REGU','NOLI','TIRR','TIRC','TIRL','TIRM','MARQ',
  105.      &            'REMP','POIN','BLAN'/
  106. C Taille SS remplacer par XS, conservee pour compatibilite jdd
  107.       DATA LTAIL /'XS  ','S   ','M   ','L   ','XL  ','XXL ','SS  '/
  108.  
  109. *     Valeurs par défaut
  110.       XGPOS =  1.D0*XSGRAN
  111.       XGNEG = -1.D0*XSGRAN
  112.       XGPET = XSPETI
  113.       ZREGU  = .FALSE.
  114.       ZNOLI  = .FALSE.
  115.       ZTIRET = .FALSE.
  116.       KTIR   = 0
  117.       ZLABEL = .FALSE.
  118.       IMARQ  = 0
  119.       ZPLEIN = .FALSE.
  120.       XTAIL  = 1.D0
  121.       IEPAI  = 1.D0
  122.       CHVIDE =' '
  123.       ZREMP = .FALSE.
  124.       ZBLANC= .FALSE.
  125.  
  126.       XMINT= XSGRAN
  127.       YMINT= XSGRAN
  128.       XMAXT=-XSGRAN
  129.       YMAXT=-XSGRAN
  130.  
  131.       DO I=1,5
  132.           TRZ(I)=0.
  133.       ENDDO
  134.       IF (ICOSC.EQ.1) THEN
  135.           ICOMBR=7
  136.       ELSE
  137.           ICOMBR=8
  138.       ENDIF
  139.  
  140.  
  141. *
  142. *  ====================================================================
  143. *  TRAITEMENT DES OPTIONS
  144. *  ====================================================================
  145. *
  146.       IF (CHAINE .NE.CHVIDE) THEN
  147.         I=1
  148.   1     CONTINUE
  149.         CALL EXTRAC (CHAINE,I,MMT)
  150.         IF (MMT.NE.CHVIDE) THEN
  151.           CALL PLACE(LCLEF,NCLEF,ICLEF,MMT(1:4))
  152.  
  153. *         'REGU'
  154.           IF (ICLEF.EQ.1) ZREGU=.TRUE.
  155.  
  156. *         'NOLI'
  157.           IF (ICLEF.EQ.2) ZNOLI=.TRUE.
  158.  
  159. *         'TIRR'/'TIRC'/'TIRL'/'TIRM' / 'POIN'
  160.           IF (ICLEF.EQ.3) THEN
  161.             ZTIRET=.TRUE.
  162.             KTIR=1
  163.           ENDIF
  164.           IF (ICLEF.EQ.4) THEN
  165.             ZTIRET=.TRUE.
  166.             KTIR=2
  167.           ENDIF
  168.           IF (ICLEF.EQ.5) THEN
  169.             ZTIRET=.TRUE.
  170.             KTIR=3
  171.           ENDIF
  172.           IF (ICLEF.EQ.6) THEN
  173.             ZTIRET=.TRUE.
  174.             KTIR=4
  175.           ENDIF
  176.           IF (ICLEF.EQ.9) THEN
  177.             ZTIRET=.TRUE.
  178.             KTIR=5
  179.           ENDIF
  180.  
  181. *         'MARQ'
  182.           IF (ICLEF.EQ.7) THEN
  183. *           La présence de ce mot-clef réinitialise les options de
  184. *           marqueur, pour le cas de spécifications successives
  185.             ZPLEIN = .FALSE.
  186.             XTAIL  = 1.D0
  187.             IEPAI  = 1.D0
  188.             IMARQ  = 0
  189.  20         CALL EXTRAC(CHAINE,I,MMT)
  190. *           remplir le marqueur ?
  191.             IF (MMT(1:4).EQ.'PLEI') THEN
  192.               ZPLEIN = .TRUE.
  193.               GOTO 20
  194.             ENDIF
  195. *           taille du marqueur
  196.             CALL PLACE(LTAIL,NTAIL,ITAIL,MMT(1:4))
  197. *            write(6,*) ' taille du marqueur ' , itail
  198.             IF (ITAIL.NE.0) THEN
  199.               IF (ITAIL.EQ.1) XTAIL = 0.25D0
  200.               IF (ITAIL.EQ.2) XTAIL = 0.50D0
  201.               IF (ITAIL.EQ.3) XTAIL = 1.00D0
  202.               IF (ITAIL.EQ.4) XTAIL = 1.25D0
  203.               IF (ITAIL.EQ.5) XTAIL = 1.75D0
  204.               IF (ITAIL.EQ.6) XTAIL = 2.50D0
  205.               IF (ITAIL.EQ.7) XTAIL = 0.25D0
  206. C             IF (ITAIL.EQ.7) THEN
  207. **               spécification d'une taille arbitraire
  208. **               (la croix et la banière pour convertir en flottant!)
  209. *                CALL EXTRAC(CHAINE,I,MMT)
  210. *                LMMT  = LONG(MMT)
  211. *                WRITE(cc,FMT='(I1)') LMMT
  212. *                FMMT  = '(I'//cc//')'
  213. *                READ(MMT,FMT=FMMT(1:4)) I1
  214. *                XTAIL = I1
  215. C             ENDIF
  216.               GOTO 20
  217.             ENDIF
  218. *           épaisseur de ligne (entre 0 et 9)
  219.             IF (MMT(1:4).EQ.'EPAI') THEN
  220.                 CALL EXTRAC(CHAINE,I,MMT)
  221.                 READ(MMT,FMT='(I1)') IEPAI
  222.               GOTO 20
  223.             ENDIF
  224. *           type de marqueur (en dernier)
  225.             CALL PLACE(LMARQ,NMARQ,IMARQ,MMT(1:4))
  226. *            write(6,*) ' type du marqueur ' , imarq
  227.             IF (IMARQ.EQ.0) THEN
  228. *              On ne comprend pas le mot %M
  229.                moterr= MMT
  230.                CALL ERREUR(7)
  231.             ENDIF
  232.           ENDIF
  233.  
  234. *         'REMP'
  235.           IF (ICLEF.EQ.8) THEN
  236.             ZREMP=.TRUE.
  237.             ZREMP2=.TRUE.
  238.           ENDIF
  239. *         'BLAN' (pour un remplissage par du blanc)
  240.           IF (ICLEF.EQ.10) ZBLANC = .TRUE.
  241.  
  242. *         'LABEL'
  243.           IF (MMT(1:4).EQ.'LABE') THEN
  244.             ZLABEL=.TRUE.
  245.             CALL EXTRAC(CHAINE,I,MLABEL)
  246.           ENDIF
  247.           IF (I.LE.72) GOTO 1
  248.         ENDIF
  249.       ENDIF
  250.  
  251. *
  252.       AXE   =IPTR1
  253.       KEVOLL=IPTR2
  254.       CTYP  =KEVOLL.TYPX
  255.       CALL PLAMO8(CLIST,NLIST,IPLACX,CTYP)
  256.       IF(IPLACX .EQ. 0)THEN
  257.         MOTERR=CTYP
  258.         CALL ERREUR(39)
  259.         RETURN
  260.       ENDIF
  261.       CASE, IPLACX
  262.         WHEN, LISTREEL
  263.           MLREEL=KEVOLL.IPROGX
  264.           inb   =MLREEL.PROG(/1)
  265.         WHEN, LISTENTI
  266.           MLENT0=KEVOLL.IPROGX
  267.           inb   =MLENT0.LECT(/1)
  268.         WHENOTHERS
  269.           MOTERR=CTYP
  270.           CALL ERREUR(39)
  271.           RETURN
  272.       ENDCASE
  273.  
  274.       CTYP =KEVOLL.TYPY
  275.       CALL PLAMO8(CLIST,NLIST,IPLACY,CTYP)
  276.       IF(IPLACY .EQ. 0)THEN
  277.         MOTERR=CTYP
  278.         CALL ERREUR(39)
  279.         RETURN
  280.       ENDIF
  281.       CASE, IPLACY
  282.         WHEN, LISTREEL
  283.           MLREE1=KEVOLL.IPROGY
  284.         WHEN, LISTENTI
  285.           MLENT1=KEVOLL.IPROGY
  286.         WHENOTHERS
  287.           MOTERR =CTYP
  288.           CALL ERREUR(39)
  289.           RETURN
  290.       ENDCASE
  291.  
  292. c Cas TRES particulier :
  293.       IF (INB.LE.0) ZREGU = .FALSE.
  294.       HMIN  = .2
  295.       DXEVL = XSUP-XINF
  296.       DYEVL = YSUP-YINF
  297.       DL    = DXEVL/100.D0
  298.       ZTRAC =.TRUE.
  299.       IF (ZLOGY) THEN
  300.         YZERO = YINF
  301.       ELSE
  302.         YZERO = MIN(MAX(0.D0,YINF),YSUP)
  303.       ENDIF
  304. c       IF (NUMEVY.EQ.'HIST') ZREMP=.TRUE.
  305.  
  306. c     ontrace entre les points IDEB et IFIN
  307.       IDEB4=MAX(1,IDEB1)
  308.       IFIN4=MIN(inb,IFIN1)
  309.  
  310. c     eventuel style de LIGNE_VARIABLE via un listentier
  311. c     (=0 pour une ligne, 1 pour TIRR, ... 5 pour POINtille  cf. KTIR)
  312.       MLENTI=ISTYL
  313.       IF(ISTYL.GT.0) THEN
  314.         SEGACT,MLENTI
  315. c       petite verif de dimension
  316.         IF(LECT(/1).LT.IFIN4-1) THEN
  317.           WRITE(IOIMP,*) 'dimension de LIGNE_VARIABLE =',(LECT(/1))
  318. c         On attend un objet de type %M1:8 de dimension %i1
  319.           INTERR=IFIN4-1
  320.           MOTERR='LISTENTI'
  321.           CALL ERREUR(1018)
  322.           RETURN
  323.         ENDIF
  324.       ENDIF
  325. c     on sauvegarde la valeur par defaut
  326.       KTIR0=KTIR
  327. c       write(*,*) KTIR,KTIR0,ISTYL
  328.  
  329. *
  330. *  ====================================================================
  331. *     TRACE DE BASE
  332. *  ====================================================================
  333. *
  334.       nlocab=numevx
  335.       CALL CHCOUL(Nlocab)
  336. *
  337. *     On rajoute cette étiquette pour gérer le fait que dans certains
  338. *     cas (histogrammes par exemple), il faut tracer la totalité des
  339. *     remplissages avant de tracer les segments, sinon ils seront
  340. *     recouverts
  341.       ZNOLI1=ZNOLI
  342.       ZREMP1=ZREMP
  343.       IF (.NOT.ZNOLI.AND.ZREMP) ZNOLI1=.TRUE.
  344.  30   CONTINUE
  345.  
  346. cbp : on va faire le travail pour espacement REGU des marqueurs ici
  347.       IF (ZREGU) THEN
  348.           xlonx=(xsup-xinf)**2
  349.           xlony=(ysup-yinf)**2
  350.           xlong=0.d0
  351.           jg=inb-1
  352.           segini,MLREE2
  353.       ENDIF
  354.  
  355.  
  356. *==== BOUCLE SUR LES SEGMENTS =========================================
  357. cbp      DO 4 I = 1,inb-1
  358.       DO 4 I = IDEB4,IFIN4-1
  359. *
  360. *-------CALCUL COORDONNEES (CORRIGEES SI LOG)-------
  361. c      -recup
  362.  
  363.         CASE, IPLACX
  364.           WHEN, LISTREEL
  365.             X1=MLREEL.PROG(I)
  366.             X2=MLREEL.PROG(I+1)
  367.           WHEN, LISTENTI
  368.             X1=FLOAT(MLENT0.LECT(I))
  369.             X2=FLOAT(MLENT0.LECT(I+1))
  370.           WHENOTHERS
  371.             MOTERR=CTYP
  372.             CALL ERREUR(39)
  373.             RETURN
  374.         ENDCASE
  375.         CASE, IPLACY
  376.           WHEN, LISTREEL
  377.             Y1=MLREE1.PROG(I)
  378.             Y2=MLREE1.PROG(I+1)
  379.           WHEN, LISTENTI
  380.             Y1=FLOAT(MLENT1.LECT(I))
  381.             Y2=FLOAT(MLENT1.LECT(I+1))
  382.           WHENOTHERS
  383.             MOTERR =CTYP
  384.             CALL ERREUR(39)
  385.             RETURN
  386.         ENDCASE
  387.  
  388. c         write(6,*) 'i=',i,X1,Y1,' - ',X2,Y2
  389. *      -Si un point est un Nan alors on ne trace pas ce segment
  390.         IF(((X1.LT.0.D0).EQV.(X1.GE.0.D0)).OR.
  391.      &     ((Y1.LT.0.D0).EQV.(Y1.GE.0.D0)).OR.
  392.      &     ((X2.LT.0.D0).EQV.(X2.GE.0.D0)).OR.
  393.      &     ((Y2.LT.0.D0).EQV.(Y2.GE.0.D0))) THEN
  394.            IF(IERPER.GE.3) GOTO 4
  395.            MOTERR='EVOLUTIO'
  396.            CALL ERREUR(1012)
  397.            IF(IERR.NE.0) RETURN
  398.            GOTO 4
  399.         ENDIF
  400. * Evite les ieee_denormal et ieee_underflow
  401.         if (abs(x1).LE.XGPET) x1=xzero
  402.         if (abs(x2).LE.XGPET) x2=xzero
  403.         if (abs(y1).LE.XGPET) y1=xzero
  404.         if (abs(y2).LE.XGPET) y2=xzero
  405.  
  406. c      -coordonnee X
  407.         IF (ZLOGX) THEN
  408. c       on verifie qu'on n'a pas des infinis (si YBOR précisé par ex.)
  409.           if(X1.le.0.D0.and.X2.le.0.d0) goto 4
  410.           if(X1.gt.0.D0) then
  411.             TX(1) = LOG10(X1)
  412.           else
  413. c           cas segment horizontal avec 1er point infini
  414.             TX(1) = XINF
  415.             TY(1) = TY(2)
  416.           endif
  417.           if(X2.gt.0.D0) then
  418.             TX(2) = LOG10(X2)
  419.           else
  420. c           cas segment horizontal avec 2eme point infini
  421.             TX(2) = XINF
  422.             TY(2) = TY(1)
  423.           endif
  424.  
  425.         ELSE
  426. c         cas points 1 et 2 infinis => on saute car segment non défini
  427.           if(X1.gt.XGPOS.and.X2.gt.XGPOS) goto 4
  428.           if(X1.lt.XGNEG.and.X2.lt.XGNEG) goto 4
  429.           TX(1) = X1
  430.           TX(2) = X2
  431.           if(X1.gt.XGPOS) then
  432. c           cas segment horizontal avec 1er point +infini
  433.             TX(1) = XSUP
  434.             TY(1) = TY(2)
  435.           elseif(X1.lt.XGNEG) then
  436. c           cas segment horizontal avec 1er point -infini
  437.             TX(1) = XINF
  438.             TY(1) = TY(2)
  439.           endif
  440.           if(X2.gt.XGPOS) then
  441. c           cas segment horizontal avec 2eme point infini
  442.             TX(2) = XSUP
  443.             TY(2) = TY(1)
  444.           elseif(X2.lt.XGNEG) then
  445. c           cas segment horizontal avec 2eme point -infini
  446.             TX(2) = XINF
  447.             TY(2) = TY(1)
  448.           endif
  449.         ENDIF
  450.  
  451. c      -coordonnee Y
  452.         IF (ZLOGY) THEN
  453. c       on verifie qu'on n'a pas des infinis (si YBOR précisé par ex.)
  454. c         cas points 1 et 2 infinis => on saute car segment non défini
  455.           if(Y1.le.0.D0.and.Y2.le.0.d0) goto 4
  456.           if(Y1.gt.0.D0) then
  457.             TY(1) = LOG10(Y1)
  458.           else
  459. c           cas segment vertical avec 1er point infini
  460.             TX(1) = TX(2)
  461.             TY(1) = YINF
  462.           endif
  463.           if(Y2.gt.0.D0) then
  464.             TY(2) = LOG10(Y2)
  465.           else
  466. c           cas segment vertical avec 2eme point infini
  467.             TX(2) = TX(1)
  468.             TY(2) = YINF
  469.           endif
  470.         ELSE
  471. c         cas points 1 et 2 infinis => on saute car segment non défini
  472.           if(Y1.gt.XGPOS.and.Y2.gt.XGPOS) goto 4
  473.           if(Y1.lt.XGNEG.and.Y2.lt.XGNEG) goto 4
  474.           TY(1) = Y1
  475.           TY(2) = Y2
  476.           if(Y1.gt.XGPOS) then
  477. c           cas segment vertical avec 1er point +infini
  478.             TX(1) = TX(2)
  479.             TY(1) = YSUP
  480.           elseif(Y1.lt.XGNEG) then
  481. c           cas segment vertical avec 1er point -infini
  482.             TX(1) = TX(2)
  483.             TY(1) = YINF
  484.           endif
  485.           if(Y2.gt.XGPOS) then
  486. c           cas segment vertical avec 2eme point +infini
  487.             TX(2) = TX(1)
  488.             TY(2) = YPOS
  489.           elseif(Y2.lt.XGNEG) then
  490. c           cas segment vertical avec 2eme point -infini
  491.             TX(2) = TX(1)
  492.             TY(2) = YINF
  493.           endif
  494.         ENDIF
  495. c         write(6,*) '->',i,TX(1),TY(1),' - ',TX(2),TY(2)
  496.  
  497. *-------CALCUL DES EXTREMA DE LA COURBE-------
  498.         IF (XMINT.EQ.XSGRAN) THEN
  499.           XMINT = TX(1)
  500.           XMAXT = TX(1)
  501.           YMINT = TY(1)
  502.           YMAXT = TY(1)
  503.         ENDIF
  504.         xtx2  = TX(2)
  505.         yty2  = ty(2)
  506.         XMINT = MIN (XMINT,xtx2)
  507.         XMAXT = MAX (XMAXT,xtx2)
  508.         YMINT = MIN (YMINT,yTY2)
  509.         YMAXT = MAX (YMAXT,yTY2)
  510. *
  511. *-------POUR CHAQUE SEGMENT : ON VERIFIE S'IL APPARAIT DANS LA FENETRE--
  512. *
  513. *      -SEGMENT HORS FENETRE ?
  514. * attention : il faut éventuellement le "remplir" quand même -> goto 41
  515.         XMAX=MAX(TX(1),TX(2))
  516.         XMIN=MIN(TX(1),TX(2))
  517. *       XMAX trop a gauche
  518.         IF (XMAX.LE.XINF) THEN
  519.           IF(XMIN.LT.XINF) GOTO 4
  520. *         si XMAX=XMIN=XINF, on trace le segment sur le cadre
  521.         ENDIF
  522. *       XMIN trop a droite
  523.         IF (XMIN.GE.XSUP) THEN
  524.           IF(XMAX.GT.XSUP) GOTO 4
  525.         ENDIF
  526.         YMAX=MAX(TY(1),TY(2))
  527.         YMIN=MIN(TY(1),TY(2))
  528. *       YMAX trop bas
  529.         IF (YMAX.LE.YINF) THEN
  530.           IF(YMIN.LT.YINF) GOTO 41
  531.         ENDIF
  532. *       YMIN trop haut
  533.         IF (YMIN.GE.YSUP) THEN
  534.           IF(YMAX.GT.YSUP) GOTO 41
  535.         ENDIF
  536. *
  537.  
  538. *
  539. *      -EXTREMITE 1 DANS LA FENETRE ?
  540.         IF((TX(1).GE.XINF).AND.(TX(1).LE.XSUP).AND.
  541.      $          (TY(1).GE.YINF).AND.(TY(1).LE.YSUP)) GOTO 5
  542. *
  543. *      -EXTREMITE 2 DANS LA FENETRE ?
  544.         IF((TX(2).GE.XINF).AND.(TX(2).LE.XSUP).AND.
  545.      $          (TY(2).GE.YINF).AND.(TY(2).LE.YSUP)) GOTO 5
  546. *
  547. *       si on est là (et pas en 5), c'est qu'
  548. *      -AUCUNE EXTREMITE DANS LA FENETRE MAIS SEGMENT SECANT
  549.  
  550. *       Cas segment vertical
  551.         IF (TX(1).EQ.TX(2)) THEN
  552.           IF ((TX(1).GT.XINF).AND.(TX(1).LT.XSUP)) THEN
  553.             GOTO 5
  554.           ELSE
  555.             GOTO 4
  556.           ENDIF
  557.         ENDIF
  558.  
  559. *       Cas segment non vertical
  560.         A = (TY(2)-TY(1)) / (TX(2)-TX(1))
  561.         IF (ABS(A).LT.1D-10) A=0.D0
  562.  
  563.         Y = A * (XINF-TX(1))+TY(1)
  564. *       Cas segment horizontal
  565.         IF (A.EQ.0.D0) THEN
  566.           IF ((Y.LT.YSUP) .AND. (Y.GT.YINF)) THEN
  567.             GOTO 5
  568.           ELSE
  569.             GOTO 41
  570.           ENDIF
  571.         ENDIF
  572.         IF ((Y.LT.YSUP) .AND. (Y.GT.YINF)) GOTO 5
  573.         Y=A*(XSUP-TX(1))+TY(1)
  574.         IF ((Y.LT.YSUP) .AND. (Y.GT.YINF)) GOTO 5
  575.         X=TX(1)+(YINF-TY(1))/A
  576.         IF ((X.LT.XSUP) .AND. (X.GT.XINF)) GOTO 5
  577.         X=TX(1)+(YSUP-TY(1))/A
  578.         IF ((X.LT.XSUP) .AND. (X.GT.XINF)) GOTO 5
  579.  
  580.         GOTO 41
  581.  
  582. *-------AU MOINS UN POINT DANS LA FENETRE-------
  583.   5     CONTINUE
  584.  
  585. *       Cas segment vertical
  586.         IF (TX(1).EQ.TX(2)) THEN
  587.             IF (TY(1).LE.YINF) TY(1)=YINF
  588.             IF (TY(2).GE.YSUP) TY(2)=YSUP
  589. *           Pas besoin de tracer le remplissage éventuel !
  590.             GOTO 51
  591.         ENDIF
  592.  
  593. *       (DBLE pour empecher une erreur de compilation sur certaines machines...)
  594.         IF (ZREMP1) THEN
  595.             TRX(1)=MIN(MAX(DBLE(TX(1)),XINF),XSUP)
  596.             TRY(1)=MIN(MAX(DBLE(TY(1)),YINF),YSUP)
  597.             TRX(2)=MIN(MAX(DBLE(TX(2)),XINF),XSUP)
  598.             TRY(2)=MIN(MAX(DBLE(TY(2)),YINF),YSUP)
  599.         ENDIF
  600. *
  601. *       LINEARISE LE PREMIER POINT EN X
  602.         IF (TX(1).LT.XINF) CALL LINEAX (TX,TY,XINF,1)
  603.         IF (TX(1).GT.XSUP) CALL LINEAX (TX,TY,XSUP,1)
  604. *
  605. *       LINEARISE LE PREMIER POINT EN Y
  606.         IF (TY(1).LT.YINF) CALL LINEAX (TY,TX,YINF,1)
  607.         IF (TY(1).GT.YSUP) CALL LINEAX (TY,TX,YSUP,1)
  608. *
  609. *       LINEARISE LE SECOND POINT EN X
  610.         IF (TX(2).LT.XINF) CALL LINEAX (TX,TY,XINF,2)
  611.         IF (TX(2).GT.XSUP) CALL LINEAX (TX,TY,XSUP,2)
  612. *
  613. *       LINEARISE LE SECOND POINT EN Y
  614.         IF (TY(2).LT.YINF) CALL LINEAX (TY,TX,YINF,2)
  615.         IF (TY(2).GT.YSUP) CALL LINEAX (TY,TX,YSUP,2)
  616. c         write(6,*) 'lineax:',TX(1),TY(1),' - ',TX(2),TY(2)
  617.  
  618.         IF (ZREMP1) THEN
  619.             NP=4
  620.             DO II=1,2
  621.                 JJ=II+NP-4
  622.                 IF (TX(II).NE.TRX(JJ).OR.TY(II).NE.TRY(JJ)) THEN
  623.                     NP=NP+1
  624.                     TRX(NP-2)=TRX(NP-3)
  625.                     TRY(NP-2)=TRY(NP-3)
  626.                     TRX(NP-3)=TX(II)
  627.                     TRY(NP-3)=TY(II)
  628.                 ENDIF
  629.             ENDDO
  630.             TRX(NP-1)=TRX(NP-2)
  631.             TRX(NP)  =TRX(1)
  632.             TRY(NP-1)=YZERO
  633.             TRY(NP)  =YZERO
  634. *           trace du remplissage
  635.             if (ZBLANC) then
  636.               CALL TRFACE(NP,TRX,TRY,TRZ,1.,ICOMBR,IEFF)
  637. *         bp: apres un tracé dans une couleur differente,
  638. *             il faut toujours revenir a celle de la courbe
  639.               CALL CHCOUL(NLOCAB)
  640.             else
  641.               CALL TRFACE(NP,TRX,TRY,TRZ,1.,NLOCAB,IEFF)
  642.             endif
  643.         ENDIF
  644.  
  645.    51   CONTINUE
  646. c       dans tous les cas sauf option 'NOLI'
  647.         IF (.NOT.ZNOLI1) THEN
  648. *           tracé du segment
  649.             IF (ZREMP.and..not.ZBLANC) CALL CHCOUL(ICOMBR)
  650. *           cas des styles de LIGNE_VARIABLE
  651.             IF(ISTYL.GT.0) THEN
  652.               KTIR=LECT(I)
  653.               IF(KTIR.GT.5) KTIR=KTIR0
  654.               ZTIRET=KTIR.GE.1
  655.             ENDIF
  656.             CALL TRSEG (IPTR1,TX,TY,ZTIRET,KTIR,DL,ZTRAC)
  657.             IF (ZREMP.and..not.ZBLANC) CALL CHCOUL(NLOCAB)
  658.  
  659. *       Ni ligne, ni remplissage, ni marqueur => marqueur par défaut
  660. cbp :   bizarre car non compatible avec REGU... => pour eviter de passer
  661. cbp     ici, l utilisateur doit preciser ce qu'il veut (LIGN ou MARQ ...)
  662.         ELSEIF (IMARQ.EQ.0.AND..NOT.ZREMP1) THEN
  663. *           tracé du point + le 2e si dernier segment
  664.             CALL DMARQ(IPTR1,TX(1),TY(1),1,1D0,.FALSE.,0)
  665.             IF (I.EQ.(INB-1))
  666.      &         CALL DMARQ(IPTR1,TX(2),TY(2),1,1D0,.FALSE.,0)
  667.         ENDIF
  668.  
  669. cbp : on calcule la longueur de la courbe xlong ici
  670.         IF (ZREGU) THEN
  671.             X2=(TX(2)-TX(1))**2
  672.             Y2=(TY(2)-TY(1))**2
  673.             xll=sqrt(X2/xlonx+Y2/xlony)
  674.             xlong=xlong+sqrt(X2/xlonx+Y2/xlony)
  675.             MLREE2.PROG(I)=xlong
  676.         ENDIF
  677.  
  678.       GOTO 4
  679.  
  680. *     LABEL 41 :
  681. *-----LE SEGMENT N'EST PAS DANS LA FENETRE, MAIS SON REMPLISSAGE PEUT Y ETRE
  682.   41  CONTINUE
  683.  
  684.       IF (ZREMP1) THEN
  685.  
  686.           TRX(1)=MIN(MAX(DBLE(TX(1)),XINF),XSUP)
  687.           TRY(1)=MIN(MAX(DBLE(TY(1)),YINF),YSUP)
  688.           TRX(2)=MIN(MAX(DBLE(TX(2)),XINF),XSUP)
  689.           TRY(2)=MIN(MAX(DBLE(TY(2)),YINF),YSUP)
  690.  
  691. *         Finalement, le segment projete son remplissage hors de la fenetre...
  692.           IF (TX(1).EQ.TX(2).AND.TY(1).EQ.TY(2)) GOTO 4
  693.  
  694. *         ... ou alors le remplissage est d'epaisseur nulle
  695.           IF (TRY(1).EQ.YZERO) GOTO 4
  696.  
  697.           TRX(3)=TRX(2)
  698.           TRX(4)=TRX(1)
  699.           TRY(3)=YZERO
  700.           TRY(4)=YZERO
  701.  
  702. *         tracé du remplissage
  703.           if (ZBLANC) then
  704.             CALL TRFACE(4,TRX,TRY,TRZ,1.,ICOMBR,IEFF)
  705.             CALL CHCOUL(NLOCAB)
  706.           else
  707.             CALL TRFACE(4,TRX,TRY,TRZ,1.,NLOCAB,IEFF)
  708.           endif
  709.       ENDIF
  710.  
  711.  
  712.   4   CONTINUE
  713. *==== FIN DE LA BOUCLE SUR LES SEGMENTS DE LA COURBE ==================
  714.  
  715.       IF (.NOT.ZNOLI.AND.ZREMP) THEN
  716.           ZNOLI1=.NOT.ZNOLI1
  717.           ZREMP1=.NOT.ZREMP1
  718.           IF (.NOT.ZREMP1) GOTO 30
  719.       ENDIF
  720.  
  721. *
  722. *  ====================================================================
  723. *     TRACE DU NOM DE LA COURBE (pour les HISTogrammes avec une legende)
  724. *  ====================================================================
  725. *bp,2019      CALL LENCHA(NOMEVY,LC)
  726.       CALL LENCHA(KEVTEX,LC)
  727.       IF (NUMEVY.EQ.'HIST'.AND.LC.GT.0) THEN
  728.           TDELTX=ABS(XSUP-XINF)/45
  729.           TDELTY=ABS(YSUP-YINF)/45
  730.           BORX1=MAX(XINF,XMINT)
  731.           BORX2=MIN(XSUP,XMAXT)
  732.           TXX=0.5*(BORX1+BORX2)
  733.           TXX2=TXX-0.125*TDELTX*LC
  734. *       ajout bp,2019 pour afficher choisir le marqueur
  735. *      -si TRIU : legende + TRIU en dessous de la courbe
  736.         IF(IMARQ.EQ.12) THEN
  737.           BORY2=MAX(YINF,YMINT)
  738.           TYY=BORY2-TDELTY
  739. *         il faut prendre en compte la taille de police (difficile)
  740.           TYY2=TYY-2.0*TDELTY
  741. *      -si TRID (par defaut) : legende + TRID au dessus de la courbe
  742.         ELSEIF(IMARQ.EQ.11) THEN
  743.           BORY2=MIN(YSUP,YMAXT)
  744.           TYY=BORY2+TDELTY
  745.           TYY2=TYY+TDELTY
  746.         ENDIF
  747.         IF (IMARQ.EQ.11.OR.IMARQ.EQ.12) THEN
  748.           CALL DMARQ (IPTR1,TXX,TYY,IMARQ,XTAIL,.FALSE.,NLOCAB)
  749.           HMIN=0.2
  750. *bp,2019          CALL TRLABL(TXX2,TYY2,0.,NOMEVY,LC,HMIN)
  751.           CALL TRLABL(TXX2,TYY2,0.,KEVTEX,LC,HMIN)
  752.         ENDIF
  753.       ENDIF
  754. *
  755. *  ====================================================================
  756. *     TRACE DE MARQUEURS OU DE LABEL
  757. *  ====================================================================
  758. *
  759. *      write(6,*)'iepai xtail zplein,nlocab',iepai,xtail,zplein,nlocab
  760. c       IF ((IMARQ.NE.0).OR.ZLABEL) THEN
  761. *bp,2019 : on enleve cette option pour les histogrammes
  762.       IF (((IMARQ.NE.0).OR.ZLABEL).and.NUMEVY.NE.'HIST')THEN
  763. *
  764. *       EN CHAQUE POINT
  765. *
  766.         IF (.NOT. ZREGU) THEN
  767. cbp          DO 6 I=1,INB
  768.           DO 6 I=IDEB4,IFIN4
  769.             CASE, IPLACX
  770.               WHEN, LISTREEL
  771.                 XVAL=MLREEL.PROG(I)
  772.               WHEN, LISTENTI
  773.                 XVAL=FLOAT(MLENT0.LECT(I))
  774.               WHENOTHERS
  775.                 MOTERR=CTYP
  776.                 CALL ERREUR(39)
  777.                 RETURN
  778.             ENDCASE
  779.             CASE, IPLACY
  780.               WHEN, LISTREEL
  781.                 YVAL=MLREE1.PROG(I)
  782.               WHEN, LISTENTI
  783.                 YVAL=FLOAT(MLENT1.LECT(I))
  784.               WHENOTHERS
  785.                 MOTERR =CTYP
  786.                 CALL ERREUR(39)
  787.                 RETURN
  788.             ENDCASE
  789.  
  790.             IF (ZLOGX) THEN
  791.               TXX=LOG10(XVAL)
  792.             ELSE
  793.               TXX=XVAL
  794.             ENDIF
  795.             IF (ZLOGY) THEN
  796.               TYY=LOG10(YVAL)
  797.             ELSE
  798.               TYY=YVAL
  799.             ENDIF
  800.  
  801. *           tracé si à peu près dans fenêtre
  802.             IF ((TXX-XINF.GE.-XZPREC*DXEVL) .AND.
  803.      &          (TXX-XSUP.LE. XZPREC*DXEVL) .AND.
  804.      &          (TYY-YINF.GE.-XZPREC*DYEVL) .AND.
  805.      &          (TYY-YSUP.LE. XZPREC*DYEVL)) THEN
  806.                IF (ZLABEL)
  807.      &            CALL TRLABL(TXX,TYY,0.,MLABEL,72,HMIN)
  808.                IF (IMARQ.NE.0) THEN
  809.                   CALL DMARQ(IPTR1,TXX,TYY,IMARQ,XTAIL,
  810.      &                       ZPLEIN,NLOCAB)
  811.                ENDIF
  812.             ENDIF
  813.   6       CONTINUE
  814.         ENDIF
  815. *
  816. *       RÉGULIÈREMENT
  817. *
  818. *        write(6,*) ' nregu' , nregu
  819.         IF (ZREGU) THEN
  820. *
  821. * calcul de la longueur de la courbe xlong
  822. *
  823. cbp : fait + haut
  824. c           xlonx=(xsup-xinf)**2
  825. c           xlony=(ysup-yinf)**2
  826. c           xlong=0.d0
  827. c           IF(ZLOGX) THEN
  828. c             XX=LOG10(PROG(1))
  829. c           ELSE
  830. c             XX=PROG(1)
  831. c           ENDIF
  832. c           IF(ZLOGY) THEN
  833. c             YY=LOG10(MLREE1.PROG(1))
  834. c           ELSE
  835. c             YY=MLREE1.PROG(1)
  836. c           ENDIF
  837. c c         on restreint les points de la courbe a l'intervalle borné
  838. c           XX=MIN(xsup,MAX(xinf,XX))
  839. c           YY=MIN(ysup,MAX(yinf,YY))
  840. c           do iy=2,prog(/1)
  841. c             IF(ZLOGX) THEN
  842. c               X1=LOG10(PROG(iy))
  843. c             ELSE
  844. c               X1=PROG(iy)
  845. c             ENDIF
  846. c             IF(ZLOGY) THEN
  847. c               Y1=LOG10(MLREE1.PROG(iy))
  848. c             ELSE
  849. c               Y1=MLREE1.PROG(iy)
  850. c             ENDIF
  851. c c           on restreint les points de la courbe a l'intervalle borné
  852. c             X1=MIN(xsup,MAX(xinf,X1))
  853. c             Y1=MIN(ysup,MAX(yinf,Y1))
  854. c             X2=(X1-XX)**2
  855. c             XX=X1
  856. c             Y2=(Y1-YY)**2
  857. c             YY=Y1
  858. c             xll=sqrt(X2/xlonx+Y2/xlony)
  859. c c             write(6,*) 'segment',iy,' ->',xll
  860. c             xlong=xlong+sqrt(X2/xlonx+Y2/xlony)
  861. c           enddo
  862.           npart=nregu
  863.           xlongp= xlong / npart
  864. c           write(6,*) 'xinf,xsup,yinf,ysup=',xinf,xsup,yinf,ysup
  865. c           write(6,*) 'xlong,nregu,xlongp=',xlong,nregu,xlongp
  866. *
  867. * tracé des marqueurs régulièrement espacés
  868. *
  869.           xmar=xlongp/2.d0
  870.           xdes=xlongp/10.
  871.           xloo= 0.D0
  872. c           IF (ZLOGX) THEN
  873. c             XX  = LOG10(PROG(1))
  874. c           ELSE
  875. c             XX  = PROG(1)
  876. c           ENDIF
  877. c           IF (ZLOGY) THEN
  878. c             YY  = LOG10(MLREE1.PROG(1))
  879. c           ELSE
  880. c             YY  = MLREE1.PROG(1)
  881. c           ENDIF
  882. c c         on restreint les points de la courbe a l'intervalle borné
  883. c           XX=MIN(xsup,MAX(xinf,XX))
  884. c           YY=MIN(ysup,MAX(yinf,YY))
  885.  
  886. cbp           do iy=2,prog(/1)
  887.           do iy=IDEB4+1,IFIN4
  888.             CASE, IPLACX
  889.               WHEN, LISTREEL
  890.                 XVAL=MLREEL.PROG(iy)
  891.               WHEN, LISTENTI
  892.                 XVAL=FLOAT(MLENT0.LECT(iy))
  893.               WHENOTHERS
  894.                 MOTERR=CTYP
  895.                 CALL ERREUR(39)
  896.                 RETURN
  897.             ENDCASE
  898.             CASE, IPLACY
  899.               WHEN, LISTREEL
  900.                 YVAL=MLREE1.PROG(iy)
  901.               WHEN, LISTENTI
  902.                 YVAL=FLOAT(MLENT1.LECT(iy))
  903.               WHENOTHERS
  904.                 MOTERR =CTYP
  905.                 CALL ERREUR(39)
  906.                 RETURN
  907.             ENDCASE
  908.  
  909.             IF(ZLOGX) THEN
  910.               X1=LOG10(XVAL)
  911.             ELSE
  912.               X1=XVAL
  913.             ENDIF
  914.             IF(ZLOGY) THEN
  915.               Y1=LOG10(YVAL)
  916.             ELSE
  917.               Y1=YVAL
  918.             ENDIF
  919.             TXX=X1
  920.             TYY=Y1
  921. c c           on restreint les points de la courbe a l'intervalle borné
  922. c c           pour le calcul de la longueur xloo
  923. c             X1=MIN(xsup,MAX(xinf,X1))
  924. c             Y1=MIN(ysup,MAX(yinf,Y1))
  925. c             X2=(X1-XX)**2
  926. c             XX=X1
  927. c             Y2=(Y1-YY)**2
  928. c             YY=Y1
  929. c             xloo=xloo+sqrt ( x2/xlonx+y2/xlony)
  930.             xloo=MLREE2.PROG(iy-1)
  931. *           tracé si on a cumulé une longueur xmar
  932.             if(xloo.gt.xmar)then
  933. *             et si à peu près dans fenêtre
  934.               IF ((TXX-XINF.GE.-XZPREC*DXEVL) .AND.
  935.      &            (TXX-XSUP.LE. XZPREC*DXEVL) .AND.
  936.      &            (TYY-YINF.GE.-XZPREC*DYEVL) .AND.
  937.      &            (TYY-YSUP.LE. XZPREC*DYEVL)) THEN
  938.                  IF (ZLABEL)
  939.      &              CALL TRLABL(TXX,TYY,0.,MLABEL,72,HMIN)
  940.                  IF (IMARQ.NE.0) THEN
  941.                     CALL DMARQ(IPTR1,TXX,TYY,IMARQ,XTAIL,
  942.      &                       ZPLEIN,NLOCAB)
  943.                  ENDIF
  944.               ENDIF
  945.   999         continue
  946.               xmar=xmar+xlongp
  947. c             si on a deja depassé xmar+xdes il faut aller chercher + loin
  948.               if(xloo.gt.xmar+xdes) then
  949. c                 write(ioimp,*) ' on saute un point'
  950.                 go to 999
  951.               endif
  952.             endif
  953.         enddo
  954.  
  955.          segsup,MLREE2
  956.          ENDIF
  957. *        fin du cas RÉGULIÈREMENT
  958. *
  959. *  9     CONTINUE
  960.  
  961.       ENDIF
  962. *
  963. *  ====================================================================
  964. *  TRACÉ DE LA LÉGENDE AUPRÈS D'UN ÉCHANTILLON DE LIGNE
  965. *  ====================================================================
  966. *
  967.       IF (ZLEGE.AND.(TITOPT(1:14).NE.'PAS DE LEGENDE')) THEN
  968.  
  969. *       on positionne la legende par rapport XPOS1 YPOS1
  970. *       definis en fonction de IPOSI
  971. *       position X pour les cas NO et SO
  972.         if(IPOSI.eq.1.or.IPOSI.eq.3) then
  973.            XPOS1 = XINF + (.06*BG)
  974.            BREF = 4.*BG
  975.         endif
  976. *       position X pour les cas NE et SE
  977.         if(IPOSI.eq.2.or.IPOSI.eq.4) then
  978. c  rem BP: On positionne pour etre OK avec la police de la sortie PS
  979. c          et tant pis pour l ecran (par defaut opti poli '8_BY_13';)
  980.            if(ZCARRE) then
  981.              BREF = 0.72*BD
  982.            else
  983.              BREF = 4.*BD
  984.            endif
  985.            if(IOPOTR.le.3) then
  986.              XPOS1 = XSUP - (0.95*BREF)
  987.            elseif(IOPOTR.le.6) then
  988.              XPOS1 = XSUP - (1.05*BREF)
  989.            elseif(IOPOTR.le.9) then
  990.              XPOS1 = XSUP - (1.15*BREF)
  991.            else
  992.              XPOS1 = XSUP - (1.25*BREF)
  993.            endif
  994.         endif
  995. *       position X pour le cas EXT
  996.         if(IPOSI.eq.5) then
  997.            XPOS1 = XSUP
  998.            BREF = BD
  999.         endif
  1000. *       position XPOSI fourni par l utilisateur
  1001.         if(IPOSI.eq.6) then
  1002.             IF(ZLOGX) THEN
  1003.               XPOS1 = LOG10(XPOSI)
  1004.             ELSE
  1005.               XPOS1 = XPOSI
  1006.             ENDIF
  1007.           BREF = 4.*BG
  1008.         endif
  1009.  
  1010. *       Le nb total de légendes à afficher, ici majoré par le nb de courbes,
  1011. *       est compris entre NLGMIN et NLGMAX
  1012. *       Première légende en haut
  1013.         NNLG = MAX(NLGMIN,MIN(INBEVO,NLGMAX))
  1014. c         write(6,*) 'NLGMIN,MAX,INBEVO,NNLG=',NLGMIN,NLGMAX,INBEVO,NNLG
  1015.         HAUT = 1.
  1016.         IF (NLG.LT.NLGMAX) THEN
  1017.  
  1018. *         on incrémente les compteurs de courbes avec legende
  1019.           NCT  = NCT + 1
  1020.           NLG  = NLG + 1
  1021.  
  1022. *         position Y pour les cas NO et NE
  1023.           if(IPOSI.le.2) then
  1024.             TYY  = YSUP + ((1.D0-NLG)*(DYEVL/NNLG))
  1025.      &                  - (.05*DYEVL)
  1026. *         position Y pour les cas SO, SE
  1027.           elseif(IPOSI.le.4) then
  1028.             TYY  = YINF + ((NLG-1.D0)*(DYEVL/NNLG))
  1029.      &                  + (.05*DYEVL)
  1030. *         position YPOSI fourni par l utilisateur
  1031.           elseif(IPOSI.eq.6) then
  1032.             IF(ZLOGY) THEN
  1033.               YPOS1 = LOG10(YPOSI)
  1034.             ELSE
  1035.               YPOS1 = YPOSI
  1036.             ENDIF
  1037.             TYY  = YPOS1 + ((1.D0-NLG)*(DYEVL/NNLG))
  1038.      &                  - (.03*DYEVL)
  1039. *         position Y pour le cas t EXT
  1040.           else
  1041.             TYY  = YINF + ((NLG-1.D0)*(DYEVL/NNLG))
  1042.      &                  + (.03*DYEVL)
  1043. cbp : contrairement a ce qui est ecrit la 1ere legende est en bas !
  1044. c             TYY  = YINF + ((NNLG-NLG)*(DYEVL/NNLG))
  1045. c      &                  + (.03*DYEVL)
  1046.           endif
  1047.  
  1048. *         un petit bout de remplissage éventuellement
  1049.           TDY=0.
  1050.           IF (ZREMP.and..not.ZBLANC) THEN
  1051.             TDY=.01*DYEVL
  1052.             TRX(1)= XPOS1 + (.06*BREF)
  1053.             TRY(1)= TYY  - TDY
  1054.             TRX(2)= XPOS1 + (.30*BREF)
  1055.             TRY(2)= TYY  - TDY
  1056.             TRX(3)= XPOS1 + (.30*BREF)
  1057.             TRY(3)= TYY  + TDY
  1058.             TRX(4)= XPOS1 + (.06*BREF)
  1059.             TRY(4)= TYY  + TDY
  1060.             CALL TRFACE(4,TRX,TRY,TRZ,1.,NLOCAB,IEFF)
  1061.           ENDIF
  1062.  
  1063. *         un petit bout de ligne éventuellement
  1064.           IF (.NOT. ZNOLI) THEN
  1065.             TX(1)= XPOS1 + (.06*BREF)
  1066.             TX(2)= XPOS1 + (.30*BREF)
  1067.             TY(1)= TYY  + TDY
  1068.             TY(2)= TYY  + TDY
  1069.             IF (ZREMP.and..not.ZBLANC) CALL CHCOUL(ICOMBR)
  1070. c             write(*,*) 'legende',KTIR0
  1071.             ZTIRET=KTIR0.GE.1
  1072.             CALL TRSEG (IPTR1,TX,TY,ZTIRET,KTIR0,DL,ZTRAC)
  1073.             IF (ZREMP.and..not.ZBLANC) CALL CHCOUL(NLOCAB)
  1074.           ENDIF
  1075.  
  1076. *         le marqueur/label éventuel
  1077.           IF ((IMARQ.NE.0).OR.ZLABEL.OR.(ZNOLI.AND..NOT.ZREMP)) THEN
  1078.             TXX  = XPOS1 + (.18*BREF)
  1079.             TYY2 = TYY  + TDY
  1080.  
  1081.             IF (IMARQ.EQ.0) THEN
  1082.                 IMARQ=1
  1083.                 IEPAI=1
  1084.                 XTAIL=1D0
  1085.                 ZPLEIN=.FALSE.
  1086.             ENDIF
  1087.  
  1088.             IF (ZLABEL) CALL TRLABL(TXX,TYY2,0.,MLABEL,72,HMIN)
  1089.             CALL DMARQ(IPTR1,TXX,TYY2,IMARQ,XTAIL,ZPLEIN,NLOCAB)
  1090.           ENDIF
  1091.  
  1092. *         et le texte, un poil plus bas
  1093.           TXX2 = XPOS1 + (.33*BREF)
  1094.           TYY2 = TYY  - (.01*DYEVL)
  1095.           CALL TRLABL (TXX2,TYY2,0.,TITOPT(1:72),72,HMIN)
  1096.  
  1097.         ENDIF
  1098.       ENDIF
  1099.       END
  1100.  
  1101.  

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