      SUBROUTINE TRAD(XX,CC,NC,XMIN,XMAX,IDECAL)
C
C Traduit le reel xx en une chaine de caractere cc de longueur nc
C
      REAL*8 X,XX,XRAP,XNLIM,XNLIM2
      CHARACTER*1 C(32),CC(*),CHIFR(10)
      PARAMETER ( NCMAX=7 , XNLIM = 10.D0**(1+NCMAX) )
      PARAMETER ( XNLIM2 = 10.D0**(-1-NCMAX) )
CC attention pas bon    PARAMETER ( NCMAX=7 , NLIM = 1+10**(NCMAX+1) )
      PARAMETER ( XRAP = 1.D-06 ) 
      DATA CHIFR / '0','1','2','3','4','5','6','7','8','9' /
C
      DO 1 I=1,32
        C(I)  = ' '
        CC(I) = ' '
 1    CONTINUE
      NLIM=NINT(XNLIM)
C
      X = DABS(XX)
      IF (X.GT.1.D-30) THEN
        IF ( (X/DBLE(ABS(XMAX-XMIN))).LT.XRAP ) THEN
          CC(1) = '0'
          NC = 1
          GOTO 1000
        ENDIF
      ELSE
        CC(1) = '0'
        NC = 1
        GOTO 1000
      ENDIF
      X = X*(10.D0**(-IDECAL))
C
      ISHIFT = 0
      NN=0
      IF (X.LT.XNLIM.AND.X.GT.XNLIM2) THEN
        NN=0
 100    IF (DNINT(X).LT.NLIM) THEN
          NN = NN+1
          X  = X*10.D0
          GOTO 100
        ENDIF
        NX = DNINT(X)
        DO 20 NC = 1,NCMAX+2
          NPUIS = 10**(NCMAX+2-NC)
          NUM = NX/NPUIS
          C(NC) = CHIFR(NUM+1)
          NX = MOD(NX,NPUIS)
   20   CONTINUE
      ELSEIF (X.GE.XNLIM) THEN
  101   ISHIFT = ISHIFT+1
        X = X/XNLIM
        IF (X.LT.XNLIM) THEN
          GOTO 100
        ELSE
          GOTO 101
        ENDIF
      ELSE
  102   ISHIFT = ISHIFT-1
        X = X*XNLIM
        IF (X.GT.XNLIM2) THEN
          GOTO 100
        ELSE
          GOTO 102
        ENDIF
      ENDIF
      NN = -NN + (NCMAX+1)*(1+ISHIFT)
      IF (XX.LT.0.) THEN
        CC(1) = '-'
      ELSE
        CC(1) = ' '
      ENDIF
      IF (NN.GE.0) THEN
        DO 30 I=1,NN+1
          CC(I+1) = C(I)
   30   CONTINUE
        NVIRG = NN+3
        CC(NVIRG) = '.'
        DO 40 I=NN+2,NCMAX+2
          CC(I+2) = C(I)
   40   CONTINUE
      ELSE
        CC(2) = '0'
        CC(3) = '.'
        NVIRG = 3
        IF (NN.LT.-1) THEN
          DO 50 I=1,-1-NN
            CC(I+NVIRG) = '0'
   50     CONTINUE
        ENDIF
        J=1
        DO 60 I=-NN,NCMAX+2
          CC(I+NVIRG) = C(J)
          J=J+1
   60   CONTINUE
      ENDIF
C
      DO I=1,NC-1
        CC(I) = CC(I+1)
      ENDDO
      NC = NC-1
