/[MITgcm]/MITgcm/eesupp/src/print.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/print.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.11 by cnh, Sat Sep 5 17:52:13 1998 UTC revision 1.33 by jmc, Wed Mar 28 20:30:26 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6  C--   File printf.F: Routines for performing formatted textual I/O  C--  File printf.F: Routines for performing formatted textual I/O
7  C--                  in the MITgcm UV implementation environment.  C--                 in the MITgcm UV implementation environment.
8  C--    Contents  C--   Contents
9  C--    o print_error    Does IO with **ERROR** highlighted header  C--   o PRINT_MESSAGE  Does IO with unhighlighted header
10  C--    o print_list_i   Prints one-deimensional list of INTEGER  C--   o PRINT_ERROR    Does IO with **ERROR** highlighted header
11  C--                     numbers.  C--   o PRINT_LIST_I   Prints one-dimensional list of INTEGER
12  C--    o print_list_l   Prints one-deimensional list of LOGICAL  C--                    numbers.
13  C--                     variables.  C--   o PRINT_LIST_L   Prints one-dimensional list of LOGICAL
14  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--                    variables.
15  C--                     numbers.  C--   o PRINT_LIST_RL  Prints one-dimensional list of Real(_RL)
16  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field  C--                    numbers.
17  C--                     Uses print_message for writing  C--   o PRINT_MAPRS    Formats ABCD... contour map of a Real(_RS) field
18  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field  C--                    Uses print_message for writing
19  C--                     Uses print_message for writing  C--   o PRINT_MAPRL    Formats ABCD... contour map of a Real(_RL) field
20  C--    o print_message  Does IO with unhighlighted header  C--                    Uses print_message for writing
21    
22    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
23    CBOP
24    C     !ROUTINE: PRINT_MESSAGE
25    C     !INTERFACE:
26          SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
27    
28    C     !DESCRIPTION:
29    C     *============================================================*
30    C     | SUBROUTINE PRINT\_MESSAGE
31    C     | o Write out informational message using "standard" format.
32    C     *============================================================*
33    C     | Notes
34    C     | =====
35    C     | o Some system   I/O is not "thread-safe". For this reason
36    C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
37    C     |   critical region is defined around the write here. In some
38    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
39    C     |   for thread number 1 - writes for other threads are
40    C     |   ignored!
41    C     | o In a non-parallel form these routines can still be used.
42    C     |   to produce pretty printed output!
43    C     *============================================================*
44    
45    C     !USES:
46          IMPLICIT NONE
47    
 CStartOfInterface  
       SUBROUTINE PRINT_ERROR( message , myThid )  
 C     /============================================================\  
 C     | SUBROUTINE PRINT_ERROR                                     |  
 C     | o Write out error message using "standard" format.         |  
 C     | Notes                                                      |  
 C     | =====                                                      |  
 C     | o Some system's I/O is not "thread-safe". For this reason  |  
 C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  
 C     |   critical region is defined around the write here. In some|  
 C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  
 C     |   for thread number 1 - writes for other threads are       |  
 C     |   ignored!                                                 |  
 C     | o In a non-parallel form these routines can still be used. |  
 C     |   to produce pretty printed output!                        |  
 C     \============================================================/  
