/[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.18 by cnh, Fri Sep 21 03:54:35 2001 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 104  C Line 126  C
126        GOTO 1000        GOTO 1000
127        END        END
128    
129  CStartofinterface  CBOP
130        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, ioUnit )  C     !ROUTINE: PRINT_LIST_I
 C     /==========================================================\  
 C     | o SUBROUTINE PRINT_LIST_I                                |  
 C     |==========================================================|  
 C     | Routine for producing list of values for a field with    |  
 C     | duplicate values collected into                          |  
 C     |    n @ value                                             |  
 C     | record.                                                  |  
 C     \==========================================================/  
131    
132    C     !INTERFACE:
133          SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
134         &                         markEnd, compact, ioUnit )
135          IMPLICIT NONE
136    C     !DESCRIPTION:
137    C     *==========================================================*
138    C     | o SUBROUTINE PRINT_LIST_I                                
139    C     *==========================================================*
140    C     | Routine for producing list of values for a field with    
141    C     | duplicate values collected into                          
142    C     |    n @ value                                              
143    C     | record.                                                  
144    C     *==========================================================*
145    
146    C     !USES:
147  C     == Global data ==    C     == Global data ==  
148  #include "SIZE.h"  #include "SIZE.h"
149  #include "EEPARAMS.h"  #include "EEPARAMS.h"
150    
151    C     !INPUT/OUTPUT PARAMETERS:
152  C     == Routine arguments ==  C     == Routine arguments ==
153  C     fld    -  Data to be printed  C     fld    ::  Data to be printed
154  C     lFld   -  Number of elements to be printed  C     lFld   ::  Number of elements to be printed
155  C     index_type - Flag indicating which type of index to print  C     index_type :: Flag indicating which type of index to print
156  C                  INDEX_K    => /* K = nnn */  C                   INDEX_K    => /* K = nnn */
157  C                  INDEX_I    => /* I = nnn */  C                   INDEX_I    => /* I = nnn */
158  C                  INDEX_J    => /* J = nnn */  C                   INDEX_J    => /* J = nnn */
159  C                  INDEX_NONE =>  C                   INDEX_NONE =>
160  C     ioUnit -  Unit number for IO.  C     compact ::  Flag to control use of repeat symbol for same valued
161    C                 fields.
162    C     markEnd ::  Flag to control whether there is a separator after the
163    C                 last element
164    C     ioUnit ::   Unit number for IO.
165        INTEGER lFld        INTEGER lFld
166        INTEGER index_type        INTEGER index_type
167        INTEGER fld(lFld)        INTEGER fld(lFld)
168          LOGICAL markEnd
169          LOGICAL compact
170        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
171    
172    C     !LOCAL VARIABLES:
173  C     == Local variables ==  C     == Local variables ==
174  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
175  C     iHi    with the same value  C     iHi    with the same value
# Line 152  C     K    - Loop counter Line 188  C     K    - Loop counter
188        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
189        CHARACTER*3 index_lab        CHARACTER*3 index_lab
190        INTEGER K        INTEGER K
191    CEOP
192    
193        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
194         index_lab = 'I ='         index_lab = 'I ='
# Line 170  C     K    - Loop counter Line 207  C     K    - Loop counter
207        xOld = fld(1)        xOld = fld(1)
208        DO K=2,lFld        DO K=2,lFld
209         xNew = fld(K  )         xNew = fld(K  )
210         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
211          nDup = iHi-iLo+1          nDup = iHi-iLo+1
212          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
213           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
214           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
215       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
216         &    commOpen,index_lab,iLo,commClose
217          ELSE          ELSE
218           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
219           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
220       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
221       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 191  C     K    - Loop counter Line 229  C     K    - Loop counter
229         ENDIF         ENDIF
230        ENDDO        ENDDO
231        punc = ' '        punc = ' '
232          IF ( markEnd ) punc = ','
233        nDup = iHi-iLo+1        nDup = iHi-iLo+1
234        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
235         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
236         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
237       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
238         &  commOpen,index_lab,iLo,commClose
239        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
240         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
241         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
242       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
243       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 207  C     K    - Loop counter Line 247  C     K    - Loop counter
247        RETURN        RETURN
248        END        END
249    
250  CStartofinterface  CBOP
251        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, ioUnit )  C     !ROUTINE: PRINT_LIST_L
252  C     /==========================================================\  
253  C     | o SUBROUTINE PRINT_LIST_L                                |  C     !INTERFACE:
254  C     |==========================================================|        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
255  C     | Routine for producing list of values for a field with    |       &                         compact, ioUnit )
256  C     | duplicate values collected into                          |        IMPLICIT NONE
257  C     |    n @ value                                             |  C     !DESCRIPTION:
258  C     | record.                                                  |  C     *==========================================================*
259  C     \==========================================================/  C     | o SUBROUTINE PRINT_LIST_L                                
260    C     *==========================================================*
261    C     | Routine for producing list of values for a field with    
262    C     | duplicate values collected into                          
263    C     |    n @ value                                              
264    C     | record.                                                  
265    C     *==========================================================*
266    
267    C     !USES:
268  C     == Global data ==    C     == Global data ==  
269  #include "SIZE.h"  #include "SIZE.h"
270  #include "EEPARAMS.h"  #include "EEPARAMS.h"
271    
272    C     !INPUT/OUTPUT PARAMETERS:
273  C     == Routine arguments ==  C     == Routine arguments ==
274  C     fld    -  Data to be printed  C     fld    -  Data to be printed
275  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 230  C                  INDEX_K    => /* K = Line 278  C                  INDEX_K    => /* K =
278  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
279  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
280  C                  INDEX_NONE =>  C                  INDEX_NONE =>
281    C     compact -  Flag to control use of repeat symbol for same valued
282    C                fields.
283    C     markEnd -  Flag to control whether there is a separator after the
284    C                last element
285  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
286        INTEGER lFld        INTEGER lFld
287        INTEGER index_type        INTEGER index_type
288        LOGICAL fld(lFld)        LOGICAL fld(lFld)
289          LOGICAL markEnd
290          LOGICAL compact
291        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
292    
293    C     !LOCAL VARIABLES:
294  C     == Local variables ==  C     == Local variables ==
295  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
296  C     iHi    with the same value  C     iHi    with the same value
# Line 255  C     K    - Loop counter Line 309  C     K    - Loop counter
309        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
310        CHARACTER*3 index_lab        CHARACTER*3 index_lab
311        INTEGER K        INTEGER K
312    CEOP
313    
314        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
315         index_lab = 'I ='         index_lab = 'I ='
# Line 273  C     K    - Loop counter Line 328  C     K    - Loop counter
328        xOld = fld(1)        xOld = fld(1)
329        DO K=2,lFld        DO K=2,lFld
330         xNew = fld(K  )         xNew = fld(K  )
331         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
332          nDup = iHi-iLo+1          nDup = iHi-iLo+1
333          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
334           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
335           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
336       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
337         &    commOpen,index_lab,iLo,commClose
338          ELSE          ELSE
339           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
340           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
341       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
342       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 294  C     K    - Loop counter Line 350  C     K    - Loop counter
350         ENDIF         ENDIF
351        ENDDO        ENDDO
352        punc = ' '        punc = ' '
353          IF ( markEnd ) punc = ','
354        nDup = iHi-iLo+1        nDup = iHi-iLo+1
355        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
356         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
357         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
358       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
359         &    commOpen,index_lab,iLo,commClose
360        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
361         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
362         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
363       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
364       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 310  C     K    - Loop counter Line 368  C     K    - Loop counter
368        RETURN        RETURN
369        END        END
370    
371  CStartofinterface  CBOP
372        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )  C     !ROUTINE: PRINT_LIST_R8
373  C     /==========================================================\  C     !INTERFACE:
374  C     | o SUBROUTINE PRINT_LIST_R8                               |        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
375  C     |==========================================================|       &    markEnd, compact, ioUnit )
376  C     | Routine for producing list of values for a field with    |        IMPLICIT NONE
377  C     | duplicate values collected into                          |  C     !DESCRIPTION:
378  C     |    n @ value                                             |  C     *==========================================================*
379  C     | record.                                                  |  C     | o SUBROUTINE PRINT_LIST_R8                                
380  C     \==========================================================/  C     *==========================================================*
381    C     | Routine for producing list of values for a field with    
382    C     | duplicate values collected into                          
383    C     |    n @ value                                              
384    C     | record.                                                  
385    C     *==========================================================*
386    
387  C     == Global data ==    C     !USES:
388    C     == Global data ==
389  #include "SIZE.h"  #include "SIZE.h"
390  #include "EEPARAMS.h"  #include "EEPARAMS.h"
391    
392    C     !INPUT/OUTPUT PARAMETERS:
393  C     == Routine arguments ==  C     == Routine arguments ==
394  C     fld    -  Data to be printed  C     fld    -  Data to be printed
395  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 333  C                  INDEX_K    => /* K = Line 398  C                  INDEX_K    => /* K =
398  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
399  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
400  C                  INDEX_NONE =>  C                  INDEX_NONE =>
401    C     compact -  Flag to control use of repeat symbol for same valued
402    C                fields.
403    C     markEnd -  Flag to control whether there is a separator after the
404    C                last element
405  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
406        INTEGER lFld        INTEGER lFld
407        INTEGER index_type        INTEGER index_type
408        Real*8  fld(lFld)        Real*8  fld(lFld)
409          LOGICAL markEnd
410          LOGICAL compact
411        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
412    
413    C     !LOCA VARIABLES:
414  C     == Local variables ==  C     == Local variables ==
415  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
416  C     iHi    with the same value  C     iHi    with the same value
# Line 358  C     K    - Loop counter Line 429  C     K    - Loop counter
429        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
430        CHARACTER*3 index_lab        CHARACTER*3 index_lab
431        INTEGER K        INTEGER K
432    CEOP
433    
434        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
435         index_lab = 'I ='         index_lab = 'I ='
# Line 376  C     K    - Loop counter Line 448  C     K    - Loop counter
448        xOld = fld(1)        xOld = fld(1)
449        DO K=2,lFld        DO K=2,lFld
450         xNew = fld(K  )         xNew = fld(K  )
451         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
452          nDup = iHi-iLo+1          nDup = iHi-iLo+1
453          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
454           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
455           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
456       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
457         &    commOpen,index_lab,iLo,commClose
458          ELSE          ELSE
459           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
460           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
461       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
462       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
463          ENDIF          ENDIF
464          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
465         &    SQUEEZE_RIGHT , 1)
466          iLo  = K          iLo  = K
467          iHi  = K          iHi  = K
468          xOld = xNew          xOld = xNew
# Line 397  C     K    - Loop counter Line 471  C     K    - Loop counter
471         ENDIF         ENDIF
472        ENDDO        ENDDO
473        punc = ' '        punc = ' '
474          IF ( markEnd ) punc = ','
475        nDup = iHi-iLo+1        nDup = iHi-iLo+1
476        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
477         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
478         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
479       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
480         &    commOpen,index_lab,iLo,commClose
481        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
482         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
483         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
484       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
485       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
486        ENDIF        ENDIF
487        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
488         &    SQUEEZE_RIGHT , 1)
489    
490        RETURN        RETURN
491        END        END
492    
493  CStartOfInterface  CBOP
494        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,  C     !ROUTINE: PRINT_MAPRS
495    C     !INTERFACE:
496          SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
497       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
498       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
499       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
500       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
501       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
502       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
503  C     /==========================================================\        IMPLICIT NONE
504  C     | SUBROUTINE PRINT_MAPR4                                   |  C     !DESCRIPTION:
505  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
506  C     |==========================================================|  C     | SUBROUTINE PRINT_MAPR4                                    
507  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.              
508  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
509  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data      
510  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the    
511  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.      
512  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like          
513  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.    
514  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation    
515  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the    
516  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the  
517  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)    
518  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for    
519  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.  
520  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).  
521  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
522  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.    
523  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr    
524    C     |      and jMin:jMax step jStr.                            
525    C     *==========================================================*
526    
527    C     !USES:
528  C     == Global variables ==  C     == Global variables ==
529  #include "SIZE.h"  #include "SIZE.h"
530  #include "EEPARAMS.h"  #include "EEPARAMS.h"
531  #include "EESUPPORT.h"  #include "EESUPPORT.h"
532          INTEGER  IFNBLNK
533          EXTERNAL IFNBLNK
534          INTEGER  ILNBLNK
535          EXTERNAL ILNBLNK
536    
537    C     !INPUT/OUTPUT PARAMETERS:
538  C     == Routine arguments ==  C     == Routine arguments ==
539  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
540  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 469  C     kStr Line 556  C     kStr
556        INTEGER jLo, jHi        INTEGER jLo, jHi
557        INTEGER kLo, kHi        INTEGER kLo, kHi
558        INTEGER nBx, nBy        INTEGER nBx, nBy
559        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
560        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
561        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
562        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
563        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
564        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
565    
566    C     !LOCAL VARIABLES:
567  C     == Local variables ==  C     == Local variables ==
568  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
569  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 511  C               Str  - stride within blo Line 593  C               Str  - stride within blo
593        INTEGER lChList        INTEGER lChList
594        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
595        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
596        REAL fMin        _RL  fMin
597        REAL fMax        _RL  fMax
598        REAL fRange        _RL  fRange
599        REAL val        _RL  val
600        REAL small        _RL  small
601        CHARACTER*2  accLab        CHARACTER*2  accLab
602        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
603        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 530  C               Str  - stride within blo Line 612  C               Str  - stride within blo
612        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
613        INTEGER bi, bj, bk        INTEGER bi, bj, bk
614        LOGICAL validRange        LOGICAL validRange
615    CEOP
616    
617        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
618        small  = 1. _d -15        small  =  1. _d -15
619        fMin   =  1. _d 32        fMin   =  1. _d  32
620        fMax   = -1. _d 32        fMax   = -1. _d  32
621        validRange = .FALSE.        validRange = .FALSE.
622    
623  C--   Calculate field range  C--   Calculate field range
# Line 543  C--   Calculate field range Line 626  C--   Calculate field range
626          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
627           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
628            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
629             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
630              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
631       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
632              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 560  C--   Calculate field range Line 643  C--   Calculate field range
643        ENDIF        ENDIF
644    
645  C--   Write field title and statistics  C--   Write field title and statistics
646        msgBuf = '// ======================================================='        msgBuf =
647         & '// ======================================================='
648        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
649       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
650        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 580  C--   Write field title and statistics Line 664  C--   Write field title and statistics
664       & '// CMAX = ', fMax       & '// CMAX = ', fMax
665        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
666       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
667        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
668       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
669         &  '// CINT = ', fRange/FLOAT(lChlist-1)
670          ELSE
671           WRITE(msgBuf,'(A,1PE30.15)')
672         &  '// CINT = ', 0.
673          ENDIF
674        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
675       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
676        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 613  C--   Write field title and statistics Line 702  C--   Write field title and statistics
702       &  ':',kStr,')'       &  ':',kStr,')'
703        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
704       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
705        msgBuf = '// ======================================================='        msgBuf =
706         & '// ======================================================='
707        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
708       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
709    
# Line 709  C      X across, Z down slice Line 799  C      X across, Z down slice
799         pltStep = sNy         pltStep = sNy
800         pltLab  = 'J ='         pltLab  = 'J ='
801        ENDIF        ENDIF
802        IF ( validRange ) THEN  C     IF ( validRange ) THEN
803  C      Header  C      Header
804  C      Data  C      Data
805         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
806          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
807           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
808       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
809           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
810       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 771  C      Data Line 861  C      Data
861               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
862                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
863               ENDIF               ENDIF
864               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
865                  IDX = NINT(
866       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
867       &             )+1       &             )+1
868                 ELSE
869                  IDX = 1
870                 ENDIF
871               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
872       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
873               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 789  C      Data Line 883  C      Data
883           ENDDO           ENDDO
884          ENDDO          ENDDO
885         ENDDO         ENDDO
886        ENDIF  C     ENDIF
887  C--   Write delimiter  C--   Write delimiter
888        msgBuf = '// ======================================================='        msgBuf =
889         & '// ======================================================='
890        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
891       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
892        msgBuf = '// END OF FIELD                                          ='        msgBuf =
893         & '// END OF FIELD                                          ='
894        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
895       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
896        msgBuf = '// ======================================================='        msgBuf =
897         & '// ======================================================='
898        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
899       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
900        msgBuf = ' '        msgBuf = ' '
# Line 807  C--   Write delimiter Line 904  C--   Write delimiter
904        RETURN        RETURN
905        END        END
906    
907  CStartOfInterface  CBOP
908        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,  C     !ROUTINE: PRINT_MAPRL
909    
910    C     !INTERFACE:
911          SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
912       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
913       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
914       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
915       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
916       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
917       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
918  C     /==========================================================\        IMPLICIT NONE
919  C     | SUBROUTINE PRINT_MAPR8                                   |  
920  C     | o Does textual mapping printing of a field.              |  C     !DESCRIPTION:
921  C     |==========================================================|  C     *==========================================================*
922  C     | This routine does the actual formatting of the data      |  C     | SUBROUTINE PRINT_MAPRL                                    
923  C     | and printing to a file. It assumes an array using the    |  C     | o Does textual mapping printing of a field.              
924  C     | MITgcm UV indexing scheme and base index variables.      |  C     *==========================================================*
925  C     | User code should call an interface routine like          |  C     | This routine does the actual formatting of the data      
926  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  C     | and printing to a file. It assumes an array using the    
927  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | MITgcm UV indexing scheme and base index variables.      
928  C     | is specficied through the "plotMode" argument. All the   |  C     | User code should call an interface routine like          
929  C     | plots made by a single call to this routine will use the |  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.    
930  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | Text plots can be oriented XY, YZ, XZ. An orientation    
931  C     | can be three-dimensional. A separate plot is made for    |  C     | is specficied through the "plotMode" argument. All the    
932  C     | each point in the plot range normal to the orientation.  |  C     | plots made by a single call to this routine will use the  
933  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | same contour interval. The plot range (iMin,...,byStr)    
934  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | can be three-dimensional. A separate plot is made for    
935  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.  
936  C     |      Each plot would have extents iMin:iMax step iStr    |  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).  
937  C     |      and jMin:jMax step jStr.                            |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
938  C     \==========================================================/  C     |      plots - one for K=1, one for K=3 and one for K=5.    
939    C     |      Each plot would have extents iMin:iMax step iStr    
940    C     |      and jMin:jMax step jStr.                            
941    C     *==========================================================*
942          IMPLICIT NONE
943    
944    C     !USES:
945  C     == Global variables ==  C     == Global variables ==
946  #include "SIZE.h"  #include "SIZE.h"
947  #include "EEPARAMS.h"  #include "EEPARAMS.h"
948  #include "EESUPPORT.h"  #include "EESUPPORT.h"
949          INTEGER  IFNBLNK
950          EXTERNAL IFNBLNK
951          INTEGER  ILNBLNK
952          EXTERNAL ILNBLNK
953    
954    C     !INPUT/OUTPUT PARAMETERS:
955  C     == Routine arguments ==  C     == Routine arguments ==
956  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
957  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 863  C     kStr Line 973  C     kStr
973        INTEGER jLo, jHi        INTEGER jLo, jHi
974        INTEGER kLo, kHi        INTEGER kLo, kHi
975        INTEGER nBx, nBy        INTEGER nBx, nBy
976        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
977        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
978        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
979        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
980        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
981        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
982    
983    C     !LOCAL VARIABLES:
984  C     == Local variables ==  C     == Local variables ==
985  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
986  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 905  C               Str  - stride within blo Line 1010  C               Str  - stride within blo
1010        INTEGER lChList        INTEGER lChList
1011        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1012        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1013        REAL fMin        _RL  fMin
1014        REAL fMax        _RL  fMax
1015        REAL fRange        _RL  fRange
1016        REAL val        _RL  val
1017        REAL small        _RL  small
1018        CHARACTER*2  accLab        CHARACTER*2  accLab
1019        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1020        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 924  C               Str  - stride within blo Line 1029  C               Str  - stride within blo
1029        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1030        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1031        LOGICAL validRange        LOGICAL validRange
1032    CEOP
1033    
1034        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1035        small  = 1. _d -15        small  = 1. _d -15
# Line 937  C--   Calculate field range Line 1043  C--   Calculate field range
1043          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1044           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1045            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1046  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1047         &     THEN
1048              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
1049       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1050              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1051       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1052  C          ENDIF             ENDIF
1053            ENDDO            ENDDO
1054           ENDDO           ENDDO
1055          ENDDO          ENDDO
# Line 954  C          ENDIF Line 1061  C          ENDIF
1061        ENDIF        ENDIF
1062    
1063  C--   Write field title and statistics  C--   Write field title and statistics
1064        msgBuf = '// ======================================================='        msgBuf =
1065         & '// ======================================================='
1066        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1067       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1068        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 974  C--   Write field title and statistics Line 1082  C--   Write field title and statistics
1082       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1083        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1084       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1085        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1086           WRITE(msgBuf,'(A,1PE30.15)')
1087       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1088          ELSE
1089           WRITE(msgBuf,'(A,1PE30.15)')
1090         & '// CINT = ', 0.
1091          ENDIF
1092        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1093       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1094        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1007  C--   Write field title and statistics Line 1120  C--   Write field title and statistics
1120       &  ':',kStr,')'       &  ':',kStr,')'
1121        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1122       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1123        msgBuf = '// ======================================================='        msgBuf =
1124         & '// ======================================================='
1125        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1126       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1127    
# Line 1103  C      X across, Z down slice Line 1217  C      X across, Z down slice
1217         pltStep = sNy         pltStep = sNy
1218         pltLab  = 'J ='         pltLab  = 'J ='
1219        ENDIF        ENDIF
1220        IF ( validRange ) THEN  C     IF ( validRange ) THEN
1221  C      Header  C      Header
1222  C      Data  C      Data
1223         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1224          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1225           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1226       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1227           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1228       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1163  C      Data Line 1277  C      Data
1277               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1278                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1279               ENDIF               ENDIF
1280               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1281       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1282       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1283         &              )+1
1284                 ELSE
1285                  IDX = 1
1286                 ENDIF
1287               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1288       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1289               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1180  C      Data Line 1298  C      Data
1298           ENDDO           ENDDO
1299          ENDDO          ENDDO
1300         ENDDO         ENDDO
1301        ENDIF  C     ENDIF
1302  C--   Write delimiter  C--   Write delimiter
1303        msgBuf = '// ======================================================='        msgBuf =
1304         & '// ======================================================='
1305        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1306       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1307        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1308         & '// END OF FIELD                                          ='
1309        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1310       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1311        msgBuf = '// ======================================================='        msgBuf =
1312         & '// ======================================================='
1313        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1314       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1315        msgBuf = ' '        msgBuf = ' '
# Line 1198  C--   Write delimiter Line 1319  C--   Write delimiter
1319        RETURN        RETURN
1320        END        END
1321    
1322  CStartOfInterface  CBOP
1323    C     !ROUTINE: PRINT_MESSAGE
1324    
1325    C     !INTERFACE:
1326        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
1327  C     /============================================================\        IMPLICIT NONE
1328  C     | SUBROUTINE PRINT_MESSAGE                                   |  C     !DESCRIPTION:
1329  C     | o Write out informational message using "standard" format. |  C     *============================================================*
1330  C     | Notes                                                      |  C     | SUBROUTINE PRINT_MESSAGE                                    
1331  C     | =====                                                      |  C     | o Write out informational message using "standard" format.  
1332  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     *============================================================*
1333  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     | Notes                                                      
1334  C     |   critical region is defined around the write here. In some|  C     | =====                                                      
1335  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     | o Some system   I/O is not "thread-safe". For this reason  
1336  C     |   for thread number 1 - writes for other threads are       |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        
1337  C     |   ignored!                                                 |  C     |   critical region is defined around the write here. In some
1338  C     | o In a non-parallel form these routines can still be used. |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes  
1339  C     |   to produce pretty printed output!                        |  C     |   for thread number 1 - writes for other threads are        
1340  C     \============================================================/  C     |   ignored!                                                  
1341    C     | o In a non-parallel form these routines can still be used.  
1342    C     |   to produce pretty printed output!                        
1343    C     *============================================================*
1344    
1345    C     !USES:
1346  C     == Global data ==  C     == Global data ==
1347  #include "SIZE.h"  #include "SIZE.h"
1348  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1349  #include "EESUPPORT.h"  #include "EESUPPORT.h"
1350          INTEGER  IFNBLNK
1351          EXTERNAL IFNBLNK
1352          INTEGER  ILNBLNK
1353          EXTERNAL ILNBLNK
1354    
1355    C     !INPUT/OUTPUT PARAMETERS:
1356  C     == Routine arguments ==  C     == Routine arguments ==
1357  C     message - Message to write  C     message :: Message to write
1358  C     unit    - Unit number to write to  C     unit    :: Unit number to write to
1359  C     sq      - Justification option  C     sq      :: Justification option
1360        CHARACTER*(*) message        CHARACTER*(*) message
1361        INTEGER       unit        INTEGER       unit
1362        CHARACTER*(*) sq        CHARACTER*(*) sq
1363        INTEGER  myThid        INTEGER  myThid
1364  CEndOfInterface  
1365        INTEGER  IFNBLNK  C     !LOCAL VARIABLES:
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1366  C     == Local variables ==  C     == Local variables ==
1367    C     iStart, iEnd :: String indexing variables
1368    C     idString     :: Temp. for building prefix.
1369        INTEGER iStart        INTEGER iStart
1370        INTEGER iEnd        INTEGER iEnd
1371        CHARACTER*9 idString        CHARACTER*9 idString
1372    CEOP
1373    
1374  C--   Find beginning and end of message  C--   Find beginning and end of message
1375        IF ( sq .EQ. SQUEEZE_BOTH .OR.        IF ( sq .EQ. SQUEEZE_BOTH .OR.
1376       &     sq .EQ. SQUEEZE_LEFT ) THEN       &     sq .EQ. SQUEEZE_LEFT ) THEN
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22