      subroutine pctime(etime)

c     Purpose: Calls time routine for Micro Soft compilers
c              N.B. Replace "gettim" by appropriate timing routine 
c                   for each compiler

c     Outputs:
c        etime     - Character array with timing information

      implicit  none
      character etime*10
      integer   ihr,imin,isec,ihth

c     call gettim (ihr,imin,isec,ihth)

      write(etime,2000) ihr,imin,isec
2000  format(i3,':',i2,':',i2)

      end

      subroutine pcdate(edate)

c     Purpose:  Put date on output file

c     Outputs:
c        edate     - character array with date information

      implicit  none
      character edate*12, mon(12)*3
      integer   iyr, imon, iday

      data mon/'Jan','Feb','Mar','Apr','May','Jun',
     &         'Jul','Aug','Sep','Oct','Nov','Dec'/

c     call getdat( iyr, imon, iday)

      write(edate,2000) mon(imon),iday,iyr
2000  format(a3,1x,i2,', ',i4)

      end

      logical function pcomp(a,b)

c     Purpose: Determine match between alphanumeric data:
c              N.B. inc = parameter for difference between 'a' and 'A'

c     Inputs:
c        a(*)      - 4-character array to test
c        b(*)      - 4-character comparison array

c     Outputs:
c        pcomp     - Flag, true if match made.  
c                    N.B.  converts all characters to lower case before
c                          test performed

      implicit  none
      integer   i,ia,ib,inc
      character a(4)*1,b(4)*1

      data inc /32/
      pcomp = .false.

      do 100 i = 1,4
         ia = ichar(a(i))
         ib = ichar(b(i))
         if(ia.ne.ib .and. ia+inc.ne.ib .and. ia.ne.ib+inc ) return
100   continue
      pcomp = .true.

      end

      subroutine pintio(y,n0)

c     Purpose:  Input control from current active unit - into a character
c               array for free format processing by 'acheck' into field
c               widths of 'n0'

c     Inputs:
c        n0       - Field width for formatting

c     Outputs:
c        y        - Character array formatted to field widths of 'n0'
c                   N.B. Internal I/O can be made to extract data

      implicit  none
      integer   n0
      character x*80,y*80

      integer         ior,iow
      common /iofile/ ior,iow

      if(ior.gt.0) read(ior,'(a)',err=100,end=100) x
      if(ior.lt.0) read(*,'(a)',err=100,end=100) x
      call acheck(x,y,n0,80)
      return

100   call perror('PINTIO',x)

      end

      subroutine pclear()

c     Purpose: Clear PC screen and home cursor on monitor

      implicit none

      write(*,2000) char(27)
2000  format(1x,a1,'[2J')

      end
