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

Example of Core Sorting Routine

	MPE documents
	Complete PDF
	Table of Contents
	Index

The following program sorts the personnel files shown below. They are sorted together by last name. The record size is determined by the input files. The status parameter is checked after the calls to HPSORTINIT and HPSORTEND.

The files that are used in this example are as follows (character positions and data descriptions are for convenience only):

TEMPEMP: information file about temporary employees:
PERMEMP: information file about permanent employees:

Example D-1 SORTFILE Program


  $standard_level system
        program SORTFILE
  C
  C  This program reads the files TEMPEMP and PERMEMP, sorts by last
  C  name, and outputs to the file ALLEMP.  The compiler directive
  C  '$standard_level system' is used to supress FORTRAN 77 warnings
  C  for non-standard features, which 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_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
        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 *,STATUS
          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.'
          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.'
        endif
  C
        return
        end
  C
        subroutine DO_SORT
  C
        system intrinsic HPSORTINIT
       2                ,HPSORTERRORMESS
       3                ,HPSORTEND
  C
        integer OUTPUT_OPTION
       2       ,NUMKEYS
       3       ,LENGTH
       4       ,INPUTFILES(3)
       5       ,OUTPUTFILE(2)
       6       ,KEYS(4)
       7       ,STATISTICS(6)
       8       ,TEMPFILENUM
       9       ,PERMFILENUM
       A       ,OUTFILENUM
       B       ,STATUS
  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

        OUTPUT_OPTION = 0
        NUMKEYS       = 1
        KEYS(1)       = 1
        KEYS(2)       = 20
        KEYS(3)       = 0
        KEYS(4)       = 0

        ALTSEQ(1:1)   = CHAR(255)
        ALTSEQ(1:2)   = CHAR(255)

        call HPSORTINIT (STATUS, INPUTFILES, OUTPUTFILE,
       2      OUTPUT_OPTION,,, NUMKEYS, KEYS, ALTSEQ)
        if (STATUS .ne. 0) then
          MESSAGE = ' '
          call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
          print *,MESSAGE
        endif

        call HPSORTEND (STATUS,STATISTICS)
        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
  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 from the sort is written to ALLEMP. To view the output:


  :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

Appendix D FORTRAN Program Examples

Example of Core Merging Routine

Example of Core Sorting Routine

MPE documents