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'
147 curtim = MPI_Wtime()-walltime
151 C curtim is the current time in seconds.
152 c write (iout,*) "curtim",curtim," timlim",timlim," safety",safety
153 if (curtim .ge. timlim - safety) then
154 write (iout,'(a,f10.2,a,f10.2,a,f10.2,a)')
155 & "***************** Elapsed time (",curtim,
156 & " s) is within the safety limit (",safety,
157 & " s) of the allocated time (",timlim," s). Terminating."
164 **************************************************************************
165 double precision function tcpu()
166 include 'COMMON.TIME1'
168 ****************************
169 C Next definition for EAGLE (ibm-es9000)
172 tcpu=cputime(micseconds,rcode)
173 tcpu=(micseconds/1.0E6) - stime
174 ****************************
177 ****************************
178 C Next definitions for sun
179 REAL*8 ECPU,ETIME,ETCPU
183 ****************************
186 ****************************
187 C Next definitions for ksr
188 C this function uses the ksr timer ALL_SECONDS from the PMON library to
189 C return the elapsed time in seconds
190 tcpu= all_seconds() - stime
191 ****************************
194 ****************************
195 C Next definitions for sgi
197 seconds = etime(timar)
198 Cd print *,'seconds=',seconds,' stime=',stime
202 ****************************
206 ****************************
207 C Next definitions for sgi
209 seconds = etime(timar)
210 Cd print *,'seconds=',seconds,' stime=',stime
214 ****************************
219 ****************************
220 C Next definitions for Cray
227 ****************************
230 ****************************
231 C Next definitions for RS6000
234 tcpu = (i1+0.0D0)/100.0D0
237 ****************************
238 c next definitions for windows NT Digital fortran
240 call cpu_time(time_real)
244 ****************************
245 c next definitions for windows NT Digital fortran
247 call cpu_time(time_real)
253 C---------------------------------------------------------------------------
254 subroutine dajczas(rntime,hrtime,mintime,sectime)
255 include 'COMMON.IOUNITS'
256 real*8 rntime,hrtime,mintime,sectime
257 hrtime=rntime/3600.0D0
259 mintime=aint((rntime-3600.0D0*hrtime)/60.0D0)
260 sectime=aint((rntime-3600.0D0*hrtime-60.0D0*mintime)+0.5D0)
261 if (sectime.eq.60.0D0) then
263 mintime=mintime+1.0D0
268 write (iout,328) ihr,imn,isc
269 328 FORMAT(//'***** Computation time: ',I4 ,' hours ',I2 ,
270 1 ' minutes ', I2 ,' seconds *****')
273 C---------------------------------------------------------------------------
274 subroutine print_detailed_timing
275 implicit real*8 (a-h,o-z)
280 include 'COMMON.IOUNITS'
281 include 'COMMON.TIME1'
282 include 'COMMON.SETUP'
285 write (iout,'(80(1h=)/a/(80(1h=)))')
286 & "Details of FG communication time"
287 write (*,'(7(a40,1pe15.5/),40(1h-)/a40,1pe15.5/80(1h=))')
288 & "BROADCAST:",time_bcast,"REDUCE:",time_reduce,
289 & "GATHER:",time_gather,
290 & "SCATTER:",time_scatter,"SENDRECV:",time_sendrecv,
291 & "BARRIER ene",time_barrier_e,
292 & "BARRIER grad",time_barrier_g,
294 & time_bcast+time_reduce+time_gather+time_scatter+time_sendrecv
295 write (*,*) fg_rank,myrank,
296 & ': Total wall clock time',time1-walltime,' sec'
297 write (*,*) "Processor",fg_rank,myrank,
298 & ": BROADCAST time",time_bcast," REDUCE time",
299 & time_reduce," GATHER time",time_gather," SCATTER time",
301 & " SCATTER fmatmult",time_scatter_fmatmult,
302 & " SCATTER ginvmult",time_scatter_ginvmult,
303 & " SCATTER fmat",time_scatter_fmat,
304 & " SCATTER ginv",time_scatter_ginv,
305 & " SENDRECV",time_sendrecv,
306 & " BARRIER ene",time_barrier_e,
307 & " BARRIER GRAD",time_barrier_g,
308 & " BCAST7",time_bcast7," BCASTC",time_bcastc,
309 & " BCASTW",time_bcastw," ALLREDUCE",time_allreduce,
311 & time_bcast+time_reduce+time_gather+time_scatter+
312 & time_sendrecv+time_barrier+time_bcastc
313 write (*,*) "Processor",fg_rank,myrank," enecalc",time_enecalc
314 write (*,*) "Processor",fg_rank,myrank," sumene",time_sumene
315 write (*,*) "Processor",fg_rank,myrank," intfromcart",
317 write (*,*) "Processor",fg_rank,myrank," vecandderiv",
319 write (*,*) "Processor",fg_rank,myrank," setmatrices",
321 write (*,*) "Processor",fg_rank,myrank," ginvmult",
323 write (*,*) "Processor",fg_rank,myrank," fricmatmult",
325 write (*,*) "Processor",fg_rank,myrank," inttocart",
327 write (*,*) "Processor",fg_rank,myrank," sumgradient",
329 write (*,*) "Processor",fg_rank,myrank," intcartderiv",
331 if (fg_rank.eq.0) then
332 write (*,*) "Processor",fg_rank,myrank," lagrangian",
334 write (*,*) "Processor",fg_rank,myrank," cartgrad",
338 write (*,*) "enecalc",time_enecalc
339 write (*,*) "sumene",time_sumene
340 write (*,*) "intfromcart",time_intfcart
341 write (*,*) "vecandderiv",time_vec
342 write (*,*) "setmatrices",time_mat
343 write (*,*) "ginvmult",time_ginvmult
344 write (*,*) "fricmatmult",time_fricmatmult
345 write (*,*) "inttocart",time_inttocart
346 write (*,*) "sumgradient",time_sumgradient
347 write (*,*) "intcartderiv",time_intcartderiv
348 write (*,*) "lagrangian",time_lagrangian
349 write (*,*) "cartgrad",time_cartgrad