Back to home page

MITgcm
 
 

    

File indexing completed on 2020-07-29 05:10:39 UTC

view on githubraw file Latest commit b9dadda2 on 2020-07-28 16:49:33 UTC
924557e60a Chri*0001 #include "CPP_EEOPTIONS.h"
                0002 
8689736b2d Jean*0003 C--  File printf.F: Routines for performing formatted textual I/O
                0004 C--                 in the MITgcm UV implementation environment.
                0005 C--   Contents
                0006 C--   o PRINT_MESSAGE  Does IO with unhighlighted header
                0007 C--   o PRINT_ERROR    Does IO with **ERROR** highlighted header
80e7a759fb Jean*0008 C--   o PRINT_LIST_I   Prints one-dimensional list of INTEGER
8689736b2d Jean*0009 C--                    numbers.
80e7a759fb Jean*0010 C--   o PRINT_LIST_L   Prints one-dimensional list of LOGICAL
8689736b2d Jean*0011 C--                    variables.
80e7a759fb Jean*0012 C--   o PRINT_LIST_RL  Prints one-dimensional list of Real(_RL)
8689736b2d Jean*0013 C--                    numbers.
                0014 C--   o PRINT_MAPRS    Formats ABCD... contour map of a Real(_RS) field
                0015 C--                    Uses print_message for writing
                0016 C--   o PRINT_MAPRL    Formats ABCD... contour map of a Real(_RL) field
                0017 C--                    Uses print_message for writing
                0018 
                0019 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0020 CBOP
                0021 C     !ROUTINE: PRINT_MESSAGE
                0022 C     !INTERFACE:
                0023       SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
4c563c2ee9 Chri*0024 
8689736b2d Jean*0025 C     !DESCRIPTION:
                0026 C     *============================================================*
                0027 C     | SUBROUTINE PRINT\_MESSAGE
                0028 C     | o Write out informational message using "standard" format.
                0029 C     *============================================================*
                0030 C     | Notes
                0031 C     | =====
                0032 C     | o Some system   I/O is not "thread-safe". For this reason
                0033 C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
                0034 C     |   critical region is defined around the write here. In some
                0035 C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
                0036 C     |   for thread number 1 - writes for other threads are
                0037 C     |   ignored!
                0038 C     | o In a non-parallel form these routines can still be used.
                0039 C     |   to produce pretty printed output!
                0040 C     *============================================================*
                0041 
                0042 C     !USES:
                0043       IMPLICIT NONE
                0044 
                0045 C     == Global data ==
                0046 #include "SIZE.h"
                0047 #include "EEPARAMS.h"
                0048 #include "EESUPPORT.h"
                0049 
                0050 C     !INPUT/OUTPUT PARAMETERS:
                0051 C     == Routine arguments ==
                0052 C     message :: Message to write
                0053 C     unit    :: Unit number to write to
                0054 C     sq      :: Justification option
                0055       CHARACTER*(*) message
                0056       INTEGER       unit
                0057       CHARACTER*(*) sq
                0058       INTEGER  myThid
                0059 
6c007c09cb Jean*0060 C     !FUNCTIONS:
                0061       INTEGER  IFNBLNK
                0062       EXTERNAL IFNBLNK
                0063       INTEGER  ILNBLNK
                0064       EXTERNAL ILNBLNK
                0065 
8689736b2d Jean*0066 C     !LOCAL VARIABLES:
                0067 C     == Local variables ==
                0068 C     iStart, iEnd :: String indexing variables
                0069 C     idString     :: Temp. for building prefix.
b9dadda204 Mart*0070 C     fmtStr, iTmp :: Temp. for building prefix.
                0071 C     iTmpThid     :: Temp. for building prefix.
8689736b2d Jean*0072       INTEGER iStart
                0073       INTEGER iEnd
b9dadda204 Mart*0074       INTEGER iTmp, iTmpThid
                0075       CHARACTER*13 fmtStr
                0076       CHARACTER*13 idString
8689736b2d Jean*0077 CEOP
                0078 
                0079 C--   Find beginning and end of message
                0080       IF ( sq .EQ. SQUEEZE_BOTH .OR.
                0081      &     sq .EQ. SQUEEZE_LEFT ) THEN
                0082        iStart = IFNBLNK( message )
                0083       ELSE
                0084        iStart = 1
                0085       ENDIF
                0086       IF ( sq .EQ. SQUEEZE_BOTH .OR.
                0087      &     sq .EQ. SQUEEZE_RIGHT ) THEN
                0088        iEnd   = ILNBLNK( message )
                0089       ELSE
                0090        iEnd   = LEN(message)
                0091       ENDIF
                0092 C--   Test to see if in multi-process ( or multi-threaded ) mode.
                0093 C     If so include process or thread identifier.
                0094       IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
                0095 C--    Write single process format
                0096        IF ( message .EQ. ' ' ) THEN
                0097         WRITE(unit,'(A)') ' '
                0098        ELSE
                0099         WRITE(unit,'(A)') message(iStart:iEnd)
                0100        ENDIF
                0101       ELSEIF ( pidIO .EQ. myProcId ) THEN
                0102 C--    Write multi-process format
d5aecb2c94 Jean*0103 C      PRINT can be called by several threads simultaneously.
d44e11c489 Jean*0104 C      The write statement may need to be marked as a critical section.
8689736b2d Jean*0105 #ifndef FMTFTN_IO_THREAD_SAFE
d5aecb2c94 Jean*0106 # ifdef USE_OMP_THREADING
                0107 C$OMP CRITICAL
                0108 # else
8689736b2d Jean*0109        _BEGIN_CRIT(myThid)
d5aecb2c94 Jean*0110 # endif
8689736b2d Jean*0111 #endif
b9dadda204 Mart*0112        fmtStr = '(I4.4,A,I4.4)'
                0113        IF ( nPx*nPy .GE. 10000 ) THEN
                0114          iTmp     = 1 + INT(LOG10(DFLOAT(nPx*nPy)))
                0115          iTmpThid = 1 + INT(LOG10(DFLOAT(MAX_NO_THREADS)))
                0116          iTmpThid = MAX( iTmpThid, 2, 8-iTmp )
                0117          WRITE(fmtStr,'(4(A,I1),A)')
                0118      &        '(I',iTmp,'.',iTmp,',A,I',iTmpThid,'.',iTmpThid,')'
                0119        ENDIF
                0120        WRITE(idString,fmtStr) myProcId,'.',myThid
                0121        iTmp = ILNBLNK( idString )
8689736b2d Jean*0122        IF ( message .EQ. ' ' ) THEN
d5aecb2c94 Jean*0123         WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
b9dadda204 Mart*0124      &   '(',PROCESS_HEADER,' ',idString(1:iTmp),')',' '
8689736b2d Jean*0125        ELSE
d5aecb2c94 Jean*0126         WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
b9dadda204 Mart*0127      &   '(',PROCESS_HEADER,' ',idString(1:iTmp),')',' ',
                0128      &   message(iStart:iEnd)
d5aecb2c94 Jean*0129        ENDIF
d44e11c489 Jean*0130        IF ( debugMode ) THEN
                0131         CALL MDS_FLUSH( unit, myThid )
                0132        ENDIF
d5aecb2c94 Jean*0133        GOTO 1000
                0134   999  CONTINUE
                0135        ioErrorCount(myThid) = ioErrorCount(myThid)+1
                0136  1000  CONTINUE
8689736b2d Jean*0137 #ifndef FMTFTN_IO_THREAD_SAFE
d5aecb2c94 Jean*0138 # ifdef USE_OMP_THREADING
                0139 C$OMP END CRITICAL
                0140 # else
                0141        _END_CRIT(myThid)
                0142 # endif
8689736b2d Jean*0143 #endif
                0144       ENDIF
                0145 
                0146 #ifndef DISABLE_WRITE_TO_UNIT_ZERO
                0147 C--   if error message, also write directly to unit 0 :
d5aecb2c94 Jean*0148       IF ( numberOfProcs .EQ. 1 .AND. myThid .EQ. 1
                0149      &     .AND. unit.EQ.errorMessageUnit
                0150      &     .AND. message .NE. ' ' ) THEN
                0151         IF ( nThreads.LE.1 ) THEN
                0152           WRITE(0,'(A)') message(iStart:iEnd)
                0153         ELSE
                0154           WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
                0155      &                   message(iStart:iEnd)
                0156         ENDIF
8689736b2d Jean*0157       ENDIF
                0158 #endif
4c563c2ee9 Chri*0159 
d5aecb2c94 Jean*0160       RETURN
8689736b2d Jean*0161       END
                0162 
                0163 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0164 CBOP
                0165 C     !ROUTINE: PRINT_ERROR
4c563c2ee9 Chri*0166 C     !INTERFACE:
924557e60a Chri*0167       SUBROUTINE PRINT_ERROR( message , myThid )
4c563c2ee9 Chri*0168 
                0169 C     !DESCRIPTION:
                0170 C     *============================================================*
8689736b2d Jean*0171 C     | SUBROUTINE PRINT\_ERROR
                0172 C     | o Write out error message using "standard" format.
4c563c2ee9 Chri*0173 C     *============================================================*
8689736b2d Jean*0174 C     | Notes
                0175 C     | =====
                0176 C     | o Some system   I/O is not "thread-safe". For this reason
                0177 C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
                0178 C     |   critical region is defined around the write here. In some
                0179 C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
                0180 C     |   for thread number 1 - writes for other threads are
                0181 C     |   ignored!
                0182 C     | o In a non-parallel form these routines are still used
