--- MITgcm/eesupp/src/print.F	1998/04/22 19:15:30	1.1
+++ MITgcm/eesupp/src/print.F	2001/09/21 03:54:35	1.18
@@ -1,4 +1,5 @@
-C $Id: print.F,v 1.1 1998/04/22 19:15:30 cnh Exp $
+C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/eesupp/src/print.F,v 1.18 2001/09/21 03:54:35 cnh Exp $
+C $Name:  $
 
 #include "CPP_EEOPTIONS.h"
 
@@ -6,42 +7,70 @@
 C--                  in the MITgcm UV implementation environment.
 C--    Contents
 C--    o print_error    Does IO with **ERROR** highlighted header
+C--    o print_list_i   Prints one-deimensional list of INTEGER
+C--                     numbers.
+C--    o print_list_l   Prints one-deimensional list of LOGICAL
+C--                     variables.
+C--    o print_list_r8  Prints one-deimensional list of Real*8
+C--                     numbers.
+C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field
+C--                     Uses print_message for writing
 C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field
 C--                     Uses print_message for writing
 C--    o print_message  Does IO with unhighlighted header
 
-CStartOfInterface
+CBOP               
+
+C     !ROUTINE: PRINT_ERROR
+
+C     !INTERFACE:
       SUBROUTINE PRINT_ERROR( message , myThid )
-C     /============================================================\
-C     | SUBROUTINE PRINT_ERROR                                     |
-C     | o Write out error message using "standard" format.         |
-C     | Notes                                                      |
-C     | =====                                                      |
-C     | o Some system's I/O is not "thread-safe". For this reason  |
-C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
-C     |   critical region is defined around the write here. In some|
-C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
-C     |   for thread number 1 - writes for other threads are       |
-C     |   ignored!                                                 |
-C     | o In a non-parallel form these routines can still be used. |
-C     |   to produce pretty printed output!                        |
-C     \============================================================/
+      IMPLICIT NONE
+
+C     !DESCRIPTION:
+C     *============================================================*
+C     | SUBROUTINE PRINT_ERROR                                      
+C     | o Write out error message using "standard" format.          
+C     *============================================================*
+C     | Notes                                                       
+C     | =====                                                       
+C     | o Some system   I/O is not "thread-safe". For this reason   
+C     |   without the FMTFTN_IO_THREAD_SAFE directive set a         
+C     |   critical region is defined around the write here. In some 
+C     |   cases  BEGIN_CRIT() is approximated by only doing writes  
+C     |   for thread number 1 - writes for other threads are        
+C     |   ignored!                                                  
+C     | o In a non-parallel form these routines are still used   
+C     |   to produce pretty printed output. The process and thread
+C     |   id prefix is omitted in this case.
+C     *============================================================*
+
+C     !USES:
 C     == Global data ==
 #include "SIZE.h"
 #include "EEPARAMS.h"
 #include "EESUPPORT.h"
-C     == Routine arguments ==
-      CHARACTER*(*) message
-      INTEGER       myThid
-CEndOfInterface
       INTEGER  IFNBLNK
       EXTERNAL IFNBLNK
       INTEGER  ILNBLNK
       EXTERNAL ILNBLNK
+
+C     !INPUT/OUTPUT PARAMETERS:
+C     == Routine arguments ==
+C     message :: Text string to print
+C     myThid  :: Thread number of this instance
+      CHARACTER*(*) message
+      INTEGER       myThid
+
+C     !LOCAL VARIABLES:
 C     == Local variables ==
+C     iStart, iEnd :: Temps. for string indexing
+C     idString     :: Temp. for building message prefix
       INTEGER iStart
       INTEGER iEnd
       CHARACTER*9 idString
+CEOP
+
 C--   Find beginning and end of message
       iStart = IFNBLNK( message )
       iEnd   = ILNBLNK( message )
@@ -52,7 +81,8 @@
        IF ( message .EQ. ' ' ) THEN
         WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
        ELSE
-        WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)
+        WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, 
+     &   message(iStart:iEnd)
        ENDIF
       ELSEIF ( pidIO .EQ. myProcId ) THEN
 C--    Write multi-process format
@@ -69,7 +99,7 @@
 #ifndef FMTFTN_IO_THREAD_SAFE
         _BEGIN_CRIT(myThid)
 #endif
-        WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') 
+        WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999) 
      &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', 
      &  ' '
 #ifndef FMTFTN_IO_THREAD_SAFE
@@ -79,7 +109,7 @@
 #ifndef FMTFTN_IO_THREAD_SAFE
         _BEGIN_CRIT(myThid)
 #endif
