/[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.8.2.1 by cnh, Sat Jun 20 21:04:59 1998 UTC revision 1.35 by utke, Mon Mar 4 17:49:45 2013 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 be 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           IF ( debugMode ) THEN
120            CALL MDS_FLUSH( unit, myThid )
121           ENDIF
122           GOTO 1000
123      999  CONTINUE
124           ioErrorCount(myThid) = ioErrorCount(myThid)+1
125     1000  CONTINUE
126  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
127    # ifdef USE_OMP_THREADING
128    C$OMP END CRITICAL
129    # else
130         _END_CRIT(myThid)         _END_CRIT(myThid)
131    # endif
132  #endif  #endif
133         IF ( message .EQ. ' ' ) THEN        ENDIF
134    
135    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
136    C--   if error message, also write directly to unit 0 :
137          IF ( numberOfProcs .EQ. 1 .AND. myThid .EQ. 1
138         &     .AND. unit.EQ.errorMessageUnit
139         &     .AND. message .NE. ' ' ) THEN
140            IF ( nThreads.LE.1 ) THEN
141              WRITE(0,'(A)') message(iStart:iEnd)
142            ELSE
143              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
144         &                   message(iStart:iEnd)
145            ENDIF
146          ENDIF
147    #endif
148    
149          RETURN
150          END
151    
152    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
153    CBOP
154    C     !ROUTINE: PRINT_ERROR
155    C     !INTERFACE:
156          SUBROUTINE PRINT_ERROR( message , myThid )
157    
158    C     !DESCRIPTION:
159    C     *============================================================*
160    C     | SUBROUTINE PRINT\_ERROR
161    C     | o Write out error message using "standard" format.
162    C     *============================================================*
163    C     | Notes
164    C     | =====
165    C     | o Some system   I/O is not "thread-safe". For this reason
166    C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
167    C     |   critical region is defined around the write here. In some
168    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
169    C     |   for thread number 1 - writes for other threads are
170    C     |   ignored!
171    C     | o In a non-parallel form these routines are still used
172    C     |   to produce pretty printed output. The process and thread
173    C     |   id prefix is omitted in this case.
174    C     *============================================================*
175    
176    C     !USES:
177          IMPLICIT NONE
178    
179    C     == Global data ==
180    #include "SIZE.h"
181    #include "EEPARAMS.h"
182    #include "EESUPPORT.h"
183    
184    C     !INPUT/OUTPUT PARAMETERS:
185    C     == Routine arguments ==
186    C     message :: Text string to print
187    C     myThid  :: Thread number of this instance
188          CHARACTER*(*) message
189          INTEGER       myThid
190    
191    C     !FUNCTIONS:
192    c     INTEGER  IFNBLNK
193    c     EXTERNAL IFNBLNK
194          INTEGER  ILNBLNK
195          EXTERNAL ILNBLNK
196    
197    C     !LOCAL VARIABLES:
198    C     == Local variables ==
199    C     iStart, iEnd :: Temps. for string indexing
200    C     idString     :: Temp. for building message prefix
201    c     INTEGER iStart
202          INTEGER iEnd
203          CHARACTER*9 idString
204    CEOP
205    
206    C--   Find beginning and end of message
207    c     iStart = IFNBLNK( message )
208          iEnd   = ILNBLNK( message )
209    C--   Test to see if in multi-process ( or multi-threaded ) mode.
210    C     If so include process or thread identifier.
211          IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
212    C--    Write single process format
213           IF ( iEnd.EQ.0 ) THEN
214            WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
215           ELSE
216            WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
217         &        message(1:iEnd)
218    c    &    message(iStart:iEnd)
219           ENDIF
220          ELSE
221  C       PRINT_ERROR can be called by several threads simulataneously.  C       PRINT_ERROR can be called by several threads simulataneously.
222  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.
223  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
224          _BEGIN_CRIT(myThid)  # ifdef USE_OMP_THREADING
225  #endif  C$OMP CRITICAL
226          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  # else
227       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',         _BEGIN_CRIT(myThid)
228       &  ' '  # endif
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
229  #endif  #endif
230         ELSE         IF ( pidIO .EQ. myProcId ) THEN
231  #ifndef FMTFTN_IO_THREAD_SAFE  C--    Write multi-process format
232          _BEGIN_CRIT(myThid)           WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
233    
234             IF ( iEnd.EQ.0 ) THEN
235              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
236         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
237         &    ' '
238             ELSE
239              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
240         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
241         &        message(1:iEnd)
242    c    &    message(iStart:iEnd)
243             ENDIF
244           ENDIF
245           IF ( debugMode ) THEN
246            CALL MDS_FLUSH( errorMessageUnit, myThid )
247           ENDIF
248           GOTO 1000
249      999  CONTINUE
250           ioErrorCount(myThid) = ioErrorCount(myThid)+1
251     1000  CONTINUE
252    
253    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
254    C--    also write directly to unit 0 :
255           IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN
256            IF ( nThreads.LE.1 ) THEN
257              WRITE(0,'(A)') message(1:iEnd)
258            ELSE
259              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
260         &                   message(1:iEnd)
261            ENDIF
262           ENDIF
263  #endif  #endif
264          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  
      &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',  
      &  message(iStart:iEnd)  
265  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
266    # ifdef USE_OMP_THREADING
267    C$OMP END CRITICAL
268    # else
269          _END_CRIT(myThid)          _END_CRIT(myThid)
270    # endif
271  #endif  #endif
        ENDIF  
272        ENDIF        ENDIF
 C  
  1000 CONTINUE  
       RETURN  
273    
274    999 CONTINUE        RETURN
        ioErrorCount(myThid) = ioErrorCount(myThid)+1  
       GOTO 1000  
275        END        END
276    
277  CStartofinterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
278        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit )  CBOP
279  C     /==========================================================\  C     !ROUTINE: PRINT_LIST_I
280  C     | o SUBROUTINE PRINT_LIST_I                                |  C     !INTERFACE:
281  C     |==========================================================|        SUBROUTINE PRINT_LIST_I( fld, iFirst, iLast, index_type,
282  C     | Routine for producing list of values for a field with    |       &                         markEnd, compact, ioUnit )
283  C     | duplicate values collected into                          |  
284  C     |    n @ value                                             |  C     !DESCRIPTION:
285  C     | record.                                                  |  C     *==========================================================*
286  C     \==========================================================/  C     | o SUBROUTINE PRINT\_LIST\_I
287    C     *==========================================================*
288    C     | Routine for producing list of values for a field with
289    C     | duplicate values collected into
290    C     |    n \@ value
291    C     | record.
292    C     *==========================================================*
293    
294    C     !USES:
295          IMPLICIT NONE
296    
297  C     == Global data ==    C     == Global data ==
298  #include "SIZE.h"  #include "SIZE.h"
299  #include "EEPARAMS.h"  #include "EEPARAMS.h"
300    
301    C     !INPUT/OUTPUT PARAMETERS:
302  C     == Routine arguments ==  C     == Routine arguments ==
303  C     fld    -  Data to be printed  C     fld     :: Data to be printed
304  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
305  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
306    C  index_type :: Flag indicating which type of index to print
307  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
308  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
309  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
310  C                  INDEX_NONE =>  C                  INDEX_NONE =>
311  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  
312  C                last element  C                last element
313  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
314        INTEGER lFld  C                fields.
315    C     ioUnit  :: Unit number for IO.
316          INTEGER iFirst, iLast
317          INTEGER fld(iFirst:iLast)
318        INTEGER index_type        INTEGER index_type
       INTEGER fld(lFld)  
