/[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.2 by cnh, Thu Apr 23 20:37:31 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_mapr8    Formats ABCD... contour map of a Real*8 field  C--   o PRINT_ERROR    Does IO with **ERROR** highlighted header
11  C--                     Uses print_message for writing  C--   o PRINT_LIST_I   Prints one-dimensional list of INTEGER
12  C--    o print_message  Does IO with unhighlighted header  C--                    numbers.
13    C--   o PRINT_LIST_L   Prints one-dimensional list of LOGICAL
14    C--                    variables.
15    C--   o PRINT_LIST_RL  Prints one-dimensional list of Real(_RL)
16    C--                    numbers.
17    C--   o PRINT_MAPRS    Formats ABCD... contour map of a Real(_RS) field
18    C--                    Uses print_message for writing
19    C--   o PRINT_MAPRL    Formats ABCD... contour map of a Real(_RL) field
20    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)')  # 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)')  
      &  '(',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
272          ENDIF
273    
274          RETURN
275          END
276    
277    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
278    CBOP
279    C     !ROUTINE: PRINT_LIST_I
280    C     !INTERFACE:
281          SUBROUTINE PRINT_LIST_I( fld, iFirst, iLast, index_type,
282         &                         markEnd, compact, ioUnit )
283    
284    C     !DESCRIPTION:
285    C     *==========================================================*
286    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 ==
298    #include "SIZE.h"
299    #include "EEPARAMS.h"
300    
301    C     !INPUT/OUTPUT PARAMETERS:
302    C     == Routine arguments ==
303    C     fld     :: Data to be printed
304    C     iFirst  :: First element to print
305    C     iLast   :: Last element to print
306    C  index_type :: Flag indicating which type of index to print
307    C                  INDEX_K    => /* K = nnn */
308    C                  INDEX_I    => /* I = nnn */
309    C                  INDEX_J    => /* J = nnn */
310    C                  INDEX_NONE =>
311    C     markEnd :: Flag to control whether there is a separator after the
312    C                last element
313    C     compact :: Flag to control use of repeat symbol for same valued
314    C                fields.
315    C     ioUnit  :: Unit number for IO.
316          INTEGER iFirst, iLast
317          INTEGER fld(iFirst:iLast)
318          INTEGER index_type
319          LOGICAL markEnd
320          LOGICAL compact
321          INTEGER ioUnit
322    
323    C     !LOCAL VARIABLES:
324    C     == Local variables ==
325    C     iLo  - Range index holders for selecting elements with
326    C     iHi    with the same value
327    C     nDup - Number of duplicates
328    C     xNew, xOld - Hold current and previous values of field
329    C     punc - Field separator
330    C     msgBuf - IO buffer
331    C     index_lab - Index for labelling elements
332    C     K    - Loop counter
333          INTEGER iLo
334          INTEGER iHi
335          INTEGER nDup
336          INTEGER xNew, xOld
337          CHARACTER punc
338          CHARACTER*(MAX_LEN_MBUF) msgBuf
339          CHARACTER*2 commOpen,commClose
340          CHARACTER*3 index_lab
341          CHARACTER*25 fmt1, fmt2
342          INTEGER K
343    CEOP
344    
345          IF     ( index_type .EQ. INDEX_I ) THEN
346           index_lab = 'I ='
347          ELSEIF ( index_type .EQ. INDEX_J ) THEN
348           index_lab = 'J ='
349          ELSEIF ( index_type .EQ. INDEX_K ) THEN
350           index_lab = 'K ='
351          ELSE
352           index_lab = '?='
353          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  = '/*'
363          commClose = '*/'
364          iLo = iFirst
365          iHi = iFirst
366          punc = ','
367          xOld = fld(iFirst)
368          DO K = iFirst+1,iLast
369           xNew = fld(K  )
370           IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
371            nDup = iHi-iLo+1
372            IF ( nDup .EQ. 1 ) THEN
373             WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
374             IF ( index_type .NE. INDEX_NONE )
375         &    WRITE(msgBuf(45:),fmt1)
376         &    commOpen,index_lab,iLo,commClose
377            ELSE
378             WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
379             IF ( index_type .NE. INDEX_NONE )
380         &    WRITE(msgBuf(45:),fmt2)
381         &    commOpen,index_lab,iLo,':',iHi,commClose
382            ENDIF
383            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
384            iLo  = K
385            iHi  = K
386            xOld = xNew
387           ELSE
388            iHi = K
389           ENDIF
390          ENDDO
391          punc = ' '
392          IF ( markEnd ) punc = ','
393          nDup = iHi-iLo+1
394          IF    ( nDup .EQ. 1 ) THEN
395           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
396           IF ( index_type .NE. INDEX_NONE )
397         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
398         &  commOpen,index_lab,iLo,commClose
399          ELSEIF( nDup .GT. 1 ) THEN
400           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
401           IF ( index_type .NE. INDEX_NONE )
402         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
403         &  commOpen,index_lab,iLo,':',iHi,commClose
404          ENDIF
405          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
406    
407          RETURN
408          END
409    
410    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
411    CBOP
412    C     !ROUTINE: PRINT_LIST_L
413    C     !INTERFACE:
414          SUBROUTINE PRINT_LIST_L( fld, iFirst, iLast, index_type,
415         &                         markEnd, compact, ioUnit )
416    
417    C     !DESCRIPTION:
418    C     *==========================================================*
419    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     !USES:
428          IMPLICIT NONE
429    
430    C     == Global data ==
431    #include "SIZE.h"
432    #include "EEPARAMS.h"
433    
434    C     !INPUT/OUTPUT PARAMETERS:
435    C     == Routine arguments ==
436    C     fld     :: Data to be printed
437    C     iFirst  :: First element to print
438    C     iLast   :: Last element to print
439    C  index_type :: Flag indicating which type of index to print
440    C                  INDEX_K    => /* K = nnn */
441    C                  INDEX_I    => /* I = nnn */
442    C                  INDEX_J    => /* J = nnn */
443    C                  INDEX_NONE =>
444    C     markEnd :: Flag to control whether there is a separator after the
445    C                last element
446    C     compact :: Flag to control use of repeat symbol for same valued
447    C                fields.
448    C     ioUnit  :: Unit number for IO.
449          INTEGER iFirst, iLast
450          LOGICAL fld(iFirst:iLast)
451          INTEGER index_type
452          LOGICAL markEnd
453          LOGICAL compact
454          INTEGER ioUnit
455    
456    C     !LOCAL VARIABLES:
457    C     == Local variables ==
458    C     iLo  - Range index holders for selecting elements with
459    C     iHi    with the same value
460    C     nDup - Number of duplicates
461    C     xNew, xOld - Hold current and previous values of field
462    C     punc - Field separator
463    C     msgBuf - IO buffer
464    C     index_lab - Index for labelling elements
465    C     K    - Loop counter
466          INTEGER iLo
467          INTEGER iHi
468          INTEGER nDup
469          LOGICAL xNew, xOld
470          CHARACTER punc
471          CHARACTER*(MAX_LEN_MBUF) msgBuf
472          CHARACTER*2 commOpen,commClose
473          CHARACTER*3 index_lab
474          CHARACTER*25 fmt1, fmt2
475          INTEGER K
476    CEOP
477    
478          IF     ( index_type .EQ. INDEX_I ) THEN
479           index_lab = 'I ='
480          ELSEIF ( index_type .EQ. INDEX_J ) THEN
481           index_lab = 'J ='
482          ELSEIF ( index_type .EQ. INDEX_K ) THEN
483           index_lab = 'K ='
484          ELSE
485           index_lab = '?='
486          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  = '/*'
496          commClose = '*/'
497          iLo = iFirst
498          iHi = iFirst
499          punc = ','
500          xOld = fld(iFirst)
501          DO K = iFirst+1,iLast
502           xNew = fld(K  )
503           IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
504            nDup = iHi-iLo+1
505            IF ( nDup .EQ. 1 ) THEN
506             WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
507             IF ( index_type .NE. INDEX_NONE )
508         &    WRITE(msgBuf(45:),fmt1)
509         &    commOpen,index_lab,iLo,commClose
510            ELSE
511             WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
512             IF ( index_type .NE. INDEX_NONE )
513         &    WRITE(msgBuf(45:),fmt2)
514         &    commOpen,index_lab,iLo,':',iHi,commClose
515            ENDIF
516            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
517            iLo  = K
518            iHi  = K
519            xOld = xNew
520           ELSE
521            iHi = K
522           ENDIF
523          ENDDO
524          punc = ' '
525          IF ( markEnd ) punc = ','
526          nDup = iHi-iLo+1
527          IF    ( nDup .EQ. 1 ) THEN
528           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
529           IF ( index_type .NE. INDEX_NONE )
530         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
531         &    commOpen,index_lab,iLo,commClose
532          ELSEIF( nDup .GT. 1 ) THEN
533           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
534           IF ( index_type .NE. INDEX_NONE )
535         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
536         &  commOpen,index_lab,iLo,':',iHi,commClose
537          ENDIF
538          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
539    
540          RETURN
541          END
542    
543    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
544    CBOP
545    C     !ROUTINE: PRINT_LIST_RL
546    C     !INTERFACE:
547          SUBROUTINE PRINT_LIST_RL( fld, iFirst, iLast, index_type,
548         &                          markEnd, compact, ioUnit )
549    
550    C     !DESCRIPTION:
551    C     *==========================================================*
552    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 ==
564    #include "SIZE.h"
565    #include "EEPARAMS.h"
566    
567    C     !INPUT/OUTPUT PARAMETERS:
568    C     == Routine arguments ==
569    C     fld     :: Data to be printed
570    C     iFirst  :: First element to print
571    C     iLast   :: Last element to print
572    C  index_type :: Flag indicating which type of index to print
573    C                  INDEX_K    => /* K = nnn */
574    C                  INDEX_I    => /* I = nnn */
575    C                  INDEX_J    => /* J = nnn */
576    C                  INDEX_NONE =>
577    C     markEnd :: Flag to control whether there is a separator after the
578    C                last element
579    C     compact :: Flag to control use of repeat symbol for same valued
580    C                fields.
581    C     ioUnit  :: Unit number for IO.
582          INTEGER iFirst, iLast
583          _RL     fld(iFirst:iLast)
584          INTEGER index_type
585          LOGICAL markEnd
586          LOGICAL compact
587          INTEGER ioUnit
588    
589    C     !LOCA VARIABLES:
590    C     == Local variables ==
591    C     iLo  - Range index holders for selecting elements with
592    C     iHi    with the same value
593    C     nDup - Number of duplicates
594    C     xNew, xOld - Hold current and previous values of field
595    C     punc - Field separator
596    C     msgBuf - IO buffer
597    C     index_lab - Index for labelling elements
598    C     K    - Loop counter
599          INTEGER iLo
600          INTEGER iHi
601          INTEGER nDup
602          _RL     xNew, xOld
603          CHARACTER punc
604          CHARACTER*(MAX_LEN_MBUF) msgBuf
605          CHARACTER*2 commOpen,commClose
606          CHARACTER*3 index_lab
607          CHARACTER*25 fmt1, fmt2
608          INTEGER K
609    CEOP
610    
611          IF     ( index_type .EQ. INDEX_I ) THEN
612           index_lab = 'I ='
613          ELSEIF ( index_type .EQ. INDEX_J ) THEN
614           index_lab = 'J ='
615          ELSEIF ( index_type .EQ. INDEX_K ) THEN
616           index_lab = 'K ='
617          ELSE
618           index_lab = '?='
619          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  = '/*'
629          commClose = '*/'
630          iLo = iFirst
631          iHi = iFirst
632          punc = ','
633          xOld = fld(iFirst)
634          DO K = iFirst+1,iLast
635           xNew = fld(K  )
636           IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
637            nDup = iHi-iLo+1
638            IF ( nDup .EQ. 1 ) THEN
639             WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
640             IF ( index_type .NE. INDEX_NONE )
641         &    WRITE(msgBuf(45:),fmt1)
642         &    commOpen,index_lab,iLo,commClose
643            ELSE
644             WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
645             IF ( index_type .NE. INDEX_NONE )
646         &    WRITE(msgBuf(45:),fmt2)
647         &    commOpen,index_lab,iLo,':',iHi,commClose
648            ENDIF
649            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
650            iLo  = K
651            iHi  = K
652            xOld = xNew
653           ELSE
654            iHi = K
655         ENDIF         ENDIF
656          ENDDO
657          punc = ' '
658          IF ( markEnd ) punc = ','
659          nDup = iHi-iLo+1
660          IF    ( nDup .EQ. 1 ) THEN
661           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
662           IF ( index_type .NE. INDEX_NONE )
663         &  WRITE(msgBuf(45:),fmt1)
664         &    commOpen,index_lab,iLo,commClose
665          ELSEIF( nDup .GT. 1 ) THEN
666           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
667           IF ( index_type .NE. INDEX_NONE )
668         &  WRITE(msgBuf(45:),fmt2)
669         &  commOpen,index_lab,iLo,':',iHi,commClose
670        ENDIF        ENDIF
671  C        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        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,  CBOP
678    C     !ROUTINE: PRINT_MAPRS
679    C     !INTERFACE:
680          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,
683       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
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 136  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 147  C     kStr Line 737  C     kStr
737        INTEGER jLo, jHi        INTEGER jLo, jHi
738        INTEGER kLo, kHi        INTEGER kLo, kHi
739        INTEGER nBx, nBy        INTEGER nBx, nBy
740        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
741        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
742        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
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 183  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 208  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 221  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 233  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 258  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 270  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 291  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 387  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 419  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 427  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 436  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 449  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 469  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 485  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        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,  CBOP
1111    C     !ROUTINE: PRINT_MAPRL
1112    C     !INTERFACE:
1113          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,
1116       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
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_MAPR8                                   |  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 530  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 541  C     kStr Line 1170  C     kStr
1170        INTEGER jLo, jHi        INTEGER jLo, jHi
1171        INTEGER kLo, kHi        INTEGER kLo, kHi
1172        INTEGER nBx, nBy        INTEGER nBx, nBy
1173        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
1174        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
1175        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
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 577  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 602  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 615  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 652  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 664  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 685  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 781  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 812  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 820  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 828  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 841  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 860  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 875  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)')  
      &   '(',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)')  
      &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',  
      &   message(iStart:iEnd)  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
 #endif  
        ENDIF  
       ENDIF  
 C  
       RETURN  
       END  
   
 C $Id$  
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.35
  ViewVC Help
Powered by ViewVC 1.1.22