-        WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)') 
+        WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999) 
      &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ', 
      &  message(iStart:iEnd)
 #ifndef FMTFTN_IO_THREAD_SAFE
@@ -88,44 +118,423 @@
        ENDIF
       ENDIF
 C
+ 1000 CONTINUE
       RETURN
+
+  999 CONTINUE
+       ioErrorCount(myThid) = ioErrorCount(myThid)+1
+      GOTO 1000
       END
 
-CStartOfInterface
-      SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,
+CBOP
+C     !ROUTINE: PRINT_LIST_I
+
+C     !INTERFACE:
+      SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, 
+     &                         markEnd, compact, ioUnit )
+      IMPLICIT NONE
+C     !DESCRIPTION:
+C     *==========================================================*
+C     | o SUBROUTINE PRINT_LIST_I                                 
+C     *==========================================================*
+C     | Routine for producing list of values for a field with     
+C     | duplicate values collected into                           
+C     |    n @ value                                              
+C     | record.                                                   
+C     *==========================================================*
+
+C     !USES:
+C     == Global data ==  
+#include "SIZE.h"
+#include "EEPARAMS.h"
+
+C     !INPUT/OUTPUT PARAMETERS:
+C     == Routine arguments ==
+C     fld    ::  Data to be printed
+C     lFld   ::  Number of elements to be printed
+C     index_type :: Flag indicating which type of index to print
+C                   INDEX_K    => /* K = nnn */
+C                   INDEX_I    => /* I = nnn */
+C                   INDEX_J    => /* J = nnn */
+C                   INDEX_NONE =>
+C     compact ::  Flag to control use of repeat symbol for same valued
+C                 fields.
+C     markEnd ::  Flag to control whether there is a separator after the
+C                 last element
+C     ioUnit ::   Unit number for IO.
+      INTEGER lFld 
+      INTEGER index_type
+      INTEGER fld(lFld)
+      LOGICAL markEnd
+      LOGICAL compact
+      INTEGER ioUnit
+
+C     !LOCAL VARIABLES:
+C     == Local variables ==
+C     iLo  - Range index holders for selecting elements with
+C     iHi    with the same value
+C     nDup - Number of duplicates
+C     xNew, xOld - Hold current and previous values of field
+C     punc - Field separator
+C     msgBuf - IO buffer
+C     index_lab - Index for labelling elements
+C     K    - Loop counter
+      INTEGER iLo
+      INTEGER iHi
+      INTEGER nDup
+      INTEGER xNew, xOld
+      CHARACTER punc
+      CHARACTER*(MAX_LEN_MBUF) msgBuf
+      CHARACTER*2 commOpen,commClose
+      CHARACTER*3 index_lab
+      INTEGER K
+CEOP
+
+      IF     ( index_type .EQ. INDEX_I ) THEN
+       index_lab = 'I ='
+      ELSEIF ( index_type .EQ. INDEX_J ) THEN
+       index_lab = 'J ='
+      ELSEIF ( index_type .EQ. INDEX_K ) THEN
+       index_lab = 'K ='
+      ELSE
+       index_lab = '?='
+      ENDIF
+      commOpen  = '/*'
+      commClose = '*/'
+      iLo = 1
+      iHi = 1
+      punc = ','
+      xOld = fld(1)
+      DO K=2,lFld
+       xNew = fld(K  )
+       IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
+        nDup = iHi-iLo+1
+        IF ( nDup .EQ. 1 ) THEN
+         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
+         IF ( index_type .NE. INDEX_NONE ) 
+     &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,commClose
+        ELSE
+         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
+         IF ( index_type .NE. INDEX_NONE ) 
+     &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,':',iHi,commClose
+        ENDIF
+        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
+        iLo  = K
+        iHi  = K
+        xOld = xNew
+       ELSE
+        iHi = K
+       ENDIF
+      ENDDO
+      punc = ' '
+      IF ( markEnd ) punc = ','
+      nDup = iHi-iLo+1
+      IF    ( nDup .EQ. 1 ) THEN
+       WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
+       IF ( index_type .NE. INDEX_NONE ) 
+     &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') 
+     &  commOpen,index_lab,iLo,commClose
+      ELSEIF( nDup .GT. 1 ) THEN
+       WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
+       IF ( index_type .NE. INDEX_NONE ) 
+     &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') 
+     &  commOpen,index_lab,iLo,':',iHi,commClose
+      ENDIF
+      CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
+
+      RETURN
+      END
+
+CBOP
+C     !ROUTINE: PRINT_LIST_L
+
+C     !INTERFACE:
+      SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, 
+     &                         compact, ioUnit )
+      IMPLICIT NONE
+C     !DESCRIPTION:
+C     *==========================================================*
+C     | o SUBROUTINE PRINT_LIST_L                                 
+C     *==========================================================*
+C     | Routine for producing list of values for a field with     
+C     | duplicate values collected into                           
+C     |    n @ value                                              
+C     | record.                                                   
+C     *==========================================================*
+
+C     !USES:
+C     == Global data ==  
+#include "SIZE.h"
+#include "EEPARAMS.h"
+
+C     !INPUT/OUTPUT PARAMETERS:
+C     == Routine arguments ==
+C     fld    -  Data to be printed
+C     lFld   -  Number of elements to be printed
+C     index_type - Flag indicating which type of index to print
+C                  INDEX_K    => /* K = nnn */
+C                  INDEX_I    => /* I = nnn */
+C                  INDEX_J    => /* J = nnn */
+C                  INDEX_NONE =>
+C     compact -  Flag to control use of repeat symbol for same valued
+C                fields.
+C     markEnd -  Flag to control whether there is a separator after the
+C                last element
+C     ioUnit -  Unit number for IO.
+      INTEGER lFld 
+      INTEGER index_type
+      LOGICAL fld(lFld)
+      LOGICAL markEnd
+      LOGICAL compact
+      INTEGER ioUnit
+
+C     !LOCAL VARIABLES:
+C     == Local variables ==
+C     iLo  - Range index holders for selecting elements with
+C     iHi    with the same value
+C     nDup - Number of duplicates
+C     xNew, xOld - Hold current and previous values of field
+C     punc - Field separator
+C     msgBuf - IO buffer
+C     index_lab - Index for labelling elements
+C     K    - Loop counter
+      INTEGER iLo
+      INTEGER iHi
+      INTEGER nDup
+      LOGICAL xNew, xOld
+      CHARACTER punc
+      CHARACTER*(MAX_LEN_MBUF) msgBuf
+      CHARACTER*2 commOpen,commClose
+      CHARACTER*3 index_lab
+      INTEGER K
+CEOP
+
+      IF     ( index_type .EQ. INDEX_I ) THEN
+       index_lab = 'I ='
+      ELSEIF ( index_type .EQ. INDEX_J ) THEN
+       index_lab = 'J ='
+      ELSEIF ( index_type .EQ. INDEX_K ) THEN
+       index_lab = 'K ='
+      ELSE
+       index_lab = '?='
+      ENDIF
+      commOpen  = '/*'
+      commClose = '*/'
+      iLo = 1
+      iHi = 1
+      punc = ','
+      xOld = fld(1)
+      DO K=2,lFld
+       xNew = fld(K  )
+       IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
+        nDup = iHi-iLo+1
+        IF ( nDup .EQ. 1 ) THEN
+         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
+         IF ( index_type .NE. INDEX_NONE ) 
+     &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,commClose
+        ELSE
+         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
+         IF ( index_type .NE. INDEX_NONE ) 
+     &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,':',iHi,commClose
+        ENDIF
+        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
+        iLo  = K
+        iHi  = K
+        xOld = xNew
+       ELSE
+        iHi = K
+       ENDIF
+      ENDDO
+      punc = ' '
+      IF ( markEnd ) punc = ','
+      nDup = iHi-iLo+1
+      IF    ( nDup .EQ. 1 ) THEN
+       WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
+       IF ( index_type .NE. INDEX_NONE ) 
+     &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,commClose
+      ELSEIF( nDup .GT. 1 ) THEN
+       WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
+       IF ( index_type .NE. INDEX_NONE ) 
+     &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') 
+     &  commOpen,index_lab,iLo,':',iHi,commClose
+      ENDIF
+      CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
+
+      RETURN
+      END
+
+CBOP
+C     !ROUTINE: PRINT_LIST_R8
+C     !INTERFACE:
+      SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, 
+     &    markEnd, compact, ioUnit )
+      IMPLICIT NONE
+C     !DESCRIPTION:
+C     *==========================================================*
+C     | o SUBROUTINE PRINT_LIST_R8                                
+C     *==========================================================*
+C     | Routine for producing list of values for a field with     
+C     | duplicate values collected into                           
+C     |    n @ value                                              
+C     | record.                                                   
+C     *==========================================================*
+
+C     !USES:
+C     == Global data ==
+#include "SIZE.h"
+#include "EEPARAMS.h"
+
+C     !INPUT/OUTPUT PARAMETERS:
+C     == Routine arguments ==
+C     fld    -  Data to be printed
+C     lFld   -  Number of elements to be printed
+C     index_type - Flag indicating which type of index to print
+C                  INDEX_K    => /* K = nnn */
+C                  INDEX_I    => /* I = nnn */
+C                  INDEX_J    => /* J = nnn */
+C                  INDEX_NONE =>
+C     compact -  Flag to control use of repeat symbol for same valued
+C                fields.
+C     markEnd -  Flag to control whether there is a separator after the
+C                last element
+C     ioUnit -  Unit number for IO.
+      INTEGER lFld 
+      INTEGER index_type
+      Real*8  fld(lFld)
+      LOGICAL markEnd
+      LOGICAL compact
+      INTEGER ioUnit
+
+C     !LOCA VARIABLES:
+C     == Local variables ==
+C     iLo  - Range index holders for selecting elements with
+C     iHi    with the same value
+C     nDup - Number of duplicates
+C     xNew, xOld - Hold current and previous values of field
+C     punc - Field separator
+C     msgBuf - IO buffer
+C     index_lab - Index for labelling elements
+C     K    - Loop counter
+      INTEGER iLo
+      INTEGER iHi
+      INTEGER nDup
+      Real*8 xNew, xOld
+      CHARACTER punc
+      CHARACTER*(MAX_LEN_MBUF) msgBuf
+      CHARACTER*2 commOpen,commClose
+      CHARACTER*3 index_lab
+      INTEGER K
+CEOP
+
+      IF     ( index_type .EQ. INDEX_I ) THEN
+       index_lab = 'I ='
+      ELSEIF ( index_type .EQ. INDEX_J ) THEN
+       index_lab = 'J ='
+      ELSEIF ( index_type .EQ. INDEX_K ) THEN
+       index_lab = 'K ='
+      ELSE
+       index_lab = '?='
+      ENDIF
+      commOpen  = '/*'
+      commClose = '*/'
+      iLo = 1
+      iHi = 1
+      punc = ','
+      xOld = fld(1)
+      DO K=2,lFld
+       xNew = fld(K  )
+       IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
+        nDup = iHi-iLo+1
+        IF ( nDup .EQ. 1 ) THEN
+         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
+         IF ( index_type .NE. INDEX_NONE ) 
+     &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,commClose
+        ELSE
+         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
+         IF ( index_type .NE. INDEX_NONE ) 
+     &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,':',iHi,commClose
+        ENDIF
+        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 
+     &    SQUEEZE_RIGHT , 1)
+        iLo  = K
+        iHi  = K
+        xOld = xNew
+       ELSE
+        iHi = K
+       ENDIF
+      ENDDO
+      punc = ' '
+      IF ( markEnd ) punc = ','
+      nDup = iHi-iLo+1
+      IF    ( nDup .EQ. 1 ) THEN
+       WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
+       IF ( index_type .NE. INDEX_NONE ) 
+     &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') 
+     &    commOpen,index_lab,iLo,commClose
+      ELSEIF( nDup .GT. 1 ) THEN
+       WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
+       IF ( index_type .NE. INDEX_NONE ) 
+     &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') 
+     &  commOpen,index_lab,iLo,':',iHi,commClose
+      ENDIF
+      CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, 
+     &    SQUEEZE_RIGHT , 1)
+
+      RETURN
+      END
+
+CBOP
+C     !ROUTINE: PRINT_MAPRS
+C     !INTERFACE:
+      SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
      I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
      I       iMin,  iMax,  iStr,
      I       jMin,  jMax,  jStr,
      I       kMin, kMax,   kStr,
      I      bxMin, bxMax,  bxStr,
      I      byMin, byMax,  byStr )