319        LOGICAL markEnd        LOGICAL markEnd
320        LOGICAL compact        LOGICAL compact
321        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
322    
323    C     !LOCAL VARIABLES:
324  C     == Local variables ==  C     == Local variables ==
325  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
326  C     iHi    with the same value  C     iHi    with the same value
# Line 157  C     K    - Loop counter Line 338  C     K    - Loop counter
338        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
339        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
340        CHARACTER*3 index_lab        CHARACTER*3 index_lab
341          CHARACTER*25 fmt1, fmt2
342        INTEGER K        INTEGER K
343    CEOP
344    
345        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
346         index_lab = 'I ='         index_lab = 'I ='
# Line 168  C     K    - Loop counter Line 351  C     K    - Loop counter
351        ELSE        ELSE
352         index_lab = '?='         index_lab = '?='
353        ENDIF        ENDIF
354    C-    fortran format to write 1 or 2 indices:
355          fmt1='(A,1X,A,I3,1X,A)'
356          fmt2='(A,1X,A,I3,A,I3,1X,A)'
357          IF ( iLast.GE.1000 ) THEN
358            K = 1+INT(LOG10(FLOAT(iLast)))
359            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
360            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
361          ENDIF
362        commOpen  = '/*'        commOpen  = '/*'
363        commClose = '*/'        commClose = '*/'
364        iLo = 1        iLo = iFirst
365        iHi = 1        iHi = iFirst
366        punc = ','        punc = ','
367        xOld = fld(1)        xOld = fld(iFirst)
368        DO K=2,lFld        DO K = iFirst+1,iLast
369         xNew = fld(K  )         xNew = fld(K  )
370         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
371          nDup = iHi-iLo+1          nDup = iHi-iLo+1
372          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
373           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
374           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
375       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
376         &    commOpen,index_lab,iLo,commClose
377          ELSE          ELSE
378           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
379           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
380       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
381       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
382          ENDIF          ENDIF
383          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 200  C     K    - Loop counter Line 392  C     K    - Loop counter
392        IF ( markEnd ) punc = ','        IF ( markEnd ) punc = ','
393        nDup = iHi-iLo+1        nDup = iHi-iLo+1
394        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
395         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
396         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
397       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
398         &  commOpen,index_lab,iLo,commClose
399        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
400         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
401         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
402       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
403       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
404        ENDIF        ENDIF
405        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 214  C     K    - Loop counter Line 407  C     K    - Loop counter
407        RETURN        RETURN
408        END        END
409    
410  CStartofinterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
411        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit )  CBOP
412  C     /==========================================================\  C     !ROUTINE: PRINT_LIST_L
413  C     | o SUBROUTINE PRINT_LIST_L                                |  C     !INTERFACE:
414  C     |==========================================================|        SUBROUTINE PRINT_LIST_L( fld, iFirst, iLast, index_type,
415  C     | Routine for producing list of values for a field with    |       &                         markEnd, compact, ioUnit )
416  C     | duplicate values collected into                          |  
417  C     |    n @ value                                             |  C     !DESCRIPTION:
418  C     | record.                                                  |  C     *==========================================================*
419  C     \==========================================================/  C     | o SUBROUTINE PRINT\_LIST\_L
420    C     *==========================================================*
421    C     | Routine for producing list of values for a field with
422    C     | duplicate values collected into
423    C     |    n \@ value
424    C     | record.
425    C     *==========================================================*
426    
427  C     == Global data ==    C     !USES:
428          IMPLICIT NONE
429    
430    C     == Global data ==
431  #include "SIZE.h"  #include "SIZE.h"
432  #include "EEPARAMS.h"  #include "EEPARAMS.h"
433    
434    C     !INPUT/OUTPUT PARAMETERS:
435  C     == Routine arguments ==  C     == Routine arguments ==
436  C     fld    -  Data to be printed  C     fld     :: Data to be printed
437  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
438  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
439    C  index_type :: Flag indicating which type of index to print
440  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
441  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
442  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
443  C                  INDEX_NONE =>  C                  INDEX_NONE =>
444  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  
445  C                last element  C                last element
446  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
447        INTEGER lFld  C                fields.
448    C     ioUnit  :: Unit number for IO.
449          INTEGER iFirst, iLast
450          LOGICAL fld(iFirst:iLast)
451        INTEGER index_type        INTEGER index_type
       LOGICAL fld(lFld)  