4c563c2ee9 Chri*0183 C     |   to produce pretty printed output. The process and thread
                0184 C     |   id prefix is omitted in this case.
                0185 C     *============================================================*
                0186 
                0187 C     !USES:
8689736b2d Jean*0188       IMPLICIT NONE
                0189 
924557e60a Chri*0190 C     == Global data ==
                0191 #include "SIZE.h"
                0192 #include "EEPARAMS.h"
                0193 #include "EESUPPORT.h"
4c563c2ee9 Chri*0194 
                0195 C     !INPUT/OUTPUT PARAMETERS:
                0196 C     == Routine arguments ==
                0197 C     message :: Text string to print
                0198 C     myThid  :: Thread number of this instance
                0199       CHARACTER*(*) message
                0200       INTEGER       myThid
                0201 
6c007c09cb Jean*0202 C     !FUNCTIONS:
                0203 c     INTEGER  IFNBLNK
                0204 c     EXTERNAL IFNBLNK
                0205       INTEGER  ILNBLNK
                0206       EXTERNAL ILNBLNK
                0207 
4c563c2ee9 Chri*0208 C     !LOCAL VARIABLES:
924557e60a Chri*0209 C     == Local variables ==
4c563c2ee9 Chri*0210 C     iStart, iEnd :: Temps. for string indexing
                0211 C     idString     :: Temp. for building message prefix
b9dadda204 Mart*0212 C     fmtStr, iTmp :: Temp. for building prefix.
                0213 C     iTmpThid     :: Temp. for building prefix.
6c007c09cb Jean*0214 c     INTEGER iStart
924557e60a Chri*0215       INTEGER iEnd
b9dadda204 Mart*0216       INTEGER iTmp, iTmpThid
                0217       CHARACTER*13 fmtStr
                0218       CHARACTER*13 idString
4c563c2ee9 Chri*0219 CEOP
                0220 
924557e60a Chri*0221 C--   Find beginning and end of message
6c007c09cb Jean*0222 c     iStart = IFNBLNK( message )
924557e60a Chri*0223       iEnd   = ILNBLNK( message )
                0224 C--   Test to see if in multi-process ( or multi-threaded ) mode.
                0225 C     If so include process or thread identifier.
                0226       IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
                0227 C--    Write single process format
6c007c09cb Jean*0228        IF ( iEnd.EQ.0 ) THEN
924557e60a Chri*0229         WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
                0230        ELSE
8689736b2d Jean*0231         WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
6c007c09cb Jean*0232      &        message(1:iEnd)
                0233 c    &    message(iStart:iEnd)
924557e60a Chri*0234        ENDIF
3c154734ac Jean*0235       ELSE
924557e60a Chri*0236 C       PRINT_ERROR can be called by several threads simulataneously.
                0237 C       The write statement may need to be marked as a critical section.
                0238 #ifndef FMTFTN_IO_THREAD_SAFE
3c154734ac Jean*0239 # ifdef USE_OMP_THREADING
                0240 C$OMP CRITICAL
                0241 # else
                0242        _BEGIN_CRIT(myThid)
                0243 # endif
924557e60a Chri*0244 #endif
3c154734ac Jean*0245        IF ( pidIO .EQ. myProcId ) THEN
                0246 C--    Write multi-process format
b9dadda204 Mart*0247          fmtStr = '(I4.4,A,I4.4)'
                0248          IF ( nPx*nPy .GE. 10000 ) THEN
                0249            iTmp     = 1 + INT(LOG10(DFLOAT(nPx*nPy)))
                0250            iTmpThid = 1 + INT(LOG10(DFLOAT(MAX_NO_THREADS)))
                0251            iTmpThid = MAX( iTmpThid, 2, 8-iTmp )
                0252            WRITE(fmtStr,'(4(A,I1),A)')
                0253      &          '(I',iTmp,'.',iTmp,',A,I',iTmpThid,'.',iTmpThid,')'
                0254          ENDIF
                0255          WRITE(idString,fmtStr) myProcId,'.',myThid
                0256          iTmp = ILNBLNK( idString )
3c154734ac Jean*0257 
                0258          IF ( iEnd.EQ.0 ) THEN
d5aecb2c94 Jean*0259           WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
b9dadda204 Mart*0260      &    '(',PROCESS_HEADER,idString(1:iTmp),')',ERROR_HEADER,' ',
3c154734ac Jean*0261      &    ' '
                0262          ELSE
d5aecb2c94 Jean*0263           WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
b9dadda204 Mart*0264      &    '(',PROCESS_HEADER,idString(1:iTmp),')',ERROR_HEADER,' ',
6c007c09cb Jean*0265      &        message(1:iEnd)
                0266 c    &    message(iStart:iEnd)
3c154734ac Jean*0267          ENDIF
                0268        ENDIF
d44e11c489 Jean*0269        IF ( debugMode ) THEN
                0270         CALL MDS_FLUSH( errorMessageUnit, myThid )
                0271        ENDIF
d5aecb2c94 Jean*0272        GOTO 1000
                0273   999  CONTINUE
                0274        ioErrorCount(myThid) = ioErrorCount(myThid)+1
                0275  1000  CONTINUE
3c154734ac Jean*0276 
                0277 #ifndef DISABLE_WRITE_TO_UNIT_ZERO
                0278 C--    also write directly to unit 0 :
                0279        IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN
                0280         IF ( nThreads.LE.1 ) THEN
                0281           WRITE(0,'(A)') message(1:iEnd)
                0282         ELSE
                0283           WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
                0284      &                   message(1:iEnd)
                0285         ENDIF
                0286        ENDIF
924557e60a Chri*0287 #endif
3c154734ac Jean*0288 
924557e60a Chri*0289 #ifndef FMTFTN_IO_THREAD_SAFE
3c154734ac Jean*0290 # ifdef USE_OMP_THREADING
                0291 C$OMP END CRITICAL
                0292 # else
924557e60a Chri*0293         _END_CRIT(myThid)
3c154734ac Jean*0294 # endif
924557e60a Chri*0295 #endif
df63838d59 Jean*0296       ENDIF
                0297 
924557e60a Chri*0298       RETURN
                0299       END
                0300 
8689736b2d Jean*0301 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*0302 CBOP
                0303 C     !ROUTINE: PRINT_LIST_I
                0304 C     !INTERFACE:
8689736b2d Jean*0305       SUBROUTINE PRINT_LIST_I( fld, iFirst, iLast, index_type,
46dc4f419b Chri*0306      &                         markEnd, compact, ioUnit )
8689736b2d Jean*0307 
4c563c2ee9 Chri*0308 C     !DESCRIPTION:
                0309 C     *==========================================================*
8689736b2d Jean*0310 C     | o SUBROUTINE PRINT\_LIST\_I
4c563c2ee9 Chri*0311 C     *==========================================================*
8689736b2d Jean*0312 C     | Routine for producing list of values for a field with
                0313 C     | duplicate values collected into
                0314 C     |    n \@ value
                0315 C     | record.
4c563c2ee9 Chri*0316 C     *==========================================================*
16708c0db0 Chri*0317 
4c563c2ee9 Chri*0318 C     !USES:
8689736b2d Jean*0319       IMPLICIT NONE
                0320 
                0321 C     == Global data ==
16708c0db0 Chri*0322 #include "SIZE.h"
                0323 #include "EEPARAMS.h"
                0324 
4c563c2ee9 Chri*0325 C     !INPUT/OUTPUT PARAMETERS:
16708c0db0 Chri*0326 C     == Routine arguments ==
8689736b2d Jean*0327 C     fld     :: Data to be printed
                0328 C     iFirst  :: First element to print
                0329 C     iLast   :: Last element to print
                0330 C  index_type :: Flag indicating which type of index to print
                0331 C                  INDEX_K    => /* K = nnn */
                0332 C                  INDEX_I    => /* I = nnn */
                0333 C                  INDEX_J    => /* J = nnn */
                0334 C                  INDEX_NONE =>
                0335 C     markEnd :: Flag to control whether there is a separator after the
                0336 C                last element
                0337 C     compact :: Flag to control use of repeat symbol for same valued
                0338 C                fields.
                0339 C     ioUnit  :: Unit number for IO.
                0340       INTEGER iFirst, iLast
                0341       INTEGER fld(iFirst:iLast)
16708c0db0 Chri*0342       INTEGER index_type
455e14887b Alis*0343       LOGICAL markEnd
                0344       LOGICAL compact
16708c0db0 Chri*0345       INTEGER ioUnit
                0346 
4c563c2ee9 Chri*0347 C     !LOCAL VARIABLES:
16708c0db0 Chri*0348 C     == Local variables ==
                0349 C     iLo  - Range index holders for selecting elements with
                0350 C     iHi    with the same value
                0351 C     nDup - Number of duplicates
                0352 C     xNew, xOld - Hold current and previous values of field
                0353 C     punc - Field separator
                0354 C     msgBuf - IO buffer
                0355 C     index_lab - Index for labelling elements
                0356 C     K    - Loop counter
                0357       INTEGER iLo
                0358       INTEGER iHi
                0359       INTEGER nDup
                0360       INTEGER xNew, xOld
                0361       CHARACTER punc
b05b067368 Chri*0362       CHARACTER*(MAX_LEN_MBUF) msgBuf
16708c0db0 Chri*0363       CHARACTER*2 commOpen,commClose
                0364       CHARACTER*3 index_lab
