HP 3000 Manuals HP 3000 Manuals
Example of Using an Altered Sequence
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
Example D-5. SORTALT Program, continued
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
Example D-5. SORTALT Program, continued
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
Example D-5. SORTALT Program, continued
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 |
| |
_______________________________________