452        LOGICAL markEnd        LOGICAL markEnd
453        LOGICAL compact        LOGICAL compact
454        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
455    
456    C     !LOCAL VARIABLES:
457  C     == Local variables ==  C     == Local variables ==
458  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
459  C     iHi    with the same value  C     iHi    with the same value
# Line 267  C     K    - Loop counter Line 471  C     K    - Loop counter
471        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
472        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
473        CHARACTER*3 index_lab        CHARACTER*3 index_lab
474          CHARACTER*25 fmt1, fmt2
475        INTEGER K        INTEGER K
476    CEOP
477    
478        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
479         index_lab = 'I ='         index_lab = 'I ='
# Line 278  C     K    - Loop counter Line 484  C     K    - Loop counter
484        ELSE        ELSE
485         index_lab = '?='         index_lab = '?='
486        ENDIF        ENDIF
487    C-    fortran format to write 1 or 2 indices:
488          fmt1='(A,1X,A,I3,1X,A)'
489          fmt2='(A,1X,A,I3,A,I3,1X,A)'
490          IF ( iLast.GE.1000 ) THEN
491            K = 1+INT(LOG10(FLOAT(iLast)))
492            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
493            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
494          ENDIF
495        commOpen  = '/*'        commOpen  = '/*'
496        commClose = '*/'        commClose = '*/'
497        iLo = 1        iLo = iFirst
498        iHi = 1        iHi = iFirst
499        punc = ','        punc = ','
500        xOld = fld(1)        xOld = fld(iFirst)
501        DO K=2,lFld        DO K = iFirst+1,iLast
502         xNew = fld(K  )         xNew = fld(K  )
503         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
504          nDup = iHi-iLo+1          nDup = iHi-iLo+1
505          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
506           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
507           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
508       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
509         &    commOpen,index_lab,iLo,commClose
510          ELSE          ELSE
511           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
512           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
513       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
514       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
515          ENDIF          ENDIF
516          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 311  C     K    - Loop counter Line 526  C     K    - Loop counter
526        nDup = iHi-iLo+1        nDup = iHi-iLo+1
527        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
528         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
529         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
530       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
531         &    commOpen,index_lab,iLo,commClose
532        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
533         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
534         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
535       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
536       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
537        ENDIF        ENDIF
538        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 324  C     K    - Loop counter Line 540  C     K    - Loop counter
540        RETURN        RETURN
541        END        END
542    
543  CStartofinterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
544        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit )  CBOP
545  C     /==========================================================\  C     !ROUTINE: PRINT_LIST_RL
546  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     !INTERFACE:
547  C     |==========================================================|        SUBROUTINE PRINT_LIST_RL( fld, iFirst, iLast, index_type,
548  C     | Routine for producing list of values for a field with    |       &                          markEnd, compact, ioUnit )
549  C     | duplicate values collected into                          |  
550  C     |    n @ value                                             |  C     !DESCRIPTION:
551  C     | record.                                                  |  C     *==========================================================*
552  C     \==========================================================/  C     | o SUBROUTINE PRINT\_LIST\_RL
553    C     *==========================================================*
554    C     | Routine for producing list of values for a field with
555    C     | duplicate values collected into
556    C     |    n \@ value
557    C     | record.
558    C     *==========================================================*
559    
560    C     !USES:
561          IMPLICIT NONE
562    
563  C     == Global data ==    C     == Global data ==
564  #include "SIZE.h"  #include "SIZE.h"
565  #include "EEPARAMS.h"  #include "EEPARAMS.h"
566    
567    C     !INPUT/OUTPUT PARAMETERS:
568  C     == Routine arguments ==  C     == Routine arguments ==
569  C     fld    -  Data to be printed  C     fld     :: Data to be printed
570  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
571  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
572    C  index_type :: Flag indicating which type of index to print
573  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
574  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
575  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
576  C                  INDEX_NONE =>  C                  INDEX_NONE =>
577  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  
578  C                last element  C                last element
579  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
580        INTEGER lFld  C                fields.
581    C     ioUnit  :: Unit number for IO.
582          INTEGER iFirst, iLast
583          _RL     fld(iFirst:iLast)
584        INTEGER index_type        INTEGER index_type
       Real*8  fld(lFld)  
