SORT-MERGE/XL Programmer's Guide > Appendix D FORTRAN Program Examples

Example of Core Merging Routine

	MPE documents
	Complete PDF
	Table of Contents
	Index

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
  C  EMPLOYEE NUMBER, and outputs them to the file ALLEMP.
  C  The compiler directive '$standard_level system' is used to
  C  supress FORTRAN 77 warnings for non-standard features, which
  C  include intrinsics 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
  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
        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
        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

Example of Core Sorting Routine

Example of Record Input

Example of Core Merging Routine

MPE documents