8689736b2d Jean*0365       CHARACTER*25 fmt1, fmt2
16708c0db0 Chri*0366       INTEGER K
4c563c2ee9 Chri*0367 CEOP
16708c0db0 Chri*0368 
                0369       IF     ( index_type .EQ. INDEX_I ) THEN
                0370        index_lab = 'I ='
                0371       ELSEIF ( index_type .EQ. INDEX_J ) THEN
                0372        index_lab = 'J ='
                0373       ELSEIF ( index_type .EQ. INDEX_K ) THEN
                0374        index_lab = 'K ='
                0375       ELSE
                0376        index_lab = '?='
                0377       ENDIF
8689736b2d Jean*0378 C-    fortran format to write 1 or 2 indices:
                0379       fmt1='(A,1X,A,I3,1X,A)'
                0380       fmt2='(A,1X,A,I3,A,I3,1X,A)'
                0381       IF ( iLast.GE.1000 ) THEN
                0382         K = 1+INT(LOG10(FLOAT(iLast)))
                0383         WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
                0384         WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
                0385       ENDIF
16708c0db0 Chri*0386       commOpen  = '/*'
                0387       commClose = '*/'
8689736b2d Jean*0388       iLo = iFirst
                0389       iHi = iFirst
16708c0db0 Chri*0390       punc = ','
8689736b2d Jean*0391       xOld = fld(iFirst)
                0392       DO K = iFirst+1,iLast
16708c0db0 Chri*0393        xNew = fld(K  )
5877f66710 Alis*0394        IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
16708c0db0 Chri*0395         nDup = iHi-iLo+1
                0396         IF ( nDup .EQ. 1 ) THEN
826d8c81cd Alis*0397          WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
8689736b2d Jean*0398          IF ( index_type .NE. INDEX_NONE )
                0399      &    WRITE(msgBuf(45:),fmt1)
46dc4f419b Chri*0400      &    commOpen,index_lab,iLo,commClose
16708c0db0 Chri*0401         ELSE
fb76777964 Alis*0402          WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
8689736b2d Jean*0403          IF ( index_type .NE. INDEX_NONE )
                0404      &    WRITE(msgBuf(45:),fmt2)
16708c0db0 Chri*0405      &    commOpen,index_lab,iLo,':',iHi,commClose
                0406         ENDIF
66dc79a095 Chri*0407         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
16708c0db0 Chri*0408         iLo  = K
                0409         iHi  = K
                0410         xOld = xNew
                0411        ELSE
                0412         iHi = K
                0413        ENDIF
                0414       ENDDO
                0415       punc = ' '
455e14887b Alis*0416       IF ( markEnd ) punc = ','
16708c0db0 Chri*0417       nDup = iHi-iLo+1
                0418       IF    ( nDup .EQ. 1 ) THEN
826d8c81cd Alis*0419        WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
8689736b2d Jean*0420        IF ( index_type .NE. INDEX_NONE )
e93a5a09dd Jean*0421      &    WRITE(msgBuf(45:),fmt1)
                0422      &    commOpen,index_lab,iLo,commClose
16708c0db0 Chri*0423       ELSEIF( nDup .GT. 1 ) THEN
fb76777964 Alis*0424        WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
8689736b2d Jean*0425        IF ( index_type .NE. INDEX_NONE )
e93a5a09dd Jean*0426      &    WRITE(msgBuf(45:),fmt2)
                0427      &    commOpen,index_lab,iLo,':',iHi,commClose
16708c0db0 Chri*0428       ENDIF
66dc79a095 Chri*0429       CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
16708c0db0 Chri*0430 
                0431       RETURN
                0432       END
                0433 
8689736b2d Jean*0434 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*0435 CBOP
                0436 C     !ROUTINE: PRINT_LIST_L
                0437 C     !INTERFACE:
8689736b2d Jean*0438       SUBROUTINE PRINT_LIST_L( fld, iFirst, iLast, index_type,
                0439      &                         markEnd, compact, ioUnit )
                0440 
4c563c2ee9 Chri*0441 C     !DESCRIPTION:
                0442 C     *==========================================================*
8689736b2d Jean*0443 C     | o SUBROUTINE PRINT\_LIST\_L
4c563c2ee9 Chri*0444 C     *==========================================================*
8689736b2d Jean*0445 C     | Routine for producing list of values for a field with
                0446 C     | duplicate values collected into
                0447 C     |    n \@ value
                0448 C     | record.
4c563c2ee9 Chri*0449 C     *==========================================================*
16708c0db0 Chri*0450 
4c563c2ee9 Chri*0451 C     !USES:
8689736b2d Jean*0452       IMPLICIT NONE
                0453 
                0454 C     == Global data ==
16708c0db0 Chri*0455 #include "SIZE.h"
                0456 #include "EEPARAMS.h"
                0457 
4c563c2ee9 Chri*0458 C     !INPUT/OUTPUT PARAMETERS:
16708c0db0 Chri*0459 C     == Routine arguments ==
8689736b2d Jean*0460 C     fld     :: Data to be printed
                0461 C     iFirst  :: First element to print
                0462 C     iLast   :: Last element to print
                0463 C  index_type :: Flag indicating which type of index to print
16708c0db0 Chri*0464 C                  INDEX_K    => /* K = nnn */
                0465 C                  INDEX_I    => /* I = nnn */
                0466 C                  INDEX_J    => /* J = nnn */
                0467 C                  INDEX_NONE =>
8689736b2d Jean*0468 C     markEnd :: Flag to control whether there is a separator after the
455e14887b Alis*0469 C                last element
8689736b2d Jean*0470 C     compact :: Flag to control use of repeat symbol for same valued
                0471 C                fields.
                0472 C     ioUnit  :: Unit number for IO.
                0473       INTEGER iFirst, iLast
                0474       LOGICAL fld(iFirst:iLast)
16708c0db0 Chri*0475       INTEGER index_type
455e14887b Alis*0476       LOGICAL markEnd
                0477       LOGICAL compact
16708c0db0 Chri*0478       INTEGER ioUnit
                0479 
4c563c2ee9 Chri*0480 C     !LOCAL VARIABLES:
16708c0db0 Chri*0481 C     == Local variables ==
                0482 C     iLo  - Range index holders for selecting elements with
                0483 C     iHi    with the same value
                0484 C     nDup - Number of duplicates
                0485 C     xNew, xOld - Hold current and previous values of field
                0486 C     punc - Field separator
                0487 C     msgBuf - IO buffer
                0488 C     index_lab - Index for labelling elements
                0489 C     K    - Loop counter
                0490       INTEGER iLo
                0491       INTEGER iHi
                0492       INTEGER nDup
                0493       LOGICAL xNew, xOld
                0494       CHARACTER punc
b05b067368 Chri*0495       CHARACTER*(MAX_LEN_MBUF) msgBuf
16708c0db0 Chri*0496       CHARACTER*2 commOpen,commClose
                0497       CHARACTER*3 index_lab
8689736b2d Jean*0498       CHARACTER*25 fmt1, fmt2
16708c0db0 Chri*0499       INTEGER K
4c563c2ee9 Chri*0500 CEOP
16708c0db0 Chri*0501 
                0502       IF     ( index_type .EQ. INDEX_I ) THEN
                0503        index_lab = 'I ='
                0504       ELSEIF ( index_type .EQ. INDEX_J ) THEN
                0505        index_lab = 'J ='
                0506       ELSEIF ( index_type .EQ. INDEX_K ) THEN
                0507        index_lab = 'K ='
                0508       ELSE
                0509        index_lab = '?='
                0510       ENDIF
8689736b2d Jean*0511 C-    fortran format to write 1 or 2 indices:
                0512       fmt1='(A,1X,A,I3,1X,A)'
                0513       fmt2='(A,1X,A,I3,A,I3,1X,A)'
                0514       IF ( iLast.GE.1000 ) THEN
                0515         K = 1+INT(LOG10(FLOAT(iLast)))
                0516         WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
                0517         WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
                0518       ENDIF
16708c0db0 Chri*0519       commOpen  = '/*'
                0520       commClose = '*/'
8689736b2d Jean*0521       iLo = iFirst
                0522       iHi = iFirst
16708c0db0 Chri*0523       punc = ','
8689736b2d Jean*0524       xOld = fld(iFirst)
                0525       DO K = iFirst+1,iLast
16708c0db0 Chri*0526        xNew = fld(K  )
5877f66710 Alis*0527        IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
16708c0db0 Chri*0528         nDup = iHi-iLo+1
                0529         IF ( nDup .EQ. 1 ) THEN
                0530          WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
8689736b2d Jean*0531          IF ( index_type .NE. INDEX_NONE )
                0532      &    WRITE(msgBuf(45:),fmt1)
46dc4f419b Chri*0533      &    commOpen,index_lab,iLo,commClose
16708c0db0 Chri*0534         ELSE
fb76777964 Alis*0535          WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
8689736b2d Jean*0536          IF ( index_type .NE. INDEX_NONE )
                0537      &    WRITE(msgBuf(45:),fmt2)
16708c0db0 Chri*0538      &    commOpen,index_lab,iLo,':',iHi,commClose
                0539         ENDIF
66dc79a095 Chri*0540         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
16708c0db0 Chri*0541         iLo  = K
                0542         iHi  = K
                0543         xOld = xNew
                0544        ELSE
                0545         iHi = K
                0546        ENDIF
                0547       ENDDO
                0548       punc = ' '
455e14887b Alis*0549       IF ( markEnd ) punc = ','
16708c0db0 Chri*0550       nDup = iHi-iLo+1
                0551       IF    ( nDup .EQ. 1 ) THEN
                0552        WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
8689736b2d Jean*0553        IF ( index_type .NE. INDEX_NONE )
                0554      &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
