subroutine timdat(itim,idat)
c===============================================================c
c     written by Vassilis Hajivassiliou                         c
c     with the aid of Yoosoon Chang.                            c
c     version 1.0, March 22, 1992                               c
c     version 1.1, July 11, 1992                                c
c===============================================================c
c
c     !!! system-dependent subroutine !!!
c
c       set of routines to do timing on a pc
c
c      (assume the lahey compiler)
c
c       vassilis hajivassiliou 25 sep 85
c       4:23 pm, sunday, may 22, 1988
c
c      1.subroutine timdat(itim,idat)
c         itim(1)=hours, itim(2)=minutes, itim(3)=secs,
c         itim(4)=1/100th secs, itim(5)=1/100th-secs-since-midnight
c         idat(1)=day, idat(2)=month, idat(3)=year
c      2.double precision function sec()
c         number of seconds since a fixed point, typically midnight
c      3.double precision function cpusec()
c         number of seconds of cpu since previous invocation
c  1,2, and 3 are system dependent routines, called by others
c
c      4.double precision function seed(iseed)
c         calls the system clock to obtain a seed; returned also as i*4
c      5.subroutine times(nfile)
c         prints timing information (since last invocation if re-called)
c      6.subroutine when(nfunit)
c         prints date and time
c      7.double precision function hsec()
c         number of 1/100th secs since fixed point (typically midnight)
c************************************************************************
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      implicit double precision (a-h,o-z)
      character*11 c11
      character*8  c8
      integer*4 itim(5),idat(3)
      integer*2 iyea,imon,iday,ihou,imin,isec,ihun
ccc      call gettim(ihou,imin,isec,ihun)
      call time(c11)
      read(c11,'(i2,1x,i2,1x,i2,1x,i2)') ihou,imin,isec,ihun
c      hours:
      itim(1)=ihou
c      minutes:
      itim(2)=imin
c      seconds:
      itim(3)=isec
c      hundredths of sec:
      itim(4)=ihun
c      time since midnight in 100th's of sec:
      itim(5)=(3600*itim(1)+60*itim(2)+itim(3))*100+itim(4)
ccc      call getdat(iyea,imon,iday)
      call date(c8)
      read(c8,'(i2,1x,i2,1x,i2)') imon,iday,iyea
c      day:
      idat(1)=iday
c      month:
      idat(2)=imon
c      year:
      idat(3)=iyea
      return
      end
c
c
c
      double precision function sec()
c===============================================================c
c     written by Vassilis Hajivassiliou and Yoosoon Chang.      c
c     version 1.0, March 22, 1992                               c
c===============================================================c
c
c     !!! system-dependent subroutine !!!
c
c     for systems that have a 100th of a sec as the highest resolution
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      integer*4 itim(5),idat(3)
      external timdat
 
      call timdat(itim,idat)
      sec = itim(5)
      sec = sec / 100.d0
      return
      end
      subroutine getevar(cvname,cvvalue)
c===============================================================c
c     written by Vassilis Hajivassiliou and Yoosoon Chang.      c
c     version 1.0, March 22, 1992                               c
c===============================================================c
c
c     vah 8:34:21.59, Tue, Mar 24, 1992
c     DOS version
c
c     cvvalue must be a character variable declared in the calling 
c     program.
c
c     if cvname is not set, cvvalue will be '?' upon return.
c
c     requires subprograms system, icoccfst, ltrim, and uc
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      character*(*) cvname,cvvalue
      character*80 line
      cvvalue='?'
      call system('set>tmpevar')
      open(99,file='tmpevar')
    1 continue 
ccc      read(99,'(a)',end=2) line
      read(99,'(a)',err=2) line
      call uc(cvname)
      l1=ltrim(cvname)
      l2=icoccfst(cvname(1:l1)//'=',line)
      if(l2.gt.0) then
         l1=icoccfst('=',line)+1
         l2=ltrim(line)
         cvvalue=line(l1:l2)
         goto 2
      endif
      goto1
    2 continue
      close(99,status='delete')
      return
      end
      subroutine fsize(fname,nbytes)
c     Returns size of file fname in bytes.
c     Returns -1 if file does not exist
c
c     dos version
c
c     vah 18:33:12.14, Sat, May 12, 1990
c         13:55:55.98, Sat, Sep 22, 1990
c
c     calls ltrim, cexist
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      character*(*) fname
      character*132 c132
      character*12  cfull
      character*8   cmain
      character*3   cext
 
      nbytes=-1

      call cexist(fname,icode)
cdbg      print *,fname,icode
 
      if(icode.ge.0) then
         is=1+max(icoccfst(':',fname),icocclst('\',fname))
         ie=ltrim(fname)
         cfull='            '
         cfull=fname(is:ie)
cdbg         print *,is,ie,cfull
         is=1+icocclst('\',cfull)
         ie=icoccfst('.',cfull(1:ltrim(cfull))//'.')-1
         cmain='        '
         cmain(1:ie-is+1)=cfull(is:ie)
         call uc(cmain)
cdbg         print *,is,ie,cmain
         idot=icocclst('.',cfull)
         if(idot.gt.0) then
            cext=cfull(idot+1:idot+3)
            call uc(cext)
         else
            cext='   '
            cfull=cfull(1:ltrim(cfull))//'.'
            fname=fname(1:ltrim(fname))//'.'
         endif
cdbg         print *,'.'//cfull//'.'
cdbg         print *,'.'//cmain//'.'
cdbg         print *,'.'//cext//'.'
cdbg         print *,'.'//fname(1:ltrim(fname))//'.'

         c132='dir '//fname(1:ltrim(fname))//
     *           ' >t$dirsiz'
         call system(c132(1:ltrim(c132)))
         open(77,file='t$dirsiz')
    3    continue
ccc         read(77,'(a)',end=5) c132
         read(77,'(a)',err=5) c132
         call uc(c132)
         imain=icoccfst(cmain,c132)
cdbg         print *,'imain',imain
cdbg         print *,'c132',c132
         if(imain.gt.0) then
cdbg      print *,'.'//cext//'  '//'.'
cdbg      print *,'.'//c132(imain+8:ltrim(c132))//'.'
               iext=icoccfst(cext//'  ',c132(imain+8:ltrim(c132)))
               if(iext.gt.0) then
c found
cdbg                  print *,'iext',iext
cdbg                  print *,'c132(imain+8:)',c132(imain+8:ltrim(c132))
                  read(c132(imain+8+iext+3:),*) nbytes
                  goto 2
               else
                  goto 3
               endif
c            endif
         endif
         goto 3
    2    continue
         close(77,status='delete')
      endif

    5 continue

      return
      end