/[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.9 by adcroft, Mon Jun 22 16:24:51 1998 UTC revision 1.27 by jmc, Tue Mar 20 23:42:16 2007 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
# Line 12  C--    o print_list_l   Prints one-deime Line 13  C--    o print_list_l   Prints one-deime
13  C--                     variables.  C--                     variables.
14  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--    o print_list_r8  Prints one-deimensional list of Real*8
15  C--                     numbers.  C--                     numbers.
16  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field  C--    o print_maprs    Formats ABCD... contour map of a Real(_RS) field
17  C--                     Uses print_message for writing  C--                     Uses print_message for writing
18  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field  C--    o print_maprl    Formats ABCD... contour map of a Real(_RL) field
19  C--                     Uses print_message for writing  C--                     Uses print_message for writing
20  C--    o print_message  Does IO with unhighlighted header  C--    o print_message  Does IO with unhighlighted header
21    
22  CStartOfInterface  CBOP              
23    
24    C     !ROUTINE: PRINT_ERROR
25    
26    C     !INTERFACE:
27        SUBROUTINE PRINT_ERROR( message , myThid )        SUBROUTINE PRINT_ERROR( message , myThid )
28  C     /============================================================\        IMPLICIT NONE
29  C     | SUBROUTINE PRINT_ERROR                                     |  
30  C     | o Write out error message using "standard" format.         |  C     !DESCRIPTION:
31  C     | Notes                                                      |  C     *============================================================*
32  C     | =====                                                      |  C     | SUBROUTINE PRINT\_ERROR                                      
33  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     | o Write out error message using "standard" format.          
34  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     *============================================================*
35  C     |   critical region is defined around the write here. In some|  C     | Notes                                                      
36  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     | =====                                                      
37  C     |   for thread number 1 - writes for other threads are       |  C     | o Some system   I/O is not "thread-safe". For this reason  
38  C     |   ignored!                                                 |  C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
39  C     | o In a non-parallel form these routines can still be used. |  C     |   critical region is defined around the write here. In some
40  C     |   to produce pretty printed output!                        |  C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
41  C     \============================================================/  C     |   for thread number 1 - writes for other threads are        
42    C     |   ignored!                                                  
43    C     | o In a non-parallel form these routines are still used  
44    C     |   to produce pretty printed output. The process and thread
45    C     |   id prefix is omitted in this case.
46    C     *============================================================*
47    
48    C     !USES:
49  C     == Global data ==  C     == Global data ==
50  #include "SIZE.h"  #include "SIZE.h"
51  #include "EEPARAMS.h"  #include "EEPARAMS.h"
52  #include "EESUPPORT.h"  #include "EESUPPORT.h"
 C     == Routine arguments ==  
       CHARACTER*(*) message  
       INTEGER       myThid  
 CEndOfInterface  
53        INTEGER  IFNBLNK        INTEGER  IFNBLNK
54        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
55        INTEGER  ILNBLNK        INTEGER  ILNBLNK
56        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
57    
58    C     !INPUT/OUTPUT PARAMETERS:
59    C     == Routine arguments ==
60    C     message :: Text string to print
61    C     myThid  :: Thread number of this instance
62          CHARACTER*(*) message
63          INTEGER       myThid
64    
65    C     !LOCAL VARIABLES:
66  C     == Local variables ==  C     == Local variables ==
67    C     iStart, iEnd :: Temps. for string indexing
68    C     idString     :: Temp. for building message prefix
69        INTEGER iStart        INTEGER iStart
70        INTEGER iEnd        INTEGER iEnd
71        CHARACTER*9 idString        CHARACTER*9 idString
72    CEOP
73    
74  C--   Find beginning and end of message  C--   Find beginning and end of message
75        iStart = IFNBLNK( message )        iStart = IFNBLNK( message )
76        iEnd   = ILNBLNK( message )        iEnd   = ILNBLNK( message )
# Line 60  C--    Write single process format Line 81  C--    Write single process format
81         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
82          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
83         ELSE         ELSE
84          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
85         &   message(iStart:iEnd)
86         ENDIF         ENDIF
87        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSE
 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  
88  C       PRINT_ERROR can be called by several threads simulataneously.  C       PRINT_ERROR can be called by several threads simulataneously.
89  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.
90  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
91          _BEGIN_CRIT(myThid)  # ifdef USE_OMP_THREADING
92  #endif  C$OMP CRITICAL
93          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  # else
94       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',         _BEGIN_CRIT(myThid)
95       &  ' '  # endif
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
96  #endif  #endif
97         ELSE         IF ( pidIO .EQ. myProcId ) THEN
98  #ifndef FMTFTN_IO_THREAD_SAFE  C--    Write multi-process format
99          _BEGIN_CRIT(myThid)           WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
100    
101             IF ( iEnd.EQ.0 ) THEN
102    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
103              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
104         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
105         &    ' '
106             ELSE
107    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
108              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
109         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
110         &    message(iStart:iEnd)
111             ENDIF
112           ENDIF
113    
114    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
115    C--    also write directly to unit 0 :
116           IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN
117            IF ( nThreads.LE.1 ) THEN
118              WRITE(0,'(A)') message(1:iEnd)
119            ELSE
120              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
121         &                   message(1:iEnd)
122            ENDIF
123           ENDIF
124  #endif  #endif
125          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  
      &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',  
      &  message(iStart:iEnd)  
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
        ENDIF  
133        ENDIF        ENDIF
134  C  
135   1000 CONTINUE   1000 CONTINUE
136        RETURN        RETURN
137    
138    999 CONTINUE  c 999 CONTINUE
139         ioErrorCount(myThid) = ioErrorCount(myThid)+1  c      ioErrorCount(myThid) = ioErrorCount(myThid)+1
140        GOTO 1000  c     GOTO 1000
141        END        END
142    
143  CStartofinterface  CBOP
144        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit )  C     !ROUTINE: PRINT_LIST_I
 C     /==========================================================\  
 C     | o SUBROUTINE PRINT_LIST_I                                |  
 C     |==========================================================|  
 C     | Routine for producing list of values for a field with    |  
 C     | duplicate values collected into                          |  
 C     |    n @ value                                             |  
 C     | record.                                                  |  
 C     \==========================================================/  
