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() 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