home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
DBASE
/
AMSF20.ZIP
/
AMST1.FOR
< prev
next >
Wrap
Text File
|
1992-01-06
|
1KB
|
49 lines
PROGRAM AMST1
IMPLICIT INTEGER*4(I-N)
C
C ... AMS TEST PROGRAM 1
C
COMMON MAVAIL,IA(30000)
MAVAIL = 30000
C ... OPEN DATA BASE
CALL DBOPEN(1,'DB1.DAT','NEW')
C ... DEFINE MATRICES
CALL DEFINE(1,'MATA',0,1,3,3,0,LOC)
CALL DEFINE(1,'BCDE',6,0,5,5,1,LOC)
CALL DEFINE(1,'SSSS',0,2,7,6,0,LOC)
CALL DEFINE(1,'QQQ',5,1,6,4,0,LOC)
CALL DEFINE(1,'DFGH',0,1,10,10,2,LOC)
CALL DEFINE(1,'A',0,1,10,10,2,LOC)
C ... LOOK DIRECTORY
CALL DIR(0)
C ... SORT DIRECTORY
CALL DSORT
CALL DIR(0)
C ... DEFINE NEW MATRICES
CALL DEFINE(1,'MATB',1,1,5,5,0,LOC)
CALL DEFINE(1,'MATC',1,1,5,5,0,LOC)
CALL DEFINE(1,'MATD',1,1,5,5,0,LOC)
CALL DIR(0)
C ... SAVE MATRIX AND RENAME
DO 10 I=1,6
10 CALL SAVE(1,'BCDE',I)
DO 20 I=1,5
20 CALL SAVE(1,'QQQ',I)
CALL RENAME(1,'BCDE','NEW1')
CALL RENAME(1,'QQQ','NEW2')
C ... LOOK DIRECTORY AGAIN
CALL DIR(0)
C ... DELETE MATRICES
CALL DELETE(1,'DFGH')
CALL DIR(0)
CALL DELETE(1,'SSSS')
C ... LOOK DIRECTORY
CALL DIR(0)
C ... DELETE ALL INCORE MATRIX
CALL DELALL(1)
CALL DIR(0)
C ... CLOSE DATA BASE
CALL DBCLOS(1,'SAVE')
STOP 'DONE.'
END