48  C     == Global data ==  C     == Global data ==
49  #include "SIZE.h"  #include "SIZE.h"
50  #include "EEPARAMS.h"  #include "EEPARAMS.h"
51  #include "EESUPPORT.h"  #include "EESUPPORT.h"
52    
53    C     !INPUT/OUTPUT PARAMETERS:
54  C     == Routine arguments ==  C     == Routine arguments ==
55    C     message :: Message to write
56    C     unit    :: Unit number to write to
57    C     sq      :: Justification option
58        CHARACTER*(*) message        CHARACTER*(*) message
59        INTEGER       myThid        INTEGER       unit
60  CEndOfInterface        CHARACTER*(*) sq
61          INTEGER  myThid
62    
63    C     !FUNCTIONS:
64        INTEGER  IFNBLNK        INTEGER  IFNBLNK
65        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
66        INTEGER  ILNBLNK        INTEGER  ILNBLNK
67        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
68    
69    C     !LOCAL VARIABLES:
70  C     == Local variables ==  C     == Local variables ==
71    C     iStart, iEnd :: String indexing variables
72    C     idString     :: Temp. for building prefix.
73        INTEGER iStart        INTEGER iStart
74        INTEGER iEnd        INTEGER iEnd
75        CHARACTER*9 idString        CHARACTER*9 idString
76    CEOP
77    
78  C--   Find beginning and end of message  C--   Find beginning and end of message
79        iStart = IFNBLNK( message )        IF ( sq .EQ. SQUEEZE_BOTH .OR.
80        iEnd   = ILNBLNK( message )       &     sq .EQ. SQUEEZE_LEFT ) THEN
81           iStart = IFNBLNK( message )
82          ELSE
83           iStart = 1
84          ENDIF
85          IF ( sq .EQ. SQUEEZE_BOTH .OR.
86         &     sq .EQ. SQUEEZE_RIGHT ) THEN
87           iEnd   = ILNBLNK( message )
88          ELSE
89           iEnd   = LEN(message)
90          ENDIF
91  C--   Test to see if in multi-process ( or multi-threaded ) mode.  C--   Test to see if in multi-process ( or multi-threaded ) mode.
92  C     If so include process or thread identifier.  C     If so include process or thread identifier.
93        IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN        IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
94  C--    Write single process format  C--    Write single process format
95         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
96          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(unit,'(A)') ' '
97         ELSE         ELSE
98          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(unit,'(A)') message(iStart:iEnd)
99         ENDIF         ENDIF
100        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSEIF ( pidIO .EQ. myProcId ) THEN
101  C--    Write multi-process format  C--    Write multi-process format
102    C      PRINT can be called by several threads simultaneously.
103    C      The write statement may need to ne marked as a critical section.
104  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
105    # ifdef USE_OMP_THREADING
106    C$OMP CRITICAL
107    # else
108         _BEGIN_CRIT(myThid)         _BEGIN_CRIT(myThid)
109    # endif
110  #endif  #endif
111          WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid         WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
112           IF ( message .EQ. ' ' ) THEN
113            WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
114         &   '(',PROCESS_HEADER,' ',idString,')',' '
115           ELSE
116            WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
117         &   '(',PROCESS_HEADER,' ',idString,')',' ',message(iStart:iEnd)
118           ENDIF
119           GOTO 1000
120      999  CONTINUE
121           ioErrorCount(myThid) = ioErrorCount(myThid)+1
122     1000  CONTINUE
123  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
124    # ifdef USE_OMP_THREADING
125    C$OMP END CRITICAL
126    # else
127         _END_CRIT(myThid)         _END_CRIT(myThid)
128    # endif
129  #endif  #endif
130         IF ( message .EQ. ' ' ) THEN        ENDIF
131    
132    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
133    C--   if error message, also write directly to unit 0 :
134          IF ( numberOfProcs .EQ. 1 .AND. myThid .EQ. 1
135         &     .AND. unit.EQ.errorMessageUnit
136         &     .AND. message .NE. ' ' ) THEN
137            IF ( nThreads.LE.1 ) THEN
138              WRITE(0,'(A)') message(iStart:iEnd)
139            ELSE
140              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
141         &                   message(iStart:iEnd)
142            ENDIF
143          ENDIF
144    #endif
145    
146          RETURN
147          END
148    
149    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
150    CBOP
151    C     !ROUTINE: PRINT_ERROR
152    C     !INTERFACE:
153          SUBROUTINE PRINT_ERROR( message , myThid )
154    
155    C     !DESCRIPTION:
156    C     *============================================================*
157    C     | SUBROUTINE PRINT\_ERROR
158    C     | o Write out error message using "standard" format.
159    C     *============================================================*
160    C     | Notes
161    C     | =====
162    C     | o Some system   I/O is not "thread-safe". For this reason
163    C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
164    C     |   critical region is defined around the write here. In some
165    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
166    C     |   for thread number 1 - writes for other threads are
167    C     |   ignored!
168    C     | o In a non-parallel form these routines are still used
169    C     |   to produce pretty printed output. The process and thread
170    C     |   id prefix is omitted in this case.
171    C     *============================================================*
172    
173    C     !USES:
174          IMPLICIT NONE
175    
176    C     == Global data ==
177    #include "SIZE.h"
178    #include "EEPARAMS.h"
179    #include "EESUPPORT.h"
180    
181    C     !INPUT/OUTPUT PARAMETERS:
182    C     == Routine arguments ==
183    C     message :: Text string to print
184    C     myThid  :: Thread number of this instance
185          CHARACTER*(*) message
186          INTEGER       myThid
187    
188    C     !FUNCTIONS:
189    c     INTEGER  IFNBLNK
190    c     EXTERNAL IFNBLNK
191          INTEGER  ILNBLNK
192          EXTERNAL ILNBLNK
193    
194    C     !LOCAL VARIABLES:
195    C     == Local variables ==
196    C     iStart, iEnd :: Temps. for string indexing
197    C     idString     :: Temp. for building message prefix
198    c     INTEGER iStart
199          INTEGER iEnd
200          CHARACTER*9 idString
201    CEOP
202    
203    C--   Find beginning and end of message
204    c     iStart = IFNBLNK( message )
205          iEnd   = ILNBLNK( message )
206    C--   Test to see if in multi-process ( or multi-threaded ) mode.
207    C     If so include process or thread identifier.
208          IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
209    C--    Write single process format
210           IF ( iEnd.EQ.0 ) THEN
211            WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
212           ELSE
213            WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
214         &        message(1:iEnd)
215    c    &    message(iStart:iEnd)
216           ENDIF
217          ELSE
218  C       PRINT_ERROR can be called by several threads simulataneously.  C       PRINT_ERROR can be called by several threads simulataneously.
219  C       The write statement may need to be marked as a critical section.  C       The write statement may need to be marked as a critical section.
220  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
221          _BEGIN_CRIT(myThid)  # ifdef USE_OMP_THREADING
222  #endif  C$OMP CRITICAL
223          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  # else
224       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',         _BEGIN_CRIT(myThid)
225       &  ' '  # endif
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
226  #endif  #endif
227         ELSE         IF ( pidIO .EQ. myProcId ) THEN
228  #ifndef FMTFTN_IO_THREAD_SAFE  C--    Write multi-process format
229          _BEGIN_CRIT(myThid)           WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
230    
231             IF ( iEnd.EQ.0 ) THEN
232              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
233         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
234         &    ' '
235             ELSE
236              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
237         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
238         &        message(1:iEnd)
239    c    &    message(iStart:iEnd)
240             ENDIF
241           ENDIF
242           GOTO 1000
243      999  CONTINUE
244           ioErrorCount(myThid) = ioErrorCount(myThid)+1
245     1000  CONTINUE
246    
247    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
248    C--    also write directly to unit 0 :
249           IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN
250            IF ( nThreads.LE.1 ) THEN
251              WRITE(0,'(A)') message(1:iEnd)
252            ELSE
253              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
254         &                   message(1:iEnd)
255            ENDIF
256           ENDIF
257  #endif  #endif
258          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  
      &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',  
      &  message(iStart:iEnd)  
