C This file: http://ftp.aset.psu.edu/pub/ger/fortran/hdk/extfloor.for
C
C===========SHORT TEST DRIVER FOR TFLOOR.
      IMPLICIT REAL*8 (A-H,O-Z)
C---------TOLERANT FUNCTION MACHINE DEPENDENT CONSTANTS.
      LOGICAL TEQ
      TEQ(U,V)=DABS(U-V).LE.CT*DMAX1(DABS(U),DABS(V))
C-----
      CT=1.D-4
      X=-999.D0*(1+.5*CT*(2.D0-CT)/(1.D0-CT))
      IF(TEQ(X,-999.D0).AND.TFLOOR(X,CT).EQ.-999.D0) GO TO 20
      TF=TFLOOR(X,CT)
      WRITE(6,11) CT,X,TF
11    FORMAT('0$$$ERROR: CT,X,TFLOOR=',3G24.16)
C-----
20    CT=1.D-13
      XN=10000.D0
      F=-100.D0*CT
      IF(TEQ(XN+F,XN).AND.TFLOOR(XN+F,CT).EQ.TFLOOR(XN,CT).AND.
     1   TFLOOR(XN,CT).EQ.XN) GO TO 30
      TF1=TFLOOR(XN+F,CT)
      TF2=TFLOOR(XN,CT)
      WRITE(6,21) CT,XN,TF1,TF2
21    FORMAT('0$$$ERROR: CT,XN,TF1,TF2=',4G24.16)
C-----
30    CT=1.D-13
      XN=1.D13
      X=XN+.4D0
      IF(TEQ(XN,XN+1.D0).AND.TFLOOR(X,CT).EQ.TCEIL(X,CT))GO TO 40
      TF=TFLOOR(X,CT)
      TC=TCEIL(X,CT)
      WRITE(6,31) CT,X,TF,TC
31    FORMAT('0$$$ERROR: CT,X,TFLOOR,TCEIL=',4G24.16)
C-----
40    CT=.001D0
      TF=TFLOOR(5000.1D0,CT)
      TFTF=TFLOOR(TF,CT)
      IF(TF.EQ.TFTF) GO TO 50
      WRITE(6,41) CT,TF,TFTF
41    FORMAT('0$$$ERROR: CT,TF,TFF=',3G24.16)
C-------
50    CT=.0001D0
      TF=TFLOOR(CT,CT)
      TC=TCEIL(CT,CT)
      IF(TF.NE.TC) WRITE(6,51)CT,TF,TC
51    FORMAT('0$$$ERROR: CT,TF.NE.TC=',3G24.16)
      WRITE(6,100)
100   FORMAT('0*******ALL TESTS RUN *******')
      STOP
      END