source/maxlik/src_FPy/timing.F

   1 C $Date: 1994/10/05 16:41:52 $
   2 C $Revision: 2.2 $
   3 C
   4 C
   5 C
   6       subroutine set_timers
   7 c
   8       implicit none
   9       double precision tcpu
  10       include 'COMMON.TIME1'
  11 C Diminish the assigned time limit a little so that there is some time to
  12 C end a batch job
  13 c     timlim=batime-150.0
  14 C Calculate the initial time, if it is not zero (e.g. for the SUN).
  15       stime=tcpu()
  16 cd    print *,' in SET_TIMERS stime=',stime
  17       return
  18       end
  19 C------------------------------------------------------------------------------
  20       logical function stopx(nf)
  21 C This function returns .true. in case of time up on the master node.
  22       include 'DIMENSIONS'
  23       include 'DIMENSIONS.ZSCOPT'
  24       integer nf,nfold
  25       save nfold
  26       logical ovrtim
  27 #ifdef MPI
  28       include 'mpif.h'
  29       include 'COMMON.MPI'
  30 #endif
  31       include 'COMMON.IOUNITS'
  32       include 'COMMON.TIME1'
  33 c      write (iout,*) "NF",nf," NFOLD",nfold," LLOCAL",llocal
  34       if (llocal) then
  35         stopx=.false.
  36         return
  37       endif
  38       cutoffeval=.false.
  39       if (nf.eq.1) nfold=1
  40       if (ovrtim()) then
  41 C Finish if time is up.
  42          stopx = .true.
  43          WhatsUp=1
  44 c         write (iout,*) "In STOPX (OVRTIM): TRUE"
  45       else if (cutoffviol) then
  46         stopx = .true.
  47         WhatsUp=2
  48 c        write (iout,*) "In STOPX (CUTOFFVIOL): TRUE"
  49       else
  50         stopx = .false.
  51 c        write (iout,*) "In STOPX: FALSE"
  52 c        write (iout,*) "NF=",nf," NFOLD=",NFOLD," NDELTA=",ndelta
  53 c        stopx=.false.
  54 c        if (nf-nfold.ge.ndelta) then
  55 c          nfold=nf
  56 c          cutoffeval=.true.
  57 c        endif
  58 c        write (iout,*) "CUFOFFEVAL",cutoffeval
  59       endif
  60       return
  61       end
  62 C--------------------------------------------------------------------------
  63       logical function ovrtim()
  64       implicit none
  65       include 'COMMON.TIME1'
  66       real*8 tcpu,curtim
  67       curtim= tcpu()
  68 c      print *,'curtim=',curtim,' timlim=',timlim
  69 C  curtim is the current time in seconds.
  70 c      ovrtim=(curtim .ge. timlim - safety )
  71 c ovrtim does not work sometimes and crashes the program !  CHUUUJ !
  72 c setting always to false
  73       ovrtim=.false.
  74       return
  75       end
  76 **************************************************************************
  77       double precision function tcpu()
  78       implicit none
  79       include 'COMMON.TIME1'
  80 #ifdef ES9000
  81 ****************************
  82 C Next definition for EAGLE (ibm-es9000)
  83       real*8 micseconds
  84       integer rcode
  85       tcpu=cputime(micseconds,rcode)
  86       tcpu=(micseconds/1.0E6) - stime
  87 ****************************
  88 #endif
  89 #ifdef SUN
  90 ****************************
  91 C Next definitions for sun
  92       REAL*8  ECPU,ETIME,ETCPU
  93       dimension tarray(2)
  94       tcpu=etime(tarray)
  95       tcpu=tarray(1)
  96 ****************************
  97 #endif
  98 #ifdef KSR
  99 ****************************
 100 C Next definitions for ksr
 101 C this function uses the ksr timer ALL_SECONDS from the PMON library to
 102 C return the elapsed time in seconds
 103       tcpu= all_seconds() - stime
 104 ****************************
 105 #endif
 106 #ifdef SGI
 107 ****************************
 108 C Next definitions for sgi
 109       real timar(2), etime, seconds
 110       seconds = etime(timar)
 111 Cd    print *,'seconds=',seconds,' stime=',stime
 112 C      usrsec = timar(1)
 113 C      syssec = timar(2)
 114       tcpu=seconds - stime
 115 ****************************
 116 #endif
 117
 118 #ifdef LINUX
 119 ****************************
 120 C Next definitions for sgi
 121       real timar(2), etime, seconds
 122       seconds = etime(timar)
 123 Cd    print *,'seconds=',seconds,' stime=',stime
 124 C      usrsec = timar(1)
 125 C      syssec = timar(2)
 126       tcpu=seconds - stime
 127 ****************************
 128 #endif
 129
 130
 131 #ifdef CRAY
 132 ****************************
 133 C Next definitions for Cray
 134 C     call date(curdat)
 135 C     curdat=curdat(1:9)
 136 C     call clock(curtim)
 137 C     curtim=curtim(1:8)
 138       cpusec = second()
 139       tcpu=cpusec - stime
 140 ****************************
 141 #endif
 142 #ifdef AIX
 143 ****************************
 144 C Next definitions for RS6000
 145        integer*4 i1,mclock
 146        i1 = mclock()
 147        tcpu = (i1+0.0D0)/100.0D0
 148 #endif
 149 #ifdef WIN
 150 ****************************
 151 c next definitions for windows NT Digital fortran
 152        real time_real
 153        call cpu_time(time_real)
 154        tcpu = time_real
 155 #endif
 156
 157       return
 158       end
 159 C---------------------------------------------------------------------------
 160       subroutine dajczas(rntime,hrtime,mintime,sectime)
 161       include 'DIMENSIONS.ZSCOPT'
 162       include 'COMMON.IOUNITS'
 163       real*8 rntime,hrtime,mintime,sectime
 164       hrtime=rntime/3600.0D0
 165       hrtime=aint(hrtime)
 166       mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
 167       sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
 168       if (sectime.eq.60.0D0) then
 169         sectime=0.0D0
 170         mintime=mintime+1.0D0
 171       endif
 172       ihr=hrtime
 173       imn=mintime
 174       isc=sectime
 175       write (iout,328) ihr,imn,isc
 176   328 FORMAT(//'***** Computation time: ',I4  ,' hours ',I2  ,
 177      1         ' minutes ', I2  ,' seconds *****')
 178       return
 179       end