259  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
260    # ifdef USE_OMP_THREADING
261    C$OMP END CRITICAL
262    # else
263          _END_CRIT(myThid)          _END_CRIT(myThid)
264    # endif
265  #endif  #endif
        ENDIF  
266        ENDIF        ENDIF
 C  
  1000 CONTINUE  
       RETURN  
267    
268    999 CONTINUE        RETURN
        ioErrorCount(myThid) = ioErrorCount(myThid)+1  
       GOTO 1000  
269        END        END
270    
271  CStartofinterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
272        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit )  CBOP
273  C     /==========================================================\  C     !ROUTINE: PRINT_LIST_I
274  C     | o SUBROUTINE PRINT_LIST_I                                |  C     !INTERFACE:
275  C     |==========================================================|        SUBROUTINE PRINT_LIST_I( fld, iFirst, iLast, index_type,
276  C     | Routine for producing list of values for a field with    |       &                         markEnd, compact, ioUnit )
277  C     | duplicate values collected into                          |  
278  C     |    n @ value                                             |  C     !DESCRIPTION:
279  C     | record.                                                  |  C     *==========================================================*
280  C     \==========================================================/  C     | o SUBROUTINE PRINT\_LIST\_I
281    C     *==========================================================*
282    C     | Routine for producing list of values for a field with
283    C     | duplicate values collected into
284    C     |    n \@ value
285    C     | record.
286    C     *==========================================================*
287    
288  C     == Global data ==    C     !USES:
289          IMPLICIT NONE
290    
291    C     == Global data ==
292  #include "SIZE.h"  #include "SIZE.h"
293  #include "EEPARAMS.h"  #include "EEPARAMS.h"
294    
295    C     !INPUT/OUTPUT PARAMETERS:
296  C     == Routine arguments ==  C     == Routine arguments ==
297  C     fld    -  Data to be printed  C     fld     :: Data to be printed
298  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
299  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
300    C  index_type :: Flag indicating which type of index to print
301  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
302  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
303  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
304  C                  INDEX_NONE =>  C                  INDEX_NONE =>
305  C     compact -  Flag to control use of repeat symbol for same valued  C     markEnd :: Flag to control whether there is a separator after the
 C                fields.  
 C     markEnd -  Flag to control whether there is a separator after the  
306  C                last element  C                last element
307  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
308        INTEGER lFld  C                fields.
309    C     ioUnit  :: Unit number for IO.
310          INTEGER iFirst, iLast
311          INTEGER fld(iFirst:iLast)
312        INTEGER index_type        INTEGER index_type
       INTEGER fld(lFld)  
313        LOGICAL markEnd        LOGICAL markEnd
314        LOGICAL compact        LOGICAL compact
315        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
316    
317    C     !LOCAL VARIABLES:
318  C     == Local variables ==  C     == Local variables ==
319  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
320  C     iHi    with the same value  C     iHi    with the same value
# Line 157  C     K    - Loop counter Line 332  C     K    - Loop counter
332        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
333        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
334        CHARACTER*3 index_lab        CHARACTER*3 index_lab
335          CHARACTER*25 fmt1, fmt2
336        INTEGER K        INTEGER K
337    CEOP
338    
339        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
340         index_lab = 'I ='         index_lab = 'I ='
# Line 168  C     K    - Loop counter Line 345  C     K    - Loop counter
345        ELSE        ELSE
346         index_lab = '?='         index_lab = '?='
347        ENDIF        ENDIF
348    C-    fortran format to write 1 or 2 indices:
349          fmt1='(A,1X,A,I3,1X,A)'
350          fmt2='(A,1X,A,I3,A,I3,1X,A)'
351          IF ( iLast.GE.1000 ) THEN
352            K = 1+INT(LOG10(FLOAT(iLast)))
353            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
354            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
355          ENDIF
356        commOpen  = '/*'        commOpen  = '/*'
357        commClose = '*/'        commClose = '*/'
358        iLo = 1        iLo = iFirst
359        iHi = 1        iHi = iFirst
360        punc = ','        punc = ','
361        xOld = fld(1)        xOld = fld(iFirst)
362        DO K=2,lFld        DO K = iFirst+1,iLast
363         xNew = fld(K  )         xNew = fld(K  )
364         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
365          nDup = iHi-iLo+1          nDup = iHi-iLo+1
366          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
367           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
368           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
369       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
370         &    commOpen,index_lab,iLo,commClose
371          ELSE          ELSE
372           WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
373           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
374       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
375       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
376          ENDIF          ENDIF
377          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 201  C     K    - Loop counter Line 387  C     K    - Loop counter
387        nDup = iHi-iLo+1        nDup = iHi-iLo+1
388        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
389         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
390         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
391       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
392         &  commOpen,index_lab,iLo,commClose
393        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
394         WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
395         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
396       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
397       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
398        ENDIF        ENDIF
399        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 214  C     K    - Loop counter Line 401  C     K    - Loop counter
401        RETURN        RETURN
402        END        END
403    
404  CStartofinterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
405        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit )  CBOP
406  C     /==========================================================\  C     !ROUTINE: PRINT_LIST_L
407  C     | o SUBROUTINE PRINT_LIST_L                                |  C     !INTERFACE:
408  C     |==========================================================|        SUBROUTINE PRINT_LIST_L( fld, iFirst, iLast, index_type,
409  C     | Routine for producing list of values for a field with    |       &                         markEnd, compact, ioUnit )
410  C     | duplicate values collected into                          |  
411  C     |    n @ value                                             |  C     !DESCRIPTION:
412  C     | record.                                                  |  C     *==========================================================*
413  C     \==========================================================/  C     | o SUBROUTINE PRINT\_LIST\_L
414    C     *==========================================================*
415    C     | Routine for producing list of values for a field with
416    C     | duplicate values collected into
417    C     |    n \@ value
418    C     | record.
419    C     *==========================================================*
420    
421  C     == Global data ==    C     !USES:
422          IMPLICIT NONE
423    
424    C     == Global data ==
425  #include "SIZE.h"  #include "SIZE.h"
426  #include "EEPARAMS.h"  #include "EEPARAMS.h"
427    
428    C     !INPUT/OUTPUT PARAMETERS:
429  C     == Routine arguments ==  C     == Routine arguments ==
430  C     fld    -  Data to be printed  C     fld     :: Data to be printed
431  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
432  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
433    C  index_type :: Flag indicating which type of index to print
434  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
435  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
436  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
437  C                  INDEX_NONE =>  C                  INDEX_NONE =>
438  C     compact -  Flag to control use of repeat symbol for same valued  C     markEnd :: Flag to control whether there is a separator after the
 C                fields.  
 C     markEnd -  Flag to control whether there is a separator after the  
