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

Example of Using an Altered Sequence

	MPE documents
	Complete PDF
	Table of Contents
	Index

The following example sorts the data file below, DATA. The entries in DATA are sorted using an altered collating sequence that is explicitly specified in the program. The sequence contains all displayable ASCII characters and alters the order of the alphabetic characters to AaBbCc .... The output file is called FRUIT

DATA: File of fruit names

Example D-5 SORTALT Program


  $standard_level system
        program SORTALT
  C
  C  This program reads the files TEMPEMP and PERMEMP, sorts them by
  C  last name, outputs them by record, alters the output recors,
  C  and prints the record to $STDLIST.
  C
        integer DATAFILENUM
       2       ,FRUITFILENUM
       3       ,STATUS
  C
        common /PARMS/ DATAFILENUM, FRUITFILENUM, 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       ,DATAFILENUM
       6       ,FRUITFILENUM
       7       ,STATUS
       8       ,RECORD_SIZE
       9       ,NEW
       A       ,WRITE
       B       ,SIZE
  C
        character DATAFILE*10
       2         ,FRUITFILE*10
  C
        common /PARMS/ DATAFILENUM, FRUITFILENUM, STATUS
  C
        DESIGNATOR  = 2
        DOMAIN      = 3
        ACCESS      = 11
        RECORD_SIZE = 19
  C
        DATAFILE = '%DATA%'
        PERMANENT = 1
        call HPFOPEN (DATAFILENUM, STATUS, DESIGNATOR,
       2             ,DATAFILE, DOMAIN, PERMANENT)
        if (STATUS .ne. 0) then
          print *, 'HPFOPEN error on DATAFILE.  Terminating.'
          call QUIT (1)
        endif
  C
        NEW       = 4
        WRITE     = 1
        SIZE      = 80
        FRUITFILE = '%FRUIT%'
        call HPFOPEN (FRUITFILENUM, STATUS, DESIGNATOR,
       2             ,FRUITFILE, DOMAIN, NEW, ACCESS, WRITE
       3             ,RECORD_SIZE, SIZE)
        if (STATUS .ne. 0) then
          print *, 'HPFOPEN error on FRUITFILE. 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       ,INPUTFILES(2)
       4       ,OUTPUTFILE(2)
       5       ,KEYS(4)
       6       ,DATAFILENUM
       7       ,FRUITFILENUM
       8       ,STATUS
  C
        character ALTSEQ*96
       1         ,MESSAGE*80
  C
        common /PARMS/ DATAFILENUM, FRUITFILENUM, STATUS
  C
        INPUTFILES(1) = DATAFILENUM
        INPUTFILES(2) = 0
  C
        OUTPUTFILE(1) = FRUITFILENUM
        OUTPUTFILE(2) = 0
  C
        OUTPUT_OPTION = 0
  C
        NUMKEYS       = 1
        KEYS(1)       = 1
        KEYS(2)       = 20
        KEYS(3)       = 0
        KEYS(4)       = 0
  C
        ALTSEQ(1:2)   = '  '
        ALTSEQ(1:1)   = CHAR(0)
        ALTSEQ(2:2)   = CHAR(93)
  C
        ALTSEQ(3:17)  = '!"#$%&''()*+,-./'
        ALTSEQ(18:33) = '0123456789::<=>?'
        ALTSEQ(34:49) = '@AaBbCcDdEeFfGgH'
        ALTSEQ(50:65) = 'hIiJjKkLlMmNnOoP'
        ALTSEQ(66:80) = 'pQqRrSsTtUuVvWwX'
        ALTSEQ(81:95) = 'xYyZz[\]^^_{|}~'
  C
        call HPSORTINIT (STATUS, INPUTFILES, OUTPUTFILE
       2                ,OUTPUT_OPTION, ,,, NUMKEYS, KEYS
       3                ,ALTSEQ,,,STATISTICS)
        if (STATUS .ne. 0) then
          MESSAGE = ' '
          call HPSORTERRORMESS (STATUS, MESSAGE, LENGTH)
          print *,MESSAGE
        endif
  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 DATAFILENUM
       2       ,FRUITFILENUM
       3       ,STATUS
  C
        common /PARMS/ DATAFILENUM, FRUITFILENUM, STATUS
  C
        DISPOSITION  = 0
        SECURITYCODE = 0
  C
        call FCLOSE (DATAFILENUM, DISPOSITION, SECURITYCODE)
        call FCLOSE (FRUITFILENUM, DISPOSITION, SECURITYCODE)
  C
        return
        end

When this program is executed, the output is written to FRUIT. To view FRUIT:


  :print fruit

  Apple
  banana
  Grapes
  grapes
  peach
  Pear
  orange

Example of Record Output

Appendix E Data Types

Example of Using an Altered Sequence

MPE documents