/[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.7 by cnh, Mon Jun 8 21:43:00 1998 UTC revision 1.22 by adcroft, Mon Feb 23 20:04:27 2004 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 18  C--    o print_mapr8    Formats ABCD... Line 19  C--    o print_mapr8    Formats ABCD...
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        ELSEIF ( pidIO .EQ. myProcId ) THEN
88  C--    Write multi-process format  C--    Write multi-process format
# Line 95  C       The write statement may need to Line 117  C       The write statement may need to
117  #endif  #endif
118         ENDIF         ENDIF
119        ENDIF        ENDIF
120  C  
121    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
122    C--   also write directly to unit 0 :
123          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1 ) THEN
124            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
125          ENDIF
126    #endif
127    
128   1000 CONTINUE   1000 CONTINUE
129        RETURN        RETURN
130    
# Line 104  C Line 133  C
133        GOTO 1000        GOTO 1000
134        END        END
135    
136  CStartofinterface  CBOP
137        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, ioUnit )  C     !ROUTINE: PRINT_LIST_I
138  C     /==========================================================\  
139  C     | o SUBROUTINE PRINT_LIST_I                                |  C     !INTERFACE:
140  C     |==========================================================|        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
141  C     | Routine for producing list of values for a field with    |       &                         markEnd, compact, ioUnit )
142  C     | duplicate values collected into                          |        IMPLICIT NONE
143  C     |    n @ value                                             |  C     !DESCRIPTION:
144  C     | record.                                                  |  C     *==========================================================*
145  C     \==========================================================/  C     | o SUBROUTINE PRINT_LIST_I                                
146    C     *==========================================================*
147    C     | Routine for producing list of values for a field with    
148    C     | duplicate values collected into                          
149    C     |    n @ value                                              
150    C     | record.                                                  
151    C     *==========================================================*
152    
153    C     !USES:
154  C     == Global data ==    C     == Global data ==  
155  #include "SIZE.h"  #include "SIZE.h"
156  #include "EEPARAMS.h"  #include "EEPARAMS.h"
157    
158    C     !INPUT/OUTPUT PARAMETERS:
159  C     == Routine arguments ==  C     == Routine arguments ==
160  C     fld    -  Data to be printed  C     fld    ::  Data to be printed
161  C     lFld   -  Number of elements to be printed  C     lFld   ::  Number of elements to be printed
162  C     index_type - Flag indicating which type of index to print  C     index_type :: Flag indicating which type of index to print
163  C                  INDEX_K    => /* K = nnn */  C                   INDEX_K    => /* K = nnn */
164  C                  INDEX_I    => /* I = nnn */  C                   INDEX_I    => /* I = nnn */
165  C                  INDEX_J    => /* J = nnn */  C                   INDEX_J    => /* J = nnn */
166  C                  INDEX_NONE =>  C                   INDEX_NONE =>
167  C     ioUnit -  Unit number for IO.  C     compact ::  Flag to control use of repeat symbol for same valued
168    C                 fields.
169    C     markEnd ::  Flag to control whether there is a separator after the
170    C                 last element
171    C     ioUnit ::   Unit number for IO.
172        INTEGER lFld        INTEGER lFld
173        INTEGER index_type        INTEGER index_type
174        INTEGER fld(lFld)        INTEGER fld(lFld)
175          LOGICAL markEnd
176          LOGICAL compact
177        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
178    
179    C     !LOCAL VARIABLES:
180  C     == Local variables ==  C     == Local variables ==
181  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
182  C     iHi    with the same value  C     iHi    with the same value
# Line 152  C     K    - Loop counter Line 195  C     K    - Loop counter
195        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
196        CHARACTER*3 index_lab        CHARACTER*3 index_lab
197        INTEGER K        INTEGER K
198    CEOP
199    
200        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
201         index_lab = 'I ='         index_lab = 'I ='
# Line 170  C     K    - Loop counter Line 214  C     K    - Loop counter
214        xOld = fld(1)        xOld = fld(1)
215        DO K=2,lFld        DO K=2,lFld
216         xNew = fld(K  )         xNew = fld(K  )
217         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
218          nDup = iHi-iLo+1          nDup = iHi-iLo+1
219          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
220           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
221           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
222       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
223         &    commOpen,index_lab,iLo,commClose
224          ELSE          ELSE
225           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
226           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
227       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
228       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 191  C     K    - Loop counter Line 236  C     K    - Loop counter
236         ENDIF         ENDIF
237        ENDDO        ENDDO
238        punc = ' '        punc = ' '
239          IF ( markEnd ) punc = ','
240        nDup = iHi-iLo+1        nDup = iHi-iLo+1
241        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
242         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
243         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
244       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
245         &  commOpen,index_lab,iLo,commClose
246        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
247         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
248         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
249       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
250       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 207  C     K    - Loop counter Line 254  C     K    - Loop counter
254        RETURN        RETURN
255        END        END
256    
257  CStartofinterface  CBOP
258        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, ioUnit )  C     !ROUTINE: PRINT_LIST_L
259  C     /==========================================================\  
260  C     | o SUBROUTINE PRINT_LIST_L                                |  C     !INTERFACE:
261  C     |==========================================================|        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
262  C     | Routine for producing list of values for a field with    |       &                         compact, ioUnit )
263  C     | duplicate values collected into                          |        IMPLICIT NONE
264  C     |    n @ value                                             |  C     !DESCRIPTION:
265  C     | record.                                                  |  C     *==========================================================*
266  C     \==========================================================/  C     | o SUBROUTINE PRINT_LIST_L                                
267    C     *==========================================================*
268    C     | Routine for producing list of values for a field with    
269    C     | duplicate values collected into                          
270    C     |    n @ value                                              
271    C     | record.                                                  
272    C     *==========================================================*
273    
274    C     !USES:
275  C     == Global data ==    C     == Global data ==  
276  #include "SIZE.h"  #include "SIZE.h"
277  #include "EEPARAMS.h"  #include "EEPARAMS.h"
278    
279    C     !INPUT/OUTPUT PARAMETERS:
280  C     == Routine arguments ==  C     == Routine arguments ==
281  C     fld    -  Data to be printed  C     fld    -  Data to be printed
282  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 230  C                  INDEX_K    => /* K = Line 285  C                  INDEX_K    => /* K =
285  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
286  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
287  C                  INDEX_NONE =>  C                  INDEX_NONE =>
288    C     compact -  Flag to control use of repeat symbol for same valued
289    C                fields.
290    C     markEnd -  Flag to control whether there is a separator after the
291    C                last element
292  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
293        INTEGER lFld        INTEGER lFld
294        INTEGER index_type        INTEGER index_type
295        LOGICAL fld(lFld)        LOGICAL fld(lFld)
296          LOGICAL markEnd
297          LOGICAL compact
298        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
299    
300    C     !LOCAL VARIABLES:
301  C     == Local variables ==  C     == Local variables ==
302  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
303  C     iHi    with the same value  C     iHi    with the same value
# Line 255  C     K    - Loop counter Line 316  C     K    - Loop counter
316        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
317        CHARACTER*3 index_lab        CHARACTER*3 index_lab
318        INTEGER K        INTEGER K
319    CEOP
320    
321        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
322         index_lab = 'I ='         index_lab = 'I ='
# Line 273  C     K    - Loop counter Line 335  C     K    - Loop counter
335        xOld = fld(1)        xOld = fld(1)
336        DO K=2,lFld        DO K=2,lFld
337         xNew = fld(K  )         xNew = fld(K  )
338         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
339          nDup = iHi-iLo+1          nDup = iHi-iLo+1
340          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
341           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
342           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
343       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
344         &    commOpen,index_lab,iLo,commClose
345          ELSE          ELSE
346           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
347           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
348       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
349       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 294  C     K    - Loop counter Line 357  C     K    - Loop counter
357         ENDIF         ENDIF
358        ENDDO        ENDDO
359        punc = ' '        punc = ' '
360          IF ( markEnd ) punc = ','
361        nDup = iHi-iLo+1        nDup = iHi-iLo+1
362        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
363         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
364         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
365       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
366         &    commOpen,index_lab,iLo,commClose
367        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
368         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
369         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
370       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
371       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 310  C     K    - Loop counter Line 375  C     K    - Loop counter
375        RETURN        RETURN
376        END        END
377    
378  CStartofinterface  CBOP
379        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )  C     !ROUTINE: PRINT_LIST_R8
380  C     /==========================================================\  C     !INTERFACE:
381  C     | o SUBROUTINE PRINT_LIST_R8                               |        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
382  C     |==========================================================|       &    markEnd, compact, ioUnit )
383  C     | Routine for producing list of values for a field with    |        IMPLICIT NONE
384  C     | duplicate values collected into                          |  C     !DESCRIPTION:
385  C     |    n @ value                                             |  C     *==========================================================*
386  C     | record.                                                  |  C     | o SUBROUTINE PRINT_LIST_R8                                
387  C     \==========================================================/  C     *==========================================================*
388    C     | Routine for producing list of values for a field with    
389    C     | duplicate values collected into                          
390    C     |    n @ value                                              
391    C     | record.                                                  
392    C     *==========================================================*
393    
394  C     == Global data ==    C     !USES:
395    C     == Global data ==
396  #include "SIZE.h"  #include "SIZE.h"
397  #include "EEPARAMS.h"  #include "EEPARAMS.h"
398    
399    C     !INPUT/OUTPUT PARAMETERS:
400  C     == Routine arguments ==  C     == Routine arguments ==
401  C     fld    -  Data to be printed  C     fld    -  Data to be printed
402  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 333  C                  INDEX_K    => /* K = Line 405  C                  INDEX_K    => /* K =
405  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
406  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
407  C                  INDEX_NONE =>  C                  INDEX_NONE =>
408    C     compact -  Flag to control use of repeat symbol for same valued
409    C                fields.
410    C     markEnd -  Flag to control whether there is a separator after the
411    C                last element
412  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
413        INTEGER lFld        INTEGER lFld
414        INTEGER index_type        INTEGER index_type
415        Real*8  fld(lFld)        Real*8  fld(lFld)
416          LOGICAL markEnd
417          LOGICAL compact
418        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
419    
420    C     !LOCA VARIABLES:
421  C     == Local variables ==  C     == Local variables ==
422  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
423  C     iHi    with the same value  C     iHi    with the same value
# Line 358  C     K    - Loop counter Line 436  C     K    - Loop counter
436        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
437        CHARACTER*3 index_lab        CHARACTER*3 index_lab
438        INTEGER K        INTEGER K
439    CEOP
440    
441        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
442         index_lab = 'I ='         index_lab = 'I ='
# Line 376  C     K    - Loop counter Line 455  C     K    - Loop counter
455        xOld = fld(1)        xOld = fld(1)
456        DO K=2,lFld        DO K=2,lFld
457         xNew = fld(K  )         xNew = fld(K  )
458         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
459          nDup = iHi-iLo+1          nDup = iHi-iLo+1
460          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
461           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
462           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
463       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
464         &    commOpen,index_lab,iLo,commClose
465          ELSE          ELSE
466           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
467           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
468       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
469       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
470          ENDIF          ENDIF
471          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
472         &    SQUEEZE_RIGHT , 1)
473          iLo  = K          iLo  = K
474          iHi  = K          iHi  = K
475          xOld = xNew          xOld = xNew
# Line 397  C     K    - Loop counter Line 478  C     K    - Loop counter
478         ENDIF         ENDIF
479        ENDDO        ENDDO
480        punc = ' '        punc = ' '
481          IF ( markEnd ) punc = ','
482        nDup = iHi-iLo+1        nDup = iHi-iLo+1
483        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
484         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
485         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
486       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
487         &    commOpen,index_lab,iLo,commClose
488        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
489         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
490         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
491       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
492       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
493        ENDIF        ENDIF
494        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
495         &    SQUEEZE_RIGHT , 1)
496    
497        RETURN        RETURN
498        END        END
499    
500  CStartOfInterface  CBOP
501        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,  C     !ROUTINE: PRINT_MAPRS
502    C     !INTERFACE:
503          SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
504       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
505       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
506       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
507       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
508       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
509       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
510  C     /==========================================================\        IMPLICIT NONE
511  C     | SUBROUTINE PRINT_MAPR4                                   |  C     !DESCRIPTION:
512  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
513  C     |==========================================================|  C     | SUBROUTINE PRINT_MAPR4                                    
514  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.              
515  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
516  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data      
517  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the    
518  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.      
519  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like          
520  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.    
521  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation    
522  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the    
523  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the  
524  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)    
525  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for    
526  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.  
527  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).  
528  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
529  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.    
530  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr    
531    C     |      and jMin:jMax step jStr.                            
532    C     *==========================================================*
533    
534    C     !USES:
535  C     == Global variables ==  C     == Global variables ==
536  #include "SIZE.h"  #include "SIZE.h"
537  #include "EEPARAMS.h"  #include "EEPARAMS.h"
538  #include "EESUPPORT.h"  #include "EESUPPORT.h"
539          INTEGER  IFNBLNK
540          EXTERNAL IFNBLNK
541          INTEGER  ILNBLNK
542          EXTERNAL ILNBLNK
543    
544    C     !INPUT/OUTPUT PARAMETERS:
545  C     == Routine arguments ==  C     == Routine arguments ==
546  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
547  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 469  C     kStr Line 563  C     kStr
563        INTEGER jLo, jHi        INTEGER jLo, jHi
564        INTEGER kLo, kHi        INTEGER kLo, kHi
565        INTEGER nBx, nBy        INTEGER nBx, nBy
566        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
567        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
568        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
569        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
570        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
571        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
572    
573    C     !LOCAL VARIABLES:
574  C     == Local variables ==  C     == Local variables ==
575  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
576  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 511  C               Str  - stride within blo Line 600  C               Str  - stride within blo
600        INTEGER lChList        INTEGER lChList
601        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
602        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
603        REAL fMin        _RL  fMin
604        REAL fMax        _RL  fMax
605        REAL fRange        _RL  fRange
606        REAL val        _RL  val
607        REAL small        _RL  small
608        CHARACTER*2  accLab        CHARACTER*2  accLab
609        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
610        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 530  C               Str  - stride within blo Line 619  C               Str  - stride within blo
619        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
620        INTEGER bi, bj, bk        INTEGER bi, bj, bk
621        LOGICAL validRange        LOGICAL validRange
622    CEOP
623    
624        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
625        small  = 1. _d -15        small  =  1. _d -15
626        fMin   =  1. _d 32        fMin   =  1. _d  32
627        fMax   = -1. _d 32        fMax   = -1. _d  32
628        validRange = .FALSE.        validRange = .FALSE.
629    
630  C--   Calculate field range  C--   Calculate field range
# Line 543  C--   Calculate field range Line 633  C--   Calculate field range
633          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
634           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
635            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
636             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
637              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
638       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
639              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 555  C--   Calculate field range Line 645  C--   Calculate field range
645         ENDDO         ENDDO
646        ENDDO        ENDDO
647        fRange = fMax-fMin        fRange = fMax-fMin
648        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
649         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
650        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
651    
652  C--   Write field title and statistics  C--   Write field title and statistics
653        msgBuf = '// ======================================================='        msgBuf =
654         & '// ======================================================='
655        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
656       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
657        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 580  C--   Write field title and statistics Line 671  C--   Write field title and statistics
671       & '// CMAX = ', fMax       & '// CMAX = ', fMax
672        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
673       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
674        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
675       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
676         &  '// CINT = ', fRange/FLOAT(lChlist-1)
677          ELSE
678           WRITE(msgBuf,'(A,1PE30.15)')
679         &  '// CINT = ', 0.
680          ENDIF
681        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
682       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
683        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 613  C--   Write field title and statistics Line 709  C--   Write field title and statistics
709       &  ':',kStr,')'       &  ':',kStr,')'
710        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
711       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
712        msgBuf = '// ======================================================='        msgBuf =
713         & '// ======================================================='
714        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
715       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
716    
717          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
718           msgBuf =
719         &  'Model domain too big to print to terminal - skipping I/O'
720           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
721         &                   SQUEEZE_RIGHT, 1)
722           RETURN
723          endif
724    
725  C--   Write field  C--   Write field
726  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
727  C     acc = accross the page  C     acc = accross the page
# Line 714  C      Header Line 819  C      Header
819  C      Data  C      Data
820         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
821          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
822           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
823       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
824           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
825       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 771  C      Data Line 876  C      Data
876               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
877                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
878               ENDIF               ENDIF
879               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
880                  IDX = NINT(
881       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
882       &             )+1       &             )+1
883                 ELSE
884                  IDX = 1
885                 ENDIF
886               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
887       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
888               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 791  C      Data Line 900  C      Data
900         ENDDO         ENDDO
901        ENDIF        ENDIF
902  C--   Write delimiter  C--   Write delimiter
903        msgBuf = '// ======================================================='        msgBuf =
904         & '// ======================================================='
905        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
906       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
907        msgBuf = '// END OF FIELD                                          ='        msgBuf =
908         & '// END OF FIELD                                          ='
909        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
910       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
911        msgBuf = '// ======================================================='        msgBuf =
912         & '// ======================================================='
913        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
914       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
915        msgBuf = ' '        msgBuf = ' '
# Line 807  C--   Write delimiter Line 919  C--   Write delimiter
919        RETURN        RETURN
920        END        END
921    
922  CStartOfInterface  CBOP
923        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,  C     !ROUTINE: PRINT_MAPRL
924    
925    C     !INTERFACE:
926          SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
927       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
928       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
929       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
930       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
931       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
932       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
933  C     /==========================================================\        IMPLICIT NONE
934  C     | SUBROUTINE PRINT_MAPR8                                   |  
935  C     | o Does textual mapping printing of a field.              |  C     !DESCRIPTION:
936  C     |==========================================================|  C     *==========================================================*
937  C     | This routine does the actual formatting of the data      |  C     | SUBROUTINE PRINT_MAPRL                                    
938  C     | and printing to a file. It assumes an array using the    |  C     | o Does textual mapping printing of a field.              
939  C     | MITgcm UV indexing scheme and base index variables.      |  C     *==========================================================*
940  C     | User code should call an interface routine like          |  C     | This routine does the actual formatting of the data      
941  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  C     | and printing to a file. It assumes an array using the    
942  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | MITgcm UV indexing scheme and base index variables.      
943  C     | is specficied through the "plotMode" argument. All the   |  C     | User code should call an interface routine like          
944  C     | plots made by a single call to this routine will use the |  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.    
945  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | Text plots can be oriented XY, YZ, XZ. An orientation    
946  C     | can be three-dimensional. A separate plot is made for    |  C     | is specficied through the "plotMode" argument. All the    
947  C     | each point in the plot range normal to the orientation.  |  C     | plots made by a single call to this routine will use the  
948  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | same contour interval. The plot range (iMin,...,byStr)    
949  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | can be three-dimensional. A separate plot is made for    
950  C     |      plots - one for K=1, one for K=3 and one for K=5.   |  C     | each point in the plot range normal to the orientation.  
951  C     |      Each plot would have extents iMin:iMax step iStr    |  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).  
952  C     |      and jMin:jMax step jStr.                            |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
953  C     \==========================================================/  C     |      plots - one for K=1, one for K=3 and one for K=5.    
954    C     |      Each plot would have extents iMin:iMax step iStr    
955    C     |      and jMin:jMax step jStr.                            
956    C     *==========================================================*
957    
958    C     !USES:
959  C     == Global variables ==  C     == Global variables ==
960  #include "SIZE.h"  #include "SIZE.h"
961  #include "EEPARAMS.h"  #include "EEPARAMS.h"
962  #include "EESUPPORT.h"  #include "EESUPPORT.h"
963          INTEGER  IFNBLNK
964          EXTERNAL IFNBLNK
965          INTEGER  ILNBLNK
966          EXTERNAL ILNBLNK
967    
968    C     !INPUT/OUTPUT PARAMETERS:
969  C     == Routine arguments ==  C     == Routine arguments ==
970  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
971  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 863  C     kStr Line 987  C     kStr
987        INTEGER jLo, jHi        INTEGER jLo, jHi
988        INTEGER kLo, kHi        INTEGER kLo, kHi
989        INTEGER nBx, nBy        INTEGER nBx, nBy
990        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
991        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
992        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
993        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
994        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
995        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
996    
997    C     !LOCAL VARIABLES:
998  C     == Local variables ==  C     == Local variables ==
999  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
1000  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 905  C               Str  - stride within blo Line 1024  C               Str  - stride within blo
1024        INTEGER lChList        INTEGER lChList
1025        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1026        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1027        REAL fMin        _RL  fMin
1028        REAL fMax        _RL  fMax
1029        REAL fRange        _RL  fRange
1030        REAL val        _RL  val
1031        REAL small        _RL  small
1032        CHARACTER*2  accLab        CHARACTER*2  accLab
1033        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1034        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 924  C               Str  - stride within blo Line 1043  C               Str  - stride within blo
1043        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1044        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1045        LOGICAL validRange        LOGICAL validRange
1046    CEOP
1047    
1048        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1049        small  = 1. _d -15        small  = 1. _d -15
# Line 937  C--   Calculate field range Line 1057  C--   Calculate field range
1057          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1058           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1059            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1060  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1061         &     THEN
1062              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
1063       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1064              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1065       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1066  C          ENDIF             ENDIF
1067            ENDDO            ENDDO
1068           ENDDO           ENDDO
1069          ENDDO          ENDDO
1070         ENDDO         ENDDO
1071        ENDDO        ENDDO
1072        fRange = fMax-fMin        fRange = fMax-fMin
1073        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
1074         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
1075        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
1076    
1077  C--   Write field title and statistics  C--   Write field title and statistics
1078        msgBuf = '// ======================================================='        msgBuf =
1079         & '// ======================================================='
1080        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1081       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1082        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 974  C--   Write field title and statistics Line 1096  C--   Write field title and statistics
1096       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1097        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1098       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1099        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1100           WRITE(msgBuf,'(A,1PE30.15)')
1101       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1102          ELSE
1103           WRITE(msgBuf,'(A,1PE30.15)')
1104         & '// CINT = ', 0.
1105          ENDIF
1106        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1107       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1108        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1007  C--   Write field title and statistics Line 1134  C--   Write field title and statistics
1134       &  ':',kStr,')'       &  ':',kStr,')'
1135        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1136       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1137        msgBuf = '// ======================================================='        msgBuf =
1138         & '// ======================================================='
1139        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1140       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1141    
1142          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1143           msgBuf =
1144         &  'Model domain too big to print to terminal - skipping I/O'
1145           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1146         &                   SQUEEZE_RIGHT, 1)
1147           RETURN
1148          endif
1149    
1150  C--   Write field  C--   Write field
1151  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1152  C     acc = accross the page  C     acc = accross the page
# Line 1108  C      Header Line 1244  C      Header
1244  C      Data  C      Data
1245         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1246          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1247           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1248       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1249           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1250       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1163  C      Data Line 1299  C      Data
1299               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1300                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1301               ENDIF               ENDIF
1302               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1303       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1304       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1305         &              )+1
1306                 ELSE
1307                  IDX = 1
1308                 ENDIF
1309               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1310       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1311               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1182  C      Data Line 1322  C      Data
1322         ENDDO         ENDDO
1323        ENDIF        ENDIF
1324  C--   Write delimiter  C--   Write delimiter
1325        msgBuf = '// ======================================================='        msgBuf =
1326         & '// ======================================================='
1327        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1328       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1329        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1330         & '// END OF FIELD                                          ='
1331        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1332       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1333        msgBuf = '// ======================================================='        msgBuf =
1334         & '// ======================================================='
1335        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1336       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1337        msgBuf = ' '        msgBuf = ' '
# Line 1198  C--   Write delimiter Line 1341  C--   Write delimiter
1341        RETURN        RETURN
1342        END        END
1343    
1344  CStartOfInterface  CBOP
1345    C     !ROUTINE: PRINT_MESSAGE
1346    
1347    C     !INTERFACE:
1348        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
1349  C     /============================================================\        IMPLICIT NONE
1350  C     | SUBROUTINE PRINT_MESSAGE                                   |  C     !DESCRIPTION:
1351  C     | o Write out informational message using "standard" format. |  C     *============================================================*
1352  C     | Notes                                                      |  C     | SUBROUTINE PRINT_MESSAGE                                    
1353  C     | =====                                                      |  C     | o Write out informational message using "standard" format.  
1354  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     *============================================================*
1355  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     | Notes                                                      
1356  C     |   critical region is defined around the write here. In some|  C     | =====                                                      
1357  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     | o Some system   I/O is not "thread-safe". For this reason  
1358  C     |   for thread number 1 - writes for other threads are       |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        
1359  C     |   ignored!                                                 |  C     |   critical region is defined around the write here. In some
1360  C     | o In a non-parallel form these routines can still be used. |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes  
1361  C     |   to produce pretty printed output!                        |  C     |   for thread number 1 - writes for other threads are        
1362  C     \============================================================/  C     |   ignored!                                                  
1363    C     | o In a non-parallel form these routines can still be used.  
1364    C     |   to produce pretty printed output!                        
1365    C     *============================================================*
1366    
1367    C     !USES:
1368  C     == Global data ==  C     == Global data ==
1369  #include "SIZE.h"  #include "SIZE.h"
1370  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1371  #include "EESUPPORT.h"  #include "EESUPPORT.h"
1372          INTEGER  IFNBLNK
1373          EXTERNAL IFNBLNK
1374          INTEGER  ILNBLNK
1375          EXTERNAL ILNBLNK
1376    
1377    C     !INPUT/OUTPUT PARAMETERS:
1378  C     == Routine arguments ==  C     == Routine arguments ==
1379  C     message - Message to write  C     message :: Message to write
1380  C     unit    - Unit number to write to  C     unit    :: Unit number to write to
1381  C     sq      - Justification option  C     sq      :: Justification option
1382        CHARACTER*(*) message        CHARACTER*(*) message
1383        INTEGER       unit        INTEGER       unit
1384        CHARACTER*(*) sq        CHARACTER*(*) sq
1385        INTEGER  myThid        INTEGER  myThid
1386  CEndOfInterface  
1387        INTEGER  IFNBLNK  C     !LOCAL VARIABLES:
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1388  C     == Local variables ==  C     == Local variables ==
1389    C     iStart, iEnd :: String indexing variables
1390    C     idString     :: Temp. for building prefix.
1391        INTEGER iStart        INTEGER iStart
1392        INTEGER iEnd        INTEGER iEnd
1393        CHARACTER*9 idString        CHARACTER*9 idString
1394    CEOP
1395    
1396  C--   Find beginning and end of message  C--   Find beginning and end of message
1397        IF ( sq .EQ. SQUEEZE_BOTH .OR.        IF ( sq .EQ. SQUEEZE_BOTH .OR.
1398       &     sq .EQ. SQUEEZE_LEFT ) THEN       &     sq .EQ. SQUEEZE_LEFT ) THEN
# Line 1289  C       The write statement may need to Line 1447  C       The write statement may need to
1447  #endif  #endif
1448         ENDIF         ENDIF
1449        ENDIF        ENDIF
1450    
1451    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
1452    C--   if error message, also write directly to unit 0 :
1453          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
1454         &     .AND. unit.EQ.errorMessageUnit ) THEN
1455            iEnd   = ILNBLNK( message )
1456            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
1457          ENDIF
1458    #endif
1459  C  C
1460   1000 CONTINUE   1000 CONTINUE
1461        RETURN        RETURN
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22