home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / APPS / DATABASE / AMSF20.ZIP / AMST5.FOR < prev    next >
Encoding:
Text File  |  1992-01-06  |  1.8 KB  |  67 lines
  1.       PROGRAM T3
  2.       IMPLICIT INTEGER*4 (I-N)
  3. C
  4. C ... TEST AMS GET/SAVE SUBROUTINES
  5. C
  6.       COMMON  MAVAIL,IA(50000)
  7.       LOGICAL ERROR
  8.       MAVAIL  = 50000
  9.       WRITE(6,1) 'OPEN DATA BASE ...'
  10. 1     FORMAT(1X,A)
  11.       NV = 10
  12.       NSIZE = 100
  13.       CALL DBOPEN(1,'T3.DAT','NEW')
  14.       WRITE(6,1) 'DEFINE MATRIX ...'
  15.       CALL DEFINE(1,'AXYZ',NV,0,NSIZE,1,0,L1)
  16.       WRITE(6,1) 'WRITE DATA TO DISK ...'
  17.       DO 20 J=NV,1,-1
  18.          DO 10 I=0,NSIZE-1
  19. 10       IA(L1+I) = (J-1)*NSIZE + I + 1
  20.       CALL SAVE(1,'AXYZ',J)
  21. 20    CONTINUE
  22.       K = 0
  23.       ERROR = .FALSE.
  24.       WRITE(6,1) 'READ DATA BACK ...'
  25.       DO 50 J=1,NV
  26.       CALL GET(1,'AXYZ',J,L1)
  27.          DO 30 I=0,NSIZE-1
  28.          K = K + 1
  29. 30       IF (K.NE.IA(L1+I)) ERROR = .TRUE.
  30. 50    CONTINUE
  31.       IF (ERROR) THEN
  32.           WRITE(6,100)
  33.       ELSE
  34.           WRITE(6,110)
  35.       END IF
  36. C ... TEST DB ASCII CONVERSION
  37.       WRITE(6,1) 'TEST DB FILE TO TEXT FILE  CONVERSION ...'
  38.       CALL DB2TXT(1,'T3.ASC')
  39. C ... NOW CREATE A NEW DATABASE 2
  40.       CALL DBOPEN(2,'T3.DT2','NEW')
  41. C ... TEST ASCII DB CONVERSION
  42.       WRITE(6,1) 'TEST TXT FILE TO DB FILE  CONVERSION ...'
  43.       CALL TXT2DB('T3.ASC',2)
  44. C ... TEST FOR CORRECTNESS
  45.       ERROR = .FALSE.
  46.       DO 80 J=1,NV
  47.          CALL GET(1,'AXYZ',J,L1)
  48.          CALL GET(2,'AXYZ',J,L2)
  49.          DO 70 I=0,NSIZE-1
  50.          IF (IA(L1+I).NE.IA(L2+I)) ERROR = .TRUE.
  51. 70       CONTINUE
  52. 80    CONTINUE
  53.       IF (ERROR) THEN
  54.           WRITE(6,120)
  55.       ELSE
  56.           WRITE(6,130)
  57.       END IF
  58.       WRITE(6,1) 'CLOSE DATA BASE, AND DELETE IT ...'
  59.       CALL DBCLOS(2,'DELETE')
  60.       CALL DBCLOS(1,'DELETE')
  61. 100   FORMAT(1X,'AMS GET/SAVE ERROR.')
  62. 110   FORMAT(1X,'AMS GET/SAVE TEST OK.')
  63. 120   FORMAT(1X,'AMS DB2TXT/TXT2DB ERROR.')
  64. 130   FORMAT(1X,'AMS DB2TXT/TXT2DB TEST OK.')
  65.       STOP 'DONE.'
  66.       END
  67.