source/cluster/wham/src-HCD-5D/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       double precision tcpu    ! function
   9       include 'COMMON.TIME1'
  10 C Diminish the assigned time limit a little so that there is some time to
  11 C end a batch job
  12 c     timlim=batime-150.0
  13 C Calculate the initial time, if it is not zero (e.g. for the SUN).
  14       stime=tcpu()
  15       return
  16       end
  17       logical function stopx(nf)
  18 C
  19 C     ..................................................................
  20 C
  21 C     *****PURPOSE...
  22 C     THIS FUNCTION MAY SERVE AS THE STOPX (ASYNCHRONOUS INTERRUPTION)
  23 C     FUNCTION FOR THE NL2SOL (NONLINEAR LEAST-SQUARES) PACKAGE AT
  24 C     THOSE INSTALLATIONS WHICH DO NOT WISH TO IMPLEMENT A
  25 C     DYNAMIC STOPX.
  26 C
  27 C     *****ALGORITHM NOTES...
  28 C     AT INSTALLATIONS WHERE THE NL2SOL SYSTEM IS USED
  29 C     INTERACTIVELY, THIS DUMMY STOPX SHOULD BE REPLACED BY A
  30 C     FUNCTION THAT RETURNS .TRUE. IF AND ONLY IF THE INTERRUPT
  31 C     (BREAK) KEY HAS BEEN PRESSED SINCE THE LAST CALL ON STOPX.
  32 C
  33 C     $$$ MODIFIED FOR USE AS  THE TIMER ROUTINE.
  34 C     $$$                              WHEN THE TIME LIMIT HAS BEEN
  35 C     $$$ REACHED     STOPX IS SET TO .TRUE  AND INITIATES (IN ITSUM)
  36 C     $$$ AND ORDERLY EXIT OUT OF SUMSL.  IF ARRAYS IV AND V ARE
  37 C     $$$ SAVED, THE SUMSL ROUTINES CAN BE RESTARTED AT THE SAME
  38 C     $$$ POINT AT WHICH THEY WERE INTERRUPTED.
  39 C
  40 C     ..................................................................
  41 C
  42       include 'DIMENSIONS'
  43       integer nf
  44       logical ovrtim
  45       include 'COMMON.IOUNITS'
  46       include 'COMMON.TIME1'
  47 #ifdef MPL
  48       include 'COMMON.INFO'
  49       integer Kwita
  50
  51 cd    print *,'Processor',MyID,' NF=',nf
  52 #endif
  53       if (ovrtim()) then
  54 C Finish if time is up.
  55          stopx = .true.
  56 #ifdef MPL
  57       else if (mod(nf,100).eq.0) then
  58 C Other processors might have finished. Check this every 100th function
  59 C evaluation.
  60 cd       print *,'Processor ',MyID,' is checking STOP: nf=',nf
  61          call recv_stop_sig(Kwita)
  62          if (Kwita.eq.-1) then
  63            write (iout,'(a,i4,a,i5)') 'Processor',
  64      &     MyID,' has received STOP signal in STOPX; NF=',nf
  65            write (*,'(a,i4,a,i5)') 'Processor',
  66      &     MyID,' has received STOP signal in STOPX; NF=',nf
  67            stopx=.true.
  68          else
  69            stopx=.false.
  70          endif
  71 #endif
  72       else
  73          stopx = .false.
  74       endif
  75       return
  76       end
  77 C=========================================================================
  78 C
  79       logical function ovrtim()
  80       double precision tcpu    ! function
  81       include 'COMMON.TIME1'
  82 C Set a 100.0 secs. safety margin, so as to allow for the termination of
  83 C a batch job.
  84 c      double  safety /150.0D0/
  85       curtim= tcpu()
  86 cd    print *,'curtim=',curtim,' timlim=',timlim
  87 C  curtim is the current time in seconds.
  88       ovrtim=(curtim .ge. timlim - safety )
  89       return
  90       end
  91 C=========================================================================
  92 C
  93       double precision function tcpu()
  94       include 'COMMON.TIME1'
  95 #ifdef ES9000
  96 ****************************
  97 C Next definition for EAGLE (ibm-es9000)
  98       real*8 micseconds
  99       integer rcode
 100       tcpu=cputime(micseconds,rcode)
 101       tcpu=(micseconds/1.0E6) - stime
 102 ****************************
 103 #endif
 104 #ifdef SUN
 105 ****************************
 106 C Next definitions for sun
 107       integer seconds
 108       call clock(seconds)
 109       tcpu=seconds - stime
 110 ****************************
 111 #endif
 112 #ifdef KSR
 113 ****************************
 114 C Next definitions for ksr
 115 C this function uses the ksr timer ALL_SECONDS from the PMON library to
 116 C return the elapsed time in seconds
 117       tcpu= all_seconds() - stime
 118 ****************************
 119 #endif
 120 #ifdef SGI
 121 ****************************
 122 C Next definitions for sgi
 123       real timar(2), etime
 124       seconds = etime(timar)
 125 C      usrsec = timar(1)
 126 C      syssec = timar(2)
 127       tcpu=seconds - stime
 128 ****************************
 129 #endif
 130 #ifdef CRAY
 131 ****************************
 132 C Next definitions for Cray
 133 C     call date(curdat)
 134 C     curdat=curdat(1:9)
 135 C     call clock(curtim)
 136 C     curtim=curtim(1:8)
 137       cpusec = second()
 138       tcpu=cpusec - stime
 139 ****************************
 140 #endif
 141 #ifdef AIX
 142 ****************************
 143 C Next definitions for RS6000
 144        integer*4 i1,mclock
 145        i1 = mclock()
 146        tcpu = (i1+0.0D0)/100.0D0
 147 #endif
 148 #ifdef LINUX
 149 ****************************
 150 C Next definitions for sgi
 151       real timar(2), etime
 152       seconds = etime(timar)
 153 Cd    print *,'seconds=',seconds,' stime=',stime
 154 C      usrsec = timar(1)
 155 C      syssec = timar(2)
 156       tcpu=seconds - stime
 157 ****************************
 158 #endif
 159       return
 160       end
 161 *
 162       subroutine dajczas(rntime,hrtime,mintime,sectime)
 163       include 'COMMON.IOUNITS'
 164       real*8 rntime,hrtime,mintime,sectime
 165       hrtime=rntime/3600.0D0
 166       hrtime=aint(hrtime)
 167       mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
 168       sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
 169       if (sectime.eq.60.0D0) then
 170         sectime=0.0D0
 171         mintime=mintime+1.0D0
 172       endif
 173       ihr=hrtime
 174       imn=mintime
 175       isc=sectime
 176       write (iout,328) ihr,imn,isc
 177   328 FORMAT(//'***** Computation time: ',I4  ,' hours ',I2  ,
 178      1         ' minutes ', I2  ,' seconds *****')
 179       return
 180       end