C* SYSDEP.F - system-dependent subroutines
C+
C In this file:
C   FILEXT
C   ATLIST
C   ATFILE
C   YMDHMSS
C   ASKUSER
C   BIGEND2
C   BIGEND4
C
C 15-May-1991 DFB Created UNIX version
C 10-Dec-1992 DFB Added BIGEND routines
C-

C*FILEXT - add a default extension on to a filename, if none is already there.
C+
      SUBROUTINE FILEXT(FNAME,EXT,STATUS)
      IMPLICIT NONE
      CHARACTER*(*) FNAME,EXT
      INTEGER STATUS
C
C This is a system-independent call to a system-dependent subroutine.
C
C Calls to external routines:
C ---------------------------
C   FILEXT needs LENB from CHRLIB.F
C
C History:
C -------
C 17-Sep-1990 DFB UNIX version
C 11-Feb-1991 DFB MSDOS version
C 10-Feb-1992 DFB Version which gets around compiler treatments of backslash
C 15-May-1992 DFB Unix version which just switches defn of backslash
C-
      INTEGER I,POS1,POS2,FLEN
      INTEGER LENB
      CHARACTER*1 BACKSLASH

      BACKSLASH='/'
      IF(STATUS.EQ.0)THEN
        FLEN=LENB(FNAME)
        DO I=FLEN,1,-1
           IF(FNAME(I:I).EQ.'.')GOTO 90
           IF(FNAME(I:I).EQ.BACKSLASH)GOTO 10
        END DO
C - If we reach here, then OK to extend filename
 10     CONTINUE
        POS1=FLEN+1
        POS2=POS1+LENB(EXT)
        IF(POS2.LE.LEN(FNAME))THEN
          FNAME(POS1:POS2)='.'//EXT
        ELSE
          PRINT*,'**Not enough room to extend filename ',FNAME(:POS1-1)
          STATUS=1
        ENDIF
C - come here to leave filename alone
  90    CONTINUE
      ENDIF
      END


c*atlist - Get filenames from a possibly multiple list of directory listings
c+
      subroutine atlist(list,nlist,ptr,fname)
      implicit none
      integer nlist,ptr
      character*(*) list(nlist),fname
c
c Description: takes a list of strings, decodes them as possible indirect
c "atfile" pointers (see description of subroutine "atfile1") and returns
c one filename at a time in FNAME, finally returning a blank string as a 
c terminator. If a blank string occurs in the input list, it terminates 
c the list.
c
c The pointer PTR should be initialised to zero on the first call and
c subsequently its value should be preserved between calls.

      if (ptr.le.0) ptr = 1
  10  continue
      if(list(ptr).eq.' ')then
            fname=' '
            return
      endif
      call atfile(list(ptr),fname)
      if (fname.eq.' ')then
            ptr=ptr+1
            if (ptr.le.nlist)goto 10
      endif
      end

c*atfile - get multiple filenames (prefix only) from a directory listing 
c* (MACHINE DEPENDENT)
c+
c

      subroutine atfile(string,fname)
      implicit none
      character*(*) string,fname
c
c Description: Takes STRING, and if it starts with an "@", opens the relevant
c file, which is expected to be a COMMAND.COM directory listing. It returns 
c in FNAME the next in the list of file names (filename part only, no 
C extension). At the end of the list, it returns a blank string.
C
C For STRING not starting with the
c "@" character, the string is returned in FNAME on the first call, and a
c blank string on the second call.
c
c This routine is highly machine-dependent!
c
c History:
c  15-May-1992 DFB Updated to not be specific to raw files
c  10-Dec-1992 DFB Made Unix version - just strips the part after the dot
c                  out, and skips files which don't have anything before
c                  the dot.
c-
      integer inunit,j,status,start,stop
      character*64 oldstring
      character*30 card
c - External functions
      integer intlc
      data oldstring/' '/

c - Default return value
      fname=' '

      j=intlc(string)
      if(j.eq.0.or.j.eq.len(string))goto 999
      if(string(j:j).eq.'@')then
        if(string.ne.oldstring)then
           call getlun(inunit)
           open(inunit,file=string(j+1:),status='old',iostat=status)
           if(status.ne.0)then
             print*,'**Unable to open file ',string(j+1:)
             goto 999
           endif
           oldstring=string
        endif
c - Read next record from listing and determine if it's a conventional file
 10     read(inunit,'(a)',end=90)card
        start=intlc(card)
        stop=index(card,'.')
c - stop<start+1 when (a) the filename begins with '.' (b) the filename is null
c   (c) the filename has no dot.
        if(stop.lt.start+1)goto 10
        fname=card(start:stop-1)
        goto 999
c - End of file list
 90     continue
        oldstring=' '
      else
        if(string.eq.oldstring)then
          oldstring=' '
        else
          oldstring=string
          fname=string
        endif
      endif

999   continue
      return        
      end


c*YMDHMSS - returns system time
c+
      subroutine ymdhmss(yr,mon,day,hr,min,sec,msec)
      implicit none
      integer yr,mon,day,hr,min,sec,msec
c
c System-dependent routine to return the system time
c
c 15-May-1992 DFB Unix version.
      integer*4 stime, tarray(9)
      integer*4 time

      stime=time()
      call ltime (stime, tarray)
      sec=tarray(1)
      min=tarray(2)
      hr=tarray(3)
      day=tarray(4)
      mon=tarray(5)+1
      yr=tarray(6)+1900
      msec=0
      end


c*ASKUSER - prompt user and get a response on the same line
c+
      subroutine askuser(prompt,plen,response,status)
      implicit none
      integer plen,status
      character*(*) prompt,response
c
c Returns status=-1 if there is a serious error, status=1 if there is an EOF
c condition (^D or ^Z typed, depending on the system).
c
c 15-May-1992 DFB Unix ONLY version
c-
      if(status.ne.0)return

      write(*,1000)prompt(:plen)
 1000 format(a,$)
      read (*,'(a)',end=90,err=99)response
      return

 90   status=1
      return
 99   status=-1
      return
      end


C*BIGEND2 - swap pairs of bytes to convert I*2 values to/from BigEndian format
C+
        subroutine bigend2(buffer,npix)
        implicit none
        integer npix
        integer*2 buffer(npix)
C
C       Note that this routine is null on a Big-endian machine
C
C-
        end


C*BIGEND4 - swap 4 successive bytes to convert to/from BigEndian format
C+
        subroutine bigend4(buffer,npix)
        implicit none
        integer npix
        integer*4 buffer(npix)
C
C       Note that this routine is null on a Big-endian machine
C
C-
        end
