 |
» |
|
|
|
The following example sorts the data file below, DATA. The entries in DATA are sorted using an altered collating sequence that is explicitly specified in the program. The sequence contains all displayable ASCII characters and alters the order of the alphabetic characters to AaBbCc .... The output file is called FRUIT - DATA
File of fruit names
banana
Apple
Grapes
grapes
Pear
peach
orange
|
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
|
When this program is executed, the output is written to
FRUIT. To view FRUIT:
:print fruit
Apple
banana
Grapes
grapes
peach
Pear
orange
|
|