-C     /==========================================================\
-C     | SUBROUTINE PRINT_MAPR4                                   |
-C     | o Does textual mapping printing of a field.              |
-C     |==========================================================|
-C     | This routine does the actual formatting of the data      |
-C     | and printing to a file. It assumes an array using the    |
-C     | MITgcm UV indexing scheme and base index variables.      |
-C     | User code should call an interface routine like          |
-C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |
-C     | Text plots can be oriented XY, YZ, XZ. An orientation    |
-C     | is specficied through the "plotMode" argument. All the   |
-C     | plots made by a single call to this routine will use the |
-C     | same contour interval. The plot range (iMin,...,byStr)   |
-C     | can be three-dimensional. A separate plot is made for    |
-C     | each point in the plot range normal to the orientation.  |
-C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |
-C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|
-C     |      plots - one for K=1, one for K=3 and one for K=5.   |
-C     |      Each plot would have extents iMin:iMax step iStr    |
-C     |      and jMin:jMax step jStr.                            |
-C     \==========================================================/
+      IMPLICIT NONE
+C     !DESCRIPTION:
+C     *==========================================================*
+C     | SUBROUTINE PRINT_MAPR4                                    
+C     | o Does textual mapping printing of a field.               
+C     *==========================================================*
+C     | This routine does the actual formatting of the data       
+C     | and printing to a file. It assumes an array using the     
+C     | MITgcm UV indexing scheme and base index variables.       
+C     | User code should call an interface routine like           
+C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.    
+C     | Text plots can be oriented XY, YZ, XZ. An orientation     
+C     | is specficied through the "plotMode" argument. All the    
+C     | plots made by a single call to this routine will use the  
+C     | same contour interval. The plot range (iMin,...,byStr)    
+C     | can be three-dimensional. A separate plot is made for     
+C     | each point in the plot range normal to the orientation.   
+C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).  
+C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY 
+C     |      plots - one for K=1, one for K=3 and one for K=5.    
+C     |      Each plot would have extents iMin:iMax step iStr     
+C     |      and jMin:jMax step jStr.                             
+C     *==========================================================*
 
