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 set of routines to do timing on a unix machine c c vassilis hajivassiliou 14:00:48.40, sun, jun 3, 1990 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-jan1,1989 c idat(1)=day, idat(2)=month, idat(3)=year (two digits) 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) integer*4 itim(5),idat(3) integer*4 time,stime,iarg(3) external itime,time,idate,secmic,sec c day: c month: c year: call idate(iarg) idat(1)=iarg(1) idat(2)=iarg(2) idat(3)=iarg(3)-1900 c to make idat(3) have two digits only dayfrm89=idat(1)+30*(idat(2)+12*(idat(3)-89)) stime=time() call itime(iarg) c hours: itim(1)=iarg(1) c minutes: itim(2)=iarg(2) c seconds: itim(3)=iarg(3) c hundredths of sec: not implemented itim(4)=secmic()/10000.d0 c time since jan 1, 1989 c hun-secs secs mins hours days itim(5)=itim(4)+100*(itim(3)+60*(itim(2)+60*itim(1))+24*dayfrm89) return end c===============================================================c c written by Vassilis Hajivassiliou and Yoosoon Chang. c c version 1.0, March 22, 1992 c c===============================================================c c sec.unx c c for c-interfaced programs, one for sec and one for secmic, c see file csecond.unx c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 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 UNIX 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, and ltrim c c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ character*(*) cvname,cvvalue character*80 line,ctemp lcvn=ltrim(cvname) cvvalue='?' call system('set>/tmp/tmpevar') call system('setenv>>/tmp/tmpevar') ccc call system('more /tmp/tmpevar') open(99,file='/tmp/tmpevar') 1 continue ccc read(99,'(a)',end=2) line read(99,'(a)',err=2) line c first search set environment ctemp=cvname(1:lcvn)//char(9) ltemp=ltrim(ctemp) l2=icoccfst(ctemp(1:ltemp),line) if(l2.gt.0) then l1=icoccfst(char(9),line)+1 l2=ltrim(line) cvvalue=line(l1:l2) goto 2 endif c now search setenv environment ctemp=cvname(1:lcvn)//'=' ltemp=ltrim(ctemp) l2=icoccfst(ctemp(1:ltemp),line) if(l2.gt.0) then l1=icoccfst('=',line)+1 l2=ltrim(line) cvvalue=line(l1:l2) goto 2 endif goto 1 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 unix version c c vah 18:33:12.14, Sat, May 12, 1990 c c calls ltrim, cexist c and unix function stat(fname,istat13) ??? sun-specific ??? c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ character*(*) fname integer istat(13) call cexist(fname,icode) if(icode.ge.0) then c_generic_unix call system c_generic_unix * ('ls -l -ag '//fname(1:ltrim(fname))//'>tdirsiz') c_generic_unix open(77,file='tdirsiz') c_generic_unix read(77,'(31x,i9)') nbytes c_generic_unix close(77,status='delete') call stat(fname,istat) nbytes=istat(8) else nbytes=-1 endif return end