439  C                last element  C                last element
440  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
441        INTEGER lFld  C                fields.
442    C     ioUnit  :: Unit number for IO.
443          INTEGER iFirst, iLast
444          LOGICAL fld(iFirst:iLast)
445        INTEGER index_type        INTEGER index_type
       LOGICAL fld(lFld)  
446        LOGICAL markEnd        LOGICAL markEnd
447        LOGICAL compact        LOGICAL compact
448        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
449    
450    C     !LOCAL VARIABLES:
451  C     == Local variables ==  C     == Local variables ==
452  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
453  C     iHi    with the same value  C     iHi    with the same value
# Line 267  C     K    - Loop counter Line 465  C     K    - Loop counter
465        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
466        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
467        CHARACTER*3 index_lab        CHARACTER*3 index_lab
468          CHARACTER*25 fmt1, fmt2
469        INTEGER K        INTEGER K
470    CEOP
471    
472        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
473         index_lab = 'I ='         index_lab = 'I ='
# Line 278  C     K    - Loop counter Line 478  C     K    - Loop counter
478        ELSE        ELSE
479         index_lab = '?='         index_lab = '?='
480        ENDIF        ENDIF
481    C-    fortran format to write 1 or 2 indices:
482          fmt1='(A,1X,A,I3,1X,A)'
483          fmt2='(A,1X,A,I3,A,I3,1X,A)'
484          IF ( iLast.GE.1000 ) THEN
485            K = 1+INT(LOG10(FLOAT(iLast)))
486            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
487            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
488          ENDIF
489        commOpen  = '/*'        commOpen  = '/*'
490        commClose = '*/'        commClose = '*/'
491        iLo = 1        iLo = iFirst
492        iHi = 1        iHi = iFirst
493        punc = ','        punc = ','
494        xOld = fld(1)        xOld = fld(iFirst)
495        DO K=2,lFld        DO K = iFirst+1,iLast
496         xNew = fld(K  )         xNew = fld(K  )
497         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
498          nDup = iHi-iLo+1          nDup = iHi-iLo+1
499          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
500           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
501           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
502       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
503         &    commOpen,index_lab,iLo,commClose
504          ELSE          ELSE
505           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
506           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
507       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
508       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
509          ENDIF          ENDIF
510          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 311  C     K    - Loop counter Line 520  C     K    - Loop counter
520        nDup = iHi-iLo+1        nDup = iHi-iLo+1
521        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
522         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
523         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
524       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
525         &    commOpen,index_lab,iLo,commClose
526        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
527         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
528         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
529       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
530       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
531        ENDIF        ENDIF
532        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 324  C     K    - Loop counter Line 534  C     K    - Loop counter
534        RETURN        RETURN
535        END        END
536    
537  CStartofinterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
538        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit )  CBOP
539  C     /==========================================================\  C     !ROUTINE: PRINT_LIST_RL
540  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     !INTERFACE:
541  C     |==========================================================|        SUBROUTINE PRINT_LIST_RL( fld, iFirst, iLast, index_type,
542  C     | Routine for producing list of values for a field with    |       &                          markEnd, compact, ioUnit )
543  C     | duplicate values collected into                          |  
544  C     |    n @ value                                             |  C     !DESCRIPTION:
545  C     | record.                                                  |  C     *==========================================================*
546  C     \==========================================================/  C     | o SUBROUTINE PRINT\_LIST\_RL
547    C     *==========================================================*
548    C     | Routine for producing list of values for a field with
549    C     | duplicate values collected into
550    C     |    n \@ value
551    C     | record.
552    C     *==========================================================*
553    
554    C     !USES:
555          IMPLICIT NONE
556    
557  C     == Global data ==    C     == Global data ==
558  #include "SIZE.h"  #include "SIZE.h"
559  #include "EEPARAMS.h"  #include "EEPARAMS.h"
560    
561    C     !INPUT/OUTPUT PARAMETERS:
562  C     == Routine arguments ==  C     == Routine arguments ==
563  C     fld    -  Data to be printed  C     fld     :: Data to be printed
564  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
565  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
566    C  index_type :: Flag indicating which type of index to print
567  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
568  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
569  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
570  C                  INDEX_NONE =>  C                  INDEX_NONE =>
571  C     compact -  Flag to control use of repeat symbol for same valued  C     markEnd :: Flag to control whether there is a separator after the
 C                fields.  
 C     markEnd -  Flag to control whether there is a separator after the  
