HP 3000 Manuals HP 3000 Manuals
Example of Core Merging Routine
The following program merges the personnel files shown at the beginning
of the previous example. They are merged by employee number. The record
size is determined by the input files. The status parameter is checked
after the calls to HPMERGEINIT and HPMERGEEND.
Example D-2. MERGEFILE Program
$standard_level system
program MERGEFILE
C
C This program reads the files TEMPEMP and PERMEMP, merges them by EMPLOYEE
C NUMBER, and outputs them to the file ALLEMP.
C The compiler directive '$standard_level system' is used to supress
C FORTRAN 77 warnings for non-standard features, which include intrinsics
C calls.
C
integer TEMPFILENUM
2 ,PERMFILENUM
3 ,OUTFILENUM
4 ,STATUS
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
call OPEN_FILES
call DO_MERGE
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
Example D-2. MERGEFILE Program, continued
C
character TEMPFILE*10
2 ,PERMFILE*10
3 ,OUTFILE*10
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
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 TEMPEMP. Terminating.'
call QUIT (1)
endif
C
PERMFILE = '%PERMEMP%'
call HPFOPEN (PERMFILENUM, STATUS, DESIGNATOR,
2 ,PERMFILE, DOMAIN, PERMANENT)
if (STATUS .ne. 0) then
print *,'HPFOPEN error on PERMEMP. Terminating.'
endif
C
NEW = 4
WRITE = 1
SIZE = 80
OUTFILE = '%ALLEMP%'
call HPFOPEN (OUTFILENUM, STATUS, DESIGNATOR, OUTFILE
2 ,DOMAIN, NEW, ACCESS, WRITE, RECORD_SIZE
3 ,SIZE)
if (STATUS .ne. 0) then
print *,'HPFOPEN error on ALLEMP. Terminating.'
endif
C
return
end
C
subroutine DO_MERGE
C
Example D-2. MERGEFILE Program, continued
system intrinsic HPMERGEINIT
2 ,HPMERGEERRORMESS
3 ,HPMERGEEND
C
integer KEYS_ONLY
2 ,NUMKEYS
3 ,LENGTH
4 ,INPUTFILES(3)
5 ,OUTPUTFILE(2)
6 ,KEYS(4)
7 ,TEMPFILENUM
8 ,PERMFILENUM
9 ,OUTFILENUM
A ,STATUS
B ,STATISTICS(6)
C
character ALTSEQ*2
2 ,MESSAGE*80
C
common /PARMS/ TEMPFILENUM, PERMFILENUM
2 ,OUTFILENUM, STATUS
C
INPUTFILES(1) = TEMPFILENUM
INPUTFILES(2) = PERMFILENUM
INPUTFILES(3) = 0
OUTPUTFILE(1) = OUTFILENUM
OUTPUTFILE(2) = 0
KEYS_ONLY = 0
NUMKEYS = 1
KEYS(1) = 41
KEYS(2) = 20
KEYS(3) = 0
KEYS(4) = 0
ALTSEQ(1:1) = CHAR(255)
ALTSEQ(1:2) = CHAR(255)
call HPMERGEINIT (STATUS, INPUTFILES,, OUTPUTFILE,,
2 KEYS_ONLY, NUMKEYS, KEYS, ALTSEQ)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPMERGEERRORMESS (STATUS, MESSAGE, LENGTH)
print *,MESSAGE
endif
Example D-2. MERGEFILE Program, continued
call HPMERGEEND (STATUS,STATISTICS)
if (STATUS .ne. 0) then
MESSAGE = ' '
call HPMERGEERRORMESS (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
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 |
| |
| Jones, Eliza 000001 06/06/87 |
| Gangley, Tomas 000003 06/06/87 |
| Smith, James 000005 06/06/87 |
| Jackson, Jonathan 000006 06/06/87 |
| Rields, Evelyn 000007 07/12/87 |
| Washington, Lois 000014 07/23/87 |
| Jackson, Rosa 000022 08/15/87 |
| Everett, Joyce 000029 10/19/87 |
| |
_____________________________________________________________________________