
*****************************************************************
*
* This program illustrates how to call the  SortMerge object
* modules from FORTRAN86.  The records to be sorted are read 
* from the SAM file Files.In, contained on the distribution 
* diskette.  The sorted records are written to the SAM file 
* Files.Out.
*
* Files.In contains a sequence of 65byte records terminated by 
* line feeds.  All the records must be exactly 65bytes long 
* (including the line feed), or the sort will not work.
*
* Two 6byte keys are used for the sort, both of type character.  
* The first is located 6 bytes from the beginning of the record, 
* and the second 26 bytes from the beginning.  Both are sorted in 
* ascending order.
*
*****************************************************************


* See FORTRAN86ChkErc.Fort86 and FORTRAN86ChkSts.Fort86 for the 
* definitions of the subroutines ChkErc and ChkSts, respectively.


*****************************************************************
* Main Program
	Program SortEx

* Variables
	implicit integer (f)
	implicit integer (s)
	implicit integer (b)

* Miscellaneous
	integer*2 iErc
	integer*2 iStsBk(2)
	integer*2 wRet

* Record buffer and size
	integer*1 iRecrd(65)
	integer*2 sRecrd

* Work areas and buffers
	dimension iRgbIn(512), iRgbOu(512), iBsIn(65), iBsOut(65)
	dimension iRgbWk(4096), iPrpSB(112)

* SortMerge key descriptor
	integer*2 iKeyDs(9)
	data iKeyDs 
*		2 keys:
     .   2,
*		1st: located 6 bytes from the beginning of the record, 6 
*		bytes long, type character (2), and sorted in ascending 
*		order (255):
     .		6, 6, 2, 255, 
*		2nd: located 26 bytes from the beginning of the record, 
*		6 bytes long, type character (2), and sorted in 
*		ascending order (255):
     .		26, 6, 2, 255

* Longinteger constants to be used in SortMerge and SAM 
* procedure calls.
	integer*4 qsWFCr, qsWrkA
	data qsWFCr, qsWrkA 1024, 8192

* Character strings to be used in SortMerge and SAM procedure 
* calls.
	integer*1   filin(8)
	character*8 chflin
	data chflin 'Files.In'
	equivalence (filin, chflin)

	integer*1   filout(9)
	character*9 chflou
	data chflou 'Files.Out'
	equivalence (filout, chflou)

	integer*1   pswd(1)
	character*1 chpswd
	data chpswd ' '
	equivalence (pswd, chpswd)

	integer*1    nWf1(21)
	character*21 chWf1
	data chWf1 '[Sys]<$>WorkFile1.Tmp'
	equivalence (nWf1, chWf1)

	integer*1    nWf2(21)
	character*21 chWf2
	data chWf2 '[Sys]<$>WorkFile2.Tmp'
	equivalence (nWf2, chWf2)

	integer*2   iModeR, iModeW
	character*2 modeR, modeW
	data modeR, modeW 'rm', 'wm'
	equivalence (iModeR, modeR), (iModeW, modeW)


* Open input file
	call ChkErc(IBSOPN(
     .    iBsIn, filin, 8, pswd, 0, iModeR, iRgbIn, 1024))

* Open output file
	call ChkErc(IBSOPN(
     .    iBsOut, filout, 9, pswd, 0, iModeW, iRgbOu, 1024))


* Initialize sort
	call ChkSts(ISMBPK(
     .        iPrpSB, nWf1, 21, nWf1, 0, nWf2, 21, nWf2, 0, 
     .        qsWFCr, 512, qsWrkA, 65, 0, iKeyDs, iRgbWk, 
     .        iStsBk),
     .    iStsBk)


* Release records
	sRecrd = 65
	write(*, '(1x  1x, a)') 'Release Records'

10	iErc = IBSRRC(iBsIn, iRecrd, 65, wRet)
	IF (iErc.ne.0) goto 20
	call ChkSts(ISMRLC(sRecrd, iRecrd, iStsBk), iStsBk)
	write(*, '(1x, 64a1)') (iRecrd(i), i=1, 64)
	goto 10

20	IF (iErc.ne.1) CALL ChkErc(iErc)


* Do sort
	write(*, '(1x, a)') 'Do Sort'
	call ChkSts(ISMDST(iStsBk), iStsBk)


* Retrieve records
	write(*, '(1x, a)') 'Return Records'
30	iErc = ISMRTC(sRecrd, iRecrd, iStsBk)
	IF (iErc.ne.0) goto 40
	call ChkErc(IBSWRC(iBsOut, iRecrd, sRecrd, wRet))
	write(*, '(1x, 64a1)') (iRecrd(i), i=1, 64)
	goto 30

40	IF (iErc.ne.3404)  CALL ChkSts(iErc, iStsBk)


* Close files and end sort
	CALL ChkSts(ISMCST(iStsBk), iStsBk)
	CALL ChkErc(IBSCLS(iBsIn))
	CALL ChkErc(IBSCLS(iBsOut))
	write(*, '(1x, a)') 'Sort concluded successfully'

	end