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

Example of Record Output

	MPE documents
	Complete PDF
	Table of Contents
	Index

The following program sorts the personnel files shown for the last example. They are sorted by last name. The output records are altered before they are output.

Example D-4 SORTREC_OUTPUT Program


  $standard_level system
        program SORTREC_OUTPUT
  C
  C  This program reads the files TEMPEMP and PERMEMP, sorts them by
  C  last name, outputs them by record, alters the output recors, and
  C  prints the record to $STDLIST.
  C
        integer TEMPFILENUM
       2       ,PERMFILENUM
       3       ,STATUS
  C
        common /PARMS/ TEMPFILENUM, PERMFILENUM, 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       ,TEMPFILENUM
       6       ,PERMFILENUM
       7       ,STATUS
  C
        character TEMPFILE*10
       2         ,PERMFILE*10
  C
        common /PARMS/ TEMPFILENUM, PERMFILENUM, STATUS
  C
        DESIGNATOR  = 2
        DOMAIN      = 3
        ACCESS      = 11
  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.'
          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
        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       ,LENGTH
       4       ,INPUTFILES(3)
       5       ,KEYS(4)
       6       ,TEMPFILENUM
       7       ,PERMFILENUM
       8       ,STATUS
  C
        character ALTSEQ*2
       2         ,MESSAGE*80
       3         ,BUFFER*80
  C
        common /PARMS/ TEMPFILENUM, PERMFILENUM, STATUS
  C
        INPUTFILES(1) = TEMPFILENUM
        INPUTFILES(2) = PERMFILENUM
        INPUTFILES(3) = 0
        LENGTH        = 1
  C
        OUTPUT_OPTION = 0
  C
        NUMKEYS       = 1
        KEYS(1)       = 1
        KEYS(2)       = 20
        KEYS(3)       = 0
        KEYS(4)       = 0
  C
        ALTSEQ(1:1)   = CHAR(255)
        ALTSEQ(2:2)   = CHAR(255)
  C
        call HPSORTINIT (STATUS, INPUTFILES,, OUTPUT_OPTION
       2                ,,, NUMKEYS, KEYS, ALTSEQ)
        if (STATUS .ne. 0) then
          MESSAGE = ' '
          call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
          print *,MESSAGE
        endif
  C
        do while (LENGTH .gt. 0)
          call HPSORTOUTPUT (STATUS, BUFFER, LENGTH)
          BUFFER(33:39) = 'Empl. #'
          BUFFER(50:59) = 'Hire Date:'
          print *,BUFFER
          if (STATUS .ne. 0) then
            call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
            print *,MESSAGE
          endif
        end do
  C
        call HPSORTEND (STATUS)
        if (STATUS .ne. 0) then
          MESSAGE = ' '
          call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
          print *,MESSAGE
        endif
  C
        return
        end
  C
        subroutine CLOSE_FILES
  C
        system intrinsic FCLOSE
  C
        integer*2 DISPOSITION
       2         ,SECURITYCODE
  C
        integer TEMPFILENUM
       2       ,PERMFILENUM
       3       ,STATUS
  C
        common /PARMS/ TEMPFILENUM, PERMFILENUM, STATUS
  C
        DISPOSITION  = 0
        SECURITYCODE = 0
  C
        call FCLOSE (TEMPFILENUM, DISPOSITION, SECURITYCODE)
        call FCLOSE (PERMFILENUM, DISPOSITION, SECURITYCODE)
  C
        return
        end

When this program is executed, the output is written to the screen:


 Everett,            Joyce       Empl. # 000029   Hire Date: 10/19/87
 Gangley,            Tomas       Empl. # 000003   Hire Date: 06/06/87
 Jackson,            Jonathan    Empl. # 000006   Hire Date: 06/06/87
 Jackson,            Rosa        Empl. # 000022   Hire Date: 08/15/87
 Jones,              Eliza       Empl. # 000001   Hire Date: 06/06/87
 Rields,             Evelyn      Empl. # 000007   Hire Date: 07/12/87
 Smith,              James       Empl. # 000005   Hire Date: 06/06/87
 Washington,         Lois        Empl. # 000014   Hire Date: 07/23/87

Example of Record Input

Example of Using an Altered Sequence

Example of Record Output

MPE documents