10 |
C-- IO_ERRCOUNT - Reads IO error counter. |
C-- IO_ERRCOUNT - Reads IO error counter. |
11 |
C-- LCASE - Translates to lower case. |
C-- LCASE - Translates to lower case. |
12 |
C--UM MACHINE - Returns character string identifying computer. |
C--UM MACHINE - Returns character string identifying computer. |
|
C-- TIMER_INDEX - Returns index associated with timer name. |
|
|
C-- M TIMER_CONTROL - Implements timer functions for given machine. |
|
|
C-- TIMER_PRINT - Print CPU timer statitics. |
|
|
C-- TIMER_PRINTALL - Prints all CPU timers statistics. |
|
|
C-- TIMER_START - Starts CPU timer for code section. |
|
|
C-- TIMER_STOP - Stop CPU tier for code section. |
|
13 |
C-- UCASE - Translates to upper case. |
C-- UCASE - Translates to upper case. |
14 |
C-- Routines marked "M" contain specific machine dependent code. |
C-- Routines marked "M" contain specific machine dependent code. |
15 |
C-- Routines marked "U" contain UNIX OS calls. |
C-- Routines marked "U" contain UNIX OS calls. |
20 |
C | SUBROUTINE DATE | |
C | SUBROUTINE DATE | |
21 |
C | o Return current date | |
C | o Return current date | |
22 |
C \==========================================================/ |
C \==========================================================/ |
23 |
|
IMPLICIT NONE |
24 |
#include "SIZE.h" |
#include "SIZE.h" |
25 |
#include "EEPARAMS.h" |
#include "EEPARAMS.h" |
26 |
C |
C |
34 |
lDate = 24 |
lDate = 24 |
35 |
IF ( LEN(string) .LT. lDate ) GOTO 901 |
IF ( LEN(string) .LT. lDate ) GOTO 901 |
36 |
string = ' ' |
string = ' ' |
37 |
|
#ifndef TARGET_T3E |
38 |
|
#ifndef TARGET_CRAY_VECTOR |
39 |
CALL FDATE( string ) |
CALL FDATE( string ) |
40 |
|
#endif |
41 |
|
#endif |
42 |
C |
C |
43 |
1000 CONTINUE |
1000 CONTINUE |
44 |
RETURN |
RETURN |
45 |
901 CONTINUE |
901 CONTINUE |
46 |
WRITE(msgBuffer,'(A)') |
WRITE(msgBuffer,'(A)') |
47 |
&' ' |
&' ' |
48 |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit, |
49 |
|
&SQUEEZE_RIGHT,myThreadId) |
50 |
WRITE(msgBuffer,'(A)') |
WRITE(msgBuffer,'(A)') |
51 |
&'*** WARNING WARNING WARNING WARNING WARNING WARNING ***' |
&'*** WARNING WARNING WARNING WARNING WARNING WARNING ***' |
52 |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit, |
53 |
|
&SQUEEZE_RIGHT,myThreadId) |
54 |
WRITE(msgBuffer,'(A)') |
WRITE(msgBuffer,'(A)') |
55 |
&'procedure: "DATE".' |
&'procedure: "DATE".' |
56 |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit, |
57 |
|
&SQUEEZE_RIGHT,myThreadId) |
58 |
WRITE(msgBuffer,'(A)') |
WRITE(msgBuffer,'(A)') |
59 |
&'Variable passed to S/R DATE is too small.' |
&'Variable passed to S/R DATE is too small.' |
60 |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit, |
61 |
|
&SQUEEZE_RIGHT,myThreadId) |
62 |
WRITE(msgBuffer,'(A)') |
WRITE(msgBuffer,'(A)') |
63 |
&' Argument must be at least',lDate,'characters long.' |
&' Argument must be at least',lDate,'characters long.' |
64 |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit, |
65 |
|
&SQUEEZE_RIGHT,myThreadId) |
66 |
WRITE(msgBuffer,'(A)') |
WRITE(msgBuffer,'(A)') |
67 |
&'*******************************************************' |
&'*******************************************************' |
68 |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit, |
69 |
|
&SQUEEZE_RIGHT,myThreadId) |
70 |
GOTO 1000 |
GOTO 1000 |
71 |
END |
END |
72 |
|
|
76 |
C | FUNCTION IFNBLNK | |
C | FUNCTION IFNBLNK | |
77 |
C | o Find first non-blank in character string. | |
C | o Find first non-blank in character string. | |
78 |
C \==========================================================/ |
C \==========================================================/ |
79 |
|
IMPLICIT NONE |
80 |
C |
C |
81 |
CHARACTER*(*) string |
CHARACTER*(*) string |
82 |
CEndOfInterface |
CEndOfInterface |
101 |
C | FUNCTION ILNBLNK | |
C | FUNCTION ILNBLNK | |
102 |
C | o Find last non-blank in character string. | |
C | o Find last non-blank in character string. | |
103 |
C \==========================================================/ |
C \==========================================================/ |
104 |
|
IMPLICIT NONE |
105 |
CHARACTER*(*) string |
CHARACTER*(*) string |
106 |
CEndOfInterface |
CEndOfInterface |
107 |
INTEGER L, LS |
INTEGER L, LS |
124 |
C | FUNCTION IO_ERRCOUNT | |
C | FUNCTION IO_ERRCOUNT | |
125 |
C | o Reads IO error counter. | |
C | o Reads IO error counter. | |
126 |
C \==========================================================/ |
C \==========================================================/ |
127 |
|
IMPLICIT NONE |
128 |
C == Global variables == |
C == Global variables == |
129 |
#include "SIZE.h" |
#include "SIZE.h" |
130 |
#include "EEPARAMS.h" |
#include "EEPARAMS.h" |
|
#include "DFILE.h" |
|
131 |
|
|
132 |
C == Routine arguments == |
C == Routine arguments == |
133 |
INTEGER myThid |
INTEGER myThid |
144 |
C | SUBROUTINE LCASE | |
C | SUBROUTINE LCASE | |
145 |
C | o Convert character string to all lower case. | |
C | o Convert character string to all lower case. | |
146 |
C \==========================================================/ |
C \==========================================================/ |
147 |
|
IMPLICIT NONE |
148 |
CHARACTER*(*) string |
CHARACTER*(*) string |
149 |
CEndOfInterface |
CEndOfInterface |
150 |
CHARACTER*26 LOWER |
CHARACTER*26 LOWER |
170 |
C | SUBROUTINE MACHINE | |
C | SUBROUTINE MACHINE | |
171 |
C | o Return computer identifier in string. | |
C | o Return computer identifier in string. | |
172 |
C \==========================================================/ |
C \==========================================================/ |
173 |
|
IMPLICIT NONE |
174 |
#include "SIZE.h" |
#include "SIZE.h" |
175 |
#include "EEPARAMS.h" |
#include "EEPARAMS.h" |
176 |
CHARACTER*(*) string |
CHARACTER*(*) string |
192 |
strTmp = 'UNKNOWN' |
strTmp = 'UNKNOWN' |
193 |
iFree = 1 |
iFree = 1 |
194 |
idSize = LEN(string) |
idSize = LEN(string) |
195 |
|
#if (defined (TARGET_T3E) || defined (TARGET_CRAY_VECTOR)) |
196 |
|
IFirst = 0 |
197 |
|
CALL PXFGETENV('USER',iFirst,strTmp,ILast,Iend ) |
198 |
|
#else |
199 |
CALL GETENV('USER',strTmp ) |
CALL GETENV('USER',strTmp ) |
200 |
|
#endif |
201 |
IF ( strTmp .NE. ' ' ) THEN |
IF ( strTmp .NE. ' ' ) THEN |
202 |
iFirst = IFNBLNK(strTmp) |
iFirst = IFNBLNK(strTmp) |
203 |
iLast = ILNBLNK(strTmp) |
iLast = ILNBLNK(strTmp) |
212 |
ENDIF |
ENDIF |
213 |
ENDIF |
ENDIF |
214 |
strTmp = 'UNKNOWN' |
strTmp = 'UNKNOWN' |
215 |
CALL GETENV('HOST',strtmp ) |
#if (defined (TARGET_T3E) || defined (TARGET_CRAY_VECTOR)) |
216 |
|
IFirst = 0 |
217 |
|
CALL PXFGETENV('HOST',iFirst,strTmp,ILast,Iend ) |
218 |
|
#else |
219 |
|
CALL GETENV('HOST',strTmp ) |
220 |
|
#endif |
221 |
IF ( strTmp .NE. ' ' ) THEN |
IF ( strTmp .NE. ' ' ) THEN |
222 |
iFirst = IFNBLNK(strTmp) |
iFirst = IFNBLNK(strTmp) |
223 |
iLast = ILNBLNK(strTmp) |
iLast = ILNBLNK(strTmp) |
235 |
1000 CONTINUE |
1000 CONTINUE |
236 |
RETURN |
RETURN |
237 |
END |
END |
|
|
|
|
CStartOfInterface |
|
|
INTEGER FUNCTION TIMER_INDEX ( |
|
|
I name,timerNames,maxTimers,nTimers ) |
|
|
C /==========================================================\ |
|
|
C | FUNCTION TIMER_INDEX | |
|
|
C | o Timing support routine. | |
|
|
C |==========================================================| |
|
|
C | Return index in timer data structure of timer named | |
|
|
C | by the function argument "name". | |
|
|
C \==========================================================/ |
|
|
INTEGER maxTimers |
|
|
INTEGER nTimers |
|
|
CHARACTER*(*) name |
|
|
CHARACTER*(*) timerNames(maxTimers) |
|
|
CEndOfInterface |
|
|
INTEGER I |
|
|
C |
|
|
TIMER_INDEX = 0 |
|
|
IF ( name .EQ. ' ' ) THEN |
|
|
TIMER_INDEX = -1 |
|
|
ELSE |
|
|
DO 10 I = 1, nTimers |
|
|
IF ( name .NE. timerNames(I) ) GOTO 10 |
|
|
TIMER_INDEX = I |
|
|
GOTO 11 |
|
|
10 CONTINUE |
|
|
11 CONTINUE |
|
|
ENDIF |
|
|
RETURN |
|
|
END |
|
|
|
|
|
CStartOfInterface |
|
|
SUBROUTINE TIMER_CONTROL ( name , action , callProc , myThreadId ) |
|
|
C /==========================================================\ |
|
|
C | SUBROUTINE TIMER_CONTROL | |
|
|
C | o Timing routine. | |
|
|
C |==========================================================| |
|
|
C | User callable interface to timing routines. Timers are | |
|
|
C | created, stopped, started and queried only through this | |
|
|
C | rtouine. | |
|
|
C \==========================================================/ |
|
|
#include "SIZE.h" |
|
|
#include "EEPARAMS.h" |
|
|
#include "EESUPPORT.h" |
|
|
CHARACTER*(*) name |
|
|
CHARACTER*(*) action |
|
|
CHARACTER*(*) callProc |
|
|
INTEGER myThreadId |
|
|
CEndOfInterface |
|
|
C |
|
|
INTEGER TIMER_INDEX |
|
|
INTEGER IFNBLNK |
|
|
INTEGER ILNBLNK |
|
|
EXTERNAL TIMER_INDEX |
|
|
EXTERNAL IFNBLNK |
|
|
EXTERNAL ILNBLNK |
|
|
C |
|
|
INTEGER maxTimers |
|
|
INTEGER maxString |
|
|
PARAMETER ( maxTimers = 40 ) |
|
|
PARAMETER ( maxString = 80 ) |
|
|
C |
|
|
INTEGER timerStarts( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerStarts |
|
|
INTEGER timerStops ( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerStops |
|
|
Real*8 timerUser ( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerUser |
|
|
Real*8 timerWall ( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerWall |
|
|
Real*8 timerSys ( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerSys |
|
|
Real*8 timerT0User( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerT0User |
|
|
Real*8 timerT0Wall( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerT0Wall |
|
|
Real*8 timerT0Sys ( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerT0Sys |
|
|
C =============================================================== |
|
|
C |
|
|
INTEGER timerStatus( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerStatus |
|
|
INTEGER timerNameLen( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerNameLen |
|
|
CHARACTER*(maxString) timerNames( maxTimers , MAX_NO_THREADS) |
|
|
SAVE timerNames |
|
|
CHARACTER*(maxString) timerAction |
|
|
INTEGER nTimers(MAX_NO_THREADS) |
|
|
CHARACTER*(maxString) tmpName |
|
|
CHARACTER*(maxString) tmpAction |
|
|
INTEGER iTimer |
|
|
INTEGER ISTART |
|
|
INTEGER IEND |
|
|
INTEGER STOPPED |
|
|
PARAMETER ( STOPPED = 0 ) |
|
|
INTEGER RUNNING |
|
|
PARAMETER ( RUNNING = 1 ) |
|
|
CHARACTER*(*) STOP |
|
|
PARAMETER ( STOP = 'STOP' ) |
|
|
CHARACTER*(*) START |
|
|
PARAMETER ( START = 'START' ) |
|
|
CHARACTER*(*) PRINT |
|
|
PARAMETER ( PRINT = 'PRINT' ) |
|
|
CHARACTER*(*) PRINTALL |
|
|
PARAMETER ( PRINTALL = 'PRINTALL' ) |
|
|
INTEGER I |
|
|
Real*8 userTime |
|
|
Real*8 systemTime |
|
|
Real*8 wallClockTime |
|
|
CHARACTER*(MAX_LEN_MBUF) msgBuffer |
|
|
C |
|
|
DATA nTimers /MAX_NO_THREADS*0/ |
|
|
SAVE nTimers |
|
|
C |
|
|
ISTART = IFNBLNK(name) |
|
|
IEND = ILNBLNK(name) |
|
|
IF ( IEND - ISTART + 1 .GT. maxString ) GOTO 901 |
|
|
IF ( ISTART .NE. 0 ) THEN |
|
|
tmpName = name(ISTART:IEND) |
|
|
CALL UCASE( tmpName ) |
|
|
ELSE |
|
|
tmpName = ' ' |
|
|
ENDIF |
|
|
ISTART = IFNBLNK(action) |
|
|
IEND = ILNBLNK(action) |
|
|
IF ( ISTART .EQ. 0 ) GOTO 902 |
|
|
IF ( IEND - ISTART + 1 .GT. maxString ) GOTO 903 |
|
|
tmpAction = action(ISTART:IEND) |
|
|
CALL UCASE( tmpAction ) |
|
|
C |
|
|
iTimer=TIMER_INDEX(tmpName,timerNames(myThreadId,1),maxTimers,nTimers(myThreadId)) |
|
|
C |
|
|
IF ( tmpAction .EQ. START ) THEN |
|
|
IF ( iTimer .EQ. 0 ) THEN |
|
|
IF ( nTimers(myThreadId) .EQ. maxTimers ) GOTO 904 |
|
|
nTimers(myThreadId) = nTimers(myThreadId) + 1 |
|
|
iTimer = nTimers(myThreadId) |
|
|
timerNames(iTimer,myThreadId) = tmpName |
|
|
timerNameLen(iTimer,myThreadId) = ILNBLNK(tmpName)-IFNBLNK(tmpName)+1 |
|
|
timerUser(iTimer,myThreadId) = 0. |
|
|
timerSys (iTimer,myThreadId) = 0. |
|
|
timerWall(iTimer,myThreadId) = 0. |
|
|
timerStarts(iTimer,myThreadId) = 0 |
|
|
timerStops (iTimer,myThreadId) = 0 |
|
|
timerStatus(iTimer,myThreadId) = STOPPED |
|
|
ENDIF |
|
|
IF ( timerStatus(iTimer,myThreadId) .NE. RUNNING ) THEN |
|
|
CALL TIMER_GET_TIME( userTime, systemTime, wallClockTime ) |
|
|
timerT0User(iTimer,myThreadId) = userTime |
|
|
timerT0Sys(iTimer,myThreadId) = systemTime |
|
|
timerT0Wall(iTimer,myThreadId) = wallClockTime |
|
|
timerStatus(iTimer,myThreadId) = RUNNING |
|
|
timerStarts(iTimer,myThreadId) = timerStarts(iTimer,myThreadId)+1 |
|
|
ENDIF |
|
|
ELSEIF ( tmpAction .EQ. STOP ) THEN |
|
|
IF ( iTimer .EQ. 0 ) GOTO 905 |
|
|
IF ( timerStatus(iTimer,myThreadId) .EQ. RUNNING ) THEN |
|
|
CALL TIMER_GET_TIME( userTime, systemTime, wallClockTime ) |
|
|
timerUser(iTimer,myThreadId) = timerUser(iTimer,myThreadId) + |
|
|
& userTime - |
|
|
& timerT0User(iTimer,myThreadId) |
|
|
timerSys (iTimer,myThreadId) = timerSys(iTimer,myThreadId) + |
|
|
& systemTime - |
|
|
& timerT0Sys(iTimer,myThreadId) |
|
|
timerWall(iTimer,myThreadId) = timerWall(iTimer,myThreadId) + |
|
|
& wallClockTime - |
|
|
& timerT0Wall(iTimer,myThreadId) |
|
|
timerStatus(iTimer,myThreadId) = STOPPED |
|
|
timerStops (iTimer,myThreadId) = timerStops (iTimer,myThreadId)+1 |
|
|
ENDIF |
|
|
ELSEIF ( tmpAction .EQ. PRINT ) THEN |
|
|
IF ( iTimer .EQ. 0 ) GOTO 905 |
|
|
WRITE(msgBuffer,*) |
|
|
& ' Seconds in section "', |
|
|
& timerNames(iTimer,myThreadId)(1:timerNameLen(iTimer,myThreadId)),'":' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' User time:',timerUser(iTimer,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' System time:',timerSys(iTimer,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' Wall clock time:',timerWall(iTimer,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' No. starts:',timerStarts(iTimer,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' No. stops:',timerStops(iTimer,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
ELSEIF ( tmpAction .EQ. PRINTALL ) THEN |
|
|
DO 10 I = 1, nTimers(myThreadId) |
|
|
WRITE(msgBuffer,*) ' Seconds in section "', |
|
|
& timerNames(I,myThreadId)(1:timerNameLen(I,myThreadId)),'":' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' User time:',timerUser(I,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' System time:',timerSys(I,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' Wall clock time:',timerWall(I,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' No. starts:',timerStarts(I,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) ' No. stops:',timerStops(I,myThreadId) |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
10 CONTINUE |
|
|
ELSE |
|
|
GOTO 903 |
|
|
ENDIF |
|
|
C |
|
|
1000 CONTINUE |
|
|
C |
|
|
RETURN |
|
|
901 CONTINUE |
|
|
WRITE(msgBuffer,'(A)') |
|
|
&' ' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*** WARNING WARNING WARNING WARNING WARNING WARNING ***' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'procedure: "',callProc,'".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'Timer name "',name(ISTART:IEND),'" is invalid.' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' Names must have fewer than',maxString+1,' characters.' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*******************************************************' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
GOTO 1000 |
|
|
902 CONTINUE |
|
|
WRITE(msgBuffer,*) |
|
|
&' ' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*** WARNING WARNING WARNING WARNING WARNING WARNING ***' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'procedure: "',callProc,'".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' No timer action specified.' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' Valid actions are:' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' "START", "STOP", "PRINT" and "PRINTALL".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*******************************************************' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
GOTO 1000 |
|
|
903 CONTINUE |
|
|
WRITE(msgBuffer,*) |
|
|
&' ' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*** WARNING WARNING WARNING WARNING WARNING WARNING ***' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'procedure: "',callProc,'".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'Timer action"',name(ISTART:IEND),'" is invalid.' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' Valid actions are:' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' "START", "STOP", "PRINT" and "PRINTALL".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*******************************************************' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
GOTO 1000 |
|
|
904 CONTINUE |
|
|
WRITE(msgBuffer,*) |
|
|
&' ' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*** WARNING WARNING WARNING WARNING WARNING WARNING ***' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'procedure: "',callProc,'".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'Timer "',name(ISTART:IEND),'" cannot be created.' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' Only ',maxTimers,' timers are allowed.' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*******************************************************' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
GOTO 1000 |
|
|
905 CONTINUE |
|
|
WRITE(msgBuffer,*) |
|
|
&' ' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*** WARNING WARNING WARNING WARNING WARNING WARNING ***' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'procedure: "',callProc,'".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'Timer name is blank.' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&' A name must be used with "START", "STOP" or "PRINT".' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
WRITE(msgBuffer,*) |
|
|
&'*******************************************************' |
|
|
CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId) |
|
|
GOTO 1000 |
|
|
END |
|
|
|
|
|
CStartOfInterface |
|
|
SUBROUTINE TIMER_GET_TIME( |
|
|
O userTime, |
|
|
O systemTime, |
|
|
O wallClockTime ) |
|
|
C /==========================================================\ |
|
|
C | SUBROUTINE TIMER_GET_TIME | |
|
|
C | o Query system timer routines. | |
|
|
C |==========================================================| |
|
|
C | Routine returns total elapsed time for program so far. | |
|
|
C | Three times are returned that conventionally are used as | |
|
|
C | user time, system time and wall-clock time. Not all these| |
|
|
C | numbers are available on all machines. | |
|
|
C \==========================================================/ |
|
|
Real*8 userTime |
|
|
Real*8 systemTime |
|
|
Real*8 wallClockTime |
|
|
CEndOfInterface |
|
|
Real*4 ETIME, ACTUAL, TARRAY(2) |
|
|
EXTERNAL ETIME |
|
|
Real*8 wtime |
|
|
Real*8 MPI_Wtime |
|
|
EXTERNAL MPI_Wtime |
|
|
|
|
|
ACTUAL = ETIME(TARRAY) |
|
|
|
|
|
userTime = TARRAY(1) |
|
|
systemTime = TARRAY(2) |
|
|
#ifdef ALLOW_USE_MPI |
|
|
wtime = MPI_Wtime() |
|
|
WRITE(0,*) ' Wtime = ', wtime |
|
|
wallClockTime = wtime |
|
|
WRITE(0,*) ' WallClocktime = ', wallClockTime |
|
|
#endif /* ALLOW_USE_MPI */ |
|
|
#ifndef ALLOW_USE_MPI |
|
|
wallClockTime = 0. |
|
|
#endif |
|
|
|
|
|
RETURN |
|
|
END |
|
|
|
|
|
CStartOfInterface |
|
|
SUBROUTINE TIMER_PRINTALL( myThreadId ) |
|
|
C /==========================================================\ |
|
|
C | SUBROUTINE TIMER_PRINTALL | |
|
|
C | o Print timer information | |
|
|
C |==========================================================| |
|
|
C | Request print out of table of timing from all timers. | |
|
|
C \==========================================================/ |
|
|
INTEGER myThreadId |
|
|
CEndOfInterface |
|
|
C Print out value for every timer. |
|
|
C |
|
|
CALL TIMER_CONTROL( ' ', 'PRINTALL', 'TIMER_PRINTALL' , myThreadId ) |
|
|
C |
|
|
RETURN |
|
|
END |
|
|
C*********************************************************************** |
|
|
SUBROUTINE TIMER_START ( string , myThreadId ) |
|
|
C Return start timer named "string". |
|
|
CHARACTER*(*) string |
|
|
INTEGER myThreadId |
|
|
C |
|
|
CALL TIMER_CONTROL( string, 'START', 'TIMER_START' , myThreadId) |
|
|
C |
|
|
RETURN |
|
|
END |
|
|
C*********************************************************************** |
|
|
SUBROUTINE TIMER_STOP ( string , myThreadId) |
|
|
C Return start timer named "string". |
|
|
CHARACTER*(*) string |
|
|
INTEGER myThreadId |
|
|
C |
|
|
CALL TIMER_CONTROL( string, 'STOP', 'TIMER_STOP' , myThreadId ) |
|
|
C |
|
|
RETURN |
|
|
END |
|
238 |
C*********************************************************************** |
C*********************************************************************** |
239 |
SUBROUTINE UCASE ( string ) |
SUBROUTINE UCASE ( string ) |
240 |
|
IMPLICIT NONE |
241 |
C Translate string to upper case. |
C Translate string to upper case. |
242 |
CHARACTER*(*) string |
CHARACTER*(*) string |
243 |
CHARACTER*26 LOWER |
CHARACTER*26 LOWER |