C DAXES     SOURCE    BP208322  12/08/02    21:15:11     7468           

      SUBROUTINE DAXES (IPTR,ZAXES,IGRIL)
*
*=============================================================
* 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 :
*
*  IPTR  : POINTEUR SUR UN AXE                         (ACTIF)
*  ZAXES : LOGIQUE INDIQUANT DE TRACER LES AXES
*
*=============================================================
*
*  1. TOUTES LES VARIABLES COMMENCANT PAR T SONT EN SIMPLE PRECISION !
*  2. PM: bien qu'aucune de ses variables ne soient modifiées, le
*     segment AXE est tout de même ouvert en modification (?)
*
*=============================================================
      IMPLICIT LOGICAL (Z)
*
*
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-S,U-Y)
*
      REAL HMIN
*
-INC CCOPTIO
-INC CCTRACE
-INC TMAXE

      EXTERNAL LONG
      
      CHARACTER*30 BUFFER
      DIMENSION  TX(5),TY(5),TZ(5),TX2(2),TY2(2),TZ2(2)
      LOGICAL ZTIRET,ZTRAC

*=============================================================
*  INITIALISATIONS
*=============================================================

      do ii=1,5
       tz(ii)=0
      enddo
      do ii=1,2
       tz2(ii)=0
      enddo
      AXE=IPTR
      SEGACT AXE*MOD
      HMIN=.2


*=============================================================
*  TRACE DES AXES + GRADUATIONS 
*=============================================================

*  TRACE DES AXES ============================================
*  (CADRE DEFINI PAR XINF XSUP YINF YSUP)
*     couleurs definies dans bdata : 0:defaut 7:blanc 8:noir 16:gris
      IF (ICOSC.EQ.2.OR.ICOSC.EQ.3) THEN
         icoul0=8
      ELSE
         icoul0=0
      ENDIF
      CALL CHCOUL(icoul0)
      TX(1)=REAL(XINF)
      TY(1)=REAL(YINF)
      TX(2)=REAL(XINF)
      TY(2)=REAL(YSUP)
      TX(3)=REAL(XSUP)
      TY(3)=REAL(YSUP)
      TX(4)=REAL(XSUP)
      TY(4)=REAL(YINF)
      TX(5)=REAL(XINF)
      TY(5)=REAL(YINF)
      CALL POLRL (5,TX,TY,tz)
*
*  TRACE DES GRADUATIONS SUR L'AXE X  ========================

*  TRACE DES GRADUATIONS PRINCIPALES
      TDELTY=REAL(DABS(YSUP-YINF))/75.
      TX(1)=REAL(XINF)
      TY(1)=REAL(YINF)
      TY(2)=REAL(YINF)+TDELTY
      TY2(1)=REAL(YSUP)
      TY2(2)=REAL(YSUP)-TDELTY
      DO 1 I=2,INX
        TX(1)=TX(1)+REAL(XINT)
        TX(2)=TX(1)
        CALL POLRL(2,TX,TY2,tz)
        CALL POLRL(2,TX,TY,tz)
  1   CONTINUE
*
*  TRACE DES GRADUATIONS NON LINEAIRES SI AXE X EN LOG 
      IF (ZLOGX) THEN
        DO 2 J=2,6,2
          TX(1)=REAL(XINF)+LOG10(REAL(J))
          TY(1)=REAL(YINF)
          TY(2)=REAL(YINF)+TDELTY
          TY2(1)=REAL(YSUP)
          TY2(2)=REAL(YSUP)-TDELTY
          DO 3 I=1,INX
            TX(2)=TX(1)
            CALL POLRL(2,TX,TY2,tz)
            CALL POLRL(2,TX,TY,tz)
            TX(1)=TX(1)+REAL(XINT)
  3       CONTINUE
  2     CONTINUE
      ENDIF
*
*  TRACE DES GRADUATIONS SUR L'AXE Y ========================
*
*  TRACE DES GRADUATIONS PRINCIPALES
      TDELTX=REAL(DABS(XSUP-XINF))/70.
      TY(1)=REAL(YINF)
      TX(1)=REAL(XINF)
      TX(2)=REAL(XINF)+TDELTX
      TX2(1)=REAL(XSUP)
      TX2(2)=REAL(XSUP)-TDELTX
      DO 4 I=2,INY
        TY(1)=TY(1)+REAL(YINT)
        TY(2)=TY(1)
        CALL POLRL (2,TX2,TY,tz)
        CALL POLRL (2,TX,TY,tz)
  4   CONTINUE