+C     !USES:
 C     == Global variables ==
 #include "SIZE.h"
 #include "EEPARAMS.h"
 #include "EESUPPORT.h"
+      INTEGER  IFNBLNK
+      EXTERNAL IFNBLNK
+      INTEGER  ILNBLNK
+      EXTERNAL ILNBLNK
 
+C     !INPUT/OUTPUT PARAMETERS:
 C     == Routine arguments ==
 C     fld        - Real*4 array holding data to be plotted
 C     fldTitle   - Name of field to be plotted
@@ -147,19 +556,14 @@
       INTEGER jLo, jHi
       INTEGER kLo, kHi
       INTEGER nBx, nBy
-      Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
+      _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
       INTEGER iMin, iMax, iStr
       INTEGER jMin, jMax, jStr
       INTEGER kMin, kMax, kStr
       INTEGER bxMin, bxMax, bxStr
       INTEGER byMin, byMax, byStr
-CEndOfInterface
-C     == Local variables ==
-      INTEGER  IFNBLNK
-      EXTERNAL IFNBLNK
-      INTEGER  ILNBLNK
-      EXTERNAL ILNBLNK
 
+C     !LOCAL VARIABLES:
 C     == Local variables ==
 C     plotBuf - Buffer for building plot record
 C     chList  - Character string used for plot
