Esope source files

   1 : C TRCUR     SOURCE    BP208322  12/08/02    21:15:43     7468           
   2 :       SUBROUTINE TRCUR(IPO1,IPO2)
   3 : *=============================================================
   4 : *
   5 : *     ECRIT SUR LE DESSIN UNE SERIE DE NOMS DE NOEUDS
   6 : *
   7 : *=============================================================
   8 : * Modifications :
   9 : *
  10 : *   95/02/07 Loca
  11 : *     passer les legendes x et y de 12 à 20 caractères:
  12 : *     SEGMENT AXE disparait et est appelé en include: -INC TMAXE.
  13 : *
  14 : *   05 sept. 2007 Maugis
  15 : *     Maintien du segment AXE actif en modification
  16 : *
  17 : *=============================================================
  18 : *
  19 : * Entrée :
  20 : *
  21 : *     IPO1 : POINTEUR SUR UN AXE                       (ACTIF)
  22 : *     IPO2 : POINTEUR SUR UNE EVOL
  23 : *
  24 : *=============================================================
  25 : 
  26 :       IMPLICIT LOGICAL (Z)
  27 :       IMPLICIT INTEGER(I-N)
  28 :       IMPLICIT REAL*8  (A-H,O-S,U-Y)
  29 : -INC SMEVOLL
  30 : -INC SMLREEL
  31 : -INC SMLMOTS
  32 : -INC TMAXE
  33 :       REAL TXX,TYY,HMIN,X,Y
  34 :       CHARACTER*30 BUFFER
  35 :       DIMENSION    TX(2),TY(2)
  36 : *
  37 :       AXE   = IPO1
  38 : *PM   SEGACT AXE
  39 :       HMIN  = .2
  40 :       KEVOLL= IPO2
  41 :       SEGACT KEVOLL
  42 : 
  43 :       IF (TYPX(1:8).EQ.'LISTMOTS') THEN
  44 : *        Le long de l'axe gauche des ordonnées
  45 : *        La première liste contient les noms, la 2e les ordonnées
  46 :          TDELTA=ABS(XSUP-XINF)/40
  47 :          MLREEL=IPROGY
  48 :          SEGACT MLREEL
  49 :          MLMOTS=IPROGX
  50 :          SEGACT MLMOTS
  51 :          DO 1 I=1,PROG(/1)
  52 :               YY=PROG(I)
  53 :               IF (ZLOGY) YY=LOG10(PROG(I))
  54 :               IF ((YY.LT.YINF).OR.(YY.GT.YSUP)) GOTO 1
  55 : *             TRACE MARQUEUR (TRIL)
  56 :               X=XINF+TDELTA
  57 :               Y=YY
  58 :               IPTR=AXE
  59 : *PM           SEGDES AXE
  59 : c               CALL DMARQ (IPTR,X,Y,7,1,1D0,.FALSE.,0)
  59 :               CALL DMARQ (IPTR,X,Y,7,1D0,.FALSE.,0)
  59 : *              CALL CHCOUL(Nlocab)
  60 : *PM           SEGACT AXE
  61 : *             AFFICHE NOM DU NOEUD
  62 :               BUFFER(1:30)=MOTS(I)
  63 :               TXX=XINF+TDELTA*2
  64 :               TYY=YY
  64 :               CALL TRLABL(TXX,TYY,0.,BUFFER(1:30),30,HMIN)
  65 : 1          CONTINUE
  66 :       ELSE
  67 : *        Le long de l'axe bas des abscisses
  68 : *        La première liste contient les abscisses, la 2e les noms
  69 :          TDELTA=ABS(YSUP-YINF)/45
  70 :          MLREEL=IPROGX
  71 :          SEGACT MLREEL
  72 :          MLMOTS=IPROGY
  73 :          SEGACT MLMOTS
  74 :          DO 2 I=1,PROG(/1)
  75 :               XX=PROG(I)
  76 :               IF (ZLOGX) XX=LOG10(PROG(I))
  77 :               IF ((XX.LT.XINF).OR.(XX.GT.XSUP)) GOTO 2
  78 : *             TRACE MARQUEUR (TRID)
  79 :               X=XX
  80 :               Y=YINF+TDELTA
  81 :               IPTR=AXE
  82 : *PM           SEGDES AXE
  82 : c               CALL DMARQ (IPTR,X,Y,7,1,1D0,.FALSE.,0)
  82 :               CALL DMARQ (IPTR,X,Y,7,1D0,.FALSE.,0)
  82 : *              CALL CHCOUL(Nlocab)
  83 : *PM           SEGACT AXE
  84 : *             AFFICHE NOM DU NOEUD
  85 :               BUFFER(1:30)=MOTS(I)
  86 :               TXX=XX
  87 :               TYY=YINF+TDELTA*2
  87 :               CALL TRLABL(TXX,TYY,0.,BUFFER(1:30),30,HMIN)
  88 : 2          CONTINUE
  89 :       ENDIF
  90 : 
  91 :       RETURN
  92 :       END
  93 :  
  94 :  
  95 :