+++ /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'
- 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'
-c 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