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
end
C------------------------------------------------------------------------------
logical function stopx(nf)
-C This function returns .true. in case of time up on the master node.
- implicit none
+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'
- include 'DIMENSIONS.ZSCOPT'
integer nf
logical ovrtim
-#ifdef MPI
+#ifdef MP
include 'mpif.h'
- include 'COMMON.MPI'
+ 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
- else if (cutoffviol) then
- stopx = .true.
- WhatsUp=2
+#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.
+ 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()
- implicit none
+ include 'DIMENSIONS'
+ include 'COMMON.IOUNITS'
include 'COMMON.TIME1'
- real*8 tcpu,curtim
+ real*8 tcpu
+#ifdef MPI
+ include "mpif.h"
+ curtim = MPI_Wtime()-walltime
+#else
curtim= tcpu()
-c print *,'curtim=',curtim,' timlim=',timlim
+#endif
C curtim is the current time in seconds.
-c ovrtim=(curtim .ge. timlim - safety )
-c ovrtim does not work sometimes and crashes the program ! CHUUUJ !
-c setting always to false
- ovrtim=.false.
+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()
- implicit none
include 'COMMON.TIME1'
#ifdef ES9000
****************************
#ifdef SGI
****************************
C Next definitions for sgi
- real timar(2), etime, seconds
+ real timar(2), etime
seconds = etime(timar)
Cd print *,'seconds=',seconds,' stime=',stime
C usrsec = timar(1)
#ifdef LINUX
****************************
C Next definitions for sgi
- real timar(2), etime, seconds
+ real timar(2), etime
seconds = etime(timar)
Cd print *,'seconds=',seconds,' stime=',stime
C usrsec = timar(1)
i1 = mclock()
tcpu = (i1+0.0D0)/100.0D0
#endif
-#ifdef WIN
+#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
end
C---------------------------------------------------------------------------
subroutine dajczas(rntime,hrtime,mintime,sectime)
- implicit none
include 'COMMON.IOUNITS'
- integer ihr,imn,isc
real*8 rntime,hrtime,mintime,sectime
hrtime=rntime/3600.0D0
hrtime=aint(hrtime)
projects / unres.git / blobdiff