585        LOGICAL markEnd        LOGICAL markEnd
586        LOGICAL compact        LOGICAL compact
587        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
588    
589    C     !LOCA VARIABLES:
590  C     == Local variables ==  C     == Local variables ==
591  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
592  C     iHi    with the same value  C     iHi    with the same value
# Line 372  C     K    - Loop counter Line 599  C     K    - Loop counter
599        INTEGER iLo        INTEGER iLo
600        INTEGER iHi        INTEGER iHi
601        INTEGER nDup        INTEGER nDup
602        Real*8 xNew, xOld        _RL     xNew, xOld
603        CHARACTER punc        CHARACTER punc
604        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
605        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
606        CHARACTER*3 index_lab        CHARACTER*3 index_lab
607          CHARACTER*25 fmt1, fmt2
608        INTEGER K        INTEGER K
609    CEOP
610    
611        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
612         index_lab = 'I ='         index_lab = 'I ='
# Line 388  C     K    - Loop counter Line 617  C     K    - Loop counter
617        ELSE        ELSE
618         index_lab = '?='         index_lab = '?='
619        ENDIF        ENDIF
620    C-    fortran format to write 1 or 2 indices:
621          fmt1='(A,1X,A,I3,1X,A)'
622          fmt2='(A,1X,A,I3,A,I3,1X,A)'
623          IF ( iLast.GE.1000 ) THEN
624            K = 1+INT(LOG10(FLOAT(iLast)))
625            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
626            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
627          ENDIF
628        commOpen  = '/*'        commOpen  = '/*'
629        commClose = '*/'        commClose = '*/'
630        iLo = 1        iLo = iFirst
631        iHi = 1        iHi = iFirst
632        punc = ','        punc = ','
633        xOld = fld(1)        xOld = fld(iFirst)
634        DO K=2,lFld        DO K = iFirst+1,iLast
635         xNew = fld(K  )         xNew = fld(K  )
636         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
637          nDup = iHi-iLo+1          nDup = iHi-iLo+1
638          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
639           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
640           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
641       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
642         &    commOpen,index_lab,iLo,commClose
643          ELSE          ELSE
644           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
645           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
646       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
647       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
648          ENDIF          ENDIF
649          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
650          iLo  = K          iLo  = K
651          iHi  = K          iHi  = K
652          xOld = xNew          xOld = xNew
# Line 421  C     K    - Loop counter Line 659  C     K    - Loop counter
659        nDup = iHi-iLo+1        nDup = iHi-iLo+1
660        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
661         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
662         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
663       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),fmt1)
664         &    commOpen,index_lab,iLo,commClose
665        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
666         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
667         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
668       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),fmt2)
669       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
670        ENDIF        ENDIF
671        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
672    
673        RETURN        RETURN
674        END        END
675    
676  CStartOfInterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
677    CBOP
678    C     !ROUTINE: PRINT_MAPRS
679    C     !INTERFACE:
680        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
681       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
682       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 442  CStartOfInterface Line 684  CStartOfInterface
684       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
685       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
686       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
687  C     /==========================================================\  
688  C     | SUBROUTINE PRINT_MAPR4                                   |  C     !DESCRIPTION:
689  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
690  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPRS
691  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.
692  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
693  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data
694  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the
695  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.
696  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like
697  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYRS( ... ) rather than this code directly.
698  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation
699  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the
700  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the
701  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)
702  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for
703  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.
704  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).
705  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
706  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.
707  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr
708    C     |      and jMin:jMax step jStr.
709    C     *==========================================================*
710    
711    C     !USES:
712          IMPLICIT NONE
713    
714  C     == Global variables ==  C     == Global variables ==
715  #include "SIZE.h"  #include "SIZE.h"
716  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
717    
718    C     !INPUT/OUTPUT PARAMETERS:
719  C     == Routine arguments ==  C     == Routine arguments ==
720  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
721  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 726  C     jLo, jHi     be five-dimensional.
726  C     kLo, kHi  C     kLo, kHi
727  C     nBx, nBy  C     nBx, nBy
728  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
729  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
730  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
731  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
732  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 496  C     kStr Line 743  C     kStr
743        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
744        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
745        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
746  CEndOfInterface  
747  C     == Local variables ==  C     !FUNCTIONS:
748        INTEGER  IFNBLNK        INTEGER  IFNBLNK
749        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
750        INTEGER  ILNBLNK        INTEGER  ILNBLNK
751        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
752    
753    C     !LOCAL VARIABLES:
754  C     == Local variables ==  C     == Local variables ==
755  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
756  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 526  C               Min  - Start index withi Line 774  C               Min  - Start index withi
774  C               Max  - End index within block  C               Max  - End index within block
775  C               Str  - stride within block  C               Str  - stride within block
776        INTEGER MAX_LEN_PLOTBUF        INTEGER MAX_LEN_PLOTBUF
777        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
778        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
779        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
780        INTEGER lChList        INTEGER lChList
781        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
782        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
783        REAL fMin        _RL  fMin
784        REAL fMax        _RL  fMax
785        REAL fRange        _RL  fRange
786        REAL val        _RL  val
787        REAL small        _RL  small
788        CHARACTER*2  accLab        CHARACTER*2  accLab
789        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
790        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 551  C               Str  - stride within blo Line 799  C               Str  - stride within blo
799        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
800        INTEGER bi, bj, bk        INTEGER bi, bj, bk
801        LOGICAL validRange        LOGICAL validRange
802    CEOP
803    
804        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
805        small  = 1. _d -15        small  =  1. _d -15
806        fMin   =  1. _d 32        fMin   =  1. _d  32
807        fMax   = -1. _d 32        fMax   = -1. _d  32
808        validRange = .FALSE.        validRange = .FALSE.
809    
810  C--   Calculate field range  C--   Calculate field range
# Line 564  C--   Calculate field range Line 813  C--   Calculate field range
813          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
814           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
815            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
816             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
817              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
818       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
819              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
820       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
821             ENDIF             ENDIF
822            ENDDO            ENDDO
# Line 576  C--   Calculate field range Line 825  C--   Calculate field range
825         ENDDO         ENDDO
826        ENDDO        ENDDO
827        fRange = fMax-fMin        fRange = fMax-fMin
828        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small ) validRange = .TRUE.
        validRange = .TRUE.  
       ENDIF  