*
*  TRACE DES GRADUATIONS NON LINEAIRES SI AXE Y EN LOG
      IF (ZLOGY) THEN
        DO 5 J=2,6,2
          TY(1)=REAL(YINF)+LOG10(REAL(J))
          TX(1)=REAL(XINF)
          TX(2)=REAL(XINF)+TDELTX
          TX2(1)=REAL(XSUP)
          TX2(2)=REAL(XSUP)-TDELTX
          DO 6 I=1,INY
            TY(2)=TY(1)
            CALL POLRL (2,TX2,TY,tz)
            CALL POLRL (2,TX,TY,tz)
            TY(1)=TY(1)+YINT
  6       CONTINUE
  5     CONTINUE
      ENDIF


*=============================================================
*  ECRITURE DES XLABEL ET YLABEL (TITX et TITY)
*=============================================================

*    J'UTILISE DES COPIES DANS BUFFER CAR AVEC LES APPELS AVEC TITREX
*  TITREY SINON EN TATB SUR LE CRAY JE PAUME UNE LEGENDE EN Y
*
c     TITX ===============================
c       ANGLE=0.d0
c       IALIGN=IPOSX
cbp : on utilise le tableau INFOTR de l include CCTRACE
      INFOTR(1)=0
      INFOTR(2)=IPOSX
      IF(IPOSX.eq.2) THEN
        TXX=REAL(.5*(XSUP+XINF))
      ELSE
cbp     on va se mettre avant l eventuel x10^{} de l'axe X
c       + on recule du nombre de caractere (on ne tient pas compte de la
c         police utilisee !!!)
        IF(ZCARRE) THEN
          TXX=REAL(XSUP)-(.017*(XSUP-XINF)*REAL(LONG(TITREX)+3))
        ELSE
          TXX=REAL(XSUP)-(.011*(XSUP-XINF)*REAL(LONG(TITREX)+3))
        ENDIF
      ENDIF
      IF(ZLOGX) THEN
        TYY=REAL(YINF)-.12*(YSUP-YINF)
      ELSE
        TYY=REAL(YINF)-.10*(YSUP-YINF)
      ENDIF
      BUFFER(1:20)=TITREX(1:20)
      CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN)

c     TITY ===============================
c       IALIGN=IPOSY
      INFOTR(1)=0
      INFOTR(2)=IPOSY
      IF(IPOSY.eq.2) THEN
        TXX=REAL(XINF)-(0.99*BG)
        TYY=REAL(0.5*(YSUP+YINF))
c         ANGLE=90.d0
        INFOTR(1)=90
      ELSE
        TXX=REAL(XINF)-.01*(XSUP-XINF)
        TYY=REAL(YSUP)+.05*(YSUP-YINF)
      ENDIF
      BUFFER(1:20)=TITREY(1:20)
      CALL TRLABL(TXX,TYY,0.,BUFFER(1:20),20,HMIN)
cbp : je n'ai pas compris le 0. ci-dessus; dans le doute je le laisse ...  
c     on remet tout a 0      
c       ANGLE=0.d0
c       IALIGN=0
      INFOTR(1)=0
      INFOTR(2)=0


*=============================================================
*  ECRITURE DES VALEURS DE GRADUATION SUR LES AXE
*=============================================================

*-------------------------------------------------------------
*  ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LINEAIRE 
*-------------------------------------------------------------
      IF (.NOT.ZLOGX) THEN
*
        IP=ICALP(XINF,XSUP)
*
*  INITIALISATION DES VALEURS POUR LE TRACE
*
        GRAD=XINF
        TXX=REAL(XINF)-(.35*BG)
        TYY=REAL(YINF)-(.3*BB)
*
*  BOUCLE POUR CHAQUE PAS
*
        DO 7 I=1,INX+1
          CH=GRAD/10.D0**FLOAT(IP)
*
*  FORMATTAGE DES VALEURS DE GRADUATION
*
          BUFFER(1:8)='        '
          IF (CH.LE.-10.D0) THEN
            WRITE (BUFFER(1:7),FMT='(F7.2)') CH
          ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
            WRITE (BUFFER(1:6),FMT='(F6.2)') CH
          ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
            WRITE (BUFFER(2:6),FMT='(F5.2)') CH
          ELSEIF (CH.GE.10.D0)THEN
            WRITE (BUFFER(1:6),FMT='(F6.2)') CH
          ENDIF
          CALL TRLABL (TXX,TYY,0.,BUFFER(1:8),8,HMIN)
          TXX=TXX+REAL(XINT)
          GRAD=GRAD+XINT
  7     CONTINUE