46dc4f419b Chri*0555      &    commOpen,index_lab,iLo,commClose
16708c0db0 Chri*0556       ELSEIF( nDup .GT. 1 ) THEN
fb76777964 Alis*0557        WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
8689736b2d Jean*0558        IF ( index_type .NE. INDEX_NONE )
                0559      &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
16708c0db0 Chri*0560      &  commOpen,index_lab,iLo,':',iHi,commClose
                0561       ENDIF
66dc79a095 Chri*0562       CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
16708c0db0 Chri*0563 
                0564       RETURN
                0565       END
                0566 
8689736b2d Jean*0567 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*0568 CBOP
80e7a759fb Jean*0569 C     !ROUTINE: PRINT_LIST_RL
4c563c2ee9 Chri*0570 C     !INTERFACE:
80e7a759fb Jean*0571       SUBROUTINE PRINT_LIST_RL( fld, iFirst, iLast, index_type,
8689736b2d Jean*0572      &                          markEnd, compact, ioUnit )
                0573 
4c563c2ee9 Chri*0574 C     !DESCRIPTION:
                0575 C     *==========================================================*
80e7a759fb Jean*0576 C     | o SUBROUTINE PRINT\_LIST\_RL
4c563c2ee9 Chri*0577 C     *==========================================================*
8689736b2d Jean*0578 C     | Routine for producing list of values for a field with
                0579 C     | duplicate values collected into
                0580 C     |    n \@ value
                0581 C     | record.
4c563c2ee9 Chri*0582 C     *==========================================================*
7a7a4899b4 Chri*0583 
4c563c2ee9 Chri*0584 C     !USES:
8689736b2d Jean*0585       IMPLICIT NONE
                0586 
4c563c2ee9 Chri*0587 C     == Global data ==
7a7a4899b4 Chri*0588 #include "SIZE.h"
                0589 #include "EEPARAMS.h"
                0590 
4c563c2ee9 Chri*0591 C     !INPUT/OUTPUT PARAMETERS:
7a7a4899b4 Chri*0592 C     == Routine arguments ==
8689736b2d Jean*0593 C     fld     :: Data to be printed
                0594 C     iFirst  :: First element to print
                0595 C     iLast   :: Last element to print
                0596 C  index_type :: Flag indicating which type of index to print
7a7a4899b4 Chri*0597 C                  INDEX_K    => /* K = nnn */
                0598 C                  INDEX_I    => /* I = nnn */
                0599 C                  INDEX_J    => /* J = nnn */
                0600 C                  INDEX_NONE =>
8689736b2d Jean*0601 C     markEnd :: Flag to control whether there is a separator after the
455e14887b Alis*0602 C                last element
8689736b2d Jean*0603 C     compact :: Flag to control use of repeat symbol for same valued
                0604 C                fields.
                0605 C     ioUnit  :: Unit number for IO.
                0606       INTEGER iFirst, iLast
80e7a759fb Jean*0607       _RL     fld(iFirst:iLast)
7a7a4899b4 Chri*0608       INTEGER index_type
455e14887b Alis*0609       LOGICAL markEnd
                0610       LOGICAL compact
7a7a4899b4 Chri*0611       INTEGER ioUnit
                0612 
4c563c2ee9 Chri*0613 C     !LOCA VARIABLES:
7a7a4899b4 Chri*0614 C     == Local variables ==
                0615 C     iLo  - Range index holders for selecting elements with
                0616 C     iHi    with the same value
                0617 C     nDup - Number of duplicates
                0618 C     xNew, xOld - Hold current and previous values of field
                0619 C     punc - Field separator
                0620 C     msgBuf - IO buffer
                0621 C     index_lab - Index for labelling elements
                0622 C     K    - Loop counter
                0623       INTEGER iLo
                0624       INTEGER iHi
                0625       INTEGER nDup
80e7a759fb Jean*0626       _RL     xNew, xOld
7a7a4899b4 Chri*0627       CHARACTER punc
b05b067368 Chri*0628       CHARACTER*(MAX_LEN_MBUF) msgBuf
7a7a4899b4 Chri*0629       CHARACTER*2 commOpen,commClose
                0630       CHARACTER*3 index_lab
805f029b5f Jean*0631       CHARACTER*25 fmt1, fmt2
7a7a4899b4 Chri*0632       INTEGER K
4c563c2ee9 Chri*0633 CEOP
7a7a4899b4 Chri*0634 
                0635       IF     ( index_type .EQ. INDEX_I ) THEN
                0636        index_lab = 'I ='
                0637       ELSEIF ( index_type .EQ. INDEX_J ) THEN
                0638        index_lab = 'J ='
                0639       ELSEIF ( index_type .EQ. INDEX_K ) THEN
                0640        index_lab = 'K ='
                0641       ELSE
                0642        index_lab = '?='
                0643       ENDIF
805f029b5f Jean*0644 C-    fortran format to write 1 or 2 indices:
                0645       fmt1='(A,1X,A,I3,1X,A)'
                0646       fmt2='(A,1X,A,I3,A,I3,1X,A)'
8689736b2d Jean*0647       IF ( iLast.GE.1000 ) THEN
                0648         K = 1+INT(LOG10(FLOAT(iLast)))
                0649         WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
805f029b5f Jean*0650         WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
                0651       ENDIF
7a7a4899b4 Chri*0652       commOpen  = '/*'
                0653       commClose = '*/'
8689736b2d Jean*0654       iLo = iFirst
                0655       iHi = iFirst
7a7a4899b4 Chri*0656       punc = ','
8689736b2d Jean*0657       xOld = fld(iFirst)
                0658       DO K = iFirst+1,iLast
7a7a4899b4 Chri*0659        xNew = fld(K  )
5877f66710 Alis*0660        IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
7a7a4899b4 Chri*0661         nDup = iHi-iLo+1
                0662         IF ( nDup .EQ. 1 ) THEN
                0663          WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
805f029b5f Jean*0664          IF ( index_type .NE. INDEX_NONE )
                0665      &    WRITE(msgBuf(45:),fmt1)
46dc4f419b Chri*0666      &    commOpen,index_lab,iLo,commClose
7a7a4899b4 Chri*0667         ELSE
46dc4f419b Chri*0668          WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
805f029b5f Jean*0669          IF ( index_type .NE. INDEX_NONE )
                0670      &    WRITE(msgBuf(45:),fmt2)
7a7a4899b4 Chri*0671      &    commOpen,index_lab,iLo,':',iHi,commClose
                0672         ENDIF
8689736b2d Jean*0673         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
7a7a4899b4 Chri*0674         iLo  = K
                0675         iHi  = K
                0676         xOld = xNew
                0677        ELSE
                0678         iHi = K
                0679        ENDIF
                0680       ENDDO
                0681       punc = ' '
455e14887b Alis*0682       IF ( markEnd ) punc = ','
7a7a4899b4 Chri*0683       nDup = iHi-iLo+1
                0684       IF    ( nDup .EQ. 1 ) THEN
                0685        WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
805f029b5f Jean*0686        IF ( index_type .NE. INDEX_NONE )
                0687      &  WRITE(msgBuf(45:),fmt1)
46dc4f419b Chri*0688      &    commOpen,index_lab,iLo,commClose
7a7a4899b4 Chri*0689       ELSEIF( nDup .GT. 1 ) THEN
46dc4f419b Chri*0690        WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
805f029b5f Jean*0691        IF ( index_type .NE. INDEX_NONE )
                0692      &  WRITE(msgBuf(45:),fmt2)
7a7a4899b4 Chri*0693      &  commOpen,index_lab,iLo,':',iHi,commClose
                0694       ENDIF
8689736b2d Jean*0695       CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
7a7a4899b4 Chri*0696 
                0697       RETURN
                0698       END
                0699 
8689736b2d Jean*0700 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*0701 CBOP
                0702 C     !ROUTINE: PRINT_MAPRS
                0703 C     !INTERFACE:
42bd47f06f Chri*0704       SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
924557e60a Chri*0705      I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
                0706      I       iMin,  iMax,  iStr,
                0707      I       jMin,  jMax,  jStr,
                0708      I       kMin, kMax,   kStr,
                0709      I      bxMin, bxMax,  bxStr,
                0710      I      byMin, byMax,  byStr )
91006928fb Jean*0711 
4c563c2ee9 Chri*0712 C     !DESCRIPTION:
                0713 C     *==========================================================*
91006928fb Jean*0714 C     | SUBROUTINE PRINT\_MAPRS
                0715 C     | o Does textual mapping printing of a field.
4c563c2ee9 Chri*0716 C     *==========================================================*
91006928fb Jean*0717 C     | This routine does the actual formatting of the data
                0718 C     | and printing to a file. It assumes an array using the
                0719 C     | MITgcm UV indexing scheme and base index variables.
                0720 C     | User code should call an interface routine like
                0721 C     | PLOT\_FIELD\_XYRS( ... ) rather than this code directly.
                0722 C     | Text plots can be oriented XY, YZ, XZ. An orientation
                0723 C     | is specficied through the "plotMode" argument. All the
                0724 C     | plots made by a single call to this routine will use the
                0725 C     | same contour interval. The plot range (iMin,...,byStr)
                0726 C     | can be three-dimensional. A separate plot is made for
                0727 C     | each point in the plot range normal to the orientation.
                0728 C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).
                0729 C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
                0730 C     |      plots - one for K=1, one for K=3 and one for K=5.
                0731 C     |      Each plot would have extents iMin:iMax step iStr
                0732 C     |      and jMin:jMax step jStr.
