/[MITgcm]/MITgcm/eesupp/src/utils.F
ViewVC logotype

Annotation of /MITgcm/eesupp/src/utils.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.3 - (hide annotations) (download)
Thu May 21 18:30:08 1998 UTC (26 years ago) by cnh
Branch: MAIN
CVS Tags: checkpoint5, checkpoint4, checkpoint6, checkpoint3, checkpoint2
Changes since 1.2: +23 -1 lines 
Added support for binary IO of model fields for restart and/or
postprocessing
1 cnh 1.3 C $Header: /u/gcmpack/models/MITgcmUV/eesupp/src/utils.F,v 1.2 1998/04/23 20:37:31 cnh Exp $
2 cnh 1.1
3     #include "CPP_EEOPTIONS.h"
4    
5     C-- File utils.F: General purpose support routines
6     C-- Contents
7     C-- U DATE - Returns date and time.
8     C-- IFNBLNK - Returns index of first non-blank string character.
9     C-- ILNBLNK - Returns index of last non-blank string character.
10 cnh 1.3 C-- IO_ERRCOUNT - Reads IO error counter.
11 cnh 1.1 C-- LCASE - Translates to lower case.
12     C--UM MACHINE - Returns character string identifying computer.
13     C-- TIMER_INDEX - Returns index associated with timer name.
14     C-- M TIMER_CONTROL - Implements timer functions for given machine.
15     C-- TIMER_PRINT - Print CPU timer statitics.
16     C-- TIMER_PRINTALL - Prints all CPU timers statistics.
17     C-- TIMER_START - Starts CPU timer for code section.
18     C-- TIMER_STOP - Stop CPU tier for code section.
19     C-- UCASE - Translates to upper case.
20     C-- Routines marked "M" contain specific machine dependent code.
21     C-- Routines marked "U" contain UNIX OS calls.
22    
23     CStartOfInterface
24     SUBROUTINE DATE ( string , myThreadId )
25     C /==========================================================\
26     C | SUBROUTINE DATE |
27     C | o Return current date |
28     C \==========================================================/
29     #include "SIZE.h"
30     #include "EEPARAMS.h"
31     C
32     CHARACTER*(*) string
33     INTEGER myThreadId
34     CEndOfInterface
35     C
36     INTEGER lDate
37     CHARACTER*(MAX_LEN_MBUF) msgBuffer
38     C
39     lDate = 24
40     IF ( LEN(string) .LT. lDate ) GOTO 901
41     string = ' '
42     CALL FDATE( string )
43     C
44     1000 CONTINUE
45     RETURN
46     901 CONTINUE
47     WRITE(msgBuffer,'(A)')
48     &' '
49     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
50     WRITE(msgBuffer,'(A)')
51     &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
52     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
53     WRITE(msgBuffer,'(A)')
54     &'procedure: "DATE".'
55     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
56     WRITE(msgBuffer,'(A)')
57     &'Variable passed to S/R DATE is too small.'
58     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
59     WRITE(msgBuffer,'(A)')
60     &' Argument must be at least',lDate,'characters long.'
61     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
62     WRITE(msgBuffer,'(A)')
63     &'*******************************************************'
64     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
65     GOTO 1000
66     END
67    
68     CStartOfInterface
69     INTEGER FUNCTION IFNBLNK( string )
70     C /==========================================================\
71     C | FUNCTION IFNBLNK |
72     C | o Find first non-blank in character string. |
73     C \==========================================================/
74     C
75     CHARACTER*(*) string
76     CEndOfInterface
77     C
78     INTEGER L, LS
79     C
80     LS = LEN(string)
81     IFNBLNK = 0
82     DO 10 L = 1, LS
83     IF ( string(L:L) .EQ. ' ' ) GOTO 10
84     IFNBLNK = L
85     GOTO 11
86     10 CONTINUE
87     11 CONTINUE
88     C
89     RETURN
90     END
91    
92     CStartOfInterface
93     INTEGER FUNCTION ILNBLNK( string )
94     C /==========================================================\
95     C | FUNCTION ILNBLNK |
96     C | o Find last non-blank in character string. |
97     C \==========================================================/
98     CHARACTER*(*) string
99     CEndOfInterface
100     INTEGER L, LS
101     C
102     LS = LEN(string)
103     ILNBLNK = LS
104     DO 10 L = LS, 1, -1
105     IF ( string(L:L) .EQ. ' ' ) GOTO 10
106     ILNBLNK = L
107     GOTO 11
108     10 CONTINUE
109     11 CONTINUE
110     C
111 cnh 1.3 RETURN
112     END
113    
114     CStartofinterface
115     INTEGER FUNCTION IO_ERRCOUNT(myThid)
116     C /==========================================================\
117     C | FUNCTION IO_ERRCOUNT |
118     C | o Reads IO error counter. |
119     C \==========================================================/
120    
121     C == Global variables ==
122     #include "SIZE.h"
123     #include "EEPARAMS.h"
124     #include "DFILE.h"
125    
126     C == Routine arguments ==
127     INTEGER myThid
128     CEndofinterface
129    
130     IO_ERRCOUNT = ioErrorCount(myThid)
131    
132 cnh 1.1 RETURN
133     END
134    
135     CStartOfInterface
136     SUBROUTINE LCASE ( string )
137     C /==========================================================\
138     C | SUBROUTINE LCASE |
139     C | o Convert character string to all lower case. |
140     C \==========================================================/
141     CHARACTER*(*) string
142     CEndOfInterface
143     CHARACTER*26 LOWER
144     DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/
145     SAVE LOWER
146     CHARACTER*26 UPPER
147     DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
148     SAVE UPPER
149     INTEGER I, L
150     C
151     DO 10 I = 1, LEN(string)
152     L = INDEX(UPPER,string(I:I))
153     IF ( L .EQ. 0 ) GOTO 10
154     string(I:I) = LOWER(L:L)
155     10 CONTINUE
156     C
157     RETURN
158     END
159    
160     CStartOfInterface
161     SUBROUTINE MACHINE ( string )
162     C /==========================================================\
163     C | SUBROUTINE MACHINE |
164     C | o Return computer identifier in string. |
165     C \==========================================================/
166     #include "SIZE.h"
167     #include "EEPARAMS.h"
168     CHARACTER*(*) string
169     CEndOfInterface
170     C
171     INTEGER IFNBLNK
172     INTEGER ILNBLNK
173     EXTERNAL IFNBLNK
174     EXTERNAL ILNBLNK
175     C
176     INTEGER iFirst
177     INTEGER iLast
178     INTEGER iEnd
179     INTEGER iFree
180     INTEGER idSize
181     CHARACTER*1024 strTmp
182     CHARACTER*1024 idString
183    
184     strTmp = 'UNKNOWN'
185     iFree = 1
186     idSize = LEN(string)
187     CALL GETENV('USER',strTmp )
188     IF ( strTmp .NE. ' ' ) THEN
189     iFirst = IFNBLNK(strTmp)
190     iLast = ILNBLNK(strTmp)
191     iEnd = iLast-iFirst+1
192     IF (iEnd .GE. 0 ) THEN
193     idString(iFree:) = strTmp(iFirst:iFirst+iEnd)
194     ENDIF
195     iFree = iFree+iEnd+1
196     IF ( iFree .LE. idSize ) THEN
197     idString(iFree:iFree) = '@'
198     iFree = iFree+1
199     ENDIF
200     ENDIF
201     strTmp = 'UNKNOWN'
202     CALL GETENV('HOST',strtmp )
203     IF ( strTmp .NE. ' ' ) THEN
204     iFirst = IFNBLNK(strTmp)
205     iLast = ILNBLNK(strTmp)
206     iEnd = iLast-iFirst+1
207     iEnd = MIN(iEnd,idSize-iFree)
208     iEnd = iEnd-1
209     IF (iEnd .GE. 0 ) THEN
210     idString(iFree:) = strTmp(iFirst:iFirst+iEnd)
211     ENDIF
212     iFree = iFree+iEnd+1
213     ENDIF
214     C
215     string = idString
216     C
217     1000 CONTINUE
218     RETURN
219     END
220    
221     CStartOfInterface
222     INTEGER FUNCTION TIMER_INDEX (
223     I name,timerNames,maxTimers,nTimers )
224     C /==========================================================\
225     C | FUNCTION TIMER_INDEX |
226     C | o Timing support routine. |
227     C |==========================================================|
228     C | Return index in timer data structure of timer named |
229     C | by the function argument "name". |
230     C \==========================================================/
231     INTEGER maxTimers
232     INTEGER nTimers
233     CHARACTER*(*) name
234     CHARACTER*(*) timerNames(maxTimers)
235     CEndOfInterface
236     INTEGER I
237     C
238     TIMER_INDEX = 0
239     IF ( name .EQ. ' ' ) THEN
240     TIMER_INDEX = -1
241     ELSE
242     DO 10 I = 1, nTimers
243     IF ( name .NE. timerNames(I) ) GOTO 10
244     TIMER_INDEX = I
245     GOTO 11
246     10 CONTINUE
247     11 CONTINUE
248     ENDIF
249     RETURN
250     END
251    
252     CStartOfInterface
253     SUBROUTINE TIMER_CONTROL ( name , action , callProc , myThreadId )
254     C /==========================================================\
255     C | SUBROUTINE TIMER_CONTROL |
256     C | o Timing routine. |
257     C |==========================================================|
258     C | User callable interface to timing routines. Timers are |
259     C | created, stopped, started and queried only through this |
260     C | rtouine. |
261     C \==========================================================/
262     #include "SIZE.h"
263     #include "EEPARAMS.h"
264     #include "EESUPPORT.h"
265     CHARACTER*(*) name
266     CHARACTER*(*) action
267     CHARACTER*(*) callProc
268     INTEGER myThreadId
269     CEndOfInterface
270     C
271     INTEGER TIMER_INDEX
272     INTEGER IFNBLNK
273     INTEGER ILNBLNK
274     EXTERNAL TIMER_INDEX
275     EXTERNAL IFNBLNK
276     EXTERNAL ILNBLNK
277     C
278     INTEGER maxTimers
279     INTEGER maxString
280     PARAMETER ( maxTimers = 40 )
281     PARAMETER ( maxString = 80 )
282     C
283     INTEGER timerStarts( maxTimers , MAX_NO_THREADS)
284     SAVE timerStarts
285     INTEGER timerStops ( maxTimers , MAX_NO_THREADS)
286     SAVE timerStops
287     Real*8 timerUser ( maxTimers , MAX_NO_THREADS)
288     SAVE timerUser
289     Real*8 timerWall ( maxTimers , MAX_NO_THREADS)
290     SAVE timerWall
291     Real*8 timerSys ( maxTimers , MAX_NO_THREADS)
292     SAVE timerSys
293     Real*8 timerT0User( maxTimers , MAX_NO_THREADS)
294     SAVE timerT0User
295     Real*8 timerT0Wall( maxTimers , MAX_NO_THREADS)
296     SAVE timerT0Wall
297     Real*8 timerT0Sys ( maxTimers , MAX_NO_THREADS)
298     SAVE timerT0Sys
299     C ===============================================================
300     C
301     INTEGER timerStatus( maxTimers , MAX_NO_THREADS)
302     SAVE timerStatus
303     INTEGER timerNameLen( maxTimers , MAX_NO_THREADS)
304     SAVE timerNameLen
305     CHARACTER*(maxString) timerNames( maxTimers , MAX_NO_THREADS)
306     SAVE timerNames
307     CHARACTER*(maxString) timerAction
308     INTEGER nTimers(MAX_NO_THREADS)
309     CHARACTER*(maxString) tmpName
310     CHARACTER*(maxString) tmpAction
311     INTEGER iTimer
312     INTEGER ISTART
313     INTEGER IEND
314     INTEGER STOPPED
315     PARAMETER ( STOPPED = 0 )
316     INTEGER RUNNING
317     PARAMETER ( RUNNING = 1 )
318     CHARACTER*(*) STOP
319     PARAMETER ( STOP = 'STOP' )
320     CHARACTER*(*) START
321     PARAMETER ( START = 'START' )
322     CHARACTER*(*) PRINT
323     PARAMETER ( PRINT = 'PRINT' )
324     CHARACTER*(*) PRINTALL
325     PARAMETER ( PRINTALL = 'PRINTALL' )
326     INTEGER I
327     Real*8 userTime
328     Real*8 systemTime
329     Real*8 wallClockTime
330     CHARACTER*(MAX_LEN_MBUF) msgBuffer
331     C
332     DATA nTimers /MAX_NO_THREADS*0/
333     SAVE nTimers
334     C
335     ISTART = IFNBLNK(name)
336     IEND = ILNBLNK(name)
337     IF ( IEND - ISTART + 1 .GT. maxString ) GOTO 901
338     IF ( ISTART .NE. 0 ) THEN
339     tmpName = name(ISTART:IEND)
340     CALL UCASE( tmpName )
341     ELSE
342     tmpName = ' '
343     ENDIF
344     ISTART = IFNBLNK(action)
345     IEND = ILNBLNK(action)
346     IF ( ISTART .EQ. 0 ) GOTO 902
347     IF ( IEND - ISTART + 1 .GT. maxString ) GOTO 903
348     tmpAction = action(ISTART:IEND)
349     CALL UCASE( tmpAction )
350     C
351     iTimer=TIMER_INDEX(tmpName,timerNames(myThreadId,1),maxTimers,nTimers(myThreadId))
352     C
353     IF ( tmpAction .EQ. START ) THEN
354     IF ( iTimer .EQ. 0 ) THEN
355     IF ( nTimers(myThreadId) .EQ. maxTimers ) GOTO 904
356     nTimers(myThreadId) = nTimers(myThreadId) + 1
357     iTimer = nTimers(myThreadId)
358     timerNames(iTimer,myThreadId) = tmpName
359     timerNameLen(iTimer,myThreadId) = ILNBLNK(tmpName)-IFNBLNK(tmpName)+1
360     timerUser(iTimer,myThreadId) = 0.
361     timerSys (iTimer,myThreadId) = 0.
362     timerWall(iTimer,myThreadId) = 0.
363     timerStarts(iTimer,myThreadId) = 0
364     timerStops (iTimer,myThreadId) = 0
365     timerStatus(iTimer,myThreadId) = STOPPED
366     ENDIF
367     IF ( timerStatus(iTimer,myThreadId) .NE. RUNNING ) THEN
368     CALL TIMER_GET_TIME( userTime, systemTime, wallClockTime )
369     timerT0User(iTimer,myThreadId) = userTime
370     timerT0Sys(iTimer,myThreadId) = systemTime
371     timerT0Wall(iTimer,myThreadId) = wallClockTime
372     timerStatus(iTimer,myThreadId) = RUNNING
373     timerStarts(iTimer,myThreadId) = timerStarts(iTimer,myThreadId)+1
374     ENDIF
375     ELSEIF ( tmpAction .EQ. STOP ) THEN
376     IF ( iTimer .EQ. 0 ) GOTO 905
377     IF ( timerStatus(iTimer,myThreadId) .EQ. RUNNING ) THEN
378     CALL TIMER_GET_TIME( userTime, systemTime, wallClockTime )
379     timerUser(iTimer,myThreadId) = timerUser(iTimer,myThreadId) +
380     & userTime -
381     & timerT0User(iTimer,myThreadId)
382     timerSys (iTimer,myThreadId) = timerSys(iTimer,myThreadId) +
383     & systemTime -
384     & timerT0Sys(iTimer,myThreadId)
385     timerWall(iTimer,myThreadId) = timerWall(iTimer,myThreadId) +
386     & wallClockTime -
387     & timerT0Wall(iTimer,myThreadId)
388     timerStatus(iTimer,myThreadId) = STOPPED
389     timerStops (iTimer,myThreadId) = timerStops (iTimer,myThreadId)+1
390     ENDIF
391     ELSEIF ( tmpAction .EQ. PRINT ) THEN
392     IF ( iTimer .EQ. 0 ) GOTO 905
393     WRITE(msgBuffer,*)
394     & ' Seconds in section "',
395     & timerNames(iTimer,myThreadId)(1:timerNameLen(iTimer,myThreadId)),'":'
396     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
397     WRITE(msgBuffer,*) ' User time:',timerUser(iTimer,myThreadId)
398     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
399     WRITE(msgBuffer,*) ' System time:',timerSys(iTimer,myThreadId)
400     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
401     WRITE(msgBuffer,*) ' Wall clock time:',timerWall(iTimer,myThreadId)
402     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
403     WRITE(msgBuffer,*) ' No. starts:',timerStarts(iTimer,myThreadId)
404     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
405     WRITE(msgBuffer,*) ' No. stops:',timerStops(iTimer,myThreadId)
406     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
407     ELSEIF ( tmpAction .EQ. PRINTALL ) THEN
408     DO 10 I = 1, nTimers(myThreadId)
409     WRITE(msgBuffer,*) ' Seconds in section "',
410     & timerNames(I,myThreadId)(1:timerNameLen(I,myThreadId)),'":'
411     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
412     WRITE(msgBuffer,*) ' User time:',timerUser(I,myThreadId)
413     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
414     WRITE(msgBuffer,*) ' System time:',timerSys(I,myThreadId)
415     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
416     WRITE(msgBuffer,*) ' Wall clock time:',timerWall(I,myThreadId)
417     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
418     WRITE(msgBuffer,*) ' No. starts:',timerStarts(I,myThreadId)
419     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
420     WRITE(msgBuffer,*) ' No. stops:',timerStops(I,myThreadId)
421     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
422     10 CONTINUE
423     ELSE
424     GOTO 903
425     ENDIF
426     C
427     1000 CONTINUE
428     C
429     RETURN
430     901 CONTINUE
431     WRITE(msgBuffer,'(A)')
432     &' '
433     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
434     WRITE(msgBuffer,*)
435     &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
436     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
437     WRITE(msgBuffer,*)
438     &'procedure: "',callProc,'".'
439     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
440     WRITE(msgBuffer,*)
441     &'Timer name "',name(ISTART:IEND),'" is invalid.'
442     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
443     WRITE(msgBuffer,*)
444     &' Names must have fewer than',maxString+1,' characters.'
445     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
446     WRITE(msgBuffer,*)
447     &'*******************************************************'
448     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
449     GOTO 1000
450     902 CONTINUE
451     WRITE(msgBuffer,*)
452     &' '
453     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
454     WRITE(msgBuffer,*)
455     &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
456     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
457     WRITE(msgBuffer,*)
458     &'procedure: "',callProc,'".'
459     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
460     WRITE(msgBuffer,*)
461     &' No timer action specified.'
462     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
463     WRITE(msgBuffer,*)
464     &' Valid actions are:'
465     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
466     WRITE(msgBuffer,*)
467     &' "START", "STOP", "PRINT" and "PRINTALL".'
468     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
469     WRITE(msgBuffer,*)
470     &'*******************************************************'
471     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
472     GOTO 1000
473     903 CONTINUE
474     WRITE(msgBuffer,*)
475     &' '
476     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
477     WRITE(msgBuffer,*)
478     &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
479     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
480     WRITE(msgBuffer,*)
481     &'procedure: "',callProc,'".'
482     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
483     WRITE(msgBuffer,*)
484     &'Timer action"',name(ISTART:IEND),'" is invalid.'
485     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
486     WRITE(msgBuffer,*)
487     &' Valid actions are:'
488     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
489     WRITE(msgBuffer,*)
490     &' "START", "STOP", "PRINT" and "PRINTALL".'
491     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
492     WRITE(msgBuffer,*)
493     &'*******************************************************'
494     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
495     GOTO 1000
496     904 CONTINUE
497     WRITE(msgBuffer,*)
498     &' '
499     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
500     WRITE(msgBuffer,*)
501     &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
502     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
503     WRITE(msgBuffer,*)
504     &'procedure: "',callProc,'".'
505     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
506     WRITE(msgBuffer,*)
507     &'Timer "',name(ISTART:IEND),'" cannot be created.'
508     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
509     WRITE(msgBuffer,*)
510     &' Only ',maxTimers,' timers are allowed.'
511     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
512     WRITE(msgBuffer,*)
513     &'*******************************************************'
514     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
515     GOTO 1000
516     905 CONTINUE
517     WRITE(msgBuffer,*)
518     &' '
519     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
520     WRITE(msgBuffer,*)
521     &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
522     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
523     WRITE(msgBuffer,*)
524     &'procedure: "',callProc,'".'
525     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
526     WRITE(msgBuffer,*)
527     &'Timer name is blank.'
528     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
529     WRITE(msgBuffer,*)
530     &' A name must be used with "START", "STOP" or "PRINT".'
531     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
532     WRITE(msgBuffer,*)
533     &'*******************************************************'
534     CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)
535     GOTO 1000
536     END
537    
538     CStartOfInterface
539     SUBROUTINE TIMER_GET_TIME(
540     O userTime,
541     O systemTime,
542     O wallClockTime )
543     C /==========================================================\
544     C | SUBROUTINE TIMER_GET_TIME |
545     C | o Query system timer routines. |
546     C |==========================================================|
547     C | Routine returns total elapsed time for program so far. |
548     C | Three times are returned that conventionally are used as |
549     C | user time, system time and wall-clock time. Not all these|
550     C | numbers are available on all machines. |
551     C \==========================================================/
552     Real*8 userTime
553     Real*8 systemTime
554     Real*8 wallClockTime
555     CEndOfInterface
556     Real*4 ETIME, ACTUAL, TARRAY(2)
557     EXTERNAL ETIME
558     Real*8 wtime
559     Real*8 MPI_Wtime
560     EXTERNAL MPI_Wtime
561    
562     ACTUAL = ETIME(TARRAY)
563    
564     userTime = TARRAY(1)
565     systemTime = TARRAY(2)
566     #ifdef ALLOW_USE_MPI
567     wtime = MPI_Wtime()
568     WRITE(0,*) ' Wtime = ', wtime
569     wallClockTime = wtime
570     WRITE(0,*) ' WallClocktime = ', wallClockTime
571     #endif /* ALLOW_USE_MPI */
572     #ifndef ALLOW_USE_MPI
573     wallClockTime = 0.
574     #endif
575    
576     RETURN
577     END
578    
579     CStartOfInterface
580     SUBROUTINE TIMER_PRINTALL( myThreadId )
581     C /==========================================================\
582     C | SUBROUTINE TIMER_PRINTALL |
583     C | o Print timer information |
584     C |==========================================================|
585     C | Request print out of table of timing from all timers. |
586     C \==========================================================/
587     INTEGER myThreadId
588     CEndOfInterface
589     C Print out value for every timer.
590     C
591     CALL TIMER_CONTROL( ' ', 'PRINTALL', 'TIMER_PRINTALL' , myThreadId )
592     C
593     RETURN
594     END
595     C***********************************************************************
596     SUBROUTINE TIMER_START ( string , myThreadId )
597     C Return start timer named "string".
598     CHARACTER*(*) string
599     INTEGER myThreadId
600     C
601     CALL TIMER_CONTROL( string, 'START', 'TIMER_START' , myThreadId)
602     C
603     RETURN
604     END
605     C***********************************************************************
606     SUBROUTINE TIMER_STOP ( string , myThreadId)
607     C Return start timer named "string".
608     CHARACTER*(*) string
609     INTEGER myThreadId
610     C
611     CALL TIMER_CONTROL( string, 'STOP', 'TIMER_STOP' , myThreadId )
612     C
613     RETURN
614     END
615     C***********************************************************************
616     SUBROUTINE UCASE ( string )
617     C Translate string to upper case.
618     CHARACTER*(*) string
619     CHARACTER*26 LOWER
620     DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/
621     SAVE LOWER
622     CHARACTER*26 UPPER
623     DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
624     SAVE UPPER
625     INTEGER I, L
626     C
627     DO 10 I = 1, LEN(string)
628     L = INDEX(LOWER,string(I:I))
629     IF ( L .EQ. 0 ) GOTO 10
630     string(I:I) = UPPER(L:L)
631     10 CONTINUE
632     C
633     RETURN
634     END
635     C************************************************************************
  ViewVC Help
Powered by ViewVC 1.1.22