572  C                last element  C                last element
573  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
574        INTEGER lFld  C                fields.
575    C     ioUnit  :: Unit number for IO.
576          INTEGER iFirst, iLast
577          _RL     fld(iFirst:iLast)
578        INTEGER index_type        INTEGER index_type
       Real*8  fld(lFld)  
579        LOGICAL markEnd        LOGICAL markEnd
580        LOGICAL compact        LOGICAL compact
581        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
582    
583    C     !LOCA VARIABLES:
584  C     == Local variables ==  C     == Local variables ==
585  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
586  C     iHi    with the same value  C     iHi    with the same value
# Line 372  C     K    - Loop counter Line 593  C     K    - Loop counter
593        INTEGER iLo        INTEGER iLo
594        INTEGER iHi        INTEGER iHi
595        INTEGER nDup        INTEGER nDup
596        Real*8 xNew, xOld        _RL     xNew, xOld
597        CHARACTER punc        CHARACTER punc
598        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
599        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
600        CHARACTER*3 index_lab        CHARACTER*3 index_lab
601          CHARACTER*25 fmt1, fmt2
602        INTEGER K        INTEGER K
603    CEOP
604    
605        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
606         index_lab = 'I ='         index_lab = 'I ='
# Line 388  C     K    - Loop counter Line 611  C     K    - Loop counter
611        ELSE        ELSE
612         index_lab = '?='         index_lab = '?='
613        ENDIF        ENDIF
614    C-    fortran format to write 1 or 2 indices:
615          fmt1='(A,1X,A,I3,1X,A)'
616          fmt2='(A,1X,A,I3,A,I3,1X,A)'
617          IF ( iLast.GE.1000 ) THEN
618            K = 1+INT(LOG10(FLOAT(iLast)))
619            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
620            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
621          ENDIF
622        commOpen  = '/*'        commOpen  = '/*'
623        commClose = '*/'        commClose = '*/'
624        iLo = 1        iLo = iFirst
625        iHi = 1        iHi = iFirst
626        punc = ','        punc = ','
627        xOld = fld(1)        xOld = fld(iFirst)
628        DO K=2,lFld        DO K = iFirst+1,iLast
629         xNew = fld(K  )         xNew = fld(K  )
630         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
631          nDup = iHi-iLo+1          nDup = iHi-iLo+1
632          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
633           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
634           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
635       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
636         &    commOpen,index_lab,iLo,commClose
637          ELSE          ELSE
638           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
639           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
640       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
641       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
642          ENDIF          ENDIF
643          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
644          iLo  = K          iLo  = K
645          iHi  = K          iHi  = K
646          xOld = xNew          xOld = xNew
# Line 421  C     K    - Loop counter Line 653  C     K    - Loop counter
653        nDup = iHi-iLo+1        nDup = iHi-iLo+1
654        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
655         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
656         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
657       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),fmt1)
658         &    commOpen,index_lab,iLo,commClose
659        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
660         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
661         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
662       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),fmt2)
663       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
664        ENDIF        ENDIF
665        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
666    
667        RETURN        RETURN
668        END        END
669    
670  CStartOfInterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
671    CBOP
672    C     !ROUTINE: PRINT_MAPRS
673    C     !INTERFACE:
674        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
675       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
676       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 442  CStartOfInterface Line 678  CStartOfInterface
678       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
679       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
680       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
681  C     /==========================================================\  
682  C     | SUBROUTINE PRINT_MAPR4                                   |  C     !DESCRIPTION:
683  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
684  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPRS
685  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.
686  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
687  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data
688  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the
689  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.
690  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like
691  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYRS( ... ) rather than this code directly.
692  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation
693  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the
694  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the
695  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)
696  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for
697  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.
698  C     |      plots - one for K=1, one for K=3 and one for K=5.   |  C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).
699  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
700  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.
701  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr
702    C     |      and jMin:jMax step jStr.
703    C     *==========================================================*
704    
705    C     !USES:
706          IMPLICIT NONE
707    
708  C     == Global variables ==  C     == Global variables ==
709  #include "SIZE.h"  #include "SIZE.h"
710  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
711    
712    C     !INPUT/OUTPUT PARAMETERS:
713  C     == Routine arguments ==  C     == Routine arguments ==
714  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
715  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 479  C     jLo, jHi     be five-dimensional. Line 720  C     jLo, jHi     be five-dimensional.
720  C     kLo, kHi  C     kLo, kHi
721  C     nBx, nBy  C     nBx, nBy
722  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
723  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
724  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
725  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
726  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 496  C     kStr Line 737  C     kStr
737        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
738        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
739        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
740  CEndOfInterface  
741  C     == Local variables ==  C     !FUNCTIONS:
742        INTEGER  IFNBLNK        INTEGER  IFNBLNK
743        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
744        INTEGER  ILNBLNK        INTEGER  ILNBLNK
745        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
746    
747    C     !LOCAL VARIABLES:
748  C     == Local variables ==  C     == Local variables ==
749  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
750  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 526  C               Min  - Start index withi Line 768  C               Min  - Start index withi
768  C               Max  - End index within block  C               Max  - End index within block
769  C               Str  - stride within block  C               Str  - stride within block
770        INTEGER MAX_LEN_PLOTBUF        INTEGER MAX_LEN_PLOTBUF
771        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
772        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
773        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
774        INTEGER lChList        INTEGER lChList
775        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
776        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
777        REAL fMin        _RL  fMin
778        REAL fMax        _RL  fMax
779        REAL fRange        _RL  fRange
780        REAL val        _RL  val
781        REAL small        _RL  small
782        CHARACTER*2  accLab        CHARACTER*2  accLab
783        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
784        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 551  C               Str  - stride within blo Line 793  C               Str  - stride within blo
793        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
794        INTEGER bi, bj, bk        INTEGER bi, bj, bk
795        LOGICAL validRange        LOGICAL validRange
796    CEOP
797    
798        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
799        small  = 1. _d -15        small  =  1. _d -15
800        fMin   =  1. _d 32        fMin   =  1. _d  32
801        fMax   = -1. _d 32        fMax   = -1. _d  32
802        validRange = .FALSE.        validRange = .FALSE.
803    
804  C--   Calculate field range  C--   Calculate field range
# Line 565  C--   Calculate field range Line 808  C--   Calculate field range
808           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
809            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
810             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
811              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
812       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
813              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
814       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
815             ENDIF             ENDIF
816            ENDDO            ENDDO
# Line 576  C--   Calculate field range Line 819  C--   Calculate field range
819         ENDDO         ENDDO
820        ENDDO        ENDDO
821        fRange = fMax-fMin        fRange = fMax-fMin
822        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small ) validRange = .TRUE.
        validRange = .TRUE.  
       ENDIF  