4c563c2ee9 Chri*0733 C     *==========================================================*
924557e60a Chri*0734 
4c563c2ee9 Chri*0735 C     !USES:
91006928fb Jean*0736       IMPLICIT NONE
                0737 
924557e60a Chri*0738 C     == Global variables ==
                0739 #include "SIZE.h"
                0740 #include "EEPARAMS.h"
                0741 
4c563c2ee9 Chri*0742 C     !INPUT/OUTPUT PARAMETERS:
924557e60a Chri*0743 C     == Routine arguments ==
                0744 C     fld        - Real*4 array holding data to be plotted
                0745 C     fldTitle   - Name of field to be plotted
                0746 C     plotMode   - Text string indicating plot orientation
                0747 C                  ( see - EEPARAMS.h for valid values ).
                0748 C     iLo, iHi,  - Dimensions of array fld. fld is assumed to
                0749 C     jLo, jHi     be five-dimensional.
                0750 C     kLo, kHi
                0751 C     nBx, nBy
                0752 C     iMin, iMax - Indexing for points to plot. Points from
8689736b2d Jean*0753 C     iStr         iMin -> iMax in steps of iStr are plotted
924557e60a Chri*0754 C     jMin. jMax   and similarly for jMin, jMax, jStr and
                0755 C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
                0756 C     kMin, kMax   byMin, byMax, byStr.
                0757 C     kStr
                0758       CHARACTER*(*) fldTitle
                0759       CHARACTER*(*) plotMode
                0760       INTEGER iLo, iHi
                0761       INTEGER jLo, jHi
                0762       INTEGER kLo, kHi
                0763       INTEGER nBx, nBy
42bd47f06f Chri*0764       _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
924557e60a Chri*0765       INTEGER iMin, iMax, iStr
                0766       INTEGER jMin, jMax, jStr
                0767       INTEGER kMin, kMax, kStr
                0768       INTEGER bxMin, bxMax, bxStr
                0769       INTEGER byMin, byMax, byStr
                0770 
6c007c09cb Jean*0771 C     !FUNCTIONS:
                0772       INTEGER  IFNBLNK
                0773       EXTERNAL IFNBLNK
                0774       INTEGER  ILNBLNK
                0775       EXTERNAL ILNBLNK
                0776 
4c563c2ee9 Chri*0777 C     !LOCAL VARIABLES:
924557e60a Chri*0778 C     == Local variables ==
                0779 C     plotBuf - Buffer for building plot record
                0780 C     chList  - Character string used for plot
                0781 C     fMin, fMax - Contour min, max and range
                0782 C     fRange
                0783 C     val     - Value of element to be "plotted"
                0784 C     small   - Lowest range for which contours are plotted
                0785 C     accXXX  - Variables used in indexing accross page records.
                0786 C     dwnXXX    Variables used in indexing down the page.
                0787 C     pltXXX    Variables used in indexing multiple plots ( multiple
                0788 C               plots use same contour range).
                0789 C               Lab  - Label
                0790 C               Base - Base number for element indexing
                0791 C                      The process bottom, left coordinate in the
                0792 C                      global domain.
                0793 C               Step - Block size
                0794 C               Blo  - Start block
                0795 C               Bhi  - End block
                0796 C               Bstr - Block stride
                0797 C               Min  - Start index within block
                0798 C               Max  - End index within block
                0799 C               Str  - stride within block
                0800       INTEGER MAX_LEN_PLOTBUF
91006928fb Jean*0801       PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
924557e60a Chri*0802       CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
                0803       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0804       INTEGER lChList
                0805       PARAMETER ( lChList = 28 )
                0806       CHARACTER*(lChList) chList
1dbaea09ee Chri*0807       _RL  fMin
                0808       _RL  fMax
                0809       _RL  fRange
                0810       _RL  val
                0811       _RL  small
924557e60a Chri*0812       CHARACTER*2  accLab
                0813       CHARACTER*7  dwnLab
                0814       CHARACTER*3  pltLab
                0815       INTEGER     accBase, dwnBase, pltBase
                0816       INTEGER     accStep, dwnStep, pltStep
                0817       INTEGER     accBlo,  dwnBlo,  pltBlo
                0818       INTEGER     accBhi,  dwnBhi,  pltBhi
                0819       INTEGER     accBstr, dwnBstr, pltBstr
                0820       INTEGER     accMin,  dwnMin,  pltMin
                0821       INTEGER     accMax,  dwnMax,  pltMax
                0822       INTEGER     accStr,  dwnStr,  pltStr
                0823       INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
                0824       INTEGER bi, bj, bk
                0825       LOGICAL validRange
4c563c2ee9 Chri*0826 CEOP
924557e60a Chri*0827 
                0828       chList = '-abcdefghijklmnopqrstuvwxyz+'
1dbaea09ee Chri*0829       small  =  1. _d -15
                0830       fMin   =  1. _d  32
                0831       fMax   = -1. _d  32
924557e60a Chri*0832       validRange = .FALSE.
                0833 
                0834 C--   Calculate field range
                0835       DO bj=byMin, byMax, byStr
                0836        DO bi=bxMin, bxMax, bxStr
                0837         DO K=kMin, kMax, kStr
                0838          DO J=jMin, jMax, jStr
                0839           DO I=iMin, iMax, iStr
910f05e765 Chri*0840            IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
8689736b2d Jean*0841             IF ( fld(I,J,K,bi,bj) .LT. fMin )
924557e60a Chri*0842      &       fMin = fld(I,J,K,bi,bj)
8689736b2d Jean*0843             IF ( fld(I,J,K,bi,bj) .GT. fMax )
924557e60a Chri*0844      &       fMax = fld(I,J,K,bi,bj)
                0845            ENDIF
                0846           ENDDO
                0847          ENDDO
                0848         ENDDO
                0849        ENDDO
                0850       ENDDO
                0851       fRange = fMax-fMin
91006928fb Jean*0852       IF ( fRange .GT. small ) validRange = .TRUE.
924557e60a Chri*0853 
                0854 C--   Write field title and statistics
8689736b2d Jean*0855       msgBuf =
46dc4f419b Chri*0856      & '// ======================================================='
924557e60a Chri*0857       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0858      &                   SQUEEZE_RIGHT, 1)
                0859       iStrngLo = IFNBLNK(fldTitle)
                0860       iStrngHi = ILNBLNK(fldTitle)
                0861       IF ( iStrngLo .LE. iStrngHi ) THEN
                0862        WRITE(msgBuf,'(A)') fldTitle(iStrngLo:iStrngHi)
                0863       ELSE
                0864        msgBuf = '// UNKNOWN FIELD'
                0865       ENDIF
                0866       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0867      &                   SQUEEZE_RIGHT, 1)
                0868       WRITE(msgBuf,'(A,1PE30.15)')
                0869      & '// CMIN = ', fMin
                0870       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0871      &                   SQUEEZE_RIGHT, 1)
                0872       WRITE(msgBuf,'(A,1PE30.15)')
                0873      & '// CMAX = ', fMax
                0874       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0875      &                   SQUEEZE_RIGHT, 1)
910f05e765 Chri*0876       IF ( validRange ) THEN
                0877        WRITE(msgBuf,'(A,1PE30.15)')
                0878      &  '// CINT = ', fRange/FLOAT(lChlist-1)
                0879       ELSE
                0880        WRITE(msgBuf,'(A,1PE30.15)')
                0881      &  '// CINT = ', 0.
                0882       ENDIF
924557e60a Chri*0883       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0884      &                   SQUEEZE_RIGHT, 1)
                0885       WRITE(msgBuf,'(A,1024A1)')
                0886      & '// SYMBOLS (CMIN->CMAX): ',(chList(I:I),I=1,lChList)
                0887       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0888      &                   SQUEEZE_RIGHT, 1)
                0889       WRITE(msgBuf,'(A,1024A1)')
                0890      & '//                  0.0: ','.'
                0891       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0892      &                   SQUEEZE_RIGHT, 1)
39a656fb94 Hong*0893        WRITE(msgBuf,'(A,3(A,I6),A)')
924557e60a Chri*0894      & '// RANGE I (Lo:Hi:Step):',
                0895      &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
                0896      &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
                0897      &  ':',iStr,')'
                0898       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0899      &                   SQUEEZE_RIGHT, 1)
39a656fb94 Hong*0900        WRITE(msgBuf,'(A,3(A,I6),A)')
924557e60a Chri*0901      & '// RANGE J (Lo:Hi:Step):',
                0902      &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
                0903      &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
                0904      &  ':',jStr,')'
                0905       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0906      &                   SQUEEZE_RIGHT, 1)
                0907        WRITE(msgBuf,'(A,3(A,I4),A)')
                0908      & '// RANGE K (Lo:Hi:Step):',
                0909      &  '(',kMin,
                0910      &  ':',kMax,
                0911      &  ':',kStr,')'
                0912       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0913      &                   SQUEEZE_RIGHT, 1)
8689736b2d Jean*0914       msgBuf =
46dc4f419b Chri*0915      & '// ======================================================='
924557e60a Chri*0916       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0917      &                   SQUEEZE_RIGHT, 1)
                0918 
91006928fb Jean*0919 c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
                0920 c      msgBuf =
                0921 c    &  'Model domain too big to print to terminal - skipping I/O'
                0922 c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                0923 c    &                   SQUEEZE_RIGHT, 1)
                0924 c      RETURN
                0925 c     endif
