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

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

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

revision 1.2 by cnh, Thu Apr 23 20:37:31 1998 UTC revision 1.10 by cnh, Sun Feb 4 14:38:44 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
# Line 7  C--    Contents Line 8  C--    Contents
8  C-- U DATE            - Returns date and time.  C-- U DATE            - Returns date and time.
9  C--   IFNBLNK         - Returns index of first non-blank string character.  C--   IFNBLNK         - Returns index of first non-blank string character.
10  C--   ILNBLNK         - Returns index of last non-blank string character.  C--   ILNBLNK         - Returns index of last non-blank string character.
11    C--   IO_ERRCOUNT     - Reads IO error counter.
12  C--   LCASE           - Translates to lower case.  C--   LCASE           - Translates to lower case.
13  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.  
14  C--   UCASE           - Translates to upper case.  C--   UCASE           - Translates to upper case.
15  C--   Routines marked "M" contain specific machine dependent code.  C--   Routines marked "M" contain specific machine dependent code.
16  C--   Routines marked "U" contain UNIX OS calls.  C--   Routines marked "U" contain UNIX OS calls.
# Line 25  C     /================================= Line 21  C     /=================================
21  C     | SUBROUTINE DATE                                          |  C     | SUBROUTINE DATE                                          |
22  C     | o Return current date                                    |  C     | o Return current date                                    |
23  C     \==========================================================/  C     \==========================================================/
24          IMPLICIT NONE
25  #include "SIZE.h"  #include "SIZE.h"
26  #include "EEPARAMS.h"  #include "EEPARAMS.h"
27  C  C
# Line 38  C Line 35  C
35        lDate = 24        lDate = 24
36        IF ( LEN(string) .LT. lDate ) GOTO 901        IF ( LEN(string) .LT. lDate ) GOTO 901
37        string = ' '        string = ' '
38    #ifndef TARGET_T3E
39    #ifndef TARGET_CRAY_VECTOR
40        CALL FDATE( string )        CALL FDATE( string )
41    #endif
42    #endif
43  C    C  
44   1000 CONTINUE   1000 CONTINUE
45        RETURN        RETURN
46    901 CONTINUE    901 CONTINUE
47        WRITE(msgBuffer,'(A)')        WRITE(msgBuffer,'(A)')
48       &'                                                       '       &'                                                       '
49        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
50         &SQUEEZE_RIGHT,myThreadId)
51        WRITE(msgBuffer,'(A)')        WRITE(msgBuffer,'(A)')
52       &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'       &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
53        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
54         &SQUEEZE_RIGHT,myThreadId)
55        WRITE(msgBuffer,'(A)')        WRITE(msgBuffer,'(A)')
56       &'procedure: "DATE".'       &'procedure: "DATE".'
57        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
58         &SQUEEZE_RIGHT,myThreadId)
59        WRITE(msgBuffer,'(A)')        WRITE(msgBuffer,'(A)')
60       &'Variable passed to S/R DATE is too small.'       &'Variable passed to S/R DATE is too small.'
61        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
62         &SQUEEZE_RIGHT,myThreadId)
63        WRITE(msgBuffer,'(A)')        WRITE(msgBuffer,'(A)')
64       &' Argument must be at least',lDate,'characters long.'       &' Argument must be at least',lDate,'characters long.'
65        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
66         &SQUEEZE_RIGHT,myThreadId)
67        WRITE(msgBuffer,'(A)')        WRITE(msgBuffer,'(A)')
68       &'*******************************************************'       &'*******************************************************'
69        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,SQUEEZE_RIGHT,myThreadId)        CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
70         &SQUEEZE_RIGHT,myThreadId)
71        GOTO 1000        GOTO 1000
72        END        END
73    
# Line 70  C     /================================= Line 77  C     /=================================
77  C     | FUNCTION IFNBLNK                                         |  C     | FUNCTION IFNBLNK                                         |
78  C     | o Find first non-blank in character string.              |  C     | o Find first non-blank in character string.              |
79  C     \==========================================================/  C     \==========================================================/
80          IMPLICIT NONE
81  C  C
82        CHARACTER*(*) string        CHARACTER*(*) string
83  CEndOfInterface  CEndOfInterface
# Line 94  C     /================================= Line 102  C     /=================================
102  C     | FUNCTION ILNBLNK                                         |  C     | FUNCTION ILNBLNK                                         |
103  C     | o Find last non-blank in character string.               |  C     | o Find last non-blank in character string.               |
104  C     \==========================================================/  C     \==========================================================/
105          IMPLICIT NONE
106        CHARACTER*(*) string        CHARACTER*(*) string
107  CEndOfInterface  CEndOfInterface
108        INTEGER L, LS        INTEGER L, LS
# Line 110  C Line 119  C
119        RETURN        RETURN
120        END        END
121    
122    CStartofinterface
123          INTEGER FUNCTION IO_ERRCOUNT(myThid)
124    C     /==========================================================\
125    C     | FUNCTION IO_ERRCOUNT                                     |
126    C     | o Reads IO error counter.                                |
127    C     \==========================================================/
128          IMPLICIT NONE
129    C     == Global variables ==
130    #include "SIZE.h"
131    #include "EEPARAMS.h"
132    
133    C     == Routine arguments ==
134          INTEGER myThid
135    CEndofinterface
136    
137          IO_ERRCOUNT = ioErrorCount(myThid)
138    
139          RETURN
140          END
141    
142  CStartOfInterface  CStartOfInterface
143        SUBROUTINE LCASE ( string )        SUBROUTINE LCASE ( string )
144  C     /==========================================================\  C     /==========================================================\
145  C     | SUBROUTINE LCASE                                         |  C     | SUBROUTINE LCASE                                         |
146  C     | o Convert character string to all lower case.            |  C     | o Convert character string to all lower case.            |
147  C     \==========================================================/  C     \==========================================================/
148          IMPLICIT NONE
149        CHARACTER*(*) string        CHARACTER*(*) string
150  CEndOfInterface  CEndOfInterface
151        CHARACTER*26  LOWER        CHARACTER*26  LOWER
# Line 141  C     /================================= Line 171  C     /=================================
171  C     | SUBROUTINE MACHINE                                       |  C     | SUBROUTINE MACHINE                                       |
172  C     | o Return computer identifier in string.                  |  C     | o Return computer identifier in string.                  |
173  C     \==========================================================/  C     \==========================================================/
174          IMPLICIT NONE
175  #include "SIZE.h"  #include "SIZE.h"
176  #include "EEPARAMS.h"  #include "EEPARAMS.h"
177        CHARACTER*(*) string        CHARACTER*(*) string
# Line 162  C Line 193  C
193        strTmp = 'UNKNOWN'        strTmp = 'UNKNOWN'
194        iFree  = 1        iFree  = 1
195        idSize = LEN(string)        idSize = LEN(string)
196    #if (defined (TARGET_T3E) || defined (TARGET_CRAY_VECTOR))
197          IFirst = 0
198          CALL PXFGETENV('USER',iFirst,strTmp,ILast,Iend  )
199    #else
200        CALL GETENV('USER',strTmp  )        CALL GETENV('USER',strTmp  )
201    #endif
202        IF ( strTmp .NE. ' ' ) THEN        IF ( strTmp .NE. ' ' ) THEN
203          iFirst = IFNBLNK(strTmp)          iFirst = IFNBLNK(strTmp)
204          iLast  = ILNBLNK(strTmp)          iLast  = ILNBLNK(strTmp)
# Line 177  C Line 213  C
213          ENDIF          ENDIF
214        ENDIF        ENDIF
215        strTmp = 'UNKNOWN'        strTmp = 'UNKNOWN'
216        CALL GETENV('HOST',strtmp )  #if (defined (TARGET_T3E) || defined (TARGET_CRAY_VECTOR))
217          IFirst = 0
218          CALL PXFGETENV('HOST',iFirst,strTmp,ILast,Iend  )
219    #else
220          CALL GETENV('HOST',strTmp  )
221    #endif
222        IF ( strTmp .NE. ' ' ) THEN        IF ( strTmp .NE. ' ' ) THEN
223          iFirst = IFNBLNK(strTmp)          iFirst = IFNBLNK(strTmp)
224          iLast  = ILNBLNK(strTmp)          iLast  = ILNBLNK(strTmp)
# Line 195  C Line 236  C
236   1000 CONTINUE   1000 CONTINUE
237        RETURN        RETURN
238        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  
239  C***********************************************************************  C***********************************************************************
240        SUBROUTINE UCASE ( string )        SUBROUTINE UCASE ( string )
241          IMPLICIT NONE
242  C     Translate string to upper case.  C     Translate string to upper case.
243        CHARACTER*(*) string        CHARACTER*(*) string
244        CHARACTER*26  LOWER        CHARACTER*26  LOWER
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22