@@ -189,11 +593,11 @@
       INTEGER lChList
       PARAMETER ( lChList = 28 )
       CHARACTER*(lChList) chList
-      REAL fMin
-      REAL fMax
-      REAL fRange
-      REAL val
-      REAL small
+      _RL  fMin
+      _RL  fMax
+      _RL  fRange
+      _RL  val
+      _RL  small
       CHARACTER*2  accLab
       CHARACTER*7  dwnLab
       CHARACTER*3  pltLab
@@ -208,11 +612,12 @@
       INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
       INTEGER bi, bj, bk
       LOGICAL validRange
+CEOP
 
       chList = '-abcdefghijklmnopqrstuvwxyz+'
-      small  = 1. _d -15
-      fMin   =  1. _d 32
-      fMax   = -1. _d 32
+      small  =  1. _d -15
+      fMin   =  1. _d  32
+      fMax   = -1. _d  32
       validRange = .FALSE.
 
 C--   Calculate field range
@@ -221,7 +626,7 @@
         DO K=kMin, kMax, kStr
          DO J=jMin, jMax, jStr
           DO I=iMin, iMax, iStr
-           IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN
+           IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
             IF ( fld(I,J,K,bi,bj) .LT. fMin ) 
      &       fMin = fld(I,J,K,bi,bj)
             IF ( fld(I,J,K,bi,bj) .GT. fMax ) 
@@ -238,7 +643,8 @@
       ENDIF
 
 C--   Write field title and statistics
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
       iStrngLo = IFNBLNK(fldTitle)
@@ -258,8 +664,13 @@
      & '// CMAX = ', fMax
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      WRITE(msgBuf,'(A,1PE30.15)')
-     & '// CINT = ', fRange/FLOAT(lChlist-1)
+      IF ( validRange ) THEN
+       WRITE(msgBuf,'(A,1PE30.15)')
+     &  '// CINT = ', fRange/FLOAT(lChlist-1)
+      ELSE
+       WRITE(msgBuf,'(A,1PE30.15)')
+     &  '// CINT = ', 0.
+      ENDIF
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
       WRITE(msgBuf,'(A,1024A1)')
