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

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