Example D-5 SORTALT Program
$standard_level system
program SORTALT
C
C This program reads the files TEMPEMP and PERMEMP, sorts them by last
C name, outputs them by record, alters the output recors, and prints the
C record to $STDLIST.
C
integer DATAFILENUM
2 ,FRUITFILENUM
3 ,STATUS
C
common /PARMS/ DATAFILENUM, FRUITFILENUM, STATUS
C
call OPEN_FILES
call DO_SORT
call CLOSE_FILES
stop
end
C
subroutine OPEN_FILES
C
system intrinsic HPFOPEN
2 ,QUIT
C
integer DESIGNATOR
2 ,DOMAIN
3 ,ACCESS
4 ,PERMANENT
5 ,DATAFILENUM
6 ,FRUITFILENUM
7 ,STATUS
8 ,RECORD_SIZE
9 ,NEW
A ,WRITE
B ,SIZE
C
character DATAFILE*10
2 ,FRUITFILE*10
C
common /PARMS/ DATAFILENUM, FRUITFILENUM, STATUS
C
DESIGNATOR = 2
DOMAIN = 3
ACCESS = 11
RECORD_SIZE = 19
C
DATAFILE = '%DATA%'
PERMANENT = 1
call HPFOPEN (DATAFILENUM, STATUS, DESIGNATOR,
2 ,DATAFILE, DOMAIN, PERMANENT)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on DATAFILE. Terminating.'
call QUIT (1)
endif
C
NEW = 4
WRITE = 1
SIZE = 80
FRUITFILE = '%FRUIT%'
call HPFOPEN (FRUITFILENUM, STATUS, DESIGNATOR,
2 ,FRUITFILE, DOMAIN, NEW, ACCESS, WRITE
3 ,RECORD_SIZE, SIZE)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on FRUITFILE. Terminating.'
call QUIT (2)
endif
C
return
end
C
subroutine DO_SORT
C
system intrinsic HPSORTINIT
2 ,HPSORTERRORMESS
3 ,HPSORTEND
4 ,HPSORTINPUT
5 ,HPSORTOUTPUT
6 ,QUIT
C
integer OUTPUT_OPTION
2 ,NUMKEYS
3 ,INPUTFILES(2)
4 ,OUTPUTFILE(2)
5 ,KEYS(4)
6 ,DATAFILENUM
7 ,FRUITFILENUM
8 ,STATUS
C
character ALTSEQ*96
1 ,MESSAGE*80
C
common /PARMS/ DATAFILENUM, FRUITFILENUM, STATUS
C
INPUTFILES(1) = DATAFILENUM
INPUTFILES(2) = 0
C
OUTPUTFILE(1) = FRUITFILENUM
OUTPUTFILE(2) = 0
C
OUTPUT_OPTION = 0
C
NUMKEYS = 1
KEYS(1) = 1
KEYS(2) = 20
KEYS(3) = 0
KEYS(4) = 0
C
ALTSEQ(1:2) = ' '
ALTSEQ(1:1) = CHAR(0)
ALTSEQ(2:2) = CHAR(93)
C
ALTSEQ(3:17) = '!"#$%&''()*+,-./'
ALTSEQ(18:33) = '0123456789::<=>?'
ALTSEQ(34:49) = '@AaBbCcDdEeFfGgH'
ALTSEQ(50:65) = 'hIiJjKkLlMmNnOoP'
ALTSEQ(66:80) = 'pQqRrSsTtUuVvWwX'
ALTSEQ(81:95) = 'xYyZz[\]^^_{|}~'
C
call HPSORTINIT (STATUS, INPUTFILES, OUTPUTFILE
2 ,OUTPUT_OPTION, ,,, NUMKEYS, KEYS
3 ,ALTSEQ,,,STATISTICS)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
C
call HPSORTEND (STATUS)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
C
return
end
C
subroutine CLOSE_FILES
C
system intrinsic FCLOSE
C
integer*2 DISPOSITION
2 ,SECURITYCODE
C
integer DATAFILENUM
2 ,FRUITFILENUM
3 ,STATUS
C
common /PARMS/ DATAFILENUM, FRUITFILENUM, STATUS
C
DISPOSITION = 0
SECURITYCODE = 0
C
call FCLOSE (DATAFILENUM, DISPOSITION, SECURITYCODE)
call FCLOSE (FRUITFILENUM, DISPOSITION, SECURITYCODE)
C
return
end
Printable version
