C $Date: 1994/10/05 16:41:52 $
C $Revision: 2.2 $
C
C
C
      subroutine set_timers
c
      implicit none
      double precision tcpu
      include 'COMMON.TIME1'
#ifdef MP
      include 'mpif.h'
#endif
C Diminish the assigned time limit a little so that there is some time to
C end a batch job
c     timlim=batime-150.0
C Calculate the initial time, if it is not zero (e.g. for the SUN).
      stime=tcpu()
#ifdef MPI
      walltime=MPI_WTIME()
      time_reduce=0.0d0
      time_allreduce=0.0d0
      time_bcast=0.0d0
      time_gather=0.0d0
      time_sendrecv=0.0d0
      time_scatter=0.0d0
      time_scatter_fmat=0.0d0
      time_scatter_ginv=0.0d0
      time_scatter_fmatmult=0.0d0
      time_scatter_ginvmult=0.0d0
      time_barrier_e=0.0d0
      time_barrier_g=0.0d0
      time_enecalc=0.0d0
      time_sumene=0.0d0
      time_lagrangian=0.0d0
      time_sumgradient=0.0d0
      time_intcartderiv=0.0d0
      time_inttocart=0.0d0
      time_ginvmult=0.0d0
      time_fricmatmult=0.0d0
      time_cartgrad=0.0d0
      time_bcastc=0.0d0
      time_bcast7=0.0d0
      time_bcastw=0.0d0
      time_intfcart=0.0d0
      time_vec=0.0d0
      time_mat=0.0d0
      time_fric=0.0d0
      time_stoch=0.0d0
      time_fricmatmult=0.0d0
      time_fsample=0.0d0
#endif
cd    print *,' in SET_TIMERS stime=',stime
      return 
      end
C------------------------------------------------------------------------------
      logical function stopx(nf)
C This function returns .true. if one of the following reasons to exit SUMSL
C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block:
C
C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false.
C...           1 - Time up in current node;
C...           2 - STOP signal was received from another node because the
C...               node's task was accomplished (parallel only);
C...          -1 - STOP signal was received from another node because of error;
C...          -2 - STOP signal was received from another node, because 
C...               the node's time was up.
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      integer nf
      logical ovrtim
#ifdef MP
      include 'mpif.h'
      include 'COMMON.INFO'
#endif
      include 'COMMON.IOUNITS'
      include 'COMMON.TIME1'
      integer Kwita

cd    print *,'Processor',MyID,' NF=',nf
#ifndef MPI
      if (ovrtim()) then
C Finish if time is up.
         stopx = .true.
         WhatsUp=1
#ifdef MPL
      else if (mod(nf,100).eq.0) then
C Other processors might have finished. Check this every 100th function 
C evaluation.
C Master checks if any other processor has sent accepted conformation(s) to it. 
         if (MyID.ne.MasterID) call receive_mcm_info
         if (MyID.eq.MasterID) call receive_conf
cd       print *,'Processor ',MyID,' is checking STOP: nf=',nf
         call recv_stop_sig(Kwita)
         if (Kwita.eq.-1) then
           write (iout,'(a,i4,a,i5)') 'Processor',
     &     MyID,' has received STOP signal in STOPX; NF=',nf
           write (*,'(a,i4,a,i5)') 'Processor',
     &     MyID,' has received STOP signal in STOPX; NF=',nf
           stopx=.true.
           WhatsUp=2
         elseif (Kwita.eq.-2) then
           write (iout,*)
     &    'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
           write (*,*)
     &    'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
           WhatsUp=-2
           stopx=.true.  
         else if (Kwita.eq.-3) then
           write (iout,*)
     &    'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
           write (*,*)
     &    'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
           WhatsUp=-1
           stopx=.true.
         else
           stopx=.false.
           WhatsUp=0
         endif
#endif
      else
         stopx = .false.
         WhatsUp=0
      endif
#else
      stopx=.false.
#endif

#ifdef OSF
c Check for FOUND_NAN flag
      if (FOUND_NAN) then
        write(iout,*)"   ***   stopx : Found a NaN"
        stopx=.true.
      endif
#endif

      return
      end
C--------------------------------------------------------------------------
      logical function ovrtim() 
      include 'DIMENSIONS'
      include 'COMMON.IOUNITS'
      include 'COMMON.TIME1'
      include 'COMMON.SETUP'
      include 'COMMON.CONTROL'
      real*8 tcpu
#ifdef MPI
      include "mpif.h"
      curtim = MPI_Wtime()-walltime
#else
      curtim= tcpu()
#endif
C  curtim is the current time in seconds.
c      write (iout,*) "curtim",curtim," timlim",timlim," safety",safety
      if (curtim .ge. timlim - safety) then
       if (me.eq.king .or. .not. out1file)
     &   write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)') 
     &  "***************** Elapsed time (",curtim,
     &  " s) is within the safety limit (",safety,
     &  " s) of the allocated time (",timlim," s). Terminating."
        ovrtim=.true.
      else
        ovrtim=.false.
      endif
      return                                               
      end
**************************************************************************      
      double precision function tcpu()
      include 'COMMON.TIME1'
#ifdef ES9000 
****************************
C Next definition for EAGLE (ibm-es9000)
      real*8 micseconds
      integer rcode
      tcpu=cputime(micseconds,rcode)
      tcpu=(micseconds/1.0E6) - stime