829    
830  C--   Write field title and statistics  C--   Write field title and statistics
831        msgBuf = '// ======================================================='        msgBuf =
832         & '// ======================================================='
833        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
834       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
835        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 601  C--   Write field title and statistics Line 849  C--   Write field title and statistics
849       & '// CMAX = ', fMax       & '// CMAX = ', fMax
850        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
851       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
852        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
853       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
854         &  '// CINT = ', fRange/FLOAT(lChlist-1)
855          ELSE
856           WRITE(msgBuf,'(A,1PE30.15)')
857         &  '// CINT = ', 0.
858          ENDIF
859        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
860       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
861        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 613  C--   Write field title and statistics Line 866  C--   Write field title and statistics
866       & '//                  0.0: ','.'       & '//                  0.0: ','.'
867        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
868       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
869         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
870       & '// RANGE I (Lo:Hi:Step):',       & '// RANGE I (Lo:Hi:Step):',
871       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
872       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
873       &  ':',iStr,')'       &  ':',iStr,')'
874        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
875       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
876         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
877       & '// RANGE J (Lo:Hi:Step):',       & '// RANGE J (Lo:Hi:Step):',
878       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
879       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
# Line 634  C--   Write field title and statistics Line 887  C--   Write field title and statistics
887       &  ':',kStr,')'       &  ':',kStr,')'
888        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
889       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
890        msgBuf = '// ======================================================='        msgBuf =
891         & '// ======================================================='
892        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
893       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
894    
895    c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
896    c      msgBuf =
897    c    &  'Model domain too big to print to terminal - skipping I/O'
898    c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
899    c    &                   SQUEEZE_RIGHT, 1)
900    c      RETURN
901    c     endif
902    
903  C--   Write field  C--   Write field
904  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
905  C     acc = accross the page  C     acc = accross the page
# Line 730  C      X across, Z down slice Line 992  C      X across, Z down slice
992         pltStep = sNy         pltStep = sNy
993         pltLab  = 'J ='         pltLab  = 'J ='
994        ENDIF        ENDIF
995    C-    check if it fits into buffer (-10 should be enough but -12 is safer):
996          IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
997         &     .AND. validRange ) THEN
998           msgBuf =
999         &  'Model domain too big to print to terminal - skipping I/O'
1000           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1001         &                   SQUEEZE_RIGHT, 1)
1002           validRange = .FALSE.
1003          ENDIF
1004        IF ( validRange ) THEN        IF ( validRange ) THEN
1005  C      Header  C      Header
1006  C      Data  C      Data
1007         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1008          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1009           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1010       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1011           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1012       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1013           plotBuf = ' '           plotBuf = ' '
1014           iBuf = 6           iBuf = 6
1015           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1016            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1017             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
1018             iBuf = iBuf + 1             iBuf = iBuf + 1
1019             IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN             IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
1020              IF ( iDx. LT. 10 ) THEN              IF ( iDx .LT. 10 ) THEN
1021               WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx
1022              ELSEIF ( iDx. LT. 100 ) THEN              ELSEIF ( iDx .LT. 100 ) THEN
1023               WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx
1024              ELSEIF ( iDx. LT. 1000 ) THEN              ELSEIF ( iDx .LT. 1000 ) THEN
1025               WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx
1026              ELSEIF ( iDx. LT. 10000 ) THEN              ELSEIF ( iDx .LT. 10000 ) THEN
1027               WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx
1028              ENDIF              ENDIF
1029             ENDIF             ENDIF
# Line 762  C      Data Line 1033  C      Data
1033           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1034       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1035           plotBuf = dwnLab           plotBuf = dwnLab
1036           iBuf = 7           iBuf = 7
1037           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1038            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1039             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 770  C      Data Line 1041  C      Data
1041             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1042              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1043             ELSE             ELSE
1044              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1045             ENDIF             ENDIF
1046            ENDDO            ENDDO
1047           ENDDO           ENDDO
# Line 779  C      Data Line 1050  C      Data
1050       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1051           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1052            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1053             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1054       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1055             iBuf = 7             iBuf = 7
1056             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 792  C      Data Line 1063  C      Data
1063               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1064                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1065               ENDIF               ENDIF
1066               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1067       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1068         &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1069       &             )+1       &             )+1
1070               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               ELSE
1071                  IDX = 1
1072                 ENDIF
1073                 IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1074       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1075               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1076                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1077       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1078               ENDIF               ENDIF
1079              ENDDO              ENDDO
# Line 812  C      Data Line 1087  C      Data
1087         ENDDO         ENDDO
1088        ENDIF        ENDIF
1089  C--   Write delimiter  C--   Write delimiter
1090        msgBuf = '// ======================================================='        msgBuf =
1091         & '// ======================================================='
1092        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1093       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1094        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1095         & '// END OF FIELD                                          ='
1096        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1097       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1098        msgBuf = '// ======================================================='        msgBuf =
1099         & '// ======================================================='
1100        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1101       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1102        msgBuf = ' '        msgBuf = ' '
# Line 828  C--   Write delimiter Line 1106  C--   Write delimiter
1106        RETURN        RETURN
1107        END        END
1108    
1109  CStartOfInterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1110    CBOP
1111    C     !ROUTINE: PRINT_MAPRL
1112    C     !INTERFACE:
1113        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
1114       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
1115       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 836  CStartOfInterface Line 1117  CStartOfInterface
1117       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
1118       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
1119       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
1120  C     /==========================================================\  
1121  C     | SUBROUTINE PRINT_MAPRL                                   |  C     !DESCRIPTION:
1122  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
1123  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPRL
1124  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.
1125  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
1126  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data
1127  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the
1128  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.
1129  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like
1130  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYRL( ... ) rather than this code directly.
1131  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation
1132  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the
1133  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the
1134  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)
1135  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for
1136  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.
1137  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).
1138  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
1139  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.
1140  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr
1141    C     |      and jMin:jMax step jStr.
1142    C     *==========================================================*
1143    
1144    C     !USES:
1145          IMPLICIT NONE
1146    
1147  C     == Global variables ==  C     == Global variables ==
1148  #include "SIZE.h"  #include "SIZE.h"
1149  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
1150    
1151    C     !INPUT/OUTPUT PARAMETERS:
1152  C     == Routine arguments ==  C     == Routine arguments ==
1153  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
1154  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 873  C     jLo, jHi     be five-dimensional. Line 1159  C     jLo, jHi     be five-dimensional.
1159  C     kLo, kHi  C     kLo, kHi
1160  C     nBx, nBy  C     nBx, nBy
1161  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
1162  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
1163  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
1164  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
1165  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 890  C     kStr Line 1176  C     kStr
1176        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
1177        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
1178        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
1179  CEndOfInterface  
1180  C     == Local variables ==  C     !FUNCTIONS:
1181        INTEGER  IFNBLNK        INTEGER  IFNBLNK
1182        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
1183        INTEGER  ILNBLNK        INTEGER  ILNBLNK
1184        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
1185    
1186    C     !LOCAL VARIABLES:
1187  C     == Local variables ==  C     == Local variables ==
1188  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
1189  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 920  C               Min  - Start index withi Line 1207  C               Min  - Start index withi
1207  C               Max  - End index within block  C               Max  - End index within block
1208  C               Str  - stride within block  C               Str  - stride within block
1209        INTEGER MAX_LEN_PLOTBUF        INTEGER MAX_LEN_PLOTBUF
1210        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
1211        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
1212        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1213        INTEGER lChList        INTEGER lChList
1214        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1215        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1216        REAL fMin        _RL  fMin
1217        REAL fMax        _RL  fMax
1218        REAL fRange        _RL  fRange
1219        REAL val        _RL  val
1220        REAL small        _RL  small
1221        CHARACTER*2  accLab        CHARACTER*2  accLab
1222        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1223        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 945  C               Str  - stride within blo Line 1232  C               Str  - stride within blo
1232        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1233        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1234        LOGICAL validRange        LOGICAL validRange
1235    CEOP
1236    
1237        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1238        small  = 1. _d -15        small  = 1. _d -15
# Line 958  C--   Calculate field range Line 1246  C--   Calculate field range
1246          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1247           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1248            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1249  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1250              IF ( fld(I,J,K,bi,bj) .LT. fMin )       &     THEN
1251                IF ( fld(I,J,K,bi,bj) .LT. fMin )
1252       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1253              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1254       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1255  C          ENDIF             ENDIF
1256            ENDDO            ENDDO
1257           ENDDO           ENDDO
1258          ENDDO          ENDDO
1259         ENDDO         ENDDO
1260        ENDDO        ENDDO
1261        fRange = fMax-fMin        fRange = fMax-fMin
1262        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small ) validRange = .TRUE.
        validRange = .TRUE.  
       ENDIF  