bf89bc5c89 Alis*0926 
924557e60a Chri*0927 C--   Write field
                0928 C     Figure out slice type and set plotting parameters appropriately
                0929 C     acc = accross the page
                0930 C     dwn = down the page
                0931       IF ( plotMode .EQ. PRINT_MAP_XY ) THEN
                0932 C      X across, Y down slice
                0933        accLab  = 'I='
                0934        accBase = myXGlobalLo
                0935        accStep = sNx
                0936        accBlo  = bxMin
                0937        accBhi  = bxMax
                0938        accBStr = bxStr
                0939        accMin  = iMin
                0940        accMax  = iMax
                0941        accStr  = iStr
                0942        dwnLab  = '|--J--|'
                0943        dwnBase = myYGlobalLo
                0944        dwnStep = sNy
                0945        dwnBlo  = byMin
                0946        dwnBhi  = byMax
                0947        dwnBStr = byStr
                0948        dwnMin  = jMin
                0949        dwnMax  = jMax
                0950        dwnStr  = jStr
                0951        pltBlo  = 1
                0952        pltBhi  = 1
                0953        pltBstr = 1
                0954        pltMin  = kMin
                0955        pltMax  = kMax
                0956        pltStr  = kStr
                0957        pltBase = 1
                0958        pltStep = 1
                0959        pltLab  = 'K ='
                0960       ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
                0961 C      Y across, Z down slice
                0962        accLab  = 'J='
                0963        accBase = myYGlobalLo
                0964        accStep = sNy
                0965        accBlo  = byMin
                0966        accBhi  = byMax
                0967        accBStr = byStr
                0968        accMin  = jMin
                0969        accMax  = jMax
                0970        accStr  = jStr
                0971        dwnLab  = '|--K--|'
                0972        dwnBase = 1
                0973        dwnStep = 1
                0974        dwnBlo  = 1
                0975        dwnBhi  = 1
                0976        dwnBStr = 1
                0977        dwnMin  = kMin
                0978        dwnMax  = kMax
                0979        dwnStr  = kStr
                0980        pltBlo  = bxMin
                0981        pltBhi  = bxMax
                0982        pltBstr = bxStr
                0983        pltMin  = iMin
                0984        pltMax  = iMax
                0985        pltStr  = iStr
                0986        pltBase = myXGlobalLo
                0987        pltStep = sNx
                0988        pltLab  = 'I ='
                0989       ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
                0990 C      X across, Z down slice
                0991        accLab  = 'I='
                0992        accBase = myXGlobalLo
                0993        accStep = sNx
                0994        accBlo  = bxMin
                0995        accBhi  = bxMax
                0996        accBStr = bxStr
                0997        accMin  = iMin
                0998        accMax  = iMax
                0999        accStr  = iStr
                1000        dwnLab  = '|--K--|'
                1001        dwnBase = 1
                1002        dwnStep = 1
                1003        dwnBlo  = 1
                1004        dwnBhi  = 1
                1005        dwnBStr = 1
                1006        dwnMin  = kMin
                1007        dwnMax  = kMax
                1008        dwnStr  = kStr
                1009        pltBlo  = byMin
                1010        pltBhi  = byMax
                1011        pltBstr = byStr
                1012        pltMin  = jMin
                1013        pltMax  = jMax
                1014        pltStr  = jStr
                1015        pltBase = myYGlobalLo
                1016        pltStep = sNy
                1017        pltLab  = 'J ='
                1018       ENDIF
91006928fb Jean*1019 C-    check if it fits into buffer (-10 should be enough but -12 is safer):
                1020       IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
                1021      &     .AND. validRange ) THEN
                1022        msgBuf =
                1023      &  'Model domain too big to print to terminal - skipping I/O'
                1024        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1025      &                   SQUEEZE_RIGHT, 1)
                1026        validRange = .FALSE.
                1027       ENDIF
39b81e6b27 Dimi*1028       IF ( validRange ) THEN
924557e60a Chri*1029 C      Header
                1030 C      Data
                1031        DO bk=pltBlo, pltBhi, pltBstr
                1032         DO K=pltMin,pltMax,pltStr
46dc4f419b Chri*1033          WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
924557e60a Chri*1034      &   pltBase-1+(bk-1)*pltStep+K
                1035          CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
                1036      &                      SQUEEZE_RIGHT, 1)
                1037          plotBuf = ' '
8689736b2d Jean*1038          iBuf = 6
924557e60a Chri*1039          DO bi=accBlo, accBhi, accBstr
                1040           DO I=accMin, accMax, accStr
                1041            iDx = accBase-1+(bi-1)*accStep+I
                1042            iBuf = iBuf + 1
                1043            IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
7ce79a6913 Jean*1044             IF ( iDx .LT. 10 ) THEN
924557e60a Chri*1045              WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx
7ce79a6913 Jean*1046             ELSEIF ( iDx .LT. 100 ) THEN
924557e60a Chri*1047              WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx
7ce79a6913 Jean*1048             ELSEIF ( iDx .LT. 1000 ) THEN
924557e60a Chri*1049              WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx
7ce79a6913 Jean*1050             ELSEIF ( iDx .LT. 10000 ) THEN
924557e60a Chri*1051              WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx
                1052             ENDIF
                1053            ENDIF
                1054           ENDDO
                1055          ENDDO
                1056          WRITE(msgBuf,'(A,A)') '// ',plotBuf
                1057          CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1058      &                      SQUEEZE_RIGHT, 1)
                1059          plotBuf = dwnLab
8689736b2d Jean*1060          iBuf = 7
924557e60a Chri*1061          DO bi=accBlo, accBhi, accBstr
                1062           DO I=accMin, accMax, accStr
                1063            iDx = accBase-1+(bi-1)*accStep+I
                1064            iBuf = iBuf+1
                1065            IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
                1066             WRITE(plotBuf(iBuf:),'(A)')  '|'
                1067            ELSE
120c45539a Jean*1068             WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
924557e60a Chri*1069            ENDIF
                1070           ENDDO
                1071          ENDDO
                1072          WRITE(msgBuf,'(A,A)') '// ',plotBuf
                1073          CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1074      &                    SQUEEZE_RIGHT, 1)
                1075          DO bj=dwnBlo, dwnBhi, dwnBStr
                1076           DO J=dwnMin, dwnMax, dwnStr
8689736b2d Jean*1077            WRITE(plotBuf,'(1X,I5,1X)')
924557e60a Chri*1078      &      dwnBase-1+(bj-1)*dwnStep+J
                1079            iBuf = 7
                1080            DO bi=accBlo,accBhi,accBstr
                1081             DO I=accMin,accMax,accStr
                1082              iBuf = iBuf + 1
                1083              IF     ( plotMode .EQ. PRINT_MAP_XY ) THEN
                1084               val = fld(I,J,K,bi,bj)
                1085              ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
                1086               val = fld(I,K,J,bi,bk)
                1087              ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
                1088               val = fld(K,I,J,bk,bi)
                1089              ENDIF
1dbaea09ee Chri*1090              IF ( validRange .AND. val .NE. 0. ) THEN
8689736b2d Jean*1091               IDX = NINT(
                1092      &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
924557e60a Chri*1093      &             )+1
910f05e765 Chri*1094              ELSE
                1095               IDX = 1
                1096              ENDIF
8689736b2d Jean*1097              IF ( iBuf .LE. MAX_LEN_PLOTBUF )
924557e60a Chri*1098      &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
                1099              IF ( val .EQ. 0. ) THEN
8689736b2d Jean*1100               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
924557e60a Chri*1101      &         plotBuf(iBuf:iBuf) = '.'
                1102              ENDIF
                1103             ENDDO
                1104            ENDDO
                1105            WRITE(msgBuf,'(A,A)') '// ',plotBuf
                1106            CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1107      &                        SQUEEZE_RIGHT, 1)
                1108           ENDDO
                1109          ENDDO
                1110         ENDDO
                1111        ENDDO
39b81e6b27 Dimi*1112       ENDIF
924557e60a Chri*1113 C--   Write delimiter
8689736b2d Jean*1114       msgBuf =
46dc4f419b Chri*1115      & '// ======================================================='
924557e60a Chri*1116       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1117      &                   SQUEEZE_RIGHT, 1)
8689736b2d Jean*1118       msgBuf =
46dc4f419b Chri*1119      & '// END OF FIELD                                          ='
924557e60a Chri*1120       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1121      &                   SQUEEZE_RIGHT, 1)
8689736b2d Jean*1122       msgBuf =
46dc4f419b Chri*1123      & '// ======================================================='
924557e60a Chri*1124       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1125      &                   SQUEEZE_RIGHT, 1)
                1126       msgBuf = ' '
                1127       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1128      &                   SQUEEZE_RIGHT, 1)
                1129 
                1130       RETURN
                1131       END
                1132 
8689736b2d Jean*1133 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4c563c2ee9 Chri*1134 CBOP
                1135 C     !ROUTINE: PRINT_MAPRL
                1136 C     !INTERFACE:
42bd47f06f Chri*1137       SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
924557e60a Chri*1138      I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
                1139      I       iMin,  iMax,  iStr,
                1140      I       jMin,  jMax,  jStr,
                1141      I       kMin, kMax,   kStr,
                1142      I      bxMin, bxMax,  bxStr,
                1143      I      byMin, byMax,  byStr )
                1144 
4c563c2ee9 Chri*1145 C     !DESCRIPTION:
                1146 C     *==========================================================*
91006928fb Jean*1147 C     | SUBROUTINE PRINT\_MAPRL
                1148 C     | o Does textual mapping printing of a field.
