/[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.10 by cnh, Sun Feb 4 14:38:44 2001 UTC revision 1.11 by cnh, Fri Sep 21 03:54:35 2001 UTC
# Line 15  C--   UCASE           - Translates to up Line 15  C--   UCASE           - Translates to up
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.
17    
18  CStartOfInterface  CBOP
19    C     !ROUTINE: DATE
20    
21    C     !INTERFACE:
22        SUBROUTINE DATE ( string , myThreadId )        SUBROUTINE DATE ( string , myThreadId )
23  C     /==========================================================\        IMPLICIT NONE
24    
25    C     !DESCRIPTION:
26    C     *==========================================================*
27  C     | SUBROUTINE DATE                                          |  C     | SUBROUTINE DATE                                          |
28  C     | o Return current date                                    |  C     | o Return current date                                    |
29  C     \==========================================================/  C     *==========================================================*
30        IMPLICIT NONE  
31    C     !USES:
32  #include "SIZE.h"  #include "SIZE.h"
33  #include "EEPARAMS.h"  #include "EEPARAMS.h"
34  C  
35    C     !INPUT/OUTPUT PARAMETERS:
36    C     string     :: Date returned in string
37    C     myThreadId :: My thread number
38        CHARACTER*(*) string        CHARACTER*(*) string
39        INTEGER myThreadId        INTEGER myThreadId
 CEndOfInterface  
40  C  C
41    C     !LOCAL VARIABLES:
42    C     lDate     :: Length of date string
43    C     msgBuffer :: Temp. for building error messages
44        INTEGER lDate        INTEGER lDate
45        CHARACTER*(MAX_LEN_MBUF) msgBuffer        CHARACTER*(MAX_LEN_MBUF) msgBuffer
46    CEOP
47  C  C
48        lDate = 24        lDate = 24
49        IF ( LEN(string) .LT. lDate ) GOTO 901        IF ( LEN(string) .LT. lDate ) GOTO 901
# Line 71  C Line 84  C
84        GOTO 1000        GOTO 1000
85        END        END
86    
87  CStartOfInterface  CBOP
88    C     !ROUTINE: IFNBLNK
89    
90    C     !INTERFACE:
91        INTEGER FUNCTION IFNBLNK( string )        INTEGER FUNCTION IFNBLNK( string )
92  C     /==========================================================\        IMPLICIT NONE
93    
94    C     !DESCRIPTION:
95    C     *==========================================================*
96  C     | FUNCTION IFNBLNK                                         |  C     | FUNCTION IFNBLNK                                         |
97  C     | o Find first non-blank in character string.              |  C     | o Find first non-blank in character string.              |
98  C     \==========================================================/  C     *==========================================================*
       IMPLICIT NONE  
99  C  C
100    C     !INPUT PARAMETERS:
101    C     string :: String to find first non-blank in.
102        CHARACTER*(*) string        CHARACTER*(*) string
103  CEndOfInterface  
104  C  C     !LOCAL VARIABLES:
105    C     L, LS :: Temps for string locations
106        INTEGER L, LS        INTEGER L, LS
107    CEOP
108  C  C
109        LS     = LEN(string)        LS     = LEN(string)
110        IFNBLNK = 0        IFNBLNK = 0
# Line 96  C Line 118  C
118        RETURN        RETURN
119        END        END
120    
121  CStartOfInterface  CBOP
122    C     !ROUTINE: ILNBLNK
123    
124    C     !INTERFACE:
125        INTEGER FUNCTION ILNBLNK( string )        INTEGER FUNCTION ILNBLNK( string )
126  C     /==========================================================\        IMPLICIT NONE
127    
128    C     !DESCRIPTION:
129    C     *==========================================================*
130  C     | FUNCTION ILNBLNK                                         |  C     | FUNCTION ILNBLNK                                         |
131  C     | o Find last non-blank in character string.               |  C     | o Find last non-blank in character string.               |
132  C     \==========================================================/  C     *==========================================================*
133        IMPLICIT NONE  
134    C     !INPUT PARAMETERS:
135    C     string :: string to scan
136        CHARACTER*(*) string        CHARACTER*(*) string
137  CEndOfInterface  
138    C     !LOCAL VARIABLES:
139    C     L, LS :: Temps. used in scanning string
140        INTEGER L, LS        INTEGER L, LS
141    CEOP
142  C  C
143        LS      = LEN(string)        LS      = LEN(string)
144        ILNBLNK = LS        ILNBLNK = LS
# Line 119  C Line 152  C
152        RETURN        RETURN
153        END        END
154    
155  CStartofinterface  CBOP
156    C     !ROUTINE: IO_ERRCOUNT
157    
158    C     !INTERFACE:
159        INTEGER FUNCTION IO_ERRCOUNT(myThid)        INTEGER FUNCTION IO_ERRCOUNT(myThid)
160  C     /==========================================================\        IMPLICIT NONE
161    
162    C     !DESCRIPTION:
163    C     *==========================================================*
164  C     | FUNCTION IO_ERRCOUNT                                     |  C     | FUNCTION IO_ERRCOUNT                                     |
165  C     | o Reads IO error counter.                                |  C     | o Reads IO error counter.                                |
166  C     \==========================================================/  C     *==========================================================*
167        IMPLICIT NONE  
168    C     !USES:
169  C     == Global variables ==  C     == Global variables ==
170  #include "SIZE.h"  #include "SIZE.h"
171  #include "EEPARAMS.h"  #include "EEPARAMS.h"
172    
173    C     !INPUT PARAMETERS:
174  C     == Routine arguments ==  C     == Routine arguments ==
175    C     myThid :: My thread number
176        INTEGER myThid        INTEGER myThid
177  CEndofinterface  
178    CEOP
179    
180        IO_ERRCOUNT = ioErrorCount(myThid)        IO_ERRCOUNT = ioErrorCount(myThid)
181    
182        RETURN        RETURN
183        END        END
184    
185  CStartOfInterface  CBOP
186    
187    C     !ROUTINE: LCASE
188    
189    C     !INTERFACE:
190        SUBROUTINE LCASE ( string )        SUBROUTINE LCASE ( string )
191  C     /==========================================================\        IMPLICIT NONE
192    
193    C     !DESCRIPTION:
194    C     *==========================================================*
195  C     | SUBROUTINE LCASE                                         |  C     | SUBROUTINE LCASE                                         |
196  C     | o Convert character string to all lower case.            |  C     | o Convert character string to all lower case.            |
197  C     \==========================================================/  C     *==========================================================*
198        IMPLICIT NONE  
199    C     !INPUT/OUTPUT PARAMETERS:
200        CHARACTER*(*) string        CHARACTER*(*) string
201  CEndOfInterface  
202    C     !LOCALVARIABLES:
203        CHARACTER*26  LOWER        CHARACTER*26  LOWER
204        DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/        DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/
205        SAVE LOWER        SAVE LOWER
# Line 155  CEndOfInterface Line 207  CEndOfInterface
207        DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/        DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
208        SAVE UPPER        SAVE UPPER
209        INTEGER   I, L        INTEGER   I, L
210    CEOP
211    
212  C  C
213        DO 10 I = 1, LEN(string)        DO 10 I = 1, LEN(string)
214          L = INDEX(UPPER,string(I:I))          L = INDEX(UPPER,string(I:I))
# Line 165  C Line 219  C
219        RETURN        RETURN
220        END        END
221    
222  CStartOfInterface  CBOP
223    C     !ROUTINE: MACHINE
224    
225    C     !INTERFACE:
226        SUBROUTINE MACHINE ( string )        SUBROUTINE MACHINE ( string )
227  C     /==========================================================\        IMPLICIT NONE
228    
229    C     !DESCRIPTION:
230    C     *==========================================================*
231  C     | SUBROUTINE MACHINE                                       |  C     | SUBROUTINE MACHINE                                       |
232  C     | o Return computer identifier in string.                  |  C     | o Return computer identifier in string.                  |
233  C     \==========================================================/  C     *==========================================================*
234        IMPLICIT NONE  
235    C     !USES:
236  #include "SIZE.h"  #include "SIZE.h"
237  #include "EEPARAMS.h"  #include "EEPARAMS.h"
       CHARACTER*(*) string  
 CEndOfInterface  
 C  
238        INTEGER  IFNBLNK        INTEGER  IFNBLNK
239        INTEGER  ILNBLNK        INTEGER  ILNBLNK
240        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
241        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
242  C  
243    C     !OUTPUT PARAMETERS:
244    C     string :: Machine identifier
245          CHARACTER*(*) string
246    
247    C     !LOCAL VARIABLES:
248    C     iFirst, iLast,      :: String indexing temps.
249    C     iEnd, iFree, idSize
250    C     strTmp, idString    :: Temps. for strings.
251        INTEGER  iFirst        INTEGER  iFirst
252        INTEGER  iLast        INTEGER  iLast
253        INTEGER  iEnd          INTEGER  iEnd  
# Line 189  C Line 255  C
255        INTEGER  idSize        INTEGER  idSize
256        CHARACTER*1024 strTmp        CHARACTER*1024 strTmp
257        CHARACTER*1024 idString        CHARACTER*1024 idString
258    CEOP
259    
260        strTmp = 'UNKNOWN'        strTmp = 'UNKNOWN'
261        iFree  = 1        iFree  = 1
# Line 236  C Line 303  C
303   1000 CONTINUE   1000 CONTINUE
304        RETURN        RETURN
305        END        END
306  C***********************************************************************  
307    CBOP
308    C     !ROUTINE: UCASE
309    
310    C     !INTERFACE:
311        SUBROUTINE UCASE ( string )        SUBROUTINE UCASE ( string )
312        IMPLICIT NONE        IMPLICIT NONE
313    
314    C     !DESCRIPTION:
315  C     Translate string to upper case.  C     Translate string to upper case.
316    
317    C     !INPUT/OUTPUT PARAMETERS:
318        CHARACTER*(*) string        CHARACTER*(*) string
319    
320    C     !LOCAL VARIABLES:
321        CHARACTER*26  LOWER        CHARACTER*26  LOWER
322        DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/        DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/
323        SAVE LOWER        SAVE LOWER
# Line 248  C     Translate string to upper case. Line 325  C     Translate string to upper case.
325        DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/        DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
326        SAVE UPPER        SAVE UPPER
327        INTEGER   I, L        INTEGER   I, L
328    CEOP
329    
330  C  C
331        DO 10 I = 1, LEN(string)        DO 10 I = 1, LEN(string)
332          L = INDEX(LOWER,string(I:I))          L = INDEX(LOWER,string(I:I))
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22