@@ -291,7 +702,8 @@
      &  ':',kStr,')'
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
 
@@ -387,12 +799,12 @@
        pltStep = sNy
        pltLab  = 'J ='
       ENDIF
-      IF ( validRange ) THEN
+C     IF ( validRange ) THEN
 C      Header
 C      Data
        DO bk=pltBlo, pltBhi, pltBstr
         DO K=pltMin,pltMax,pltStr
-         WRITE(plotBuf,'(A,I,I,I,I)') pltLab,
+         WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
      &   pltBase-1+(bk-1)*pltStep+K
          CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
      &                      SQUEEZE_RIGHT, 1)
@@ -449,9 +861,13 @@
              ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
               val = fld(K,I,J,bk,bi)
              ENDIF
-             IDX = NINT( 
+             IF ( validRange .AND. val .NE. 0. ) THEN
+              IDX = NINT( 
      &              FLOAT( lChList-1 )*( val-fMin ) / (fRange) 
      &             )+1
+             ELSE
+              IDX = 1
+             ENDIF
              IF ( iBuf .LE. MAX_LEN_PLOTBUF ) 
      &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
              IF ( val .EQ. 0. ) THEN
@@ -467,15 +883,18 @@
          ENDDO
         ENDDO
        ENDDO
-      ENDIF
+C     ENDIF
 C--   Write delimiter
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      msgBuf = '// END OF FIELD                                          ='
+      msgBuf = 
+     & '// END OF FIELD                                          ='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
       msgBuf = ' '
@@ -485,41 +904,54 @@
       RETURN
       END
 
-CStartOfInterface
-      SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,
+CBOP
+C     !ROUTINE: PRINT_MAPRL
+
+C     !INTERFACE:
+      SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
      I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
      I       iMin,  iMax,  iStr,
      I       jMin,  jMax,  jStr,
      I       kMin, kMax,   kStr,
      I      bxMin, bxMax,  bxStr,
      I      byMin, byMax,  byStr )
-C     /==========================================================\
-C     | SUBROUTINE PRINT_MAPR8                                   |
-C     | o Does textual mapping printing of a field.              |
-C     |==========================================================|
-C     | This routine does the actual formatting of the data      |
-C     | and printing to a file. It assumes an array using the    |
-C     | MITgcm UV indexing scheme and base index variables.      |
-C     | User code should call an interface routine like          |
-C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |
-C     | Text plots can be oriented XY, YZ, XZ. An orientation    |
-C     | is specficied through the "plotMode" argument. All the   |
-C     | plots made by a single call to this routine will use the |
-C     | same contour interval. The plot range (iMin,...,byStr)   |
-C     | can be three-dimensional. A separate plot is made for    |
-C     | each point in the plot range normal to the orientation.  |
-C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |
-C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|
-C     |      plots - one for K=1, one for K=3 and one for K=5.   |
-C     |      Each plot would have extents iMin:iMax step iStr    |
-C     |      and jMin:jMax step jStr.                            |
-C     \==========================================================/
+      IMPLICIT NONE
+
+C     !DESCRIPTION:
+C     *==========================================================*
+C     | SUBROUTINE PRINT_MAPRL                                    
+C     | o Does textual mapping printing of a field.               
+C     *==========================================================*
+C     | This routine does the actual formatting of the data       
+C     | and printing to a file. It assumes an array using the     
+C     | MITgcm UV indexing scheme and base index variables.       
+C     | User code should call an interface routine like           
+C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.    
+C     | Text plots can be oriented XY, YZ, XZ. An orientation     
+C     | is specficied through the "plotMode" argument. All the    
+C     | plots made by a single call to this routine will use the  
+C     | same contour interval. The plot range (iMin,...,byStr)    
+C     | can be three-dimensional. A separate plot is made for     
+C     | each point in the plot range normal to the orientation.   
+C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).  
+C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY 
+C     |      plots - one for K=1, one for K=3 and one for K=5.    
+C     |      Each plot would have extents iMin:iMax step iStr     
+C     |      and jMin:jMax step jStr.                             
+C     *==========================================================*
+      IMPLICIT NONE
 
+C     !USES:
 C     == Global variables ==
 #include "SIZE.h"
 #include "EEPARAMS.h"
 #include "EESUPPORT.h"
