home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / fortran77_210 / library / f77 / arttest < prev    next >
Encoding:
Text File  |  1993-01-27  |  3.2 KB  |  115 lines
  1. *                      PROGRAM ARTTes Version 1.0 27-Jan-1993
  2. *
  3. *  PURPOSE
  4. *    TO TEST COMPONENTS OF ARTLib
  5. *
  6. *  AUTHOR
  7. *    A.R. Thawley
  8. *    8 The Copse
  9. *    Bannister Green
  10. *    Felsted
  11. *    Essex
  12. *    England
  13. *    CM6 3NP
  14. *    Telephone +44 (0)371 821009, Fax +44 (0)371 821323
  15. *
  16. *      ----------------------------------------------------------------------
  17. *
  18.        PROGRAM ARTTes
  19.        DIMENSION X(40), Y(40), XTES(10), YTES(10)
  20.        REAL SECRES
  21.        CHARACTER * 100 NAME
  22.        CHARACTER * 48 QUERY
  23.        CHARACTER * 32 DATSTR
  24.        CHARACTER * 16 FILNAM
  25.        CHARACTER * 13 CURDIR
  26.        CHARACTER * 12 NAMTES
  27.        LOGICAL NAMEOK, OSCLI, XOK, YOK
  28.        DATA XTES/0,.5,1,2,5,8,9.1,10.00,10000.0001,.000000623/
  29.        DATA YTES/0.54,0.985,1.315,2.26,4.51,7.31,-2.89,
  30.      +           -.000033,-0.000034,-2.0000351/
  31.        NAMTES = 'VAREAD test'
  32.        QUERY = 'Enter ''Test'' as the file to be opened here: '
  33.        IERLUN = 1
  34.        INLUN = 4
  35.        IF (.NOT. OSCLI('Set F77$DevDir <Obey$Dir>') ) STOP
  36.        CURDIR = '<F77$DevDir>.'
  37. *
  38. *  TEST FLQUES
  39. *
  40.        CALL FLQUES(INLUN, QUERY, CURDIR, FILNAM)
  41. *
  42. *  TEST LENSTR
  43. *
  44.        ISTR = LENSTR(FILNAM)
  45.        IF (ISTR .EQ. 4) THEN
  46.          PRINT *, 'Function LENSTR satisfactory'
  47.        ELSE
  48.          PRINT *, 'ERROR in Function LENSTR'
  49.        ENDIF
  50. *
  51. *  TEST IDATE
  52. *
  53.        CALL IDATE(DATSTR)
  54.        WRITE (*, 1000) DATSTR
  55. 1000   FORMAT ('Date/time returned from Subroutine IDATE is '/A)
  56.  
  57. *
  58. *  TEST XYREAD
  59. *
  60.        NOVAR = 10
  61.        CALL XYREAD(X, Y, NOVAR, INLUN, IERLUN, IERROR)
  62.        IF (IERROR .EQ. 0) THEN
  63.          PRINT *, 'Subroutine XYREAD returned without error'
  64.          XOK = .TRUE.
  65.          YOK = .TRUE.
  66.          IF (NOVAR .NE. 10) PRINT *,
  67.      +   'Subroutine XYREAD did NOT find the expected 10 data pairs'
  68.          DO 100 I = 1, NOVAR
  69.            IF (X(I) .NE. XTES(I)) XOK = .FALSE.
  70.            IF (Y(I) .NE. YTES(I)) YOK = .FALSE.
  71. 100      CONTINUE
  72.          IF (XOK .AND. YOK) THEN
  73.            PRINT *, 'Subroutine XYREAD read the test data correctly'
  74.          ELSE
  75.            PRINT *,
  76.      1       'Subroutine XYREAD did NOT read the test data correctly'
  77.          ENDIF
  78.        ELSE
  79.          WRITE (*, 1100) IERROR
  80. 1100     FORMAT ('Subroutine XYREAD returned error code',I4)
  81.        ENDIF
  82. *
  83. *  TEST VAREAD
  84. *
  85.        NAMPOS = 3
  86.        CALL VAREAD(X, NAME, NOVAR, NAMPOS, INLUN, IERLUN, IERROR)
  87.        IF (IERROR .EQ. 0) THEN
  88.          PRINT *, 'Subroutine VAREAD returned without error'
  89.          XOK = .TRUE.
  90.          NAMEOK = .TRUE.
  91.          IF (NOVAR .NE. 10) PRINT *,
  92.      +     'Subroutine VAREAD did NOT find the expected 10 data values'
  93.          DO 200 I = 1, NOVAR
  94.            IF (X(I) .NE. XTES(I)) XOK = .FALSE.
  95. 200      CONTINUE
  96.          IF (NAME(1:LENSTR(NAME)) .NE. NAMTES) NAMEOK = .FALSE.
  97.          IF (XOK .AND. NAMEOK) THEN
  98.            PRINT *, 'Subroutine VAREAD read the test data correctly'
  99.          ELSE
  100.            PRINT *,
  101.      1       'Subroutine VAREAD did NOT read the test data correctly'
  102.          ENDIF
  103.        ELSE
  104.          WRITE (*, 1210) IERROR
  105. 1210     FORMAT ('Subroutine VAREAD returned error code',I4)
  106.        ENDIF
  107. *
  108. *  TEST SECNDS
  109. *
  110.        SECRES = SECNDS()
  111.        WRITE (*, 1300) SECRES
  112. 1300   FORMAT ('Timer result returned from Function SECNDS is ',F12.2)
  113. *
  114.        END
  115.