Sources Esope | Cast3M

trcur
C TRCUR     SOURCE    CB215821  21/06/10    21:16:00     11029          
      SUBROUTINE TRCUR(IPO1,IPO2)
*=============================================================
*
*     ECRIT SUR LE DESSIN UNE SERIE DE NOMS DE NOEUDS
*
*=============================================================
* Modifications :
*
*   95/02/07 Loca
*     passer les legendes x et y de 12 à 20 caractères:
*     SEGMENT AXE disparait et est appelé en include: -INC TMAXE.
*
*   05 sept. 2007 Maugis
*     Maintien du segment AXE actif en modification
*
*=============================================================
*
* Entrée :
*
*     IPO1 : POINTEUR SUR UN AXE                       (ACTIF)
*     IPO2 : POINTEUR SUR UNE EVOL
*
*=============================================================
 
      IMPLICIT LOGICAL (Z)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8  (A-H,O-S,U-Y)
-INC SMEVOLL
-INC SMLREEL
-INC SMLENTI
-INC SMLMOTS
-INC TMAXE
      REAL TXX,TYY,HMIN,X,Y
      CHARACTER*30 BUFFER
      DIMENSION    TX(2),TY(2)
*
      AXE   = IPO1
*PM   SEGACT AXE
      HMIN  = .2
      KEVOLL= IPO2
 
*bp,2020 : ajout de la couleur      
      NLOCAB=NUMEVX
      CALL CHCOUL(NLOCAB)
 
      IF (TYPX.EQ.'LISTMOTS' .AND. TYPY.EQ.'LISTREEL') THEN
*        Le long de l'axe gauche des ordonnées
*        La première liste contient les noms, la 2e les ordonnées
         TDELTA=ABS(XSUP-XINF)/40
         MLREEL=IPROGY
         MLMOTS=IPROGX
         DO 1 I=1,PROG(/1)
              YY=PROG(I)
              IF (ZLOGY) YY=LOG10(YY)
              IF ((YY.LT.YINF).OR.(YY.GT.YSUP)) GOTO 1
*             TRACE MARQUEUR (TRIL)
              X=XINF+TDELTA
              Y=YY
              IPTR=AXE
c               CALL DMARQ (IPTR,X,Y,7,1,1D0,.FALSE.,0)
              CALL DMARQ (IPTR,X,Y,7,1D0,.FALSE.,0)
*              CALL CHCOUL(Nlocab)
*             AFFICHE NOM DU NOEUD
              BUFFER = MOTS(I)
              TXX    = XINF+TDELTA*2
              TYY    = YY
              CALL TRLABL(TXX,TYY,0.,BUFFER,30,HMIN)
1          CONTINUE
 
      ELSEIF(TYPY.EQ.'LISTMOTS' .AND. TYPX.EQ.'LISTREEL')THEN
*        Le long de l'axe bas des abscisses
*        La première liste contient les abscisses, la 2e les noms
         TDELTA=ABS(YSUP-YINF)/45
         MLREEL=IPROGX
         MLMOTS=IPROGY
         DO 2 I=1,PROG(/1)
              XX=PROG(I)
              IF (ZLOGX) XX=LOG10(XX)
              IF ((XX.LT.XINF).OR.(XX.GT.XSUP)) GOTO 2
*             TRACE MARQUEUR (TRID)
              X=XX
              Y=YINF+TDELTA
              IPTR=AXE
c               CALL DMARQ (IPTR,X,Y,7,1,1D0,.FALSE.,0)
              CALL DMARQ (IPTR,X,Y,7,1D0,.FALSE.,0)
*              CALL CHCOUL(Nlocab)
*             AFFICHE NOM DU NOEUD
              BUFFER=MOTS(I)
              TXX=XX
              TYY=YINF+TDELTA*2
              CALL TRLABL(TXX,TYY,0.,BUFFER,30,HMIN)
2          CONTINUE
 
      ELSEIF (TYPX.EQ.'LISTMOTS' .AND. TYPY.EQ.'LISTENTI') THEN
*        Le long de l'axe gauche des ordonnées
*        La première liste contient les noms, la 2e les ordonnées
         TDELTA=ABS(XSUP-XINF)/40
         MLENTI=IPROGY
         MLMOTS=IPROGX
         DO 3 I=1,LECT(/1)
              YY=REAL(LECT(I))
              IF (ZLOGY) YY=LOG10(YY)
              IF ((YY.LT.YINF).OR.(YY.GT.YSUP)) GOTO 3
*             TRACE MARQUEUR (TRIL)
              X=XINF+TDELTA
              Y=YY
              IPTR=AXE
c               CALL DMARQ (IPTR,X,Y,7,1,1D0,.FALSE.,0)
              CALL DMARQ (IPTR,X,Y,7,1D0,.FALSE.,0)
*              CALL CHCOUL(Nlocab)
*             AFFICHE NOM DU NOEUD
              BUFFER = MOTS(I)
              TXX    = XINF+TDELTA*2
              TYY    = YY
              CALL TRLABL(TXX,TYY,0.,BUFFER,30,HMIN)
3          CONTINUE
 
      ELSEIF(TYPY.EQ.'LISTMOTS' .AND. TYPX.EQ.'LISTENTI')THEN
*        Le long de l'axe bas des abscisses
*        La première liste contient les abscisses, la 2e les noms
         TDELTA=ABS(YSUP-YINF)/45
         MLENTI=IPROGX
         MLMOTS=IPROGY
         DO 4 I=1,LECT(/1)
              XX=REAL(LECT(I))
              IF (ZLOGX) XX=LOG10(XX)
              IF ((XX.LT.XINF).OR.(XX.GT.XSUP)) GOTO 4
*             TRACE MARQUEUR (TRID)
              X=XX
              Y=YINF+TDELTA
              IPTR=AXE
c               CALL DMARQ (IPTR,X,Y,7,1,1D0,.FALSE.,0)
              CALL DMARQ (IPTR,X,Y,7,1D0,.FALSE.,0)
*              CALL CHCOUL(Nlocab)
*             AFFICHE NOM DU NOEUD
              BUFFER=MOTS(I)
              TXX=XX
              TYY=YINF+TDELTA*2
              CALL TRLABL(TXX,TYY,0.,BUFFER,30,HMIN)
4          CONTINUE
 
      ELSE
        CALL ERREUR(5)
        RETURN
      ENDIF
 
      RETURN
      END