      SUBROUTINE LECTUR(IGR,NCOL,ICOL1,ICOL2)
C
      INCLUDE 'param.f'
C
      REAL*8 XBID,YBID
      CHARACTER*1 CC
      CHARACTER*256 CBID
C
C Lecture des fichiers
C
      REWIND(10)
      III = IGR-10
      NDEB(III) = NPTOT
      ISPEED2 = 0
C
C Lecture du titre eventuel (la ligne doit alors commencer par # ou %)
C
      NTITR = 0
      NTRONC = 0
 10   CONTINUE
      READ(10,'(A1)',END=11,ERR=11) CC
      IF (CC.EQ.'#'.OR.CC.EQ.'%') THEN
        NTITR = NTITR + 1
        GOTO 10
      ENDIF
C h:m:s
 12   READ(10,'(A)',END=11,ERR=11) CBID
      CALL ENLEVE_TOUS_BLANCS(CBID,L,256)
      CALL NUMOK(CBID,L)
      IF (L.LT.0) GOTO 12
C
      CALL INITHMS(CBID,L,ITIMEX,ITIMEY,ITIME,NCOL,IERR)
      ICOL1 = MIN(ICOL1,NCOL)
      ICOL2 = MIN(ICOL2,NCOL)
      IF (ISPEED.GT.0.AND.ICOL1.EQ.1.AND.ICOL2.EQ.2.AND.ITIME.EQ.0) THEN
        ISPEED2 = 1
        CBID(1:1) = ' '
      ENDIF
      IF (IERR.EQ.0) GOTO 1
C
 11   IF (NTITR.EQ.0) THEN
        NPOINT(III) = 0
        IF (FRANCAIS) THEN
          PRINT*,CHAR(9)//' *** Mauvais fichier ***'
        ELSE
          PRINT*,CHAR(9)//' *** Bad file ***'
        ENDIF
        RETURN
      ENDIF
C
    1 REWIND(10)
C
      IF (NTITR.GT.0) THEN
        DO I=1,NTITR
          READ(10,'(A1)') CC
        ENDDO
      ENDIF
C 
      NN  = 0
      NTROU(III) = 0
      NNN = 0
C
 100  NN = NN+1
      IF (ISPEED2.EQ.0) THEN
        READ(10,FMT='(A)',ERR=99,END=99) CBID
        CALL ENLEVE_TOUS_BLANCS(CBID,L,256)
        CALL NUMOK(CBID,L)
      ELSE
 101    NNN = NNN+1
        IF (ISPEED.EQ.1.OR.MOD(NNN,ISPEED).EQ.1) THEN
          READ(10,*,ERR=99,END=99) XBID,YBID
        ELSE
          READ(10,'(A1)',ERR=99,END=99) CC
          GOTO 101
        ENDIF
        L = 1
      ENDIF
      IF (L.GT.0.AND.CBID(1:1).NE.'#'.AND.CBID(1:1).NE.'%') THEN
        IF (ISPEED2.EQ.0)
     &    CALL TRADHMS(CBID,L,XBID,YBID,ITIMEX,ITIMEY,ITIME,ICOL1,ICOL2
     &                ,NN)
        IF (XBID.LT.0.) ILOGXOK = 1
        IF (YBID.LT.0.) ILOGYOK = 1
        IF (ILOGX.LT.0) THEN
          IF (XBID.LT.0..OR.ITIMEX.NE.0) THEN
            ILOGX = -ILOGX
            IGR = -IGR
            IF (FRANCAIS) THEN
              PRINT*,
     & '*** Echelle logarithmique impossible sur l''axe ',
     &                 'X pour la courbe',III
              PRINT*,'*** On recommence...'
            ELSE
              PRINT*,
     & '*** Logarithmic scale not allowed on X axis for the plot',III
              PRINT*,'I do it again...'
            ENDIF
            CLOSE(10)
            RETURN
          ELSE
            IF (XBID.GT.0.) THEN
              XBID = LOG10(XBID)
            ELSE
              XBID = -987654321.
            ENDIF
          ENDIF
        ENDIF
        IF (ILOGY.LT.0) THEN
          IF (YBID.LT.0..OR.ITIMEY.NE.0) THEN
            ILOGY = -ILOGY
            IGR = -IGR
            IF (FRANCAIS) THEN
              PRINT*,
     & '*** Echelle logarithmique impossible sur l''axe ',
     &                 'Y pour la courbe',III
              PRINT*,'*** On recommence...'
            ELSE
              PRINT*,
     & '*** Logarithmic scale not allowed on Y axis for the plot',III
              PRINT*,'I do it again...'
            ENDIF
            CLOSE(10)
            RETURN
          ELSE
            IF (YBID.GT.0.) THEN
              YBID = LOG10(YBID)
            ELSE
              YBID = -987654321.
            ENDIF
          ENDIF
        ENDIF
        IF (XBID.NE.-987654321.) XMIN = MIN(XBID,XMIN)
        XMAX = MAX(XBID,XMAX)
        IF (YBID.NE.-987654321.) YMIN = MIN(YBID,YMIN)
        YMAX = MAX(YBID,YMAX)
C
C Ce filtre est la jusqu'a ce qu'on ait regle le probleme des echelles
C pour les tres grandes valeurs (10-93)
C
        NPTOT = NPTOT+1
        IF (NPTOT.GT.MEM) THEN
          IF (FRANCAIS) THEN
            PRINT*,'*** Trop de points (maximum=',MEM,')'
          ELSE
            PRINT*,'*** Too many points (maximum=',MEM,')'
          ENDIF
          STOP
        ENDIF
        IF (ISAFE.EQ.0) THEN
          XPOINT(NPTOT) = XBID
          YPOINT(NPTOT) = YBID
        ELSE
          CALL FILTRE(XBID,XPOINT(NPTOT),NTRONC)
          CALL FILTRE(YBID,YPOINT(NPTOT),NTRONC)
        ENDIF
        XXMIN(III) = MIN(XXMIN(III),XPOINT(NPTOT))
        XXMAX(III) = MAX(XXMAX(III),XPOINT(NPTOT))
        YYMIN(III) = MIN(YYMIN(III),YPOINT(NPTOT))
        YYMAX(III) = MAX(YYMAX(III),YPOINT(NPTOT))
      ELSE
        NN = NN-1
        IF (L.EQ.0) THEN
          IF (NTROU(III).GT.0) THEN
            IF (ITROU(NDEB(III)+NTROU(III)).NE.NN) THEN
              NTROU(III) = NTROU(III)+1
              ITROU(NDEB(III)+NTROU(III)) = NN
            ENDIF
          ELSE  
            NTROU(III) = 1
            ITROU(NDEB(III)+1) = NN
          ENDIF
        ENDIF
      ENDIF
      GOTO 100
C
 99   NN = NN-1
      NPOINT(III) = NN
      XMIMI = XMIN - 5.*(XMAX-XMIN)
      YMIMI = YMIN - 5.*(YMAX-YMIN)
      DO I=1,NPOINT(III)
        J = NDEB(III)+I
        IF (XPOINT(J).EQ.-987654321.) XPOINT(J) = XMIMI
        IF (YPOINT(J).EQ.-987654321.) YPOINT(J) = YMIMI
      ENDDO
      CLOSE(10)
      IF (NTRONC.NE.0) THEN
        IF (ISTDOUT.EQ.0) THEN
          IF (FRANCAIS) THEN
            PRINT*,'(fich.',III,'),',NN,' pts, ',NTRONC
     &           ,' valeurs arrondies (',REAL(100*NTRONC)/REAL(NN),' %)'
          ELSE
            PRINT*,'(file',III,'),',NN,' pts, ',NTRONC
     &           ,' values rounded (',REAL(100*NTRONC)/REAL(NN),' %)'
          ENDIF
        ENDIF
      ELSE
        IF (ISTDOUT.EQ.0) THEN
          IF (FRANCAIS) THEN
            PRINT*,'(fich.',III,'),',NN,' pts'
          ELSE
            PRINT*,'(file',III,'),',NN,' pts'
          ENDIF
        ENDIF
        XMAXMAX = MAX(ABS(XMAX),ABS(XMIN),ABS(YMAX),ABS(YMIN))
        IF (XMAXMAX.GE.1.E18) THEN
          IF (ISTDOUT.EQ.0) THEN
            PRINT*,' '
            IF (FRANCAIS) THEN
              PRINT*,'****** ATTENTION fichier',III,' *******'
              PRINT*,
     &             '****** De très grandes valeurs ont été lues -->'
     &             ,XMAXMAX
              PRINT*,'****** Si ça plante, essayez "'//
     &          PROGEFF(1:LPROGEFF)//' -check"'
            ELSE
              PRINT*,'****** WARNING file',III,' *******'
              PRINT*,'****** Huge values have been red -->',XMAXMAX
              PRINT*,'****** If it hangs, try "'//
     &          PROGEFF(1:LPROGEFF)//' -check"'
            ENDIF
            PRINT*,' '
          ENDIF
        ENDIF
      ENDIF
      ITROU(NDEB(III)+NTROU(III)+1) = NN
      IF (NTROU(III).NE.0) THEN
        IF (ISTDOUT.EQ.0) THEN
          IF (FRANCAIS) THEN
            PRINT*,'Nombre de trous :',NTROU(III)
          ELSE
            PRINT*,'Number of holes:',NTROU(III)
          ENDIF
        ENDIF
      ENDIF
C
      END
C=======================================================================
      SUBROUTINE FILTRE(X,XX,NTRONC)
      REAL*8 X,XMIN,XMAX
      DATA XMAX / 5.D+17 /
      DATA XMIN / 1.D-18 /
C
      IF (DABS(X).LT.XMIN) THEN
        IF (X.NE.0.) NTRONC = NTRONC+1
        XX = 0.
      ELSEIF(X.GT.XMAX) THEN
        NTRONC = NTRONC+1 
        XX = REAL(XMAX)
      ELSEIF(X.LT.-XMAX) THEN
        NTRONC = NTRONC+1 
        XX = -REAL(XMAX)
      ELSE
        XX = REAL(X)
      ENDIF
      END
C=======================================================================
      SUBROUTINE NUMOK(CHAINE,LONG)
      CHARACTER*1 CHAINE(*)
C
      IF (LONG.GT.0) THEN
        DO I=1,LONG
          IF (CHAINE(I).NE.'0'.AND.CHAINE(I).NE.'1'.AND.CHAINE(I).NE.'2'
     &   .AND.CHAINE(I).NE.'3'.AND.CHAINE(I).NE.'4'.AND.CHAINE(I).NE.'5'
     &   .AND.CHAINE(I).NE.'6'.AND.CHAINE(I).NE.'7'.AND.CHAINE(I).NE.'8'
     &   .AND.CHAINE(I).NE.'9'.AND.CHAINE(I).NE.'.'.AND.CHAINE(I).NE.'+'
     &   .AND.CHAINE(I).NE.'-'.AND.CHAINE(I).NE.'E'.AND.CHAINE(I).NE.'e'
     &   .AND.CHAINE(I).NE.'D'.AND.CHAINE(I).NE.'d'.AND.CHAINE(I).NE.' '
     &   .AND.CHAINE(I).NE.':'.AND.CHAINE(I).NE.'/'
     &   .AND.CHAINE(I).NE.CHAR(9).AND.CHAINE(I).NE.CHAR(13)) THEN
            LONG = -LONG
            RETURN
          ENDIF
        ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE LICHAINEGRA(XCUR,YCUR,CHAINE,NCHAINE,IOP)
C
      INCLUDE 'param.f'
      CHARACTER*132 CHAINE
      DIMENSION XBID(2),YBID(2)
C
      CALL ASFCOL(7)
      IF (IOP.EQ.1) THEN
        CALL ECABS(1)
      ELSEIF(IOP.EQ.2) THEN
        CALL ECORD(1)
      ELSE
        CALL ECGEN(1)
      ENDIF
      GOTO 3737
 3636 IF (IOP.EQ.1) THEN
        CALL ECABS(2)
      ELSEIF(IOP.EQ.2) THEN
        CALL ECORD(2)
      ELSE
        CALL ECGEN(2)
      ENDIF
      IF (IOP.EQ.2) THEN
        CALL GSCA(0.,1.)
        TAILL = TAILLE_CHAINE(CHAINE,IPTC)
        CALL GSCA(1.,0.)
        YPTC = YINPUT(1) + TAILL + .5*YBOX
        CALL GSCOL(1)
        CALL GSMOVE(XINPUT(1)-.1*XBOX,YPTC)
        CALL GSLINE(XINPUT(3)+.1*XBOX,YPTC)
        CALL GSCOL(7)
      ELSE
        TAILL = TAILLE_CHAINE(CHAINE,IPTC)
        XPTC = XINPUT(1) + TAILL + .5*XBOX
        CALL GSCOL(1)
        CALL GSMOVE(XPTC,YINPUT(1)+.1*YBOX)
        CALL GSLINE(XPTC,YINPUT(3)-.1*YBOX)
        CALL GSCOL(7)
      ENDIF
      CALL LIT1XCAR(IEV,XCUR,YCUR)
      IF (IEV.EQ.13.OR.IEV.EQ.27.OR.IEV.EQ.1103) THEN
        CALL GSMIX(1)
        CALL GSPAT(8)
        XBID(1) = XFMIN
        XBID(2) = XHELP
        YBID(1) = YFMIN
        YBID(2) = YFMAX
        CALL MY_GSAREA2(XBID,YBID)
        CALL ASFCOL(8)
        CALL GSLSS(IFONT1)
        IF (FRANCAIS) THEN
          CALL GSCHAR3(.5*(XMAX+XMIN),YZONE1,65,
     &"Entrez un titre en terminant par <ret> (accents possibles : "//
     &          CHAR(92)//"'e=é)",8,-1)
        ELSE
          CALL GSCHAR3(.5*(XMAX+XMIN),YZONE1,54,
     &"Type a title ending by <return> (Latin accents: "//
     &          CHAR(92)//"'e=é)",8,-1)
        ENDIF
        CALL ASFCOL(7)
        CALL GSLSS(IFONT2)
        CALL GSMIX(0)
        CALL ENLEVE_TOUS_BLANCS(CHAINE,NCHAINE,NCHAINE)
        CALL METSACCENTS(1)
        IF (IOP.EQ.1) THEN
          CALL ECABS(3)
        ELSEIF(IOP.EQ.2) THEN
          CALL ECORD(3)
        ENDIF
        CALL METSACCENTS(0)
        CALL CHANGE_CURS(1)
        RETURN
      ELSEIF(IEV.GE.32.AND.IEV.LE.126) THEN
        IF (NCHAINE.LT.132) THEN
          IF (IPTC.LT.NCHAINE) THEN
            DO K=NCHAINE,IPTC+1,-1
              CHAINE(K+1:K+1) = CHAINE(K:K)
            ENDDO
          ENDIF
          IPTC = IPTC+1
          CHAINE(IPTC:IPTC) = CHAR(IEV)
          NCHAINE = NCHAINE+1
        ELSE
          CALL FSALRM
        ENDIF
        GOTO 3636
      ELSEIF(IEV.EQ.8) THEN
        IF (IPTC.GT.0) THEN
          IF (IPTC.LT.NCHAINE) THEN
            DO K=IPTC+1,NCHAINE
              CHAINE(K-1:K-1) = CHAINE(K:K)
            ENDDO
          ENDIF
          CHAINE(NCHAINE:NCHAINE) = ' '
          NCHAINE = NCHAINE-1
          IPTC = IPTC-1
        ELSE
          CALL FSALRM
        ENDIF
        GOTO 3636
      ELSEIF(IEV.EQ.127) THEN
        IF (IPTC.LT.NCHAINE) THEN
          DO K=IPTC+1,NCHAINE-1
            CHAINE(K:K) = CHAINE(K+1:K+1)
          ENDDO
          CHAINE(NCHAINE:NCHAINE) = ' '
          NCHAINE = NCHAINE-1
        ELSE
          CALL FSALRM
        ENDIF
        GOTO 3636
C
C Fleche gauche
C
      ELSEIF(IEV.EQ.1100) THEN
        IF (IPTC.GT.0) THEN
          IPTC = IPTC-1
        ELSE
          CALL FSALRM
        ENDIF
        GOTO 3636
C
C Fleche droite
C
      ELSEIF(IEV.EQ.1102) THEN
        IF (IPTC.LT.NCHAINE) THEN
          IPTC = IPTC+1
        ELSE
          CALL FSALRM
        ENDIF
        GOTO 3636
      ELSEIF(IEV.GE.251.AND.IEV.LE.253) THEN
 3737   IPTC = 0
        IF (NCHAINE.GT.0) THEN
          IF (IOP.EQ.2) THEN
            ERR = ABS(YINPUT(1) + .5*YBOX - YCUR)
            CALL GSCA(0.,1.)
            TAILL = TAILLE_CHAINE(CHAINE,NCHAINE)
            DO K=1,NCHAINE
              TAILL = TAILLE_CHAINE(CHAINE,K)
              E = ABS(YINPUT(1) + TAILL + .5*YBOX - YCUR)
              IF (E.LT.ERR) THEN
                IPTC = K
                ERR = E
              ENDIF
            ENDDO
            CALL GSCA(1.,0.)
          ELSE
            ERR = ABS(XINPUT(1) + .5*XBOX - XCUR)
            DO K=1,NCHAINE
              TAILL = TAILLE_CHAINE(CHAINE,K)
              E = ABS(XINPUT(1) + TAILL + .5*XBOX - XCUR)
              IF (E.LT.ERR) THEN
                IPTC = K
                ERR = E
              ENDIF
            ENDDO
          ENDIF
        ENDIF
        GOTO 3636
      ELSE
        GOTO 3636
      ENDIF
      END
C=======================================================================
      SUBROUTINE INITHMS(CBID,L,ITIMEX,ITIMEY,ITIME,NCOL,IERR)
      CHARACTER*256 CBID
      PARAMETER (NCOLMAX=256)
      DIMENSION X(NCOLMAX)
C
      IERR = 0
      LL = ABS(L)
      I1 = 0
      I2 = 0
      I3 = 0
      I4 = LL
      NCOL = 0
      DO I=1,LL
        IF (I1.EQ.0) THEN
          IF (CBID(I:I).NE.' '.AND.CBID(I:I).NE.CHAR(9)) I1 = I
        ELSEIF(I2.EQ.0) THEN
          IF (CBID(I:I).EQ.' '.OR.CBID(I:I).EQ.CHAR(9)) I2 = I
        ELSEIF(I3.EQ.0) THEN
          IF (CBID(I:I).NE.' '.AND.CBID(I:I).NE.CHAR(9)) I3 = I
Cfj        ELSEIF(I4.EQ.0) THEN
Cfj          IF (CBID(I:I).EQ.' '.OR.CBID(I:I).EQ.CHAR(9)) I4 = I
        ENDIF
      ENDDO
C
      IF (I1.NE.0.AND.I2.NE.0.AND.ITIMEX.EQ.0) THEN
        DO I=I1,I2
          IF (CBID(I:I).EQ.':') ITIMEX = ITIMEX+1
        ENDDO
        IF (ITIMEX.EQ.0) THEN
          DO I=I1,I2
            IF (CBID(I:I).EQ.'/') ITIMEX = ITIMEX-1
          ENDDO
        ENDIF
        IF (ITIMEX.NE.0) ILOGXOK = 1
        IF (IABS(ITIMEX).GT.2) THEN
          IERR = 1
          RETURN
        ENDIF
      ENDIF
      ITIMEY = 0
      IF (I3.NE.0.AND.I4.NE.0.AND.ITIMEY.EQ.0) THEN
        DO I=I3,I4
          IF (CBID(I:I).EQ.':') ITIMEY = ITIMEY+1
        ENDDO
        IF (ITIMEY.EQ.0) THEN
          DO I=I3,I4
            IF (CBID(I:I).EQ.'/') ITIMEY = ITIMEY-1
          ENDDO
        ENDIF
        IF (ITIMEY.NE.0) ILOGYOK = 1
        IF (IABS(ITIMEY).GT.2) THEN
          IERR = 1
          RETURN
        ENDIF
      ENDIF
      IF (ITIMEX.NE.0.OR.ITIMEY.NE.0) THEN
        ITIME = 1
        NCOL  = 2
      ELSE
        ITIME = 0
        DO N=1,NCOLMAX
          READ(CBID(1:LL),*,END=10,ERR=10) (X(K),K=1,N)
          NCOL = NCOL+1
        ENDDO
 10     CONTINUE
      ENDIF
      END
C=======================================================================
      SUBROUTINE TRADHMS(CBID,L,X,Y,ITIMEX,ITIMEY,ITIME,ICOL1,ICOL2,NN)
      CHARACTER*256 CBID
      CHARACTER*1   SEPAR
      PARAMETER (NCOLMAX=256)
      REAL*8 XBID(NCOLMAX),X,Y,X1,X2,X3
C
      IF (ITIME.EQ.0) THEN
        READ(CBID,*) (XBID(K),K=1,MAX(ICOL1,ICOL2))
        IF (ICOL1.EQ.ICOL2) THEN
          X = REAL(NN)
        ELSE
          X = XBID(ICOL1)
        ENDIF
        Y = XBID(ICOL2)
      ELSE
        I1 = 0
        I2 = 0
        I3 = 0
        I4 = L
        DO I=1,L
          IF (I1.EQ.0) THEN
            IF (CBID(I:I).NE.' '.AND.CBID(I:I).NE.CHAR(9)) I1 = I
          ELSEIF(I2.EQ.0) THEN
            IF (CBID(I:I).EQ.' '.OR.CBID(I:I).EQ.CHAR(9)) I2 = I-1
          ELSEIF(I3.EQ.0) THEN
            IF (CBID(I:I).NE.' '.AND.CBID(I:I).NE.CHAR(9)) I3 = I
Cfj          ELSEIF(I4.EQ.0) THEN
Cfj            IF (CBID(I:I).EQ.' '.OR.CBID(I:I).EQ.CHAR(9)) I4 = I-1
          ENDIF
        ENDDO
        IF (ITIMEX.EQ.0) THEN
          READ(CBID(I1:I2),*) X
        ELSE
          IF (ITIMEX.GT.0) THEN
            SEPAR = ':'
          ELSE
            SEPAR = '/'
          ENDIF
          ICOLO = 0
          ISEP1 = 0
          DO I=I1,I2
            IF (CBID(I:I).EQ.SEPAR) THEN
              ICOLO = ICOLO+1
              IF (ISEP1.EQ.0) ISEP1 = I
            ENDIF
          ENDDO
          IF (ICOLO.EQ.1) THEN
            READ(CBID(I1:ISEP1-1),*) X1
            READ(CBID(ISEP1+1:I2),*) X2
            IF (ITIMEX.GT.0) THEN
              X = X1 + X2/60.D0
            ELSE
              X = X2 + X1/12.D0
            ENDIF
          ELSEIF(ICOLO.EQ.2) THEN
            READ(CBID(I1:ISEP1-1),*) X1
            READ(CBID(ISEP1+1:ISEP1+2),*) X2
            READ(CBID(ISEP1+4:I2),*) X3
            IF (ITIMEX.GT.0) THEN
              X = X1 + X2/60.D0 + X3/3600.D0
            ELSE
cc              X = X3 + X2/12.D0 + X1/365.D0
              CALL JOURDELANNEE(X,X1,X2,X3)
            ENDIF
          ELSE
            READ(CBID(I1:I2),*) X
          ENDIF
        ENDIF
        IF (ITIMEY.EQ.0) THEN
          READ(CBID(I3:I4),*) Y
        ELSE
          IF (ITIMEY.GT.0) THEN
            SEPAR = ':'
          ELSE
            SEPAR = '/'
          ENDIF
          ICOLO = 0
          ISEP1 = 0
          DO I=I3,I4
            IF (CBID(I:I).EQ.SEPAR) THEN
              ICOLO = ICOLO+1
              IF (ISEP1.EQ.0) ISEP1 = I
            ENDIF
          ENDDO
          IF (ICOLO.EQ.1) THEN
            READ(CBID(I3:ISEP1-1),*) X1
            READ(CBID(ISEP1+1:I4),*) X2
            IF (ITIMEY.GT.0) THEN
              Y = X1 + X2/60.D0
            ELSE
              Y = X2 + X1/12.D0
            ENDIF
          ELSEIF(ICOLO.EQ.2) THEN
            READ(CBID(I3:ISEP1-1),*) X1
            READ(CBID(ISEP1+1:ISEP1+2),*) X2
            READ(CBID(ISEP1+4:I4),*) X3
            IF (ITIMEY.GT.0) THEN
              Y = X1 + X2/60.D0 + X3/3600.D0
            ELSE
cc              Y = X3 + X2/12.D0 + X1/365.D0
              CALL JOURDELANNEE(Y,X1,X2,X3)
            ENDIF
          ELSE
            READ(CBID(I3:I4),*) Y
          ENDIF
        ENDIF
      ENDIF
      END
C=======================================================================
      SUBROUTINE JOURDELANNEE(X,X1,X2,X3)
      REAL*8 X,X1,X2,X3
      INTEGER LM(12)
      DATA LM / 31,28,31,30,31,30,31,31,30,31,30,31 /
C
      IAN = NINT(X3)
      IMOIS = NINT(X2)
      IJOUR = NINT(X1)
      IF (4*(IAN/4).EQ.IAN) THEN
        IBI = 1
      ELSE
        IBI = 0
      ENDIF
      IJ = IJOUR
      IF (IMOIS.GT.1) THEN
        DO I=1,IMOIS-1
          IJ = IJ+LM(I)
          IF (I.EQ.2) IJ = IJ+IBI
        ENDDO
      ENDIF
      X = DBLE(IAN) + DBLE(IJ)/DBLE(365+IBI)
cc      print*,ian,imois,ijour,x,X3 + X2/12.D0 + X1/365.D0
      END
C=======================================================================
      SUBROUTINE INVJOURDELANNEE(X,IAN,IMOIS,IJOUR)
      REAL*8 X
      INTEGER LM(12)
      DATA LM / 31,28,31,30,31,30,31,31,30,31,30,31 /
C
      IAN = INT(X)
      IF (4*(IAN/4).EQ.IAN) THEN
        IBI = 1
      ELSE
        IBI = 0
      ENDIF
      IJ = NINT( (X-DBLE(IAN))*DBLE(365+IBI) )
      IMOIS = 0
      DO WHILE(IJ.GT.0.AND.IMOIS.LT.12)
        IMOIS = IMOIS+1
        IJ = IJ-LM(IMOIS)
        IF (IMOIS.EQ.2) IJ = IJ-IBI
      ENDDO
      IJOUR = IJ+LM(IMOIS)
      END