*
*  ECRITURE DE P APRES FORMATTAGE
*
        IF (IP.NE.0) THEN
c           BUFFER(1:10)='x1.E        '
c           ideb=4          
          BUFFER(1:10)='x10^{     '
          ideb=6          
          IF (IP.LE.-10) THEN
            ideb2=ideb+3
            WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
          ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
            ideb2=ideb+1
            WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
          ELSEIF (IP.GE.10) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ENDIF
          BUFFER(ideb2:ideb2)='}'          
          TYY=REAL(YINF-.10*(YSUP-YINF))
          if(ZCARRE) then
            TXX=REAL(XSUP)-(.015*(XSUP-XINF))
          else
            TXX=REAL(XSUP)-(.010*(XSUP-XINF))
          endif
          CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
        ENDIF

*-------------------------------------------------------------
*  ECRITURE DES VALEURS DE GRADUATION SUR AXE X EN LOG
*-------------------------------------------------------------
      ELSE
        GRAD=XINF
c         TXX=REAL(XINF)-(BG/4.)
c         TXX=REAL(XINF)-((BG+BD)/8.)
c         TXX=REAL(XINF)-(0.15*BG)
        TXX=REAL(XINF)-(0.10*BG)
c         TYY=REAL(YINF)-.06*(YSUP-YINF)
        TYY=REAL(YINF)-.07*(YSUP-YINF)
        DO 8 I=1,INX+1
          IP=INT(GRAD)
c           BUFFER(1:6)='1.E   '
c           ideb=4          
          BUFFER(1:10)='10^{     '
          ideb=5          
          IF (IP.LE.-10) THEN
            ideb2=ideb+3
            WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
          ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
            ideb2=ideb+1
            WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
          ELSEIF (IP.GE.10) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ENDIF
          BUFFER(ideb2:ideb2)='}'          
          CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
          TXX=TXX+XINT
          GRAD=GRAD+XINT
  8     CONTINUE
*
        IF ((XSUP-XINF).LE.9.D0) THEN
*
*  ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE X EN LOG
*   UNIQUEMENT SI LEUR NOMBRE N'EST PAS TROP IMPORTANT
*
          DO 9 J=1,7,2
            IF (J.EQ.1) THEN
              TXX=REAL(XINF)
            ELSE
              TXX=REAL(XINF)+LOG10(REAL(J)-REAL(1.))
            ENDIF
            TXX=TXX-(0.07*BG)
            TYY=REAL(YINF)-(0.25*BB)
            DO 10 I=1,INX
              JJ=1
              IF (J.GT.1) JJ=J-1
              WRITE (BUFFER(1:1),FMT='(I1)') JJ
              CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
              TXX=TXX+REAL(XINT)
              IF ((I.EQ.INX).AND.(J.EQ.1)) THEN
                JJ=1
                WRITE (BUFFER(1:1),FMT='(I1)') JJ
                CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
              ENDIF
10          CONTINUE
 9        CONTINUE
        ENDIF
      ENDIF


*-------------------------------------------------------------
*  ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LINEAIRE
*-------------------------------------------------------------
      IF (.NOT.ZLOGY) THEN
*
        IP=ICALP(YINF,YSUP)
*
*  INITIALISATION DES VALEURS POUR LE TRACE
*
        GRAD=YINF
        TXX=REAL(XINF)-(BG*0.9)
        TYY=REAL(YINF)
*
*  BOUCLE POUR CHAQUE PAS
*
        DO 11 I=1,INY+1
          CH=GRAD/10.D0**FLOAT(IP)
