1 C $Date: 1994/10/05 16:41:52 $
10 include 'COMMON.TIME1'
14 C Diminish the assigned time limit a little so that there is some time to
17 C Calculate the initial time, if it is not zero (e.g. for the SUN).
27 time_scatter_fmat=0.0d0
28 time_scatter_ginv=0.0d0
29 time_scatter_fmatmult=0.0d0
30 time_scatter_ginvmult=0.0d0
36 time_sumgradient=0.0d0
37 time_intcartderiv=0.0d0
40 time_fricmatmult=0.0d0
50 time_fricmatmult=0.0d0
53 cd print *,' in SET_TIMERS stime=',stime
56 C------------------------------------------------------------------------------
57 logical function stopx(nf)
58 C This function returns .true. if one of the following reasons to exit SUMSL
59 C occurs. The "reason" code is stored in WHATSUP passed thru a COMMON block:
61 C... WHATSUP = 0 - go on, no reason to stop. Stopx will return .false.
62 C... 1 - Time up in current node;
63 C... 2 - STOP signal was received from another node because the
64 C... node's task was accomplished (parallel only);
65 C... -1 - STOP signal was received from another node because of error;
66 C... -2 - STOP signal was received from another node, because
67 C... the node's time was up.
68 implicit real*8 (a-h,o-z)
76 include 'COMMON.IOUNITS'
77 include 'COMMON.TIME1'
80 cd print *,'Processor',MyID,' NF=',nf
83 C Finish if time is up.
87 else if (mod(nf,100).eq.0) then
88 C Other processors might have finished. Check this every 100th function
90 C Master checks if any other processor has sent accepted conformation(s) to it.
91 if (MyID.ne.MasterID) call receive_mcm_info
92 if (MyID.eq.MasterID) call receive_conf
93 cd print *,'Processor ',MyID,' is checking STOP: nf=',nf
94 call recv_stop_sig(Kwita)
96 write (iout,'(a,i4,a,i5)') 'Processor',
97 & MyID,' has received STOP signal in STOPX; NF=',nf
98 write (*,'(a,i4,a,i5)') 'Processor',
99 & MyID,' has received STOP signal in STOPX; NF=',nf
102 elseif (Kwita.eq.-2) then
104 & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
106 & 'Processor',MyID,' received TIMEUP-STOP signal in SUMSL.'
109 else if (Kwita.eq.-3) then
111 & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
113 & 'Processor',MyID,' received ERROR-STOP signal in SUMSL.'
130 c Check for FOUND_NAN flag
132 write(iout,*)" *** stopx : Found a NaN"
139 C--------------------------------------------------------------------------
140 logical function ovrtim()
142 include 'COMMON.IOUNITS'
143 include 'COMMON.TIME1'
144 include 'COMMON.SETUP'
145 include 'COMMON.CONTROL'
149 curtim = MPI_Wtime()-walltime
153 C curtim is the current time in seconds.
154 c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety
155 if (curtim .ge. timlim - safety) then
156 if (me.eq.king .or. .not. out1file)
157 & write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)')
158 & "***************** Elapsed time (",curtim,
159 & " s) is within the safety limit (",safety,
160 & " s) of the allocated time (",timlim," s). Terminating."
167 **************************************************************************
168 double precision function tcpu()
169 include 'COMMON.TIME1'
171 ****************************
172 C Next definition for EAGLE (ibm-es9000)
175 tcpu=cputime(micseconds,rcode)
176 tcpu=(micseconds/1.0E6) - stime
177 ****************************
180 ****************************
181 C Next definitions for sun
182 REAL*8 ECPU,ETIME,ETCPU
186 ****************************
189 ****************************
190 C Next definitions for ksr
191 C this function uses the ksr timer ALL_SECONDS from the PMON library to
192 C return the elapsed time in seconds
193 tcpu= all_seconds() - stime
194 ****************************
197 ****************************
198 C Next definitions for sgi
200 seconds = etime(timar)
201 Cd print *,'seconds=',seconds,' stime=',stime
205 ****************************
209 c****************************
210 cC Next definitions for sgi
211 c real timar(2), etime
212 c seconds = etime(timar)
213 Cd print *,'seconds=',seconds,' stime=',stime
216 c tcpu=seconds - stime
217 c****************************
222 ****************************
223 C Next definitions for Cray
230 ****************************
233 ****************************
234 C Next definitions for RS6000
235 c integer*4 i1,mclock
237 tcpu = (i1+0.0D0)/100.0D0
240 ****************************
241 c next definitions for windows NT Digital fortran
243 call cpu_time(time_real)
247 ****************************
248 c next definitions for windows NT Digital fortran
250 call cpu_time(time_real)
256 C---------------------------------------------------------------------------
257 subroutine dajczas(rntime,hrtime,mintime,sectime)
258 include 'COMMON.IOUNITS'
259 real*8 rntime,hrtime,mintime,sectime
260 hrtime=rntime/3600.0D0
262 mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
263 sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
264 if (sectime.eq.60.0D0) then
266 mintime=mintime+1.0D0
271 write (iout,328) ihr,imn,isc
272 328 FORMAT(//'***** Computation time: ',I4 ,' hours ',I2 ,
273 1 ' minutes ', I2 ,' seconds *****')
276 C---------------------------------------------------------------------------
277 subroutine print_detailed_timing
278 implicit real*8 (a-h,o-z)
283 include 'COMMON.IOUNITS'
284 include 'COMMON.TIME1'
285 include 'COMMON.SETUP'
288 write (iout,'(80(1h=)/a/(80(1h=)))')
289 & "Details of FG communication time"
290 write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))')
291 & "BROADCAST:",time_bcast,"REDUCE:",time_reduce,
292 & "GATHER:",time_gather,
293 & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv,
294 & "BARRIER ene",time_barrier_e,
295 & "BARRIER grad",time_barrier_g,
297 & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv
298 write (*,*) fg_rank,myrank,
299 & ': Total wall clock time',time1-walltime,' sec'
300 write (*,*) "Processor",fg_rank,myrank,
301 & ": BROADCAST time",time_bcast," REDUCE time",
302 & time_reduce," GATHER time",time_gather," SCATTER time",
304 & " SCATTER fmatmult",time_scatter_fmatmult,
305 & " SCATTER ginvmult",time_scatter_ginvmult,
306 & " SCATTER fmat",time_scatter_fmat,
307 & " SCATTER ginv",time_scatter_ginv,
308 & " SENDRECV",time_sendrecv,
309 & " BARRIER ene",time_barrier_e,
310 & " BARRIER GRAD",time_barrier_g,
311 & " BCAST7",time_bcast7," BCASTC",time_bcastc,
312 & " BCASTW",time_bcastw," ALLREDUCE",time_allreduce,
314 & time_bcast+time_reduce+time_gather+time_scatter+
315 & time_sendrecv+time_barrier+time_bcastc
319 write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc
320 write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene
321 write (*,*) "Processor",fg_rank,myrank," intfromcart",
323 write (*,*) "Processor",fg_rank,myrank," vecandderiv",
325 write (*,*) "Processor",fg_rank,myrank," setmatrices",
327 write (*,*) "Processor",fg_rank,myrank," ginvmult",
329 write (*,*) "Processor",fg_rank,myrank," fricmatmult",
331 write (*,*) "Processor",fg_rank,myrank," inttocart",
333 write (*,*) "Processor",fg_rank,myrank," sumgradient",
335 write (*,*) "Processor",fg_rank,myrank," intcartderiv",
337 if (fg_rank.eq.0) then
338 write (*,*) "Processor",fg_rank,myrank," lagrangian",
340 write (*,*) "Processor",fg_rank,myrank," cartgrad",