--- MITgcm/optim/utils.F	2002/02/05 20:34:35	1.1
+++ MITgcm/optim/utils.F	2002/11/15 04:03:25	1.2
@@ -0,0 +1,259 @@
+C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/optim/utils.F,v 1.2 2002/11/15 04:03:25 heimbach Exp $
+
+#include "CPP_EEOPTIONS.h"
+
+C--   File utils.F: General purpose support routines
+C--    Contents
+C-- U DATE            - Returns date and time.
+C--   IFNBLNK         - Returns index of first non-blank string character.
+C--   ILNBLNK         - Returns index of last non-blank string character.
+C--   IO_ERRCOUNT     - Reads IO error counter.
+C--   LCASE           - Translates to lower case.
+C--UM MACHINE         - Returns character string identifying computer.
+C--   UCASE           - Translates to upper case.
+C--   Routines marked "M" contain specific machine dependent code.
+C--   Routines marked "U" contain UNIX OS calls.
+
+CStartOfInterface
+      SUBROUTINE DATE ( string , myThreadId )
+C     /==========================================================\
+C     | SUBROUTINE DATE                                          |
+C     | o Return current date                                    |
+C     \==========================================================/
+      IMPLICIT NONE
+#include "SIZE.h"
+#include "EEPARAMS.h"
+C
+      CHARACTER*(*) string
+      INTEGER myThreadId
+CEndOfInterface
+C
+      INTEGER lDate
+      CHARACTER*(MAX_LEN_MBUF) msgBuffer
+C
+      lDate = 24
+      IF ( LEN(string) .LT. lDate ) GOTO 901
+      string = ' '
+#ifndef TARGET_T3E
+#ifndef TARGET_CRAY_VECTOR
+      CALL FDATE( string )
+#endif
+#endif
+C   
+ 1000 CONTINUE
+      RETURN
+  901 CONTINUE
+      WRITE(msgBuffer,'(A)')
+     &'                                                       '
+      CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
+     &SQUEEZE_RIGHT,myThreadId)
+      WRITE(msgBuffer,'(A)')
+     &'*** WARNING WARNING WARNING WARNING WARNING WARNING ***'
+      CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
+     &SQUEEZE_RIGHT,myThreadId)
+      WRITE(msgBuffer,'(A)')
+     &'procedure: "DATE".'
+      CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
+     &SQUEEZE_RIGHT,myThreadId)
+      WRITE(msgBuffer,'(A)')
+     &'Variable passed to S/R DATE is too small.'
+      CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
+     &SQUEEZE_RIGHT,myThreadId)
+      WRITE(msgBuffer,'(A)')
+     &' Argument must be at least',lDate,'characters long.'
+      CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
+     &SQUEEZE_RIGHT,myThreadId)
+      WRITE(msgBuffer,'(A)')
+     &'*******************************************************'
+      CALL PRINT_MESSAGE(msgBuffer,standardMessageUnit,
+     &SQUEEZE_RIGHT,myThreadId)
+      GOTO 1000
+      END
+
+CStartOfInterface
+      INTEGER FUNCTION IFNBLNK( string )
+C     /==========================================================\
+C     | FUNCTION IFNBLNK                                         |
+C     | o Find first non-blank in character string.              |
+C     \==========================================================/
+      IMPLICIT NONE
+C
+      CHARACTER*(*) string
+CEndOfInterface
+C
+      INTEGER L, LS
+C
+      LS     = LEN(string)
+      IFNBLNK = 0
+      DO 10 L = 1, LS
+       IF ( string(L:L) .EQ. ' ' ) GOTO 10
+        IFNBLNK = L
+        GOTO 11
+   10 CONTINUE
+   11 CONTINUE
+C
+      RETURN
+      END
+
+CStartOfInterface
+      INTEGER FUNCTION ILNBLNK( string )
+C     /==========================================================\
+C     | FUNCTION ILNBLNK                                         |
+C     | o Find last non-blank in character string.               |
+C     \==========================================================/
+      IMPLICIT NONE
+      CHARACTER*(*) string
+CEndOfInterface
+      INTEGER L, LS
+C
+      LS      = LEN(string)
+      ILNBLNK = LS
+      DO 10 L = LS, 1, -1
+        IF ( string(L:L) .EQ. ' ' ) GOTO 10
+         ILNBLNK = L
+         GOTO 11
+   10 CONTINUE
+   11 CONTINUE
+C
+      RETURN
+      END
+
+CStartofinterface
+      INTEGER FUNCTION IO_ERRCOUNT(myThid)
+C     /==========================================================\
+C     | FUNCTION IO_ERRCOUNT                                     |
+C     | o Reads IO error counter.                                |
+C     \==========================================================/
+      IMPLICIT NONE
+C     == Global variables ==
+#include "SIZE.h"
+#include "EEPARAMS.h"
+
+C     == Routine arguments ==
+      INTEGER myThid
+CEndofinterface
+
+      IO_ERRCOUNT = ioErrorCount(myThid)
+
+      RETURN
+      END
+
+CStartOfInterface
+      SUBROUTINE LCASE ( string )
+C     /==========================================================\
+C     | SUBROUTINE LCASE                                         |
+C     | o Convert character string to all lower case.            |
+C     \==========================================================/
+      IMPLICIT NONE
+      CHARACTER*(*) string
+CEndOfInterface
+      CHARACTER*26  LOWER
+      DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/
+      SAVE LOWER
+      CHARACTER*26  UPPER
+      DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+      SAVE UPPER
+      INTEGER   I, L
+C
+      DO 10 I = 1, LEN(string)
+        L = INDEX(UPPER,string(I:I))
+        IF ( L .EQ. 0 ) GOTO 10
+         string(I:I) = LOWER(L:L)
+   10 CONTINUE
+C   
+      RETURN
+      END
+
+CStartOfInterface
+      SUBROUTINE MACHINE ( string )
+C     /==========================================================\
+C     | SUBROUTINE MACHINE                                       |
+C     | o Return computer identifier in string.                  |
+C     \==========================================================/
+      IMPLICIT NONE
+#include "SIZE.h"
+#include "EEPARAMS.h"
+      CHARACTER*(*) string
+CEndOfInterface
+C
+      INTEGER  IFNBLNK
+      INTEGER  ILNBLNK
+      EXTERNAL IFNBLNK
+      EXTERNAL ILNBLNK
+C
+      INTEGER  iFirst
+      INTEGER  iLast 
+      INTEGER  iEnd  
+      INTEGER  iFree
+      INTEGER  idSize
+      CHARACTER*1024 strTmp
+      CHARACTER*1024 idString
+
+      strTmp = 'UNKNOWN'
+      iFree  = 1
+      idSize = LEN(string)
+#if (defined (TARGET_T3E) || defined (TARGET_CRAY_VECTOR))
+      IFirst = 0
+      CALL PXFGETENV('USER',iFirst,strTmp,ILast,Iend  )
+#else
+      CALL GETENV('USER',strTmp  )
+#endif
+      IF ( strTmp .NE. ' ' ) THEN
+        iFirst = IFNBLNK(strTmp)
+        iLast  = ILNBLNK(strTmp)
+        iEnd   = iLast-iFirst+1
+        IF (iEnd .GE. 0 ) THEN
+         idString(iFree:) = strTmp(iFirst:iFirst+iEnd)
+        ENDIF
+        iFree = iFree+iEnd+1
+        IF ( iFree .LE. idSize ) THEN
+          idString(iFree:iFree) = '@'
+          iFree = iFree+1
+        ENDIF
+      ENDIF
+      strTmp = 'UNKNOWN'
+#if (defined (TARGET_T3E) || defined (TARGET_CRAY_VECTOR))
+      IFirst = 0
+      CALL PXFGETENV('HOST',iFirst,strTmp,ILast,Iend  )
+#else
+      CALL GETENV('HOST',strTmp  )
+#endif
+      IF ( strTmp .NE. ' ' ) THEN
+        iFirst = IFNBLNK(strTmp)
+        iLast  = ILNBLNK(strTmp)
+        iEnd   = iLast-iFirst+1
+        iEnd   = MIN(iEnd,idSize-iFree)
+        iEnd   = iEnd-1
+        IF (iEnd .GE. 0 ) THEN
+          idString(iFree:) = strTmp(iFirst:iFirst+iEnd)
+        ENDIF
+        iFree = iFree+iEnd+1
+      ENDIF
+C
+      string = idString
+C
+ 1000 CONTINUE
+      RETURN
+      END
+C***********************************************************************
+      SUBROUTINE UCASE ( string )
+      IMPLICIT NONE
+C     Translate string to upper case.
+      CHARACTER*(*) string
+      CHARACTER*26  LOWER
+      DATA LOWER /'abcdefghijklmnopqrstuvwxyz'/
+      SAVE LOWER
+      CHARACTER*26  UPPER
+      DATA UPPER /'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
+      SAVE UPPER
+      INTEGER   I, L
+C
+      DO 10 I = 1, LEN(string)
+        L = INDEX(LOWER,string(I:I))
+        IF ( L .EQ. 0 ) GOTO 10
+          string(I:I) = UPPER(L:L)
+   10 CONTINUE
+C   
+      RETURN
+      END
+C************************************************************************