HP 3000 Manuals HP 3000 Manuals
Example of Record Input
The following program sorts the personnel files shown below. They are
sorted by last name. The program marks the employee numbers for the
temporary employees with an asterisk.
The files that are used in the following example are as follows (data
descriptions and character positions are indicated for convenience only):
TEMPEMP Information file about temporary employees:
Last Name First Name Employee Number Hire Date
Gangley, Tomas 000003 06/06/87
Rields, Evelyn 000007 07/12/87
Everett, Joyce 000029 10/19/87
0 1 2 3 4 5 6 7
1234567890123456789012345678901234567890123456789012345678901234567890
PERMEMP Information file about permanent employees:
Last Name First Name Employee Number Hire Date
Jones, Eliza 000001 06/06/87
Smith, James 000005 06/06/87
Jackson, Johnathon 000006 06/06/87
Washington, Lois 000014 07/23/87
Jackson, Rosa 000022 08/15/87
0 1 2 3 4 5 6 7
1234567890123456789012345678901234567890123456789012345678901234567890
Example D-3. SORTREC_INPUT Program
$standard_level system
program SORTREC_INPUT
C
C This program reads the files TEMPEMP and PERMEMP, alters the TEMPEMP
C records, passes all records to SORT/XL, and outputs to the file ALLEMP.
C
integer TEMPFILENUM
2 ,PERMFILENUM
3 ,OUTFILENUM
4 ,STATUS
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, 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 ,RECORD_SIZE
5 ,PERMANENT
6 ,NEW
7 ,WRITE
8 ,SIZE
9 ,TEMPFILENUM
A ,PERMFILENUM
B ,OUTFILENUM
C ,STATUS
C
character TEMPFILE*10
2 ,PERMFILE*10
3 ,OUTFILE*10
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
Example D-3. SORTREC_INPUT Program, continued
DESIGNATOR = 2
DOMAIN = 3
ACCESS = 11
RECORD_SIZE = 19
C
TEMPFILE = '%TEMPEMP%'
PERMANENT = 1
call HPFOPEN (TEMPFILENUM, STATUS, DESIGNATOR,
2 ,TEMPFILE, DOMAIN, PERMANENT)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on TEMPFILE. Terminating.'
endif
C
PERMFILE = '%PERMEMP%'
call HPFOPEN (PERMFILENUM, STATUS, DESIGNATOR,
2 ,PERMFILE, DOMAIN, PERMANENT)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on PERMEMP. Terminating.'
call QUIT (2)
endif
C
NEW = 4
WRITE = 1
SIZE = 80
OUTFILE = '%ALLEMP%'
call HPFOPEN (OUTFILENUM, STATUS, DESIGNATOR,
2 ,OUTFILE, DOMAIN, NEW, ACCESS, WRITE,
3 ,RECORD_SIZE, SIZE)
if (STATUS .ne. 0) then
print *, 'HPFOPEN error on ALLEMP. Terminating.'
call QUIT (3)
endif
C
return
end
C
subroutine DO_SORT
C
system intrinsic HPSORTINIT
2 ,HPSORTERRORMESS
3 ,HPSORTEND
4 ,HPSORTINPUT
5 ,FREAD
6 ,QUIT
C
Example D-3. SORTREC_INPUT Program, continued
integer OUTPUT_OPTION
2 ,NUMKEYS
3 ,LENGTH
4 ,OUTPUTFILE(2)
5 ,KEYS(4)
6 ,TEMPFILENUM
7 ,PERMFILENUM
8 ,OUTFILENUM
9 ,STATUS
A ,RECLENGTH
C
integer*2 LNGTH
C
logical EOF
C
character ALTSEQ*2
2 ,MESSAGE*80
3 ,BUFFER*80
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
OUTPUTFILE(1) = OUTFILENUM
OUTPUTFILE(2) = 0
OUTPUT_OPTION = 0
RECLENGTH = 80
NUMKEYS = 1
KEYS(1) = 1
KEYS(2) = 20
KEYS(3) = 0
KEYS(4) = 0
ALTSEQ(1:1) = CHAR(255)
ALTSEQ(2:2) = CHAR(255)
call HPSORTINIT (STATUS,, OUTPUTFILE, OUTPUT_OPTION
2 ,RECLENGTH,, NUMKEYS, KEYS, ALTSEQ)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
Example D-3. SORTREC_INPUT Program, continued
LENGTH = 72
EOF = .false.
C Read TEMPEMP file. Start with a priming read. If EOF is not found on
C the priming read, call HPSORTINPUT to put the record into the sort, then
C read and input until EOF is found.
LNGTH = FREAD (TEMPFILENUM, BUFFER, LENGTH)
if (ccode()) 10,30,20
10 print *, 'FREAD error on TEMPFILE'
call QUIT (10)
20 EOF = .true.
30 continue
do while ( .not. EOF)
BUFFER(40:40) = '*'
call HPSORTINPUT (STATUS, BUFFER, LENGTH)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *, MESSAGE
endif
C Read the next record. CCG indicates EOF has been found.
LNGTH = FREAD (TEMPFILENUM, BUFFER, LENGTH)
if (ccode()) 40,60,50
40 print *, 'FREAD error on TEMPFILE'
call QUIT (40)
50 EOF = .true.
60 continue
end do
C Now read PERMEMP, as explained above.
EOF = .false.
LNGTH = FREAD (PERMFILENUM, BUFFER, LENGTH)
if (ccode()) 70,90,80
Example D-3. SORTREC_INPUT Program, continued
70 print *, 'FREAD error on PERMEMP.'
call QUIT (70)
80 EOF = .true.
90 continue
do while (.not. EOF)
call HPSORTINPUT (STATUS, BUFFER, LENGTH)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *, MESSAGE
endif
LNGTH = FREAD (PERMFILENUM, BUFFER, LENGTH)
if (ccode()) 100,120,110
100 print *, 'FREAD error on PERMEMP'
call QUIT (100)
110 EOF = .true.
120 continue
end do
call HPSORTEND (STATUS)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
return
end
C
subroutine CLOSE_FILES
C
system intrinsic FCLOSE
C
integer*2 DISPOSITION
2 ,SECURITYCODE
C
integer TEMPFILENUM
2 ,PERMFILENUM
3 ,OUTFILENUM
4 ,STATUS
Example D-3. SORTREC_INPUT Program, continued
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
DISPOSITION = 0
SECURITYCODE = 0
C
call FCLOSE (TEMPFILENUM, DISPOSITION, SECURITYCODE)
call FCLOSE (PERMFILENUM, DISPOSITION, SECURITYCODE)
DISPOSITION = 1
call FCLOSE (OUTFILENUM, DISPOSITION, SECURITYCODE)
return
end
When this program is executed, the output is written to ALLEMP. To view
ALLEMP:
_____________________________________________________________________________
| |
| |
| :print allemp |
| |
| Everett, Joyce *000029 10/19/87 |
| Gangley, Tomas *000003 06/06/87 |
| Jackson, Jonathan 000006 06/06/87 |
| Jackson, Rosa 000022 08/15/87 |
| Jones, Eliza 000001 06/06/87 |
| Rields, Evelyn *000007 07/12/87 |
| Smith, James 000005 06/06/87 |
| Washington, Lois 000014 07/23/87 |
| |
_____________________________________________________________________________