+      INTEGER  IFNBLNK
+      EXTERNAL IFNBLNK
+      INTEGER  ILNBLNK
+      EXTERNAL ILNBLNK
 
+C     !INPUT/OUTPUT PARAMETERS:
 C     == Routine arguments ==
 C     fld        - Real*8 array holding data to be plotted
 C     fldTitle   - Name of field to be plotted
@@ -541,19 +973,14 @@
       INTEGER jLo, jHi
       INTEGER kLo, kHi
       INTEGER nBx, nBy
-      Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
+      _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
       INTEGER iMin, iMax, iStr
       INTEGER jMin, jMax, jStr
       INTEGER kMin, kMax, kStr
       INTEGER bxMin, bxMax, bxStr
       INTEGER byMin, byMax, byStr
-CEndOfInterface
-C     == Local variables ==
-      INTEGER  IFNBLNK
-      EXTERNAL IFNBLNK
-      INTEGER  ILNBLNK
-      EXTERNAL ILNBLNK
 
+C     !LOCAL VARIABLES:
 C     == Local variables ==
 C     plotBuf - Buffer for building plot record
 C     chList  - Character string used for plot
@@ -583,11 +1010,11 @@
       INTEGER lChList
       PARAMETER ( lChList = 28 )
       CHARACTER*(lChList) chList
-      REAL fMin
-      REAL fMax
-      REAL fRange
-      REAL val
-      REAL small
+      _RL  fMin
+      _RL  fMax
+      _RL  fRange
+      _RL  val
+      _RL  small
       CHARACTER*2  accLab
       CHARACTER*7  dwnLab
       CHARACTER*3  pltLab
@@ -602,6 +1029,7 @@
       INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
       INTEGER bi, bj, bk
       LOGICAL validRange
+CEOP
 
       chList = '-abcdefghijklmnopqrstuvwxyz+'
       small  = 1. _d -15
@@ -615,12 +1043,13 @@
         DO K=kMin, kMax, kStr
          DO J=jMin, jMax, jStr
           DO I=iMin, iMax, iStr
-C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN
+           IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. ) 
+     &     THEN
             IF ( fld(I,J,K,bi,bj) .LT. fMin ) 
      &       fMin = fld(I,J,K,bi,bj)
             IF ( fld(I,J,K,bi,bj) .GT. fMax ) 
      &       fMax = fld(I,J,K,bi,bj)
-C          ENDIF
+           ENDIF
           ENDDO
          ENDDO
         ENDDO
@@ -632,7 +1061,8 @@
       ENDIF
 
 C--   Write field title and statistics
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
       iStrngLo = IFNBLNK(fldTitle)
@@ -652,8 +1082,13 @@
      & '// CMAX = ', fMax
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      WRITE(msgBuf,'(A,1PE30.15)')
+      IF ( validRange ) THEN
+       WRITE(msgBuf,'(A,1PE30.15)')
      & '// CINT = ', fRange/FLOAT(lChlist-1)
+      ELSE
+       WRITE(msgBuf,'(A,1PE30.15)')
+     & '// CINT = ', 0.
+      ENDIF
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
       WRITE(msgBuf,'(A,1024A1)')
@@ -685,7 +1120,8 @@
      &  ':',kStr,')'
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
 
@@ -781,12 +1217,12 @@
        pltStep = sNy
        pltLab  = 'J ='
       ENDIF
-      IF ( validRange ) THEN
+C     IF ( validRange ) THEN
 C      Header
 C      Data
        DO bk=pltBlo, pltBhi, pltBstr
         DO K=pltMin,pltMax,pltStr
-         WRITE(plotBuf,'(A,I,I,I,I)') pltLab,
+         WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
      &   pltBase-1+(bk-1)*pltStep+K
          CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
      &                      SQUEEZE_RIGHT, 1)
@@ -841,9 +1277,13 @@
              ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
               val = fld(K,I,J,bk,bi)
              ENDIF
-             IDX = NINT( 
-     &              FLOAT( lChList-1 )*( val-fMin ) / (fRange) 
-     &             )+1
+             IF ( validRange .AND. val .NE. 0. ) THEN
+              IDX = NINT( 
+     &               FLOAT( lChList-1 )*( val-fMin ) / (fRange) 
+     &              )+1
+             ELSE
+              IDX = 1
+             ENDIF
              IF ( iBuf .LE. MAX_LEN_PLOTBUF ) 
      &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
              IF ( val .EQ. 0. ) THEN
@@ -858,15 +1298,18 @@
          ENDDO
         ENDDO
        ENDDO
