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

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