*
*  FORMATTAGE DES VALEURS DE GRADUATION
*
          BUFFER(1:8)=' '
          IF (CH.LE.-10.D0) THEN
            WRITE (BUFFER(1:7),FMT='(F7.2)') CH
          ELSEIF (CH.GT.-10.D0.AND.CH.LT.0.D0) THEN
            WRITE (BUFFER(1:6),FMT='(F6.2)') CH
          ELSEIF (CH.GE.0.D0.AND.CH.LT.10.D0) THEN
            WRITE (BUFFER(2:6),FMT='(F5.2)') CH
          ELSEIF (CH.GE.10.D0)THEN
            WRITE (BUFFER(1:6),FMT='(F6.2)') CH
          ENDIF
          CALL TRLABL (TXX,TYY,0.,BUFFER(1:8),8,HMIN)
          TYY=TYY+REAL(YINT)
          GRAD=GRAD+YINT
 11     CONTINUE
*
*  ECRITURE APRES FORMATTAGE DE P
*
        IF (IP.NE.0) THEN
c           BUFFER(1:10)='x1.E        '
c           ideb=5
          BUFFER(1:10)='x10^{     '
          ideb=6          
          IF (IP.LE.-10) THEN
            ideb2=ideb+3
            WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
          ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
            ideb2=ideb+1
            WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
          ELSEIF (IP.GE.10) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ENDIF
          BUFFER(ideb2:ideb2)='}'          
          TYY=(YSUP)+.05*(YSUP-YINF)
          CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
        ENDIF
*
*-------------------------------------------------------------
*  ECRITURE DES VALEURS DE GRADUATION SUR AXE Y EN LOG
*-------------------------------------------------------------
*
      ELSE
        GRAD=YINF
c         TXX=REAL(XINF)-(BG*0.99)
        TXX=REAL(XINF)-(BG*0.8)
        TYY=REAL(YINF)
        DO 12 I=1,INY+1
          IP=INT(GRAD)
c           BUFFER(1:3)='1.E'
c           ideb=4          
          BUFFER(1:10)='10^{     '
          ideb=5          
          IF (IP.LE.-10) THEN
            ideb2=ideb+3
            WRITE (BUFFER(ideb:ideb+2),FMT='(I3)') IP
          ELSEIF (IP.GT.-10.AND.IP.LT.0) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ELSEIF (IP.GE.-10.AND.IP.LT.10) THEN
            ideb2=ideb+1
            WRITE (BUFFER(ideb:ideb),FMT='(I1)') IP
          ELSEIF (IP.GE.10) THEN
            ideb2=ideb+2
            WRITE (BUFFER(ideb:ideb+1),FMT='(I2)') IP
          ENDIF
          BUFFER(ideb2:ideb2)='}'          
          CALL TRLABL(TXX,TYY,0.,BUFFER(1:10),10,HMIN)
          TYY=TYY+REAL(YINT)
          GRAD=GRAD+YINT
 12     CONTINUE
*
        IF ((YSUP-YINF).LE.7.D0) THEN
*
*  ECRITURE DES VALEURS DE SOUS-GRADUATION SUR AXE Y EN LOG
*   UNIQUEMENT SI LEUR NOMBRE N'EST PAS TROP IMPORTANT
*
          DO 13 J=1,7,2
            IF (J.EQ.1) THEN
              TYY=REAL(YINF)-real(BB/30.)
            ELSE
              TYY=REAL(YINF)+LOG10(REAL(J)-REAL(1.))-real(BB/30.)
            ENDIF
            TXX=REAL(XINF)-REAL(0.2*BG)
            DO 14 I=1,INY
              JJ=1
              IF (J.GT.1) JJ=J-1
              WRITE (BUFFER(1:1),FMT='(I1)') JJ
              CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
              TYY=TYY+YINT
              IF ((I.EQ.INY).AND.(J.EQ.1)) THEN
                JJ=1
                WRITE (BUFFER(1:1),FMT='(I1)') JJ
                CALL TRLABL(TXX,TYY,0.,BUFFER(1:1),1,HMIN)
              ENDIF
 14         CONTINUE
 13       CONTINUE
        ENDIF
      ENDIF


*=============================================================
*  TRACE DE GRILLE
*=============================================================
*
      IF (ZGRILL) THEN
      
c       grille en gris ?
        icoul1=icoul0
        if(IGRIL.lt.0) then
          icoul1=15
          CALL CHCOUL(icoul1)
        endif
        
c       bp faut-il faire des pointillés?
        IGRILA = abs(IGRIL)
        ZTIRET=(IGRILA.gt.1)
        IGRIL1= IGRILA-1
        DXEVL = XSUP-XINF
        DL    = DXEVL/100.D0
        ZTRAC =.TRUE.
        
