--- /dev/null
+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'
+ 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
+ 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'
+ 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
+ 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
projects / unres.git / blobdiff