/[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.5 by cnh, Wed Oct 28 03:11:35 1998 UTC revision 1.9 by heimbach, Wed Jun 21 20:44:06 2000 UTC
# Line 20  C     /================================= Line 20  C     /=================================
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
# Line 33  C Line 34  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
# Line 71  C     /================================= Line 76  C     /=================================
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
# Line 95  C     /================================= Line 101  C     /=================================
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
# Line 117  C     /================================= Line 124  C     /=================================
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
# Line 138  C     /================================= Line 144  C     /=================================
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
# Line 163  C     /================================= Line 170  C     /=================================
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
# Line 184  C Line 192  C
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)
# Line 199  C Line 212  C
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)
# Line 219  C Line 237  C
237        END        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
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22