823    
824  C--   Write field title and statistics  C--   Write field title and statistics
825        msgBuf = '// ======================================================='        msgBuf =
826         & '// ======================================================='
827        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
828       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
829        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 618  C--   Write field title and statistics Line 860  C--   Write field title and statistics
860       & '//                  0.0: ','.'       & '//                  0.0: ','.'
861        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
862       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
863         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
864       & '// RANGE I (Lo:Hi:Step):',       & '// RANGE I (Lo:Hi:Step):',
865       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
866       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
867       &  ':',iStr,')'       &  ':',iStr,')'
868        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
869       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
870         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
871       & '// RANGE J (Lo:Hi:Step):',       & '// RANGE J (Lo:Hi:Step):',
872       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
873       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
# Line 639  C--   Write field title and statistics Line 881  C--   Write field title and statistics
881       &  ':',kStr,')'       &  ':',kStr,')'
882        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
883       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
884        msgBuf = '// ======================================================='        msgBuf =
885         & '// ======================================================='
886        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
887       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
888    
889    c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
890    c      msgBuf =
891    c    &  'Model domain too big to print to terminal - skipping I/O'
892    c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
893    c    &                   SQUEEZE_RIGHT, 1)
894    c      RETURN
895    c     endif
896    
897  C--   Write field  C--   Write field
898  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
899  C     acc = accross the page  C     acc = accross the page
# Line 735  C      X across, Z down slice Line 986  C      X across, Z down slice
986         pltStep = sNy         pltStep = sNy
987         pltLab  = 'J ='         pltLab  = 'J ='
988        ENDIF        ENDIF
989  C     IF ( validRange ) THEN  C-    check if it fits into buffer (-10 should be enough but -12 is safer):
990          IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
991         &     .AND. validRange ) THEN
992           msgBuf =
993         &  'Model domain too big to print to terminal - skipping I/O'
994           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
995         &                   SQUEEZE_RIGHT, 1)
996           validRange = .FALSE.
997          ENDIF
998          IF ( validRange ) THEN
999  C      Header  C      Header
1000  C      Data  C      Data
1001         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1002          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1003           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1004       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1005           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1006       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1007           plotBuf = ' '           plotBuf = ' '
1008           iBuf = 6           iBuf = 6
1009           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1010            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1011             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 767  C      Data Line 1027  C      Data
1027           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1028       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1029           plotBuf = dwnLab           plotBuf = dwnLab
1030           iBuf = 7           iBuf = 7
1031           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1032            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1033             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 775  C      Data Line 1035  C      Data
1035             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1036              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1037             ELSE             ELSE
1038              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1039             ENDIF             ENDIF
1040            ENDDO            ENDDO
1041           ENDDO           ENDDO
# Line 784  C      Data Line 1044  C      Data
1044       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1045           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1046            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1047             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1048       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1049             iBuf = 7             iBuf = 7
1050             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 797  C      Data Line 1057  C      Data
1057               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1058                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1059               ENDIF               ENDIF
1060               IF ( validRange ) THEN               IF ( validRange .AND. val .NE. 0. ) THEN
1061                IDX = NINT(                IDX = NINT(
1062       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1063       &             )+1       &             )+1
1064               ELSE               ELSE
1065                IDX = 1                IDX = 1
1066               ENDIF               ENDIF
1067               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1068       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1069               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1070                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1071       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1072               ENDIF               ENDIF
1073              ENDDO              ENDDO
# Line 819  C      Data Line 1079  C      Data
1079           ENDDO           ENDDO
1080          ENDDO          ENDDO
1081         ENDDO         ENDDO
1082  C     ENDIF        ENDIF
1083  C--   Write delimiter  C--   Write delimiter
1084        msgBuf = '// ======================================================='        msgBuf =
1085         & '// ======================================================='
1086        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1087       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1088        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1089         & '// END OF FIELD                                          ='
1090        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1091       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1092        msgBuf = '// ======================================================='        msgBuf =
1093         & '// ======================================================='
1094        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1095       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1096        msgBuf = ' '        msgBuf = ' '
# Line 837  C--   Write delimiter Line 1100  C--   Write delimiter
1100        RETURN        RETURN
1101        END        END
1102    
1103  CStartOfInterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1104    CBOP
1105    C     !ROUTINE: PRINT_MAPRL
1106    C     !INTERFACE:
1107        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
1108       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
1109       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 845  CStartOfInterface Line 1111  CStartOfInterface
1111       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
1112       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
1113       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
1114  C     /==========================================================\  
1115  C     | SUBROUTINE PRINT_MAPRL                                   |  C     !DESCRIPTION:
1116  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
1117  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPRL
1118  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.
1119  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
1120  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data
1121  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the
1122  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.
1123  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like
1124  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYRL( ... ) rather than this code directly.
1125  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation
1126  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the
1127  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the
1128  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)
1129  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for
1130  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.
1131  C     |      plots - one for K=1, one for K=3 and one for K=5.   |  C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).
1132  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
1133  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.
1134  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr
1135    C     |      and jMin:jMax step jStr.
1136    C     *==========================================================*
1137    
1138    C     !USES:
1139          IMPLICIT NONE
1140    
1141  C     == Global variables ==  C     == Global variables ==
1142  #include "SIZE.h"  #include "SIZE.h"
1143  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
1144    
1145    C     !INPUT/OUTPUT PARAMETERS:
1146  C     == Routine arguments ==  C     == Routine arguments ==
1147  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
1148  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 882  C     jLo, jHi     be five-dimensional. Line 1153  C     jLo, jHi     be five-dimensional.
1153  C     kLo, kHi  C     kLo, kHi
1154  C     nBx, nBy  C     nBx, nBy
1155  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
1156  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
1157  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
1158  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
1159  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 899  C     kStr Line 1170  C     kStr
1170        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
1171        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
1172        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
1173  CEndOfInterface  
1174  C     == Local variables ==  C     !FUNCTIONS:
1175        INTEGER  IFNBLNK        INTEGER  IFNBLNK
1176        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
1177        INTEGER  ILNBLNK        INTEGER  ILNBLNK
1178        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
1179    
1180    C     !LOCAL VARIABLES:
1181  C     == Local variables ==  C     == Local variables ==
1182  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
1183  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 929  C               Min  - Start index withi Line 1201  C               Min  - Start index withi
1201  C               Max  - End index within block  C               Max  - End index within block
1202  C               Str  - stride within block  C               Str  - stride within block
1203        INTEGER MAX_LEN_PLOTBUF        INTEGER MAX_LEN_PLOTBUF
1204        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
1205        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
1206        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1207        INTEGER lChList        INTEGER lChList
1208        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1209        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1210        REAL fMin        _RL  fMin
1211        REAL fMax        _RL  fMax
1212        REAL fRange        _RL  fRange
1213        REAL val        _RL  val
1214        REAL small        _RL  small
1215        CHARACTER*2  accLab        CHARACTER*2  accLab
1216        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1217        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 954  C               Str  - stride within blo Line 1226  C               Str  - stride within blo
1226        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1227        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1228        LOGICAL validRange        LOGICAL validRange
1229    CEOP
1230    
1231        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1232        small  = 1. _d -15        small  = 1. _d -15
# Line 967  C--   Calculate field range Line 1240  C--   Calculate field range
1240          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1241           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1242            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1243             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1244              IF ( fld(I,J,K,bi,bj) .LT. fMin )       &     THEN
1245                IF ( fld(I,J,K,bi,bj) .LT. fMin )
1246       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1247              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1248       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1249             ENDIF             ENDIF
1250            ENDDO            ENDDO
# Line 979  C--   Calculate field range Line 1253  C--   Calculate field range
1253         ENDDO         ENDDO
1254        ENDDO        ENDDO
1255        fRange = fMax-fMin        fRange = fMax-fMin
1256        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small ) validRange = .TRUE.
        validRange = .TRUE.  
       ENDIF  
