C $Id: print.F,v 1.2 2006/05/12 22:25:15 ce107 Exp $
C--   File printf.F: Routines for performing formatted textual I/O
C--                  in the MITgcm UV implementation environment.
C--    Contents
C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field
C--                     Uses print_message for writing


CStartOfInterface
      SUBROUTINE PRINT_MAPR8 ( fld, fldTitle,
     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     | User code should call an interface routine like          |
C     | PRINT_MAP_XYR8                                           |
C     \==========================================================/
      IMPLICIT NONE

C     == Global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"

C     == Routine arguments ==
      CHARACTER*(*) fldTitle
      INTEGER iLo, iHi
      INTEGER jLo, jHi
      INTEGER kLo, kHi
      INTEGER nBx, nBy
      Real 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 ==
      INTEGER MAX_LEN_PLOTBUF
      PARAMETER ( MAX_LEN_PLOTBUF = 8192 )
      CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER lChList
      PARAMETER ( lChList = 28 )
      CHARACTER*(lChList) chList
      Real fMin
      Real fMax
      Real fRange
      Real small
      INTEGER I, J, K, bi, bj, iStrngLo, iStrngHi, iBuf, iDx
      LOGICAL validRange

      chList = '-abcdefghijklmnopqrstuvwxyz+'
      small  = 1. _d -15
      fMin   =  1. _d 32
      fMax   = -1. _d 32
      validRange = .FALSE.

C--   Calculate field range
      DO bj=byMin, byMax, byStr
       DO bi=bxMin, bxMax, bxStr
        DO K=kMin, kMax, kStr
         DO J=jMin, jMax, jStr
          DO I=iMin, iMax, iStr
           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)
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO
      fRange = fMax-fMin
      IF ( fRange .GT. small ) THEN
       validRange = .TRUE.
      ENDIF

C--   Write field title and statistics
      msgBuf = '================================================'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
      iStrngLo = IFNBLNK(fldTitle)
      iStrngHi = ILNBLNK(fldTitle)
      IF ( iStrngLo .LE. iStrngHi ) THEN
       WRITE(msgBuf,'(A)') fldTitle(iStrngLo:iStrngHi)
      ELSE
       msgBuf = 'UNKNOWN FIELD'
      ENDIF
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
      WRITE(msgBuf,'(4X,3(A,E12.5))')
     & '  CMIN = ',fMin,
     & ', CMAX = ',fMax,
     & ', CINT = ',fRange/FLOAT(lChlist)
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
      WRITE(msgBuf,'(4X,A,1024A1)')
     & '  SYMBOLS (CMIN->CMAX): ',(chList(I:I),I=1,lChList)
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
      WRITE(msgBuf,'(4X,A,1024A1)')
     & '                   0.0: ','*'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
       WRITE(msgBuf,'(4X,A,3(A,I4),A)')
     & '  RANGE I (Lo:Hi:Step):',
     &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
     &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
     &  ':',iStr,')'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
       WRITE(msgBuf,'(4X,A,3(A,I4),A)')
     & '  RANGE J (Lo:Hi:Step):',
     &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
     &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
     &  ':',jStr,')'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
       WRITE(msgBuf,'(4X,A,3(A,I4),A)')
     & '  RANGE K (Lo:Hi:Step):',
     &  '(',kMin,
     &  ':',kMax,
     &  ':',kStr,')'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
      msgBuf = '================================================'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)

C--   Write field
      IF ( validRange ) THEN
C      Header
       plotBuf = ' '
       iBuf = 6 
       DO bi=bxMin, bxMax, bxStr
        DO I=iMin, iMax, iStr
         iDx = myXGlobalLo-1+(bi-1)*sNx+I
         iBuf = iBuf + 1
         IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
          IF ( iDx. LT. 10 ) THEN
           WRITE(plotBuf(iBuf:),'(A,I1)') 'I=',iDx
          ELSEIF ( iDx. LT. 100 ) THEN
           WRITE(plotBuf(iBuf:),'(A,I2)') 'I=',iDx
          ELSEIF ( iDx. LT. 1000 ) THEN
           WRITE(plotBuf(iBuf:),'(A,I3)') 'I=',iDx
          ELSEIF ( iDx. LT. 10000 ) THEN
           WRITE(plotBuf(iBuf:),'(A,I4)') 'I=',iDx
          ENDIF
         ENDIF
        ENDDO
       ENDDO
       CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT, 1)
       plotBuf = '|--J--|'
       iBuf = 7 
       DO bi=bxMin, bxMax, bxStr
        DO I=iMin, iMax, iStr
         iDx = myXGlobalLo-1+(bi-1)*sNx+I
         iBuf = iBuf+1
         IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
          WRITE(plotBuf(iBuf:),'(A)')  '|'
         ELSE
          WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)
         ENDIF
        ENDDO
       ENDDO
       CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
     &                    SQUEEZE_RIGHT, 1)
C      Data
       DO K=kMin, kMax, kStr
        DO bj=byMin, byMax, byStr
         DO J=jMin, jMax, jStr
          WRITE(plotBuf,'(1X,I5,1X)') 
     &     myYGlobalLo-1+(bj-1)*sNy+J
          iBuf = 7
          DO bi=bxMin, bxMax, bxStr
           DO I=iMin, iMax, iStr
            iBuf = iBuf + 1
            IDX = NINT( 
     &           FLOAT( lChList-1 )*( fld(I,J,K,bi,bj)-fMin ) / (fRange)
     $           )+1
            IF ( iBuf .LE. MAX_LEN_PLOTBUF ) 
     &       plotBuf(iBuf:iBuf) = chList(IDX:IDX)
            IF ( fld(I,J,K,bi,bj) .EQ. 0. _d 0) THEN
             IF ( iBuf .LE. MAX_LEN_PLOTBUF ) 
     &        plotBuf(iBuf:iBuf) = '*'
            ENDIF
           ENDDO
          ENDDO
          CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
     &                       SQUEEZE_RIGHT, 1)
         ENDDO
        ENDDO
       ENDDO
      ENDIF
C--   Write delimiter
      msgBuf = '================================================'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
      msgBuf = '=  END OF FIELD                                ='
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)
      msgBuf = '================================================'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT, 1)

      RETURN
      END



CStartOfInterface
      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     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
C     == Routine arguments ==
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 ==
      INTEGER iStart
      INTEGER iEnd
      CHARACTER*9 idString
C--   Find beginning and end of message
      IF ( sq .EQ. SQUEEZE_BOTH .OR.
     &     sq .EQ. SQUEEZE_LEFT ) THEN
       iStart = IFNBLNK( message )
      ELSE
       iStart = 1
      ENDIF
      IF ( sq .EQ. SQUEEZE_BOTH .OR.
     &     sq .EQ. SQUEEZE_RIGHT ) THEN
       iEnd   = ILNBLNK( message )
      ELSE
       iEnd   = LEN(message)
      ENDIF
      IF ( message .EQ. ' ' ) THEN
       WRITE(unit,'(A)') ' '
      ELSE
       WRITE(unit,'(A)') message(iStart:iEnd)
      ENDIF
C
      RETURN
      END