/[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.21 by jmc, Tue Jan 27 15:59:23 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, markEnd, compact, 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     compact -  Flag to control use of repeat symbol for same valued  C     compact ::  Flag to control use of repeat symbol for same valued
168  C                fields.  C                 fields.
169  C     markEnd -  Flag to control whether there is a separator after the  C     markEnd ::  Flag to control whether there is a separator after the
170  C                last element  C                 last element
171  C     ioUnit -  Unit number for IO.  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        LOGICAL markEnd
176        LOGICAL compact        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 158  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 176  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 ( .NOT. compact .OR. 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 200  C     K    - Loop counter Line 239  C     K    - Loop counter
239        IF ( markEnd ) punc = ','        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 214  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, markEnd, compact, ioUnit )  C     !ROUTINE: PRINT_LIST_L
 C     /==========================================================\  
 C     | o SUBROUTINE PRINT_LIST_L                                |  
 C     |==========================================================|  
 C     | Routine for producing list of values for a field with    |  
 C     | duplicate values collected into                          |  
 C     |    n @ value                                             |  
 C     | record.                                                  |  
 C     \==========================================================/  
259    
260    C     !INTERFACE:
261          SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
262         &                         compact, ioUnit )
263          IMPLICIT NONE
264    C     !DESCRIPTION:
265    C     *==========================================================*
266    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 248  C     ioUnit -  Unit number for IO. Line 296  C     ioUnit -  Unit number for IO.
296        LOGICAL markEnd        LOGICAL markEnd
297        LOGICAL compact        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 268  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 286  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 ( .NOT. compact .OR. 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 312  C     K    - Loop counter Line 362  C     K    - Loop counter
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 324  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, markEnd, compact, 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 358  C     ioUnit -  Unit number for IO. Line 416  C     ioUnit -  Unit number for IO.
416        LOGICAL markEnd        LOGICAL markEnd
417        LOGICAL compact        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 378  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 396  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 ( .NOT. compact .OR. 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 422  C     K    - Loop counter Line 483  C     K    - Loop counter
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    C     !ROUTINE: PRINT_MAPRS
502    C     !INTERFACE:
503        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,        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,
# Line 442  CStartOfInterface Line 507  CStartOfInterface
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 496  C     kStr Line 569  C     kStr
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 532  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 551  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 564  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 576  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 601  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 634  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    
# Line 735  C      Header Line 811  C      Header
811  C      Data  C      Data
812         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
813          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
814           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
815       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
816           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
817       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 792  C      Data Line 868  C      Data
868               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
869                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
870               ENDIF               ENDIF
871               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
872                  IDX = NINT(
873       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
874       &             )+1       &             )+1
875                 ELSE
876                  IDX = 1
877                 ENDIF
878               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
879       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
880               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 812  C      Data Line 892  C      Data
892         ENDDO         ENDDO
893        ENDIF        ENDIF
894  C--   Write delimiter  C--   Write delimiter
895        msgBuf = '// ======================================================='        msgBuf =
896         & '// ======================================================='
897        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
898       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
899        msgBuf = '// END OF FIELD                                          ='        msgBuf =
900         & '// END OF FIELD                                          ='
901        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
902       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
903        msgBuf = '// ======================================================='        msgBuf =
904         & '// ======================================================='
905        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
906       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
907        msgBuf = ' '        msgBuf = ' '
# Line 828  C--   Write delimiter Line 911  C--   Write delimiter
911        RETURN        RETURN
912        END        END
913    
914  CStartOfInterface  CBOP
915    C     !ROUTINE: PRINT_MAPRL
916    
917    C     !INTERFACE:
918        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
919       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
920       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 836  CStartOfInterface Line 922  CStartOfInterface
922       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
923       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
924       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
925  C     /==========================================================\        IMPLICIT NONE
926  C     | SUBROUTINE PRINT_MAPRL                                   |  
927  C     | o Does textual mapping printing of a field.              |  C     !DESCRIPTION:
928  C     |==========================================================|  C     *==========================================================*
929  C     | This routine does the actual formatting of the data      |  C     | SUBROUTINE PRINT_MAPRL                                    
930  C     | and printing to a file. It assumes an array using the    |  C     | o Does textual mapping printing of a field.              
931  C     | MITgcm UV indexing scheme and base index variables.      |  C     *==========================================================*
932  C     | User code should call an interface routine like          |  C     | This routine does the actual formatting of the data      
933  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  C     | and printing to a file. It assumes an array using the    
934  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | MITgcm UV indexing scheme and base index variables.      
935  C     | is specficied through the "plotMode" argument. All the   |  C     | User code should call an interface routine like          
936  C     | plots made by a single call to this routine will use the |  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.    
937  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | Text plots can be oriented XY, YZ, XZ. An orientation    
938  C     | can be three-dimensional. A separate plot is made for    |  C     | is specficied through the "plotMode" argument. All the    
939  C     | each point in the plot range normal to the orientation.  |  C     | plots made by a single call to this routine will use the  
940  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | same contour interval. The plot range (iMin,...,byStr)    
941  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | can be three-dimensional. A separate plot is made for    
942  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.  
943  C     |      Each plot would have extents iMin:iMax step iStr    |  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).  
944  C     |      and jMin:jMax step jStr.                            |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
945  C     \==========================================================/  C     |      plots - one for K=1, one for K=3 and one for K=5.    
946    C     |      Each plot would have extents iMin:iMax step iStr    
947    C     |      and jMin:jMax step jStr.                            
948    C     *==========================================================*
949    
950    C     !USES:
951  C     == Global variables ==  C     == Global variables ==
952  #include "SIZE.h"  #include "SIZE.h"
953  #include "EEPARAMS.h"  #include "EEPARAMS.h"
954  #include "EESUPPORT.h"  #include "EESUPPORT.h"
955          INTEGER  IFNBLNK
956          EXTERNAL IFNBLNK
957          INTEGER  ILNBLNK
958          EXTERNAL ILNBLNK
959    
960    C     !INPUT/OUTPUT PARAMETERS:
961  C     == Routine arguments ==  C     == Routine arguments ==
962  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
963  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 890  C     kStr Line 985  C     kStr
985        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
986        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
987        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
988    
989    C     !LOCAL VARIABLES:
990  C     == Local variables ==  C     == Local variables ==
991  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
992  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 926  C               Str  - stride within blo Line 1016  C               Str  - stride within blo
1016        INTEGER lChList        INTEGER lChList
1017        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1018        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1019        REAL fMin        _RL  fMin
1020        REAL fMax        _RL  fMax
1021        REAL fRange        _RL  fRange
1022        REAL val        _RL  val
1023        REAL small        _RL  small
1024        CHARACTER*2  accLab        CHARACTER*2  accLab
1025        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1026        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 945  C               Str  - stride within blo Line 1035  C               Str  - stride within blo
1035        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1036        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1037        LOGICAL validRange        LOGICAL validRange
1038    CEOP
1039    
1040        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1041        small  = 1. _d -15        small  = 1. _d -15
# Line 958  C--   Calculate field range Line 1049  C--   Calculate field range
1049          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1050           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1051            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1052  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1053         &     THEN
1054              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
1055       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1056              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1057       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1058  C          ENDIF             ENDIF
1059            ENDDO            ENDDO
1060           ENDDO           ENDDO
1061          ENDDO          ENDDO
1062         ENDDO         ENDDO
1063        ENDDO        ENDDO
1064        fRange = fMax-fMin        fRange = fMax-fMin
1065        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
1066         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
1067        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
1068    
1069  C--   Write field title and statistics  C--   Write field title and statistics
1070        msgBuf = '// ======================================================='        msgBuf =
1071         & '// ======================================================='
1072        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1073       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1074        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 995  C--   Write field title and statistics Line 1088  C--   Write field title and statistics
1088       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1089        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1090       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1091        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1092           WRITE(msgBuf,'(A,1PE30.15)')
1093       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1094          ELSE
1095           WRITE(msgBuf,'(A,1PE30.15)')
1096         & '// CINT = ', 0.
1097          ENDIF
1098        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1099       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1100        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1028  C--   Write field title and statistics Line 1126  C--   Write field title and statistics
1126       &  ':',kStr,')'       &  ':',kStr,')'
1127        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1128       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1129        msgBuf = '// ======================================================='        msgBuf =
1130         & '// ======================================================='
1131        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1132       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1133    
# Line 1129  C      Header Line 1228  C      Header
1228  C      Data  C      Data
1229         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1230          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1231           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1232       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1233           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1234       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1184  C      Data Line 1283  C      Data
1283               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1284                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1285               ENDIF               ENDIF
1286               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1287       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1288       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1289         &              )+1
1290                 ELSE
1291                  IDX = 1
1292                 ENDIF
1293               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1294       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1295               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1203  C      Data Line 1306  C      Data
1306         ENDDO         ENDDO
1307        ENDIF        ENDIF
1308  C--   Write delimiter  C--   Write delimiter
1309        msgBuf = '// ======================================================='        msgBuf =
1310         & '// ======================================================='
1311        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1312       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1313        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1314         & '// END OF FIELD                                          ='
1315        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1316       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1317        msgBuf = '// ======================================================='        msgBuf =
1318         & '// ======================================================='
1319        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1320       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1321        msgBuf = ' '        msgBuf = ' '
# Line 1219  C--   Write delimiter Line 1325  C--   Write delimiter
1325        RETURN        RETURN
1326        END        END
1327    
1328  CStartOfInterface  CBOP
1329    C     !ROUTINE: PRINT_MESSAGE
1330    
1331    C     !INTERFACE:
1332        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
1333  C     /============================================================\        IMPLICIT NONE
1334  C     | SUBROUTINE PRINT_MESSAGE                                   |  C     !DESCRIPTION:
1335  C     | o Write out informational message using "standard" format. |  C     *============================================================*
1336  C     | Notes                                                      |  C     | SUBROUTINE PRINT_MESSAGE                                    
1337  C     | =====                                                      |  C     | o Write out informational message using "standard" format.  
1338  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     *============================================================*
1339  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     | Notes                                                      
1340  C     |   critical region is defined around the write here. In some|  C     | =====                                                      
1341  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     | o Some system   I/O is not "thread-safe". For this reason  
1342  C     |   for thread number 1 - writes for other threads are       |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        
1343  C     |   ignored!                                                 |  C     |   critical region is defined around the write here. In some
1344  C     | o In a non-parallel form these routines can still be used. |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes  
1345  C     |   to produce pretty printed output!                        |  C     |   for thread number 1 - writes for other threads are        
1346  C     \============================================================/  C     |   ignored!                                                  
1347    C     | o In a non-parallel form these routines can still be used.  
1348    C     |   to produce pretty printed output!                        
1349    C     *============================================================*
1350    
1351    C     !USES:
1352  C     == Global data ==  C     == Global data ==
1353  #include "SIZE.h"  #include "SIZE.h"
1354  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1355  #include "EESUPPORT.h"  #include "EESUPPORT.h"
1356          INTEGER  IFNBLNK
1357          EXTERNAL IFNBLNK
1358          INTEGER  ILNBLNK
1359          EXTERNAL ILNBLNK
1360    
1361    C     !INPUT/OUTPUT PARAMETERS:
1362  C     == Routine arguments ==  C     == Routine arguments ==
1363  C     message - Message to write  C     message :: Message to write
1364  C     unit    - Unit number to write to  C     unit    :: Unit number to write to
1365  C     sq      - Justification option  C     sq      :: Justification option
1366        CHARACTER*(*) message        CHARACTER*(*) message
1367        INTEGER       unit        INTEGER       unit
1368        CHARACTER*(*) sq        CHARACTER*(*) sq
1369        INTEGER  myThid        INTEGER  myThid
1370  CEndOfInterface  
1371        INTEGER  IFNBLNK  C     !LOCAL VARIABLES:
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1372  C     == Local variables ==  C     == Local variables ==
1373    C     iStart, iEnd :: String indexing variables
1374    C     idString     :: Temp. for building prefix.
1375        INTEGER iStart        INTEGER iStart
1376        INTEGER iEnd        INTEGER iEnd
1377        CHARACTER*9 idString        CHARACTER*9 idString
1378    CEOP
1379    
1380  C--   Find beginning and end of message  C--   Find beginning and end of message
1381        IF ( sq .EQ. SQUEEZE_BOTH .OR.        IF ( sq .EQ. SQUEEZE_BOTH .OR.
1382       &     sq .EQ. SQUEEZE_LEFT ) THEN       &     sq .EQ. SQUEEZE_LEFT ) THEN
# Line 1310  C       The write statement may need to Line 1431  C       The write statement may need to
1431  #endif  #endif
1432         ENDIF         ENDIF
1433        ENDIF        ENDIF
1434    
1435    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
1436    C--   if error message, also write directly to unit 0 :
1437          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
1438         &     .AND. unit.EQ.errorMessageUnit ) THEN
1439            iEnd   = ILNBLNK( message )
1440            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
1441          ENDIF
1442    #endif
1443  C  C
1444   1000 CONTINUE   1000 CONTINUE
1445        RETURN        RETURN
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.21
  ViewVC Help
Powered by ViewVC 1.1.22