-      ENDIF
+C     ENDIF
 C--   Write delimiter
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      msgBuf = '// END OF FIELD                                          ='
+      msgBuf = 
+     & '// END OF FIELD                                          ='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
-      msgBuf = '// ======================================================='
+      msgBuf = 
+     & '// ======================================================='
       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
      &                   SQUEEZE_RIGHT, 1)
       msgBuf = ' '
@@ -876,43 +1319,58 @@
       RETURN
       END
 
-CStartOfInterface
+CBOP
+C     !ROUTINE: PRINT_MESSAGE
+
+C     !INTERFACE:
       SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
-C     /============================================================\
-C     | SUBROUTINE PRINT_MESSAGE                                   |
-C     | o Write out informational message using "standard" format. |
-C     | Notes                                                      |
-C     | =====                                                      |
-C     | o Some system's I/O is not "thread-safe". For this reason  |
-C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
-C     |   critical region is defined around the write here. In some|
-C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
-C     |   for thread number 1 - writes for other threads are       |
-C     |   ignored!                                                 |
-C     | o In a non-parallel form these routines can still be used. |
-C     |   to produce pretty printed output!                        |
-C     \============================================================/
+      IMPLICIT NONE
+C     !DESCRIPTION:
+C     *============================================================*
+C     | SUBROUTINE PRINT_MESSAGE                                    
+C     | o Write out informational message using "standard" format.  
+C     *============================================================*
+C     | Notes                                                       
+C     | =====                                                       
+C     | o Some system   I/O is not "thread-safe". For this reason   
+C     |   without the FMTFTN_IO_THREAD_SAFE directive set a         
+C     |   critical region is defined around the write here. In some 
+C     |   cases  BEGIN_CRIT() is approximated by only doing writes  
+C     |   for thread number 1 - writes for other threads are        
+C     |   ignored!                                                  
+C     | o In a non-parallel form these routines can still be used.  
+C     |   to produce pretty printed output!                         
+C     *============================================================*
+
+C     !USES:
 C     == Global data ==
 #include "SIZE.h"
 #include "EEPARAMS.h"
 #include "EESUPPORT.h"
+      INTEGER  IFNBLNK
+      EXTERNAL IFNBLNK
+      INTEGER  ILNBLNK
+      EXTERNAL ILNBLNK
+
+C     !INPUT/OUTPUT PARAMETERS:
 C     == Routine arguments ==
-C     message - Message to write
-C     unit    - Unit number to write to
-C     sq      - Justification option
+C     message :: Message to write
+C     unit    :: Unit number to write to
+C     sq      :: Justification option
       CHARACTER*(*) message
       INTEGER       unit
       CHARACTER*(*) sq
       INTEGER  myThid
-CEndOfInterface
-      INTEGER  IFNBLNK
-      EXTERNAL IFNBLNK
-      INTEGER  ILNBLNK
-      EXTERNAL ILNBLNK
+
+C     !LOCAL VARIABLES:
 C     == Local variables ==
+C     iStart, iEnd :: String indexing variables
+C     idString     :: Temp. for building prefix.
       INTEGER iStart
       INTEGER iEnd
       CHARACTER*9 idString
+CEOP
+
 C--   Find beginning and end of message
       IF ( sq .EQ. SQUEEZE_BOTH .OR.
      &     sq .EQ. SQUEEZE_LEFT ) THEN
@@ -950,7 +1408,7 @@
 #ifndef FMTFTN_IO_THREAD_SAFE
         _BEGIN_CRIT(myThid)
 #endif
-         WRITE(unit,'(A,A,A,A,A,A)') 
+         WRITE(unit,'(A,A,A,A,A,A)',ERR=999) 
      &   '(',PROCESS_HEADER,' ',idString,')',' '
 #ifndef FMTFTN_IO_THREAD_SAFE
         _END_CRIT(myThid)
@@ -959,7 +1417,7 @@
 #ifndef FMTFTN_IO_THREAD_SAFE
         _BEGIN_CRIT(myThid)
 #endif
-         WRITE(unit,'(A,A,A,A,A,A,A)') 
+         WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999) 
      &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ', 
      &   message(iStart:iEnd)
 #ifndef FMTFTN_IO_THREAD_SAFE
@@ -968,7 +1426,10 @@
        ENDIF
       ENDIF
 C
+ 1000 CONTINUE
       RETURN
-      END
+  999 CONTINUE
+       ioErrorCount(myThid) = ioErrorCount(myThid)+1
+      GOTO 1000
 
-C $Id: print.F,v 1.1 1998/04/22 19:15:30 cnh Exp $
+      END