1257    
1258  C--   Write field title and statistics  C--   Write field title and statistics
1259        msgBuf = '// ======================================================='        msgBuf =
1260         & '// ======================================================='
1261        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1262       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1263        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 1021  C--   Write field title and statistics Line 1294  C--   Write field title and statistics
1294       & '//                  0.0: ','.'       & '//                  0.0: ','.'
1295        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1296       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1297         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
1298       & '// RANGE I (Lo:Hi:Step):',       & '// RANGE I (Lo:Hi:Step):',
1299       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
1300       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
1301       &  ':',iStr,')'       &  ':',iStr,')'
1302        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1303       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1304         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
1305       & '// RANGE J (Lo:Hi:Step):',       & '// RANGE J (Lo:Hi:Step):',
1306       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
1307       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
# Line 1042  C--   Write field title and statistics Line 1315  C--   Write field title and statistics
1315       &  ':',kStr,')'       &  ':',kStr,')'
1316        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1317       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1318        msgBuf = '// ======================================================='        msgBuf =
1319         & '// ======================================================='
1320        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1321       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1322    
1323    c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1324    c      msgBuf =
1325    c    &  'Model domain too big to print to terminal - skipping I/O'
1326    c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1327    c    &                   SQUEEZE_RIGHT, 1)
1328    c      RETURN
1329    c     endif
1330    
1331  C--   Write field  C--   Write field
1332  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1333  C     acc = accross the page  C     acc = accross the page
# Line 1138  C      X across, Z down slice Line 1420  C      X across, Z down slice
1420         pltStep = sNy         pltStep = sNy
1421         pltLab  = 'J ='         pltLab  = 'J ='
1422        ENDIF        ENDIF
1423  C     IF ( validRange ) THEN  C-    check if it fits into buffer (-10 should be enough but -12 is safer):
1424          IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
1425         &     .AND. validRange ) THEN
1426           msgBuf =
1427         &  'Model domain too big to print to terminal - skipping I/O'
1428           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1429         &                   SQUEEZE_RIGHT, 1)
1430           validRange = .FALSE.
1431          ENDIF
1432          IF ( validRange ) THEN
1433  C      Header  C      Header
1434  C      Data  C      Data
1435         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1436          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1437           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1438       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1439           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1440       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1441           plotBuf = ' '           plotBuf = ' '
1442           iBuf = 6           iBuf = 6
1443           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1444            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1445             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 1169  C      Data Line 1460  C      Data
1460           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1461       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1462           plotBuf = dwnLab           plotBuf = dwnLab
1463           iBuf = 7           iBuf = 7
1464           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1465            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1466             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 1177  C      Data Line 1468  C      Data
1468             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1469              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1470             ELSE             ELSE
1471              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1472             ENDIF             ENDIF
1473            ENDDO            ENDDO
1474           ENDDO           ENDDO
# Line 1185  C      Data Line 1476  C      Data
1476       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1477           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1478            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1479             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1480       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1481             iBuf = 7             iBuf = 7
1482             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 1198  C      Data Line 1489  C      Data
1489               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1490                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1491               ENDIF               ENDIF
1492               IF ( validRange ) THEN               IF ( validRange .AND. val .NE. 0. ) THEN
1493                IDX = NINT(                IDX = NINT(
1494       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1495       &              )+1       &              )+1
1496               ELSE               ELSE
1497                IDX = 1                IDX = 1
1498               ENDIF               ENDIF
1499               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1500       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1501               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1502                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1503       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1504               ENDIF               ENDIF
1505              ENDDO              ENDDO
# Line 1219  C      Data Line 1510  C      Data
1510           ENDDO           ENDDO
1511          ENDDO          ENDDO
1512         ENDDO         ENDDO
1513  C     ENDIF        ENDIF
1514  C--   Write delimiter  C--   Write delimiter
1515        msgBuf = '// ======================================================='        msgBuf =
1516         & '// ======================================================='
1517        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1518       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1519        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1520         & '// END OF FIELD                                          ='
1521        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1522       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1523        msgBuf = '// ======================================================='        msgBuf =
1524         & '// ======================================================='
1525        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1526       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1527        msgBuf = ' '        msgBuf = ' '
# Line 1236  C--   Write delimiter Line 1530  C--   Write delimiter
1530    
1531        RETURN        RETURN
1532        END        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     \============================================================/  
 C     == Global data ==  
 #include "SIZE.h"  
 #include "EEPARAMS.h"  
 #include "EESUPPORT.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  
 C--   Test to see if in multi-process ( or multi-threaded ) mode.  
 C     If so include process or thread identifier.  
       IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN  
 C--    Write single process format  
        IF ( message .EQ. ' ' ) THEN  
         WRITE(unit,'(A)') ' '  
        ELSE  
         WRITE(unit,'(A)') message(iStart:iEnd)  
        ENDIF  
       ELSEIF ( pidIO .EQ. myProcId ) THEN  
 C--    Write multi-process format  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _BEGIN_CRIT(myThid)  
 #endif  
         WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _END_CRIT(myThid)  
 #endif  
        IF ( message .EQ. ' ' ) THEN  
 C       PRINT can be called by several threads simultaneously.  
 C       The write statement may need to ne marked as a critical section.  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _BEGIN_CRIT(myThid)  
 #endif  
          WRITE(unit,'(A,A,A,A,A,A)',ERR=999)  
      &   '(',PROCESS_HEADER,' ',idString,')',' '  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
 #endif  
        ELSE  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _BEGIN_CRIT(myThid)  
 #endif  
          WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)  
      &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',  
      &   message(iStart:iEnd)  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
 #endif  
        ENDIF  
       ENDIF  
 C  
  1000 CONTINUE  
       RETURN  
   999 CONTINUE  
        ioErrorCount(myThid) = ioErrorCount(myThid)+1  
       GOTO 1000  
   
       END  
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.33
  ViewVC Help
Powered by ViewVC 1.1.22