C
      IF (IDECAL.NE.0.AND.(NC.NE.1.OR.CC(1).NE.'0')) THEN
        IPOINT = 0
        DO I=1,NC
          IF (CC(I).EQ.'.') IPOINT = I
        ENDDO
        IF (IDECAL.GT.0) THEN
          IF (IPOINT.EQ.0) THEN
            DO I=1,IDECAL
              CC(NC+I) = '0'
            ENDDO
            NC = NC+IDECAL
          ELSEIF ((NC-IPOINT).GT.IDECAL) THEN
            DO I=IPOINT,IPOINT+IDECAL-1
              CC(I) = CC(I+1)
            ENDDO
            CC(IPOINT+IDECAL) = '.'
          ELSE
            DO I=IPOINT,NC-1
              CC(I) = CC(I+1)
            ENDDO
            IF (IDECAL.GT.NC-IPOINT) THEN
              DO I=NC,IDECAL+IPOINT-1
                CC(I) = '0'
              ENDDO
            ENDIF
            NC = IDECAL+IPOINT-1
          ENDIF
        ELSE
          IF (IPOINT.EQ.0) THEN
            IF (NC.GT.-IDECAL) THEN
              DO I=NC,NC+IDECAL+1,-1
                CC(I+1) = CC(I)
              ENDDO
              CC(NC+IDECAL+1) = '.'
              NC = NC+1
            ELSE
              DO I=NC,1,-1
                CC(I-IDECAL-NC+2) = CC(I)
              ENDDO
              CC(1) = '0'
              CC(2) = '.'
              IF ((-IDECAL-NC).GE.1) THEN
                DO I=3,2-IDECAL-NC
                  CC(I) = '0'
                ENDDO
              ENDIF
              NC = -IDECAL+2
            ENDIF
          ELSE
            IF ((IPOINT-1).GT.-IDECAL) THEN
              DO I=IPOINT-1,IPOINT+IDECAL,-1
                CC(I+1) = CC(I)
              ENDDO
              CC(IPOINT+IDECAL) = '.'
            ELSE
              DO I=NC,1,-1
                IF (I.GT.IPOINT) THEN
                  CC(I+2-IPOINT-IDECAL) = CC(I)
                ELSEIF(I.LT.IPOINT) THEN
                  CC(I+3-IPOINT-IDECAL) = CC(I)
                ENDIF
              ENDDO
              CC(1) = '0'
              CC(2) = '.'
              IF ((-IPOINT-IDECAL).GE.0) THEN
                DO I=3,3-IPOINT-IDECAL
                  CC(I) = '0'
                ENDDO
              ENDIF
            ENDIF
            NC = NC+2-IPOINT-IDECAL
          ENDIF
        ENDIF
        DO I=NC+1,32
          CC(I) = ' '
        ENDDO
      ENDIF
      INZER = 0
      DO I=1,NC
        IF (INZER.EQ.0.AND.CC(I).NE.'0') INZER = I
      ENDDO
      IF (INZER.EQ.0) THEN
        CC(1) = '0'
        NC = 1
      ELSE
        IF (CC(INZER).EQ.'.') THEN
          DO I=INZER-1,NC
            CC(I-INZER+2) = CC(I)
          ENDDO
          NC = NC-INZER+2
        ELSE
          DO I=INZER,NC
            CC(I-INZER+1) = CC(I)
          ENDDO
          NC = NC-INZER+1
        ENDIF
      ENDIF
C
      IPOINT = 0
      DO I=1,NC
        IF (CC(I).EQ.'.') IPOINT = I
      ENDDO
      IF (IPOINT.NE.0) THEN
        NC = NC+1
  200   NC = NC-1
        IF (CC(NC).EQ.'0' .OR. CC(NC).EQ.' ') GOTO 200
      ENDIF
      IF (CC(NC).EQ.'.') NC=NC-1
      IF (XX.LT.0.) THEN
        DO I=NC,1,-1
          CC(I+1) = CC(I)
        ENDDO
        CC(1) = '-'
        NC = NC+1
      ENDIF
      DO I=NC+1,32
        CC(I) = ' '
      ENDDO
      IF (NC.EQ.2.AND.CC(1).EQ.'-'.AND.CC(2).EQ.'0') THEN
        CC(1) = '0'
        CC(2) = ' '
        NC = 1
      ENDIF
C
 1000 END
C----------------------------------------------------------------------
      SUBROUTINE TRAD2(CC,NC,NC2)
      CHARACTER*1  CC(*),CBID1
      CHARACTER*2  CBID2
      CHARACTER*32 C
C
      IF (CC(1).EQ.'-') THEN
        ISIGN = -1
        NC = NC-1
        DO I=1,NC
          CC(I) = CC(I+1)
        ENDDO
      ELSE
        ISIGN = 1
      ENDIF
C
      IF (CC(2).NE.'.') THEN
        NN = NC+1
   10   NN = NN-1
        IF (CC(NN).EQ.'0'.OR.CC(NN).EQ.' ') GOTO 10
        C(1:1)=CC(1)
        C(2:2)='.'
        IF (NN.GT.1) THEN
          DO I=2,NN
            C(I+1:I+1) = CC(I)
          ENDDO
        ENDIF
        C(NN+2:NN+4) = ' 10'
        NNN = NN+5
        IF ((NC-1).LE.9) THEN
C          ENCODE(1,'(I1)',CBID1) NC-1
          WRITE(CBID1,'(I1)') NC-1
          C(NNN:NNN) = CBID1 
          NC2 = 1
        ELSE
C          ENCODE(2,'(I2)',CBID2) NC-1
          WRITE(CBID2,'(I2)') NC-1
          C(NNN:NNN+1) = CBID2
          NC2 = 2
        ENDIF
        NC = NN+4
      ELSE
        NN = 2
   20   NN = NN+1
        IF (CC(NN).EQ.'0') GOTO 20
        C(1:1) = CC(NN)
        C(2:2)='.'
        IF (NN.LT.NC) THEN
          DO I=NN+1,NC
            C(I-NN+2:I-NN+2) = CC(I)
          ENDDO
        ENDIF
        NC = NC-NN+5 
        C(NC-2:NC+1) = ' 10-'
        NNN = NC+2
        IF ((NN-2).LE.9) THEN
C          ENCODE(1,'(I1)',CBID1) NN-2
          WRITE(CBID1,'(I1)') NN-2
          C(NNN:NNN) = CBID1 
          NC2 = 2
        ELSE
