INTEGER FUNCTION MEMSIZ()
      PARAMETER (msiz=1500000)
      COMMON /SYSxMD/ USERMEM(msiz)
C
C     INTEGER FUNCTION TO RETURN OF TOTAL MEMORY SIZE ALLOCATED TO
C     IO-BUFFERS. RETURNS # BLOCKS COMPATIBLE WITH LAST PARAMETER
C     IN CALL TO OPNBUF.
       MEMSIZ=IFIX( (0.5*MSIZ-1200)/64)
       RETURN
       END
      INTEGER FUNCTION MEMLFT()
      PARAMETER (msiz=1500000)
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /SYSxMA/ ISOLD
C
C     INTEGER FUNCTION TO RETURN OF REMAINING MEMORY SIZE FOR
C     IO-BUFFERS. RETURNS # BLOCKS COMPATIBLE WITH LAST PARAMETER
C     IN CALL TO OPNBUF.
       MEMLFT=IFIX( (0.5*(MSIZ-ISOLD+1)-63)/64)
       RETURN
       END
      SUBROUTINE OPNBUF(IUN,LREC,NREC,IBUFSIZ)
      PARAMETER (msiz=1500000)
      CHARACTER*60 FILENM
      INTEGER SYSADDMEM
      integer TOGGLE,LL
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      INDX1(LL)=NINT(0.5+0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
      INDX2(LL)=NINT(0.5-0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
C
      IF (IUN.GT.99.OR.IUN.LT.1) THEN
      CALL AIOERR('OPNBUF',IUN,1)
      END IF
      IF (IOPN(IUN).EQ.1) THEN
      CALL AIOERR('OPNBUF',IUN,3)
      ELSE
      IOPN(IUN)=1
      END IF
      IRSIZE(IUN)=IBUFSIZ*64+63
      IF (LREC.GT.IRSIZE(IUN)) THEN
      CALL AIOERR('OPNBUF',IUN,4)
      END IF
      ISTAT=SYSADDMEM(ISTART(IUN),2*IRSIZE(IUN))
      IF (ISTAT.NE.0) STOP
      IREC(IUN)=LREC
      NTOT=LREC*NREC
      NN=IRSIZE(IUN)/LREC
      NOFR(IUN)=(NREC-1)/NN+1
      NPRREC(IUN)=LREC*NN
      ICOUNT(IUN)=1
      IRECAC(IUN)=1
      IRDIR(IUN)=0
      TOGGLE(IUN)=-1
      IB1(IUN)=INDX1(TOGGLE(IUN))
      IB2(IUN)=INDX2(TOGGLE(IUN))
      IOFF(IUN)=0
      IF (NOFR(IUN).GT.2) THEN
      NSIZE=NOFR(IUN)*IRSIZE(IUN)*1.2E-3
C      LNREC=(IRSIZE(IUN))*8
C      WRITE(FILENM,1230) IUN,NSIZE,MOD(IUN,NDISK)+20
C 1230 FORMAT('FTN0',I2.2,',SI=',I5.5,',DI=',I2)
C     WRITE(FILENM,1230) IUN,NSIZE
C1230 FORMAT('FTN0',I2.2,',SI=',I5.5)
C      OPEN(UNIT=IUN,FILE=FILENM,FORM='UNFORMATTED',
C     1     RECL=LNREC,
C     1     SYNC='ASYNCHRONOUS')
      OPEN(UNIT=IUN,STATUS='SCRATCH',FORM='UNFORMATTED')
      END IF
      RETURN
      END
C
C
      SUBROUTINE ENFBUF(IUN)
      PARAMETER (msiz=1500000)
      CHARACTER*60 FILENM
      integer TOGGLE,LL
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      INDX1(LL)=NINT(0.5+0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
      INDX2(LL)=NINT(0.5-0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
C
      IF (IOPN(IUN).NE.1) THEN
      CALL AIOERR('ENFBUF',IUN,2)
      END IF
      IF (NOFR(IUN).GT.2) THEN
      IB1(IUN)=INDX1(TOGGLE(IUN))
      CALL ASOUT(IUN,USERMEM(IB1(IUN)),IRSIZE(IUN))
      ENDFILE(IUN)
      END IF
      NOFR(IUN)=IRECAC(IUN)
      IRDIR(IUN)=-2
      RETURN
      END
C
C
      SUBROUTINE RWDBUF(IUN)
      PARAMETER (msiz=1500000)
      CHARACTER*60 FILENM
      integer TOGGLE,LL
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      INDX1(LL)=NINT(0.5+0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
      INDX2(LL)=NINT(0.5-0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
C
      IF (IOPN(IUN).NE.1) THEN
      CALL AIOERR('RWDBUF',IUN,2)
      END IF
      TOGGLE(IUN)=-1
      IB1(IUN)=INDX1(TOGGLE(IUN))
      IB2(IUN)=INDX2(TOGGLE(IUN))
      IOFF(IUN)=0
      ICOUNT(IUN)=1
      IRECAC(IUN)=1
      IRDIR(IUN)=1
      IF (NOFR(IUN).GT.2) THEN
      REWIND(IUN)
      CALL ASRDIN(IUN,USERMEM(IB1(IUN)),IRSIZE(IUN))
      CALL ASRDIN(IUN,USERMEM(IB2(IUN)),IRSIZE(IUN))
      END IF
      RETURN
      END
C
C
      SUBROUTINE CLSBUF(IUN)
      PARAMETER (msiz=1500000)
      CHARACTER*60 FILENM
      INTEGER SYSSUBMEM
      integer TOGGLE,LL
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      INDX1(LL)=NINT(0.5+0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
      INDX2(LL)=NINT(0.5-0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
C
      IF (IOPN(IUN).NE.1) THEN
      CALL AIOERR('CLSBUF',IUN,2)
      ELSE
      IOPN(IUN)=0
      END IF
      IF (NOFR(IUN).GT.2) THEN
      CLOSE(UNIT=IUN,STATUS='DELETE')
      END IF
      ISTAT=SYSSUBMEM(ISTART(IUN),2*IRSIZE(IUN))
      IF (ISTAT.NE.0) STOP

      RETURN
      END
C
C
      SUBROUTINE WRBUF(IUN,C,NVAL)
      PARAMETER (msiz=1500000)
      DIMENSION C(NVAL)
      CHARACTER*60 FILENM
      integer TOGGLE,LL
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      INDX1(LL)=NINT(0.5+0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
      INDX2(LL)=NINT(0.5-0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
C
      IF (IOPN(IUN).NE.1) THEN
      CALL AIOERR('WRBUF ',IUN,2)
      END IF
      IF (IRECAC(IUN).GT.NOFR(IUN)) THEN
      CALL AIOERR('WRBUF ',IUN,5)
      END IF
      IF (NVAL.GT.IREC(IUN)) THEN
      CALL AIOERR('WRBUF ',IUN,6)
      END IF
      IF (IRDIR(IUN).NE.0) THEN
        CALL AIOERR('WRBUF ',IUN,9)
      END IF
      IF (IOFF(IUN).GE.NPRREC(IUN)) THEN
      IOFF(IUN)=0
      TOGGLE(IUN)=-TOGGLE(IUN)
      IB1(IUN)=INDX1(TOGGLE(IUN))
      IB2(IUN)=INDX2(TOGGLE(IUN))
      IRECAC(IUN)=IRECAC(IUN)+1
      IF (NOFR(IUN).GT.2) THEN
      CALL ASOUT(IUN,USERMEM(IB2(IUN)),IRSIZE(IUN))
      END IF
      END IF
      IADDR=IOFF(IUN)+IB1(IUN)
C      CALL VMOV(C,1,USERMEM(IADDR),1,NVAL)
      DO 10 II=1,NVAL
       USERMEM(IADDR+II-1)=C(II)
 10   CONTINUE
      IOFF(IUN)=IOFF(IUN)+IREC(IUN)
      ICOUNT(IUN)=ICOUNT(IUN)+1
      RETURN
      END
C
C
      SUBROUTINE RDBUF(IUN,C,NVAL)
      PARAMETER (msiz=1500000)
      DIMENSION C(NVAL)
      CHARACTER*60 FILENM
      integer TOGGLE,LL
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      INDX1(LL)=NINT(0.5+0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
      INDX2(LL)=NINT(0.5-0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
C
      IF (IOPN(IUN).NE.1) THEN
      CALL AIOERR('RDBUF ',IUN,2)
      END IF
      IF (IRECAC(IUN).GT.NOFR(IUN)) THEN
      CALL AIOERR('RDBUF ',IUN,7)
      END IF
      IF (NVAL.GT.IREC(IUN)) THEN
      CALL AIOERR('RDBUF ',IUN,8)
      END IF
      IF (IRDIR(IUN).NE.1) THEN
        CALL AIOERR('WRBUF ',IUN,9)
      END IF
      IF (IOFF(IUN).GE.NPRREC(IUN)) THEN
      IOFF(IUN)=0
      TOGGLE(IUN)=-TOGGLE(IUN)
      IB1(IUN)=INDX1(TOGGLE(IUN))
      IB2(IUN)=INDX2(TOGGLE(IUN))
      IRECAC(IUN)=IRECAC(IUN)+1
      IF (NOFR(IUN).GT.2) THEN
      IF (IRECAC(IUN).LT.NOFR(IUN)) THEN
      CALL ASRDIN(IUN,USERMEM(IB2(IUN)),IRSIZE(IUN))
      ELSE
C      WAIT(IUN)
      END IF
      END IF
      END IF
      IADDR=IB1(IUN)+IOFF(IUN)
C      CALL VMOV(USERMEM(IADDR),1,C,1,NVAL)
      DO 10 II=1,NVAL
       C(II)=USERMEM(IADDR+II-1)
 10   CONTINUE
      IOFF(IUN)=IOFF(IUN)+IREC(IUN)
      ICOUNT(IUN)=ICOUNT(IUN)+1
      RETURN
      END
      SUBROUTINE RBBUF(IUN,C,NVAL)
      PARAMETER (msiz=1500000)
      dimension C(NVAL)
      CHARACTER*60 FILENM
      integer TOGGLE,LL
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      INDX1(LL)=NINT(0.5+0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
      INDX2(LL)=NINT(0.5-0.5*ISIGN(1,LL))*IRSIZE(IUN)+ISTART(IUN)
C
      IF (IOPN(IUN).NE.1) THEN
      CALL AIOERR('RBBUF ',IUN,2)
      END IF
      IF (IRECAC(IUN).LT.1) THEN
      CALL AIOERR('RBBUF ',IUN,7)
      END IF
      IF (NVAL.GT.IREC(IUN)) THEN
      CALL AIOERR('RBBUF ',IUN,8)
      END IF
C
C     IF FIRST BACKWARDS READ, POSOTION FILE FOR NEXT READ
C
      IF (IRDIR(IUN).EQ.-1) THEN
        IOFF(IUN)=IOFF(IUN)-IREC(IUN)
      ELSE IF (IRDIR(IUN).EQ.-2) THEN
        IF (NOFR(IUN).GT.2) THEN
          BACKSPACE(IUN)
          BACKSPACE(IUN)
        END IF
        IRDIR(IUN)=-1
        IOFF(IUN)=IOFF(IUN)-IREC(IUN)
      ELSE IF (IRDIR(IUN).EQ.0) THEN
        CALL AIOERR('RBBUF ',IUN,9)
      ELSE
        CALL AIOERR('RBBUF ',IUN,10)
      END IF
C
      IF (IOFF(IUN).LT.0) THEN
        IOFF(IUN)=NPRREC(IUN)-IREC(IUN)
        TOGGLE(IUN)=-TOGGLE(IUN)
        IB1(IUN)=INDX1(TOGGLE(IUN))
        IB2(IUN)=INDX2(TOGGLE(IUN))
        IRECAC(IUN)=IRECAC(IUN)-1
        IF (NOFR(IUN).GT.2) THEN
          IF (IRECAC(IUN).GT.1) THEN
            BACKSPACE(IUN)
            BACKSPACE(IUN)
            CALL ASRDIN(IUN,USERMEM(IB2(IUN)),IRSIZE(IUN))
          ELSE
C            WAIT(IUN)
          END IF
        END IF
      END IF
      IADDR=IB1(IUN)+IOFF(IUN)
C      CALL VMOV(USERMEM(IADDR),1,C,1,NVAL)
      DO 10 II=1,NVAL
       C(II)=USERMEM(IADDR+II-1)
 10   CONTINUE
      ICOUNT(IUN)=ICOUNT(IUN)-1
      RETURN
      END
      SUBROUTINE ASOUT(IUN,AA,NUM)
      DIMENSION AA(NUM)
C      WRITE(UNIT=IUN,WAIT=.FALSE.) AA
      WRITE(UNIT=IUN) (AA(J),J=1,NUM)
      RETURN
      END
      SUBROUTINE ASRDIN(IUN,AA,NUM)
      DIMENSION AA(NUM)
C      READ(UNIT=IUN,WAIT=.FALSE.) AA
      READ(UNIT=IUN) (AA(J),J=1,NUM)
      RETURN
      END
      SUBROUTINE AIOERR(TIT,IUN,IERR)
      CHARACTER*6 TIT
      CHARACTER*30 MESS(10)
      DATA MESS(1) /'*** ILLEGAL LOGICAL UNIT   ***'/
      DATA MESS(2) /'*** FILE NOT OPENED        ***'/
      DATA MESS(3) /'*** FILE ALREADY OPENED    ***'/
      DATA MESS(4) /'*** BUFFER TOO SMALL       ***'/
      DATA MESS(5) /'*** WRITE PAST END OF FILE ***'/
      DATA MESS(6) /'*** WRITE PAST END OF RECD ***'/
      DATA MESS(7) /'*** READ PAST END OF FILE  ***'/
      DATA MESS(8) /'*** READ PAST END OF RECD  ***'/
      DATA MESS(9) /'*** MIXED R/W NOT ALLOWED  ***'/
      DATA MESS(10) /'*** TWO WAY READ MODE N.A. ***'/
C
C
 100  FORMAT(1H ,'*** ASYNCHRONOUS IO ERROR   ***')
 200  FORMAT(1H ,'*** SUBROUTINE: ',A6,'      ***')
 300  FORMAT(1H ,'*** UNIT NUMBER:',I6,'      ***')
 400  FORMAT(1H ,'*** ERROR NUMBER:',I5,'      ***')
 500  FORMAT(1H ,A30)
      WRITE(6,100)
      WRITE(6,200) TIT
      WRITE(6,300) IUN
      WRITE(6,400) IERR
      WRITE(6,500) MESS(IERR)
      STOP '*** EXECUTION TERMINATED   ***'
      END
      INTEGER FUNCTION SYSADDMEM(IST,ISIZ)
      PARAMETER (msiz=1500000)
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /SYSxMA/ ISOLD
      IST=ISOLD
      ISOLD=IST+ISIZ
      IF (ISOLD.GT.MSIZ+1) THEN
        WRITE(6,*) '>>> FATAL: INSUFFICIENT BUFFER SPACE <<<'
        SYSADDMEM=1
      ELSE
        SYSADDMEM=0
      END IF
      RETURN
      END
      INTEGER FUNCTION SYSSUBMEM(IST,ISIZ)
      PARAMETER (msiz=1500000)
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /SYSxMA/ ISOLD
      ISOLD=MIN(ISOLD,IST)
      IF (ISOLD.LT.1) THEN
        WRITE(6,*) '>>> FATAL: EXCESSIVE BUFFER SPACE SUBTRACTION <<<'
        SYSSUBMEM=1
      ELSE
        SYSSUBMEM=0
      END IF
      RETURN
      END
      BLOCK DATA ASIO
      PARAMETER (msiz=1500000)
      integer TOGGLE
      COMMON /SYSxMD/ USERMEM(msiz)
      COMMON /SYSxMA/ ISOLD
      COMMON /AIOBUF/ IBUF(99),NOFR(99),IRECAC(99),NPRREC(99),
     1  ICOUNT(99),TOGGLE(99),IB1(99),IB2(99),IOFF(99),IREC(99),
     2  IRSIZE(99),ISTART(99),IOPN(99),IRDIR(99)
      DATA IOPN /99*0/
      DATA ISOLD /1/
C
      END
      SUBROUTINE CLTIME
      DIMENSION SECS(2)
      COMMON /TIMECT/ OLDSECS
      OLDSECS = ETIME(SECS)
C      OLDSECS=SECS(1)
C      CALLSTAT=LIB$INIT_TIMER()
      RETURN
      END
      SUBROUTINE RDTIME(T1)
c
c Returns CPU time in secs.
c
C *** UNIX SYSTEMS
      DIMENSION SECS(2)
      COMMON /TIMECT/ OLDSECS
      T1=ETIME(SECS)-OLDSECS
C *** VMS SYSTEMS
CVMS  INTEGER*4 IT4
CVMS  REAL*8 IT8
CVMS  EQUIVALENCE (IT4,IT8)
CVMS  CALLSTAT=LIB$STAT_TIMER(2,IT4)
CVMS  T1=1E-2*IT4
      RETURN
      END
      SUBROUTINE OPFILW(IUN,IOER)
      CHARACTER*40 FILENM
      character*6 ENVVAR
      IOER=0
C
C     OPENS SEQUENCIAL ASCII FILE FOR WRITE
C
C***  VMS
C     OPEN(UNIT=IUN,STATUS='NEW',FORM='FORMATTED',ERR=300)
C***  ultrix 
      WRITE(ENVVAR,'(A3,I3.3)') 'FOR',IUN
      CALL GETENV(ENVVAR,FILENM)
      IF (FILENM.EQ.' ') THEN
       OPEN(UNIT=IUN,STATUS='UNKNOWN',FORM='FORMATTED',ERR=300)
      ELSE
       OPEN(UNIT=IUN,FILE=FILENM,STATUS='UNKNOWN',
     &      FORM='FORMATTED',ERR=300)
      END IF
C***  MS-DOS         
c      IF (IUN.LT.10) THEN
c        WRITE(FILENM,100) IUN
c      ELSE
c        WRITE(FILENM,200) IUN
c      END IF
c 100  FORMAT('FOR00',I1,'.DAT')
c 200  FORMAT('FOR0',I2,'.DAT')
c      OPEN(UNIT=IUN,FILE=FILENM,STATUS='UNKNOWN',FORM='FORMATTED',
c     1     ERR=300)
      RETURN
 300  IOER=1
      RETURN
C
      ENTRY OPFILR(IUN,IOER)
      IOER=0
C
C     OPENS SEQUENCIAL ASCII FILE FOR READ
C
C***  VMS
C     OPEN(UNIT=IUN,STATUS='OLD',ERR=400)
C***  ultrix 
      WRITE(ENVVAR,'(A3,I3.3)') 'FOR',IUN
      CALL GETENV(ENVVAR,FILENM)
      IF (FILENM.EQ.' ') THEN
       OPEN(UNIT=IUN,STATUS='OLD',FORM='FORMATTED',ERR=400)
      ELSE
       OPEN(UNIT=IUN,FILE=FILENM,STATUS='OLD',
     &      FORM='FORMATTED',ERR=400)
      END IF
C***  MS-DOS         
c      IF (IUN.LT.10) THEN
c        WRITE(FILENM,100) IUN
c      ELSE
c        WRITE(FILENM,200) IUN
c      END IF
c      OPEN(UNIT=IUN,FILE=FILENM,STATUS='OLD',ERR=400)
      RETURN
 400  IOER=2
      RETURN
      END