1263    
1264  C--   Write field title and statistics  C--   Write field title and statistics
1265        msgBuf = '// ======================================================='        msgBuf =
1266         & '// ======================================================='
1267        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1268       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1269        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 995  C--   Write field title and statistics Line 1283  C--   Write field title and statistics
1283       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1284        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1285       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1286        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1287           WRITE(msgBuf,'(A,1PE30.15)')
1288       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1289          ELSE
1290           WRITE(msgBuf,'(A,1PE30.15)')
1291         & '// CINT = ', 0.
1292          ENDIF
1293        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1294       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1295        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1007  C--   Write field title and statistics Line 1300  C--   Write field title and statistics
1300       & '//                  0.0: ','.'       & '//                  0.0: ','.'
1301        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1302       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1303         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
1304       & '// RANGE I (Lo:Hi:Step):',       & '// RANGE I (Lo:Hi:Step):',
1305       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,       &  '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
1306       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,       &  ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
1307       &  ':',iStr,')'       &  ':',iStr,')'
1308        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1309       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1310         WRITE(msgBuf,'(A,3(A,I4),A)')         WRITE(msgBuf,'(A,3(A,I6),A)')
1311       & '// RANGE J (Lo:Hi:Step):',       & '// RANGE J (Lo:Hi:Step):',
1312       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,       &  '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
1313       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,       &  ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
# Line 1028  C--   Write field title and statistics Line 1321  C--   Write field title and statistics
1321       &  ':',kStr,')'       &  ':',kStr,')'
1322        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1323       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1324        msgBuf = '// ======================================================='        msgBuf =
1325         & '// ======================================================='
1326        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1327       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1328    
1329    c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1330    c      msgBuf =
1331    c    &  'Model domain too big to print to terminal - skipping I/O'
1332    c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1333    c    &                   SQUEEZE_RIGHT, 1)
1334    c      RETURN
1335    c     endif
1336    
1337  C--   Write field  C--   Write field
1338  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1339  C     acc = accross the page  C     acc = accross the page
# Line 1124  C      X across, Z down slice Line 1426  C      X across, Z down slice
1426         pltStep = sNy         pltStep = sNy
1427         pltLab  = 'J ='         pltLab  = 'J ='
1428        ENDIF        ENDIF
1429    C-    check if it fits into buffer (-10 should be enough but -12 is safer):
1430          IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
1431         &     .AND. validRange ) THEN
1432           msgBuf =
1433         &  'Model domain too big to print to terminal - skipping I/O'
1434           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1435         &                   SQUEEZE_RIGHT, 1)
1436           validRange = .FALSE.
1437          ENDIF
1438        IF ( validRange ) THEN        IF ( validRange ) THEN
1439  C      Header  C      Header
1440  C      Data  C      Data
1441         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1442          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1443           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1444       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1445           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1446       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1447           plotBuf = ' '           plotBuf = ' '
1448           iBuf = 6           iBuf = 6
1449           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1450            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1451             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
1452             iBuf = iBuf + 1             iBuf = iBuf + 1
1453             IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN             IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
1454              IF ( iDx. LT. 10 ) THEN              IF ( iDx .LT. 10 ) THEN
1455               WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I1)') accLab,iDx
1456              ELSEIF ( iDx. LT. 100 ) THEN              ELSEIF ( iDx .LT. 100 ) THEN
1457               WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I2)') accLab,iDx
1458              ELSEIF ( iDx. LT. 1000 ) THEN              ELSEIF ( iDx .LT. 1000 ) THEN
1459               WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I3)') accLab,iDx
1460              ELSEIF ( iDx. LT. 10000 ) THEN              ELSEIF ( iDx .LT. 10000 ) THEN
1461               WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx               WRITE(plotBuf(iBuf:),'(A,I4)') accLab,iDx
1462              ENDIF              ENDIF
1463             ENDIF             ENDIF
# Line 1155  C      Data Line 1466  C      Data
1466           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1467       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1468           plotBuf = dwnLab           plotBuf = dwnLab
1469           iBuf = 7           iBuf = 7
1470           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1471            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1472             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 1163  C      Data Line 1474  C      Data
1474             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1475              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1476             ELSE             ELSE
1477              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1478             ENDIF             ENDIF
1479            ENDDO            ENDDO
1480           ENDDO           ENDDO
# Line 1171  C      Data Line 1482  C      Data
1482       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1483           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1484            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1485             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1486       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1487             iBuf = 7             iBuf = 7
1488             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 1184  C      Data Line 1495  C      Data
1495               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1496                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1497               ENDIF               ENDIF
1498               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1499       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1500       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1501               IF ( iBuf .LE. MAX_LEN_PLOTBUF )       &              )+1
1502                 ELSE
1503                  IDX = 1
1504                 ENDIF
1505                 IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1506       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1507               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1508                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1509       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1510               ENDIF               ENDIF
1511              ENDDO              ENDDO
# Line 1203  C      Data Line 1518  C      Data
1518         ENDDO         ENDDO
1519        ENDIF        ENDIF
1520  C--   Write delimiter  C--   Write delimiter
1521        msgBuf = '// ======================================================='        msgBuf =
1522         & '// ======================================================='
1523        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1524       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1525        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1526         & '// END OF FIELD                                          ='
1527        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1528       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1529        msgBuf = '// ======================================================='        msgBuf =
1530         & '// ======================================================='
1531        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1532       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1533        msgBuf = ' '        msgBuf = ' '
# Line 1218  C--   Write delimiter Line 1536  C--   Write delimiter
1536    
1537        RETURN        RETURN
1538        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.8.2.1  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22