4c563c2ee9 Chri*1149 C     *==========================================================*
91006928fb Jean*1150 C     | This routine does the actual formatting of the data
                1151 C     | and printing to a file. It assumes an array using the
                1152 C     | MITgcm UV indexing scheme and base index variables.
                1153 C     | User code should call an interface routine like
                1154 C     | PLOT\_FIELD\_XYRL( ... ) rather than this code directly.
                1155 C     | Text plots can be oriented XY, YZ, XZ. An orientation
                1156 C     | is specficied through the "plotMode" argument. All the
                1157 C     | plots made by a single call to this routine will use the
                1158 C     | same contour interval. The plot range (iMin,...,byStr)
                1159 C     | can be three-dimensional. A separate plot is made for
                1160 C     | each point in the plot range normal to the orientation.
                1161 C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).
                1162 C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
                1163 C     |      plots - one for K=1, one for K=3 and one for K=5.
                1164 C     |      Each plot would have extents iMin:iMax step iStr
                1165 C     |      and jMin:jMax step jStr.
4c563c2ee9 Chri*1166 C     *==========================================================*
                1167 
                1168 C     !USES:
91006928fb Jean*1169       IMPLICIT NONE
                1170 
924557e60a Chri*1171 C     == Global variables ==
                1172 #include "SIZE.h"
                1173 #include "EEPARAMS.h"
                1174 
4c563c2ee9 Chri*1175 C     !INPUT/OUTPUT PARAMETERS:
924557e60a Chri*1176 C     == Routine arguments ==
                1177 C     fld        - Real*8 array holding data to be plotted
                1178 C     fldTitle   - Name of field to be plotted
                1179 C     plotMode   - Text string indicating plot orientation
                1180 C                  ( see - EEPARAMS.h for valid values ).
                1181 C     iLo, iHi,  - Dimensions of array fld. fld is assumed to
                1182 C     jLo, jHi     be five-dimensional.
                1183 C     kLo, kHi
                1184 C     nBx, nBy
                1185 C     iMin, iMax - Indexing for points to plot. Points from
8689736b2d Jean*1186 C     iStr         iMin -> iMax in steps of iStr are plotted
924557e60a Chri*1187 C     jMin. jMax   and similarly for jMin, jMax, jStr and
                1188 C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
                1189 C     kMin, kMax   byMin, byMax, byStr.
                1190 C     kStr
                1191       CHARACTER*(*) fldTitle
                1192       CHARACTER*(*) plotMode
                1193       INTEGER iLo, iHi
                1194       INTEGER jLo, jHi
                1195       INTEGER kLo, kHi
                1196       INTEGER nBx, nBy
42bd47f06f Chri*1197       _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
924557e60a Chri*1198       INTEGER iMin, iMax, iStr
                1199       INTEGER jMin, jMax, jStr
                1200       INTEGER kMin, kMax, kStr
                1201       INTEGER bxMin, bxMax, bxStr
                1202       INTEGER byMin, byMax, byStr
                1203 
6c007c09cb Jean*1204 C     !FUNCTIONS:
                1205       INTEGER  IFNBLNK
                1206       EXTERNAL IFNBLNK
                1207       INTEGER  ILNBLNK
                1208       EXTERNAL ILNBLNK
                1209 
4c563c2ee9 Chri*1210 C     !LOCAL VARIABLES:
924557e60a Chri*1211 C     == Local variables ==
                1212 C     plotBuf - Buffer for building plot record
                1213 C     chList  - Character string used for plot
                1214 C     fMin, fMax - Contour min, max and range
                1215 C     fRange
                1216 C     val     - Value of element to be "plotted"
                1217 C     small   - Lowest range for which contours are plotted
                1218 C     accXXX  - Variables used in indexing accross page records.
                1219 C     dwnXXX    Variables used in indexing down the page.
                1220 C     pltXXX    Variables used in indexing multiple plots ( multiple
                1221 C               plots use same contour range).
                1222 C               Lab  - Label
                1223 C               Base - Base number for element indexing
                1224 C                      The process bottom, left coordinate in the
                1225 C                      global domain.
                1226 C               Step - Block size
                1227 C               Blo  - Start block
                1228 C               Bhi  - End block
                1229 C               Bstr - Block stride
                1230 C               Min  - Start index within block
                1231 C               Max  - End index within block
                1232 C               Str  - stride within block
                1233       INTEGER MAX_LEN_PLOTBUF
91006928fb Jean*1234       PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
924557e60a Chri*1235       CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
                1236       CHARACTER*(MAX_LEN_MBUF) msgBuf
                1237       INTEGER lChList
                1238       PARAMETER ( lChList = 28 )
                1239       CHARACTER*(lChList) chList
1dbaea09ee Chri*1240       _RL  fMin
                1241       _RL  fMax
                1242       _RL  fRange
                1243       _RL  val
                1244       _RL  small
924557e60a Chri*1245       CHARACTER*2  accLab
                1246       CHARACTER*7  dwnLab
                1247       CHARACTER*3  pltLab
                1248       INTEGER     accBase, dwnBase, pltBase
                1249       INTEGER     accStep, dwnStep, pltStep
                1250       INTEGER     accBlo,  dwnBlo,  pltBlo
                1251       INTEGER     accBhi,  dwnBhi,  pltBhi
                1252       INTEGER     accBstr, dwnBstr, pltBstr
                1253       INTEGER     accMin,  dwnMin,  pltMin
                1254       INTEGER     accMax,  dwnMax,  pltMax
                1255       INTEGER     accStr,  dwnStr,  pltStr
                1256       INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
                1257       INTEGER bi, bj, bk
                1258       LOGICAL validRange
4c563c2ee9 Chri*1259 CEOP
924557e60a Chri*1260 
                1261       chList = '-abcdefghijklmnopqrstuvwxyz+'
                1262       small  = 1. _d -15
                1263       fMin   =  1. _d 32
                1264       fMax   = -1. _d 32
                1265       validRange = .FALSE.
                1266 
                1267 C--   Calculate field range
                1268       DO bj=byMin, byMax, byStr
                1269        DO bi=bxMin, bxMax, bxStr
                1270         DO K=kMin, kMax, kStr
                1271          DO J=jMin, jMax, jStr
                1272           DO I=iMin, iMax, iStr
8689736b2d Jean*1273            IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
46dc4f419b Chri*1274      &     THEN
8689736b2d Jean*1275             IF ( fld(I,J,K,bi,bj) .LT. fMin )
924557e60a Chri*1276      &       fMin = fld(I,J,K,bi,bj)
8689736b2d Jean*1277             IF ( fld(I,J,K,bi,bj) .GT. fMax )
924557e60a Chri*1278      &       fMax = fld(I,J,K,bi,bj)
910f05e765 Chri*1279            ENDIF
924557e60a Chri*1280           ENDDO
                1281          ENDDO
                1282         ENDDO
                1283        ENDDO
                1284       ENDDO
                1285       fRange = fMax-fMin
91006928fb Jean*1286       IF ( fRange .GT. small ) validRange = .TRUE.
924557e60a Chri*1287 
                1288 C--   Write field title and statistics
8689736b2d Jean*1289       msgBuf =
46dc4f419b Chri*1290      & '// ======================================================='
924557e60a Chri*1291       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1292      &                   SQUEEZE_RIGHT, 1)
                1293       iStrngLo = IFNBLNK(fldTitle)
                1294       iStrngHi = ILNBLNK(fldTitle)
                1295       IF ( iStrngLo .LE. iStrngHi ) THEN
                1296        WRITE(msgBuf,'(A)') fldTitle(iStrngLo:iStrngHi)
                1297       ELSE
                1298        msgBuf = '// UNKNOWN FIELD'
                1299       ENDIF
                1300       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1301      &                   SQUEEZE_RIGHT, 1)
                1302       WRITE(msgBuf,'(A,1PE30.15)')
                1303      & '// CMIN = ', fMin
                1304       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1305      &                   SQUEEZE_RIGHT, 1)
                1306       WRITE(msgBuf,'(A,1PE30.15)')
                1307      & '// CMAX = ', fMax
                1308       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1309      &                   SQUEEZE_RIGHT, 1)
910f05e765 Chri*1310       IF ( validRange ) THEN
                1311        WRITE(msgBuf,'(A,1PE30.15)')
924557e60a Chri*1312      & '// CINT = ', fRange/FLOAT(lChlist-1)
910f05e765 Chri*1313       ELSE
                1314        WRITE(msgBuf,'(A,1PE30.15)')
                1315      & '// CINT = ', 0.
                1316       ENDIF
924557e60a Chri*1317       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1318      &                   SQUEEZE_RIGHT, 1)
                1319       WRITE(msgBuf,'(A,1024A1)')
                1320      & '// SYMBOLS (CMIN->CMAX): ',(chList(I:I),I=1,lChList)
                1321       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1322      &                   SQUEEZE_RIGHT, 1)
                1323       WRITE(msgBuf,'(A,1024A1)')
                1324      & '//                  0.0: ','.'
                1325       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1326      &                   SQUEEZE_RIGHT, 1)
39a656fb94 Hong*1327        WRITE(msgBuf,'(A,3(A,I6),A)')
924557e60a Chri*1328      & '// RANGE I (Lo:Hi:Step):',
                1329      &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
                1330      &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
                1331      &  ':',iStr,')'
                1332       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1333      &                   SQUEEZE_RIGHT, 1)