145    
146    C     !INTERFACE:
147          SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
148         &                         markEnd, compact, ioUnit )
149          IMPLICIT NONE
150    C     !DESCRIPTION:
151    C     *==========================================================*
152    C     | o SUBROUTINE PRINT\_LIST\_I                                
153    C     *==========================================================*
154    C     | Routine for producing list of values for a field with    
155    C     | duplicate values collected into                          
156    C     |    n \@ value                                              
157    C     | record.                                                  
158    C     *==========================================================*
159    
160    C     !USES:
161  C     == Global data ==    C     == Global data ==  
162  #include "SIZE.h"  #include "SIZE.h"
163  #include "EEPARAMS.h"  #include "EEPARAMS.h"
164    
165    C     !INPUT/OUTPUT PARAMETERS:
166  C     == Routine arguments ==  C     == Routine arguments ==
167  C     fld    -  Data to be printed  C     fld    ::  Data to be printed
168  C     lFld   -  Number of elements to be printed  C     lFld   ::  Number of elements to be printed
169  C     index_type - Flag indicating which type of index to print  C     index_type :: Flag indicating which type of index to print
170  C                  INDEX_K    => /* K = nnn */  C                   INDEX_K    => /* K = nnn */
171  C                  INDEX_I    => /* I = nnn */  C                   INDEX_I    => /* I = nnn */
172  C                  INDEX_J    => /* J = nnn */  C                   INDEX_J    => /* J = nnn */
173  C                  INDEX_NONE =>  C                   INDEX_NONE =>
174  C     compact -  Flag to control use of repeat symbol for same valued  C     compact ::  Flag to control use of repeat symbol for same valued
175  C                fields.  C                 fields.
176  C     markEnd -  Flag to control whether there is a separator after the  C     markEnd ::  Flag to control whether there is a separator after the
177  C                last element  C                 last element
178  C     ioUnit -  Unit number for IO.  C     ioUnit ::   Unit number for IO.
179        INTEGER lFld        INTEGER lFld
180        INTEGER index_type        INTEGER index_type
181        INTEGER fld(lFld)        INTEGER fld(lFld)
182        LOGICAL markEnd        LOGICAL markEnd
183        LOGICAL compact        LOGICAL compact
184        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
185    
186    C     !LOCAL VARIABLES:
187  C     == Local variables ==  C     == Local variables ==
188  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
189  C     iHi    with the same value  C     iHi    with the same value
# Line 158  C     K    - Loop counter Line 202  C     K    - Loop counter
202        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
203        CHARACTER*3 index_lab        CHARACTER*3 index_lab
204        INTEGER K        INTEGER K
205    CEOP
206    
207        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
208         index_lab = 'I ='         index_lab = 'I ='
# Line 176  C     K    - Loop counter Line 221  C     K    - Loop counter
221        xOld = fld(1)        xOld = fld(1)
222        DO K=2,lFld        DO K=2,lFld
223         xNew = fld(K  )         xNew = fld(K  )
224         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
225          nDup = iHi-iLo+1          nDup = iHi-iLo+1
226          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
227           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
228           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
229       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
230         &    commOpen,index_lab,iLo,commClose
231          ELSE          ELSE
232           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
233           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
234       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
235       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 200  C     K    - Loop counter Line 246  C     K    - Loop counter
246        IF ( markEnd ) punc = ','        IF ( markEnd ) punc = ','
247        nDup = iHi-iLo+1        nDup = iHi-iLo+1
248        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
249         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
250         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
251       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
252         &  commOpen,index_lab,iLo,commClose
253        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
254         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
255         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
256       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
257       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 214  C     K    - Loop counter Line 261  C     K    - Loop counter
261        RETURN        RETURN
262        END        END
263    
264  CStartofinterface  CBOP
265        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit )  C     !ROUTINE: PRINT_LIST_L
266  C     /==========================================================\  
267  C     | o SUBROUTINE PRINT_LIST_L                                |  C     !INTERFACE:
268  C     |==========================================================|        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
269  C     | Routine for producing list of values for a field with    |       &                         compact, ioUnit )
270  C     | duplicate values collected into                          |        IMPLICIT NONE
271  C     |    n @ value                                             |  C     !DESCRIPTION:
272  C     | record.                                                  |  C     *==========================================================*
273  C     \==========================================================/  C     | o SUBROUTINE PRINT\_LIST\_L                                
274    C     *==========================================================*
275    C     | Routine for producing list of values for a field with    
276    C     | duplicate values collected into                          
277    C     |    n \@ value                                              
278    C     | record.                                                  
279    C     *==========================================================*
280    
281    C     !USES:
282  C     == Global data ==    C     == Global data ==  
283  #include "SIZE.h"  #include "SIZE.h"
284  #include "EEPARAMS.h"  #include "EEPARAMS.h"
285    
286    C     !INPUT/OUTPUT PARAMETERS:
287  C     == Routine arguments ==  C     == Routine arguments ==
288  C     fld    -  Data to be printed  C     fld    -  Data to be printed
289  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 248  C     ioUnit -  Unit number for IO. Line 303  C     ioUnit -  Unit number for IO.
303        LOGICAL markEnd        LOGICAL markEnd
304        LOGICAL compact        LOGICAL compact
305        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
306    
307    C     !LOCAL VARIABLES:
308  C     == Local variables ==  C     == Local variables ==
309  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
310  C     iHi    with the same value  C     iHi    with the same value
# Line 268  C     K    - Loop counter Line 323  C     K    - Loop counter
323        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
324        CHARACTER*3 index_lab        CHARACTER*3 index_lab
325        INTEGER K        INTEGER K
326    CEOP
327    
328        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
329         index_lab = 'I ='         index_lab = 'I ='
# Line 286  C     K    - Loop counter Line 342  C     K    - Loop counter
342        xOld = fld(1)        xOld = fld(1)
343        DO K=2,lFld        DO K=2,lFld
344         xNew = fld(K  )         xNew = fld(K  )
345         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
346          nDup = iHi-iLo+1          nDup = iHi-iLo+1
347          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
348           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
349           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
350       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
351         &    commOpen,index_lab,iLo,commClose
352          ELSE          ELSE
353           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
354           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
355       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
356       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 312  C     K    - Loop counter Line 369  C     K    - Loop counter
369        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
370         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
371         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
372       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
373         &    commOpen,index_lab,iLo,commClose
374        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
375         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
376         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
377       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
378       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 324  C     K    - Loop counter Line 382  C     K    - Loop counter
382        RETURN        RETURN
383        END        END
384    
385  CStartofinterface  CBOP
386        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit )  C     !ROUTINE: PRINT_LIST_R8
387  C     /==========================================================\  C     !INTERFACE:
388  C     | o SUBROUTINE PRINT_LIST_R8                               |        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
389  C     |==========================================================|       &    markEnd, compact, ioUnit )
390  C     | Routine for producing list of values for a field with    |        IMPLICIT NONE
391  C     | duplicate values collected into                          |  C     !DESCRIPTION:
392  C     |    n @ value                                             |  C     *==========================================================*
393  C     | record.                                                  |  C     | o SUBROUTINE PRINT\_LIST\_R8
394  C     \==========================================================/  C     *==========================================================*
395    C     | Routine for producing list of values for a field with    
396    C     | duplicate values collected into                          
397    C     |    n \@ value                                              
398    C     | record.                                                  
399    C     *==========================================================*
400    
401  C     == Global data ==    C     !USES:
402    C     == Global data ==
403  #include "SIZE.h"  #include "SIZE.h"
404  #include "EEPARAMS.h"  #include "EEPARAMS.h"
405    
406    C     !INPUT/OUTPUT PARAMETERS:
407  C     == Routine arguments ==  C     == Routine arguments ==
408  C     fld    -  Data to be printed  C     fld    -  Data to be printed
409  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 358  C     ioUnit -  Unit number for IO. Line 423  C     ioUnit -  Unit number for IO.
423        LOGICAL markEnd        LOGICAL markEnd
424        LOGICAL compact        LOGICAL compact
425        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
426    
427    C     !LOCA VARIABLES:
428  C     == Local variables ==  C     == Local variables ==
429  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
430  C     iHi    with the same value  C     iHi    with the same value
# Line 377  C     K    - Loop counter Line 442  C     K    - Loop counter
442        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
443        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
444        CHARACTER*3 index_lab        CHARACTER*3 index_lab
445          CHARACTER*25 fmt1, fmt2
446        INTEGER K        INTEGER K
447    CEOP
448    
449        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
450         index_lab = 'I ='         index_lab = 'I ='
# Line 388  C     K    - Loop counter Line 455  C     K    - Loop counter
455        ELSE        ELSE
456         index_lab = '?='         index_lab = '?='
457        ENDIF        ENDIF
458    C-    fortran format to write 1 or 2 indices:
459          fmt1='(A,1X,A,I3,1X,A)'
460          fmt2='(A,1X,A,I3,A,I3,1X,A)'
461          IF ( lFld.GE.1000 ) THEN
462            K = 1+INT(LOG10(FLOAT(lFld)))
463            WRITE(fmt1,'(A,I1,A)') '(A,1X,A,I',K,',1X,A)'
464            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
465          ENDIF
466        commOpen  = '/*'        commOpen  = '/*'
467        commClose = '*/'        commClose = '*/'
468        iLo = 1        iLo = 1
# Line 396  C     K    - Loop counter Line 471  C     K    - Loop counter
471        xOld = fld(1)        xOld = fld(1)
472        DO K=2,lFld        DO K=2,lFld
473         xNew = fld(K  )         xNew = fld(K  )
474         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
475          nDup = iHi-iLo+1          nDup = iHi-iLo+1
476          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
477           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
478           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
479       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
480         &    commOpen,index_lab,iLo,commClose
481          ELSE          ELSE
482           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
483           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
484       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
485       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
486          ENDIF          ENDIF
487          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
488         &    SQUEEZE_RIGHT , 1)
489          iLo  = K          iLo  = K
490          iHi  = K          iHi  = K
491          xOld = xNew          xOld = xNew
# Line 421  C     K    - Loop counter Line 498  C     K    - Loop counter
498        nDup = iHi-iLo+1        nDup = iHi-iLo+1
499        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
500         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
501         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
502       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),fmt1)
503         &    commOpen,index_lab,iLo,commClose
504        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
505         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
506         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
507       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),fmt2)
508       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
509        ENDIF        ENDIF
510        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
511         &    SQUEEZE_RIGHT , 1)
512    
513        RETURN        RETURN
514        END        END
515    
516  CStartOfInterface  CBOP
517    C     !ROUTINE: PRINT_MAPRS
518    C     !INTERFACE:
519        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
520       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
521       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 442  CStartOfInterface Line 523  CStartOfInterface
523       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
524       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
525       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
526  C     /==========================================================\        IMPLICIT NONE
527  C     | SUBROUTINE PRINT_MAPR4                                   |  C     !DESCRIPTION:
528  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
529  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPRS                                    
530  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.              
531  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
532  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data      
533  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the    
534  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.      
535  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like          
536  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYRS( ... ) rather than this code directly.    
537  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation    
538  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the    
539  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the  
540  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)    
541  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for    
542  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.  
543  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).  
544  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
545  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.    
546  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr    
547    C     |      and jMin:jMax step jStr.                            
548    C     *==========================================================*
549    
550    C     !USES:
551  C     == Global variables ==  C     == Global variables ==
552  #include "SIZE.h"  #include "SIZE.h"
553  #include "EEPARAMS.h"  #include "EEPARAMS.h"
554  #include "EESUPPORT.h"  #include "EESUPPORT.h"
555          INTEGER  IFNBLNK
556          EXTERNAL IFNBLNK
557          INTEGER  ILNBLNK
558          EXTERNAL ILNBLNK
559    
560    C     !INPUT/OUTPUT PARAMETERS:
561  C     == Routine arguments ==  C     == Routine arguments ==
562  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
563  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 496  C     kStr Line 585  C     kStr
585        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
586        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
587        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
588    
589    C     !LOCAL VARIABLES:
590  C     == Local variables ==  C     == Local variables ==
591  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
592  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 532  C               Str  - stride within blo Line 616  C               Str  - stride within blo
616        INTEGER lChList        INTEGER lChList
617        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
618        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
619        REAL fMin        _RL  fMin
620        REAL fMax        _RL  fMax
621        REAL fRange        _RL  fRange
622        REAL val        _RL  val
623        REAL small        _RL  small
624        CHARACTER*2  accLab        CHARACTER*2  accLab
625        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
626        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 551  C               Str  - stride within blo Line 635  C               Str  - stride within blo
635        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
636        INTEGER bi, bj, bk        INTEGER bi, bj, bk
637        LOGICAL validRange        LOGICAL validRange
638    CEOP
639    
640        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
641        small  = 1. _d -15        small  =  1. _d -15
642        fMin   =  1. _d 32        fMin   =  1. _d  32
643        fMax   = -1. _d 32        fMax   = -1. _d  32
644        validRange = .FALSE.        validRange = .FALSE.
645    
646  C--   Calculate field range  C--   Calculate field range
# Line 564  C--   Calculate field range Line 649  C--   Calculate field range
649          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
650           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
651            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
652             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
653              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
654       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
655              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 576  C--   Calculate field range Line 661  C--   Calculate field range
661         ENDDO         ENDDO
662        ENDDO        ENDDO
663        fRange = fMax-fMin        fRange = fMax-fMin
664        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
665         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
666        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
667    
668  C--   Write field title and statistics  C--   Write field title and statistics
669        msgBuf = '// ======================================================='        msgBuf =
670         & '// ======================================================='
671        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
672       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
673        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 601  C--   Write field title and statistics Line 687  C--   Write field title and statistics
687       & '// CMAX = ', fMax       & '// CMAX = ', fMax
688        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
689       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
690        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
691       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
692         &  '// CINT = ', fRange/FLOAT(lChlist-1)
693          ELSE
694           WRITE(msgBuf,'(A,1PE30.15)')
695         &  '// CINT = ', 0.
696          ENDIF
697        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
698       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
699        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 634  C--   Write field title and statistics Line 725  C--   Write field title and statistics
725       &  ':',kStr,')'       &  ':',kStr,')'
726        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
727       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
728        msgBuf = '// ======================================================='        msgBuf =
729         & '// ======================================================='
730        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
731       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
732    
733          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
734           msgBuf =
735         &  'Model domain too big to print to terminal - skipping I/O'
736           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
737         &                   SQUEEZE_RIGHT, 1)
738           RETURN
739          endif
740    
741  C--   Write field  C--   Write field
742  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
743  C     acc = accross the page  C     acc = accross the page
# Line 735  C      Header Line 835  C      Header
835  C      Data  C      Data
836         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
837          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
838           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
839       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
840           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
841       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 770  C      Data Line 870  C      Data
870             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
871              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
872             ELSE             ELSE
873              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
874             ENDIF             ENDIF
875            ENDDO            ENDDO
876           ENDDO           ENDDO
# Line 792  C      Data Line 892  C      Data
892               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
893                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
894               ENDIF               ENDIF
895               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
896                  IDX = NINT(
897       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
898       &             )+1       &             )+1
899                 ELSE
900                  IDX = 1
901                 ENDIF
902               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
903       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
904               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 812  C      Data Line 916  C      Data
916         ENDDO         ENDDO
917        ENDIF        ENDIF
918  C--   Write delimiter  C--   Write delimiter
919        msgBuf = '// ======================================================='        msgBuf =
920         & '// ======================================================='
921        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
922       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
923        msgBuf = '// END OF FIELD                                          ='        msgBuf =
924         & '// END OF FIELD                                          ='
925        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
926       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
927        msgBuf = '// ======================================================='        msgBuf =
928         & '// ======================================================='
929        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
930       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
931        msgBuf = ' '        msgBuf = ' '
# Line 828  C--   Write delimiter Line 935  C--   Write delimiter
935        RETURN        RETURN
936        END        END
937    
938  CStartOfInterface  CBOP
939    C     !ROUTINE: PRINT_MAPRL
940    
941    C     !INTERFACE:
942        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
943       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
944       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 836  CStartOfInterface Line 946  CStartOfInterface
946       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
947       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
948       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
949  C     /==========================================================\        IMPLICIT NONE
 C     | SUBROUTINE PRINT_MAPRL                                   |  
 C     | o Does textual mapping printing of a field.              |  
 C     |==========================================================|  
 C     | This routine does the actual formatting of the data      |  
 C     | and printing to a file. It assumes an array using the    |  
 C     | MITgcm UV indexing scheme and base index variables.      |  
 C     | User code should call an interface routine like          |  
 C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  
 C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  
 C     | is specficied through the "plotMode" argument. All the   |  
 C     | plots made by a single call to this routine will use the |  
 C     | same contour interval. The plot range (iMin,...,byStr)   |  
 C     | can be three-dimensional. A separate plot is made for    |  
 C     | each point in the plot range normal to the orientation.  |  
 C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  
 C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  
 C     |      plots - one for K=1, one for K=3 and one for K=5.   |  
 C     |      Each plot would have extents iMin:iMax step iStr    |  
 C     |      and jMin:jMax step jStr.                            |  
 C     \==========================================================/  