****************************
#endif
#ifdef SUN
****************************
C Next definitions for sun
      REAL*8  ECPU,ETIME,ETCPU
      dimension tarray(2)
      tcpu=etime(tarray)
      tcpu=tarray(1)
****************************
#endif
#ifdef KSR
****************************
C Next definitions for ksr
C this function uses the ksr timer ALL_SECONDS from the PMON library to
C return the elapsed time in seconds
      tcpu= all_seconds() - stime
****************************
#endif
#ifdef SGI
****************************
C Next definitions for sgi
      real timar(2), etime
      seconds = etime(timar)
Cd    print *,'seconds=',seconds,' stime=',stime
C      usrsec = timar(1)
C      syssec = timar(2)
      tcpu=seconds - stime
****************************
#endif

#ifdef LINUX
****************************
C Next definitions for sgi
      real timar(2), etime
      seconds = etime(timar)
Cd    print *,'seconds=',seconds,' stime=',stime
C      usrsec = timar(1)
C      syssec = timar(2)
      tcpu=seconds - stime
****************************
#endif


#ifdef CRAY
****************************
C Next definitions for Cray
C     call date(curdat)
C     curdat=curdat(1:9)
C     call clock(curtim)
C     curtim=curtim(1:8)
      cpusec = second()
      tcpu=cpusec - stime
****************************
#endif
#ifdef AIX
****************************
C Next definitions for RS6000
       integer*4 i1,mclock
       i1 = mclock()
       tcpu = (i1+0.0D0)/100.0D0
#endif
#ifdef WINPGI
****************************
c next definitions for windows NT Digital fortran
       real time_real
       call cpu_time(time_real)
       tcpu = time_real
#endif
#ifdef WINIFL
****************************
c next definitions for windows NT Digital fortran
       real time_real
       call cpu_time(time_real)
       tcpu = time_real
#endif

      return     
      end  
C---------------------------------------------------------------------------
      subroutine dajczas(rntime,hrtime,mintime,sectime)
      include 'COMMON.IOUNITS'
      real*8 rntime,hrtime,mintime,sectime 
      hrtime=rntime/3600.0D0 
      hrtime=aint(hrtime)
      mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
      sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
      if (sectime.eq.60.0D0) then
        sectime=0.0D0
        mintime=mintime+1.0D0
      endif
      ihr=hrtime
      imn=mintime
      isc=sectime
      write (iout,328) ihr,imn,isc
  328 FORMAT(//'***** Computation time: ',I4  ,' hours ',I2  ,
     1         ' minutes ', I2  ,' seconds *****')       
      return
      end
C---------------------------------------------------------------------------
      subroutine print_detailed_timing
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
#ifdef MPI
      include 'mpif.h'
#endif
      include 'COMMON.IOUNITS'
      include 'COMMON.TIME1'
      include 'COMMON.SETUP'
#ifdef MPI
      time1=MPI_WTIME()
         write (iout,'(80(1h=)/a/(80(1h=)))') 
     &    "Details of FG communication time"
         write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))') 
     &    "BROADCAST:",time_bcast,"REDUCE:",time_reduce,
     &    "GATHER:",time_gather,
     &    "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv,
     &    "BARRIER ene",time_barrier_e,
     &    "BARRIER grad",time_barrier_g,
     &    "TOTAL:",
     &    time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv
         write (*,*) fg_rank,myrank,
     &     ': Total wall clock time',time1-walltime,' sec'
         write (*,*) "Processor",fg_rank,myrank,
     &     ": BROADCAST time",time_bcast," REDUCE time",
     &      time_reduce," GATHER time",time_gather," SCATTER time",
     &      time_scatter,
     &     " SCATTER fmatmult",time_scatter_fmatmult,
     &     " SCATTER ginvmult",time_scatter_ginvmult,
     &     " SCATTER fmat",time_scatter_fmat,
     &     " SCATTER ginv",time_scatter_ginv,
     &      " SENDRECV",time_sendrecv,
     &      " BARRIER ene",time_barrier_e,
     &      " BARRIER GRAD",time_barrier_g,
     &      " BCAST7",time_bcast7," BCASTC",time_bcastc,
     &      " BCASTW",time_bcastw," ALLREDUCE",time_allreduce,
     &      " TOTAL",
     &      time_bcast+time_reduce+time_gather+time_scatter+
     &      time_sendrecv+time_barrier+time_bcastc
#else
      time1=tcpu()
#endif
         write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc
         write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene
         write (*,*) "Processor",fg_rank,myrank," intfromcart",
     &     time_intfcart
         write (*,*) "Processor",fg_rank,myrank," vecandderiv",
     &     time_vec
         write (*,*) "Processor",fg_rank,myrank," setmatrices",
     &     time_mat
         write (*,*) "Processor",fg_rank,myrank," ginvmult",
     &     time_ginvmult
         write (*,*) "Processor",fg_rank,myrank," fricmatmult",
     &     time_fricmatmult
         write (*,*) "Processor",fg_rank,myrank," inttocart",
     &     time_inttocart
         write (*,*) "Processor",fg_rank,myrank," sumgradient",
     &     time_sumgradient
         write (*,*) "Processor",fg_rank,myrank," intcartderiv",
     &     time_intcartderiv
         if (fg_rank.eq.0) then
           write (*,*) "Processor",fg_rank,myrank," lagrangian",
     &       time_lagrangian
           write (*,*) "Processor",fg_rank,myrank," cartgrad",
     &       time_cartgrad
         endif
      return
      end