C          ENCODE(2,'(I2)',CBID2) NN-2
          WRITE(CBID2,'(I2)') NN-2
          C(NNN:NNN+1) = CBID2
          NC2 = 3
        ENDIF
      ENDIF
C
      IF (ISIGN.EQ.1) THEN
        DO I=1,NC+NC2
          CC(I) = C(I:I)
        ENDDO
      ELSE
        CC(1) = '-'
        DO I=1,NC+NC2
          CC(I+1) = C(I:I)
        ENDDO
        NC = NC+1
      ENDIF
C
      END
C----------------------------------------------------------------------
      SUBROUTINE TRADHMS2(X,CC,NC,ITIMEX)
      REAL*8 X,X1
      CHARACTER*32 CC
C
      CC = '                                '
      IF (ITIMEX.GT.0) THEN
        WRITE(CC,'(I20)') INT(X)
        I1 = 0
        I2 = 0
        DO I=1,32
          IF (I1.EQ.0) THEN
            IF (CC(I:I).NE.' ') I1 = I
          ELSEIF(I2.EQ.0) THEN
            IF (CC(I:I).EQ.' ') I2 = I-1
          ENDIF
        ENDDO
        L = I2-I1+1
        CC(1:L) = CC(I1:I2)
        CC(L+1:L+1) = ':'
        X1 = (X-INT(X))*60.D0
        IF (ITIMEX.EQ.1) THEN
          WRITE(CC(L+2:L+6),'(F5.2)') X1
          NC = L+6
        ELSE
          WRITE(CC(L+2:L+3),'(I2.2)') INT(X1)
          CC(L+4:L+4) = ':'
          X1 = (X1-INT(X1))*60.D0
          WRITE(CC(L+5:L+9),'(F5.2)') X1
          NC = L+9
        ENDIF
        IF (CC(NC-4:NC-4).EQ.' ') CC(NC-4:NC-4) = '0'
        IF (CC(NC-3:NC-3).EQ.' ') CC(NC-3:NC-3) = '0'
        IF (CC(NC:NC).EQ.'0') THEN
          NC = NC-1
          IF (CC(NC:NC).EQ.'0') NC = NC-2
        ENDIF
      ELSEIF(ITIMEX.LT.0) THEN
Cfj        IAN = INT(X)
Cfj        X1 = (X-DBLE(IAN))*12.D0
Cfj        IMOIS = INT(X1)
        CALL INVJOURDELANNEE(X,IAN,IMOIS,IJOUR)
        IF (ITIMEX.EQ.-1) THEN
          IF (IAN.GE.1000) THEN
            WRITE(CC(1:7),'(I2.2,"/",I4)') IMOIS,IAN
            NC = 7
          ELSEIF(IAN.GE.100) THEN
            WRITE(CC(1:6),'(I2.2,"/",I3)') IMOIS,IAN
            NC = 6
          ELSE
            WRITE(CC(1:5),'(I2.2,"/",I2.2)') IMOIS,IAN
            NC = 5
          ENDIF
        ELSE
Cfj          X1 = (X1-DBLE(IMOIS))*30.D0
Cfj          IJOUR = NINT(X1)
          IF (IAN.GE.1000) THEN
            WRITE(CC(1:10),'(I2.2,"/",I2.2,"/",I4)') IJOUR,IMOIS,IAN
            NC = 10
          ELSEIF(IAN.GE.100) THEN
            WRITE(CC(1:9),'(I2.2,"/",I2.2,"/",I3)') IJOUR,IMOIS,IAN
            NC = 9
          ELSE
            WRITE(CC(1:8),'(I2.2,"/",I2.2,"/",I2.2)') IJOUR,IMOIS,IAN
            NC = 8
          ENDIF
        ENDIF
      ENDIF
      END
C----------------------------------------------------------------------
      SUBROUTINE TRADVERIF(X,CC,NC,NC2,ILOGPUI,IRC)
      REAL*8 X,XX
      CHARACTER*32 CC
C
      IF (ILOGPUI.EQ.1.AND.NC.EQ.1.AND.CC(1:1).EQ.'0') THEN
        IDECAL = INT(DLOG10(X))-1
        XX = 10.D0**IDECAL
        I = NINT(X/XX)
        WRITE(CC(1:5),'(I1,". 10")') I
        NC = 5
        IF (IDECAL.GT.10) THEN
          WRITE(CC(6:7),'(I2)') IDECAL
          NC2 = 2
        ELSEIF(IDECAL.GT.0) THEN
          WRITE(CC(6:6),'(I1)') IDECAL
          NC2 = 1
        ELSEIF(IDECAL.GT.-10) THEN
          WRITE(CC(6:7),'(I2)') IDECAL
          NC2 = 2
        ELSE
          WRITE(CC(6:8),'(I3)') IDECAL
          NC2 = 3
        ENDIF
        IRC = 1
      ELSE
        IRC = 0
      ENDIF
      END