950    
951    C     !DESCRIPTION:
952    C     *==========================================================*
953    C     | SUBROUTINE PRINT\_MAPRL                                    
954    C     | o Does textual mapping printing of a field.              
955    C     *==========================================================*
956    C     | This routine does the actual formatting of the data      
957    C     | and printing to a file. It assumes an array using the    
958    C     | MITgcm UV indexing scheme and base index variables.      
959    C     | User code should call an interface routine like          
960    C     | PLOT\_FIELD\_XYRL( ... ) rather than this code directly.    
961    C     | Text plots can be oriented XY, YZ, XZ. An orientation    
962    C     | is specficied through the "plotMode" argument. All the    
963    C     | plots made by a single call to this routine will use the  
964    C     | same contour interval. The plot range (iMin,...,byStr)    
965    C     | can be three-dimensional. A separate plot is made for    
966    C     | each point in the plot range normal to the orientation.  
967    C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).  
968    C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
969    C     |      plots - one for K=1, one for K=3 and one for K=5.    
970    C     |      Each plot would have extents iMin:iMax step iStr    
971    C     |      and jMin:jMax step jStr.                            
972    C     *==========================================================*
973    
974    C     !USES:
975  C     == Global variables ==  C     == Global variables ==
976  #include "SIZE.h"  #include "SIZE.h"
977  #include "EEPARAMS.h"  #include "EEPARAMS.h"
978  #include "EESUPPORT.h"  #include "EESUPPORT.h"
979          INTEGER  IFNBLNK
980          EXTERNAL IFNBLNK
981          INTEGER  ILNBLNK
982          EXTERNAL ILNBLNK
983    
984    C     !INPUT/OUTPUT PARAMETERS:
985  C     == Routine arguments ==  C     == Routine arguments ==
986  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
987  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 890  C     kStr Line 1009  C     kStr
1009        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
1010        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
1011        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1012    
1013    C     !LOCAL VARIABLES:
1014  C     == Local variables ==  C     == Local variables ==
1015  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
1016  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 926  C               Str  - stride within blo Line 1040  C               Str  - stride within blo
1040        INTEGER lChList        INTEGER lChList
1041        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1042        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1043        REAL fMin        _RL  fMin
1044        REAL fMax        _RL  fMax
1045        REAL fRange        _RL  fRange
1046        REAL val        _RL  val
1047        REAL small        _RL  small
1048        CHARACTER*2  accLab        CHARACTER*2  accLab
1049        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1050        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 945  C               Str  - stride within blo Line 1059  C               Str  - stride within blo
1059        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1060        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1061        LOGICAL validRange        LOGICAL validRange
1062    CEOP
1063    
1064        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1065        small  = 1. _d -15        small  = 1. _d -15
# Line 958  C--   Calculate field range Line 1073  C--   Calculate field range
1073          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1074           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1075            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1076  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1077         &     THEN
1078              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
1079       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1080              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1081       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1082  C          ENDIF             ENDIF
1083            ENDDO            ENDDO
1084           ENDDO           ENDDO
1085          ENDDO          ENDDO
1086         ENDDO         ENDDO
1087        ENDDO        ENDDO
1088        fRange = fMax-fMin        fRange = fMax-fMin
1089        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
1090         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
1091        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
1092    
1093  C--   Write field title and statistics  C--   Write field title and statistics
1094        msgBuf = '// ======================================================='        msgBuf =
1095         & '// ======================================================='
1096        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1097       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1098        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 995  C--   Write field title and statistics Line 1112  C--   Write field title and statistics
1112       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1113        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1114       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1115        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1116           WRITE(msgBuf,'(A,1PE30.15)')
1117       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1118          ELSE
1119           WRITE(msgBuf,'(A,1PE30.15)')
1120         & '// CINT = ', 0.
1121          ENDIF
1122        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1123       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1124        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1028  C--   Write field title and statistics Line 1150  C--   Write field title and statistics
1150       &  ':',kStr,')'       &  ':',kStr,')'
1151        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1152       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1153        msgBuf = '// ======================================================='        msgBuf =
1154         & '// ======================================================='
1155        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1156       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1157    
1158          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1159           msgBuf =
1160         &  'Model domain too big to print to terminal - skipping I/O'
1161           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1162         &                   SQUEEZE_RIGHT, 1)
1163           RETURN
1164          endif
1165    
1166  C--   Write field  C--   Write field
1167  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1168  C     acc = accross the page  C     acc = accross the page
# Line 1129  C      Header Line 1260  C      Header
1260  C      Data  C      Data
1261         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1262          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1263           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1264       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1265           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1266       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1163  C      Data Line 1294  C      Data
1294             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1295              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1296             ELSE             ELSE
1297              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1298             ENDIF             ENDIF
1299            ENDDO            ENDDO
1300           ENDDO           ENDDO
# Line 1184  C      Data Line 1315  C      Data
1315               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1316                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1317               ENDIF               ENDIF
1318               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1319       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1320       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1321         &              )+1
1322                 ELSE
1323                  IDX = 1
1324                 ENDIF
1325               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1326       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1327               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1203  C      Data Line 1338  C      Data
1338         ENDDO         ENDDO
1339        ENDIF        ENDIF
1340  C--   Write delimiter  C--   Write delimiter
1341        msgBuf = '// ======================================================='        msgBuf =
1342         & '// ======================================================='
1343        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1344       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1345        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1346         & '// END OF FIELD                                          ='
1347        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1348       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1349        msgBuf = '// ======================================================='        msgBuf =
1350         & '// ======================================================='
1351        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1352       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1353        msgBuf = ' '        msgBuf = ' '
# Line 1219  C--   Write delimiter Line 1357  C--   Write delimiter
1357        RETURN        RETURN
1358        END        END
1359    
1360  CStartOfInterface  CBOP
1361    C     !ROUTINE: PRINT_MESSAGE
1362    
1363    C     !INTERFACE:
1364        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
1365  C     /============================================================\        IMPLICIT NONE
1366  C     | SUBROUTINE PRINT_MESSAGE                                   |  C     !DESCRIPTION:
1367  C     | o Write out informational message using "standard" format. |  C     *============================================================*
1368  C     | Notes                                                      |  C     | SUBROUTINE PRINT\_MESSAGE                                    
1369  C     | =====                                                      |  C     | o Write out informational message using "standard" format.  
1370  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     *============================================================*
1371  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     | Notes                                                      
1372  C     |   critical region is defined around the write here. In some|  C     | =====                                                      
1373  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     | o Some system   I/O is not "thread-safe". For this reason  
1374  C     |   for thread number 1 - writes for other threads are       |  C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
1375  C     |   ignored!                                                 |  C     |   critical region is defined around the write here. In some
1376  C     | o In a non-parallel form these routines can still be used. |  C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
1377  C     |   to produce pretty printed output!                        |  C     |   for thread number 1 - writes for other threads are        
1378  C     \============================================================/  C     |   ignored!                                                  
1379    C     | o In a non-parallel form these routines can still be used.  
1380    C     |   to produce pretty printed output!                        
1381    C     *============================================================*
1382    
1383    C     !USES:
1384  C     == Global data ==  C     == Global data ==
1385  #include "SIZE.h"  #include "SIZE.h"
1386  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1387  #include "EESUPPORT.h"  #include "EESUPPORT.h"
1388          INTEGER  IFNBLNK
1389          EXTERNAL IFNBLNK
1390          INTEGER  ILNBLNK
1391          EXTERNAL ILNBLNK
1392    
1393    C     !INPUT/OUTPUT PARAMETERS:
1394  C     == Routine arguments ==  C     == Routine arguments ==
1395  C     message - Message to write  C     message :: Message to write
1396  C     unit    - Unit number to write to  C     unit    :: Unit number to write to
1397  C     sq      - Justification option  C     sq      :: Justification option
1398        CHARACTER*(*) message        CHARACTER*(*) message
1399        INTEGER       unit        INTEGER       unit
1400        CHARACTER*(*) sq        CHARACTER*(*) sq
1401        INTEGER  myThid        INTEGER  myThid
1402  CEndOfInterface  
1403        INTEGER  IFNBLNK  C     !LOCAL VARIABLES:
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1404  C     == Local variables ==  C     == Local variables ==
1405    C     iStart, iEnd :: String indexing variables
1406    C     idString     :: Temp. for building prefix.
1407        INTEGER iStart        INTEGER iStart
1408        INTEGER iEnd        INTEGER iEnd
1409        CHARACTER*9 idString        CHARACTER*9 idString
1410    CEOP
1411    
1412  C--   Find beginning and end of message  C--   Find beginning and end of message
1413        IF ( sq .EQ. SQUEEZE_BOTH .OR.        IF ( sq .EQ. SQUEEZE_BOTH .OR.
1414       &     sq .EQ. SQUEEZE_LEFT ) THEN       &     sq .EQ. SQUEEZE_LEFT ) THEN
# Line 1310  C       The write statement may need to Line 1463  C       The write statement may need to
1463  #endif  #endif
1464         ENDIF         ENDIF
1465        ENDIF        ENDIF
1466    
1467    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
1468    C--   if error message, also write directly to unit 0 :
1469          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
1470         &     .AND. unit.EQ.errorMessageUnit ) THEN
1471            iEnd   = ILNBLNK( message )
1472            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
1473          ENDIF
1474    #endif
1475  C  C
1476   1000 CONTINUE   1000 CONTINUE
1477        RETURN        RETURN
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22