*       trace grille secondaire (nonlineaire) si axe x en log 
*       (en pointillés gris)
        IF (ZLOGX) THEN
          CALL CHCOUL(15)
          GRAD=XINF
          DO 151 I=1,INX
            TX1=REAL(GRAD+FLOAT(I-1)*XINT)
*           trace grille non lineaire si axe x en log (pointillés gris)
            DO 155 J=2,9,1
                TX(1)=TX1+LOG10(REAL(J))
                TX(2)=TX(1)
                TY(1)=REAL(YINF)
                TY(2)=REAL(YSUP)
                CALL TRSEG (IPTR,TX,TY,.true.,5,DL,ZTRAC)
 155        CONTINUE
 151      CONTINUE
          CALL CHCOUL(icoul1)
        ENDIF
        
c       grille des x
        IF (INX.GT.1)THEN
          GRAD=XINF
          DO 15 I=1,INX-1
            TX(1)=REAL(GRAD+FLOAT(I)*XINT)
            TX(2)=TX(1)
            TY(1)=REAL(YINF)
            TY(2)=REAL(YSUP)
c             CALL POLRL (2,TX,TY,tz)
            CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC)
 15       CONTINUE
        ENDIF
        
*       trace grille secondaire (nonlineaire) si axe y en log 
*       (en pointillés gris)
        IF (ZLOGY) THEN
          CALL CHCOUL(15)
          GRAD=YINF
          DO 161 I=1,INY
            TY1=REAL(GRAD+FLOAT(I-1)*YINT)
*           trace grille non lineaire si axe y en log (pointillés gris)
c             DO 165 J=2,8,2
            DO 165 J=2,9,1
                TX(1)=REAL(XINF)
                TX(2)=REAL(XSUP)
                TY(1)=TY1+LOG10(REAL(J))
                TY(2)=TY(1)
                CALL TRSEG (IPTR,TX,TY,.true.,5,DL,ZTRAC)
 165        CONTINUE
 161      CONTINUE
          CALL CHCOUL(icoul1)
        ENDIF
        
c       grille des y
        IF (INY.GT.1)THEN
          GRAD=YINF
          DO 16 I=1,INY-1
            TX(1)=REAL(XINF)
            TX(2)=REAL(XSUP)
            TY(1)=REAL(GRAD+FLOAT(I)*YINT)
            TY(2)=TY(1)
c             CALL POLRL (2,TX,TY,tz)
            CALL TRSEG (IPTR,TX,TY,ZTIRET,IGRIL1,DL,ZTRAC)
 16       CONTINUE
        ENDIF
        
c       on remet la couleur des axes
        CALL CHCOUL(icoul0)
        
      ENDIF
      

*=============================================================
*  TRACE DES AXES Ox et Oy, UNIQUEMENT EN LINEAIRE
*=============================================================
*
      IF (ZAXES) THEN
        IF (.NOT.ZLOGX.AND.XINF*XSUP.LE.0.D0) THEN
          TX(1)=0.
          TX(2)=0.
          TY(1)=REAL(YINF)
          TY(2)=REAL(YSUP)+3.*TDELTY
          CALL POLRL (2,TX,TY,tz)
          TX(1)=-0.5*TDELTX
          TX(3)=0.5*TDELTX
          TY(1)=TY(2)-TDELTY
          TY(3)=TY(1)
          CALL POLRL (3,TX,TY,tz)
*          BUFFER(1:2)='Oy'
*          TXX=TDELTX
*          TYY=REAL(YSUP)+2.*TDELTY
*          CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN)
        ENDIF
        IF (.NOT.ZLOGY.AND.YINF*YSUP.LE.0.D0) THEN
          TX(1)=REAL(XINF)
          TX(2)=REAL(XSUP)+3.*TDELTX
          TY(1)=0.
          TY(2)=0.
          CALL POLRL (2,TX,TY,tz)
          TY(1)=0.5*TDELTY
          TY(3)=-0.5*TDELTY
          TX(1)=TX(2)-TDELTX
          TX(3)=TX(1)
          CALL POLRL (3,TX,TY,tz)
*          BUFFER(1:2)='Ox'
*          TXX=REAL(XSUP)+3.*TDELTX
*          TYY=-2.*TDELTY
*          CALL TRLABL(TXX,TYY,0.,BUFFER(1:2),2,HMIN)
        ENDIF
      ENDIF
*
*PM   SEGDES AXE
*
      END