39a656fb94 Hong*1334        WRITE(msgBuf,'(A,3(A,I6),A)')
924557e60a Chri*1335      & '// RANGE J (Lo:Hi:Step):',
                1336      &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
                1337      &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
                1338      &  ':',jStr,')'
                1339       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1340      &                   SQUEEZE_RIGHT, 1)
                1341        WRITE(msgBuf,'(A,3(A,I4),A)')
                1342      & '// RANGE K (Lo:Hi:Step):',
                1343      &  '(',kMin,
                1344      &  ':',kMax,
                1345      &  ':',kStr,')'
                1346       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1347      &                   SQUEEZE_RIGHT, 1)
8689736b2d Jean*1348       msgBuf =
46dc4f419b Chri*1349      & '// ======================================================='
924557e60a Chri*1350       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1351      &                   SQUEEZE_RIGHT, 1)
                1352 
91006928fb Jean*1353 c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
                1354 c      msgBuf =
                1355 c    &  'Model domain too big to print to terminal - skipping I/O'
                1356 c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1357 c    &                   SQUEEZE_RIGHT, 1)
                1358 c      RETURN
                1359 c     endif
bf89bc5c89 Alis*1360 
924557e60a Chri*1361 C--   Write field
                1362 C     Figure out slice type and set plotting parameters appropriately
                1363 C     acc = accross the page
                1364 C     dwn = down the page
                1365       IF ( plotMode .EQ. PRINT_MAP_XY ) THEN
                1366 C      X across, Y down slice
                1367        accLab  = 'I='
                1368        accBase = myXGlobalLo
                1369        accStep = sNx
                1370        accBlo  = bxMin
                1371        accBhi  = bxMax
                1372        accBStr = bxStr
                1373        accMin  = iMin
                1374        accMax  = iMax
                1375        accStr  = iStr
                1376        dwnLab  = '|--J--|'
                1377        dwnBase = myYGlobalLo
                1378        dwnStep = sNy
                1379        dwnBlo  = byMin
                1380        dwnBhi  = byMax
                1381        dwnBStr = byStr
                1382        dwnMin  = jMin
                1383        dwnMax  = jMax
                1384        dwnStr  = jStr
                1385        pltBlo  = 1
                1386        pltBhi  = 1
                1387        pltBstr = 1
                1388        pltMin  = kMin
                1389        pltMax  = kMax
                1390        pltStr  = kStr
                1391        pltBase = 1
                1392        pltStep = 1
                1393        pltLab  = 'K ='
                1394       ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
                1395 C      Y across, Z down slice
                1396        accLab  = 'J='
                1397        accBase = myYGlobalLo
                1398        accStep = sNy
                1399        accBlo  = byMin
                1400        accBhi  = byMax
                1401        accBStr = byStr
                1402        accMin  = jMin
                1403        accMax  = jMax
                1404        accStr  = jStr
                1405        dwnLab  = '|--K--|'
                1406        dwnBase = 1
                1407        dwnStep = 1
                1408        dwnBlo  = 1
                1409        dwnBhi  = 1
                1410        dwnBStr = 1
                1411        dwnMin  = kMin
                1412        dwnMax  = kMax
                1413        dwnStr  = kStr
                1414        pltBlo  = bxMin
                1415        pltBhi  = bxMax
                1416        pltBstr = bxStr
                1417        pltMin  = iMin
                1418        pltMax  = iMax
                1419        pltStr  = iStr
                1420        pltBase = myXGlobalLo
                1421        pltStep = sNx
                1422        pltLab  = 'I ='
                1423       ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
                1424 C      X across, Z down slice
                1425        accLab  = 'I='
                1426        accBase = myXGlobalLo
                1427        accStep = sNx
                1428        accBlo  = bxMin
                1429        accBhi  = bxMax
                1430        accBStr = bxStr
                1431        accMin  = iMin
                1432        accMax  = iMax
                1433        accStr  = iStr
                1434        dwnLab  = '|--K--|'
                1435        dwnBase = 1
                1436        dwnStep = 1
                1437        dwnBlo  = 1
                1438        dwnBhi  = 1
                1439        dwnBStr = 1
                1440        dwnMin  = kMin
                1441        dwnMax  = kMax
                1442        dwnStr  = kStr
                1443        pltBlo  = byMin
                1444        pltBhi  = byMax
                1445        pltBstr = byStr
                1446        pltMin  = jMin
                1447        pltMax  = jMax
                1448        pltStr  = jStr
                1449        pltBase = myYGlobalLo
                1450        pltStep = sNy
                1451        pltLab  = 'J ='
                1452       ENDIF
91006928fb Jean*1453 C-    check if it fits into buffer (-10 should be enough but -12 is safer):
                1454       IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
                1455      &     .AND. validRange ) THEN
                1456        msgBuf =
                1457      &  'Model domain too big to print to terminal - skipping I/O'
                1458        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1459      &                   SQUEEZE_RIGHT, 1)
                1460        validRange = .FALSE.
                1461       ENDIF
39b81e6b27 Dimi*1462       IF ( validRange ) THEN
924557e60a Chri*1463 C      Header
                1464 C      Data
                1465        DO bk=pltBlo, pltBhi, pltBstr
                1466         DO K=pltMin,pltMax,pltStr
46dc4f419b Chri*1467          WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
924557e60a Chri*1468      &   pltBase-1+(bk-1)*pltStep+K
                1469          CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
                1470      &                      SQUEEZE_RIGHT, 1)
                1471          plotBuf = ' '
8689736b2d Jean*1472          iBuf = 6
924557e60a Chri*1473          DO bi=accBlo, accBhi, accBstr
                1474           DO I=accMin, accMax, accStr
                1475            iDx = accBase-1+(bi-1)*accStep+I
                1476            iBuf = iBuf + 1
                1477            IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
7ce79a6913 Jean*1478             IF ( iDx .LT. 10 ) THEN
924557e60a Chri*1479              WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx
7ce79a6913 Jean*1480             ELSEIF ( iDx .LT. 100 ) THEN
924557e60a Chri*1481              WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx
7ce79a6913 Jean*1482             ELSEIF ( iDx .LT. 1000 ) THEN
924557e60a Chri*1483              WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx
7ce79a6913 Jean*1484             ELSEIF ( iDx .LT. 10000 ) THEN
924557e60a Chri*1485              WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx
                1486             ENDIF
                1487            ENDIF
                1488           ENDDO
                1489          ENDDO
                1490          CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
                1491      &                      SQUEEZE_RIGHT, 1)
                1492          plotBuf = dwnLab
8689736b2d Jean*1493          iBuf = 7
924557e60a Chri*1494          DO bi=accBlo, accBhi, accBstr
                1495           DO I=accMin, accMax, accStr
                1496            iDx = accBase-1+(bi-1)*accStep+I
                1497            iBuf = iBuf+1
                1498            IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
                1499             WRITE(plotBuf(iBuf:),'(A)')  '|'
                1500            ELSE
3bcc40067f Jean*1501             WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
924557e60a Chri*1502            ENDIF
                1503           ENDDO
                1504          ENDDO
                1505          CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
                1506      &                    SQUEEZE_RIGHT, 1)
                1507          DO bj=dwnBlo, dwnBhi, dwnBStr
                1508           DO J=dwnMin, dwnMax, dwnStr
8689736b2d Jean*1509            WRITE(plotBuf,'(1X,I5,1X)')
924557e60a Chri*1510      &      dwnBase-1+(bj-1)*dwnStep+J
                1511            iBuf = 7
                1512            DO bi=accBlo,accBhi,accBstr
                1513             DO I=accMin,accMax,accStr
                1514              iBuf = iBuf + 1
                1515              IF     ( plotMode .EQ. PRINT_MAP_XY ) THEN
                1516               val = fld(I,J,K,bi,bj)
                1517              ELSEIF ( plotMode .EQ. PRINT_MAP_XZ ) THEN
                1518               val = fld(I,K,J,bi,bk)
                1519              ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
                1520               val = fld(K,I,J,bk,bi)
                1521              ENDIF
1dbaea09ee Chri*1522              IF ( validRange .AND. val .NE. 0. ) THEN
8689736b2d Jean*1523               IDX = NINT(
                1524      &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
910f05e765 Chri*1525      &              )+1
                1526              ELSE
                1527               IDX = 1
                1528              ENDIF
8689736b2d Jean*1529              IF ( iBuf .LE. MAX_LEN_PLOTBUF )
924557e60a Chri*1530      &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
                1531              IF ( val .EQ. 0. ) THEN
8689736b2d Jean*1532               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
924557e60a Chri*1533      &         plotBuf(iBuf:iBuf) = '.'
                1534              ENDIF
                1535             ENDDO
                1536            ENDDO
                1537            CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
                1538      &                        SQUEEZE_RIGHT, 1)
                1539           ENDDO
                1540          ENDDO
                1541         ENDDO
                1542        ENDDO
39b81e6b27 Dimi*1543       ENDIF
924557e60a Chri*1544 C--   Write delimiter
8689736b2d Jean*1545       msgBuf =
46dc4f419b Chri*1546      & '// ======================================================='
924557e60a Chri*1547       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1548      &                   SQUEEZE_RIGHT, 1)
8689736b2d Jean*1549       msgBuf =
46dc4f419b Chri*1550      & '// END OF FIELD                                          ='
924557e60a Chri*1551       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1552      &                   SQUEEZE_RIGHT, 1)
8689736b2d Jean*1553       msgBuf =
46dc4f419b Chri*1554      & '// ======================================================='
924557e60a Chri*1555       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1556      &                   SQUEEZE_RIGHT, 1)
                1557       msgBuf = ' '
                1558       CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
                1559      &                   SQUEEZE_RIGHT, 1)
                1560 
                1561       RETURN
                1562       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!