/[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.4 by cnh, Sun Apr 26 23:41:54 1998 UTC revision 1.25 by jmc, Sat Sep 2 22:47:10 2006 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 6  C--   File printf.F: Routines for perfor Line 7  C--   File printf.F: Routines for perfor
7  C--                  in the MITgcm UV implementation environment.  C--                  in the MITgcm UV implementation environment.
8  C--    Contents  C--    Contents
9  C--    o print_error    Does IO with **ERROR** highlighted header  C--    o print_error    Does IO with **ERROR** highlighted header
10    C--    o print_list_i   Prints one-deimensional list of INTEGER
11    C--                     numbers.
12    C--    o print_list_l   Prints one-deimensional list of LOGICAL
13    C--                     variables.
14  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--    o print_list_r8  Prints one-deimensional list of Real*8
15  C--                     numbers.  C--                     numbers.
16  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field
# Line 14  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 56  C--    Write single process format Line 81  C--    Write single process format
81         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
82          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
83         ELSE         ELSE
84          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
85         &   message(iStart:iEnd)
86         ENDIF         ENDIF
87        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSE
 C--    Write multi-process format  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _BEGIN_CRIT(myThid)  
 #endif  
         WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _END_CRIT(myThid)  
 #endif  
        IF ( message .EQ. ' ' ) THEN  
88  C       PRINT_ERROR can be called by several threads simulataneously.  C       PRINT_ERROR can be called by several threads simulataneously.
89  C       The write statement may need to be marked as a critical section.  C       The write statement may need to be marked as a critical section.
90  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
91          _BEGIN_CRIT(myThid)  # ifdef USE_OMP_THREADING
92  #endif  C$OMP CRITICAL
93          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')  # else
94       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',         _BEGIN_CRIT(myThid)
95       &  ' '  # endif
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
96  #endif  #endif
97         ELSE         IF ( pidIO .EQ. myProcId ) THEN
98  #ifndef FMTFTN_IO_THREAD_SAFE  C--    Write multi-process format
99          _BEGIN_CRIT(myThid)           WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
100    
101             IF ( iEnd.EQ.0 ) THEN
102    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
103              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
104         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
105         &    ' '
106             ELSE
107    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
108              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
109         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
110         &    message(iStart:iEnd)
111             ENDIF
112           ENDIF
113    
114    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
115    C--    also write directly to unit 0 :
116           IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN
117            IF ( nThreads.LE.1 ) THEN
118              WRITE(0,'(A)') message(1:iEnd)
119            ELSE
120              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
121         &                   message(1:iEnd)
122            ENDIF
123           ENDIF
124  #endif  #endif
125          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')  
      &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',  
      &  message(iStart:iEnd)  
126  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
127    # ifdef USE_OMP_THREADING
128    C$OMP END CRITICAL
129    # else
130          _END_CRIT(myThid)          _END_CRIT(myThid)
131    # endif
132  #endif  #endif
133          ENDIF
134    
135     1000 CONTINUE
136          RETURN
137    
138    c 999 CONTINUE
139    c      ioErrorCount(myThid) = ioErrorCount(myThid)+1
140    c     GOTO 1000
141          END
142    
143    CBOP
144    C     !ROUTINE: PRINT_LIST_I
145    
146    C     !INTERFACE:
147          SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
148         &                         markEnd, compact, ioUnit )
149          IMPLICIT NONE
150    C     !DESCRIPTION:
151    C     *==========================================================*
152    C     | o SUBROUTINE PRINT\_LIST\_I                                
153    C     *==========================================================*
154    C     | Routine for producing list of values for a field with    
155    C     | duplicate values collected into                          
156    C     |    n \@ value                                              
157    C     | record.                                                  
158    C     *==========================================================*
159    
160    C     !USES:
161    C     == Global data ==  
162    #include "SIZE.h"
163    #include "EEPARAMS.h"
164    
165    C     !INPUT/OUTPUT PARAMETERS:
166    C     == Routine arguments ==
167    C     fld    ::  Data to be printed
168    C     lFld   ::  Number of elements to be printed
169    C     index_type :: Flag indicating which type of index to print
170    C                   INDEX_K    => /* K = nnn */
171    C                   INDEX_I    => /* I = nnn */
172    C                   INDEX_J    => /* J = nnn */
173    C                   INDEX_NONE =>
174    C     compact ::  Flag to control use of repeat symbol for same valued
175    C                 fields.
176    C     markEnd ::  Flag to control whether there is a separator after the
177    C                 last element
178    C     ioUnit ::   Unit number for IO.
179          INTEGER lFld
180          INTEGER index_type
181          INTEGER fld(lFld)
182          LOGICAL markEnd
183          LOGICAL compact
184          INTEGER ioUnit
185    
186    C     !LOCAL VARIABLES:
187    C     == Local variables ==
188    C     iLo  - Range index holders for selecting elements with
189    C     iHi    with the same value
190    C     nDup - Number of duplicates
191    C     xNew, xOld - Hold current and previous values of field
192    C     punc - Field separator
193    C     msgBuf - IO buffer
194    C     index_lab - Index for labelling elements
195    C     K    - Loop counter
196          INTEGER iLo
197          INTEGER iHi
198          INTEGER nDup
199          INTEGER xNew, xOld
200          CHARACTER punc
201          CHARACTER*(MAX_LEN_MBUF) msgBuf
202          CHARACTER*2 commOpen,commClose
203          CHARACTER*3 index_lab
204          INTEGER K
205    CEOP
206    
207          IF     ( index_type .EQ. INDEX_I ) THEN
208           index_lab = 'I ='
209          ELSEIF ( index_type .EQ. INDEX_J ) THEN
210           index_lab = 'J ='
211          ELSEIF ( index_type .EQ. INDEX_K ) THEN
212           index_lab = 'K ='
213          ELSE
214           index_lab = '?='
215          ENDIF
216          commOpen  = '/*'
217          commClose = '*/'
218          iLo = 1
219          iHi = 1
220          punc = ','
221          xOld = fld(1)
222          DO K=2,lFld
223           xNew = fld(K  )
224           IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
225            nDup = iHi-iLo+1
226            IF ( nDup .EQ. 1 ) THEN
227             WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
228             IF ( index_type .NE. INDEX_NONE )
229         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
230         &    commOpen,index_lab,iLo,commClose
231            ELSE
232             WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
233             IF ( index_type .NE. INDEX_NONE )
234         &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
235         &    commOpen,index_lab,iLo,':',iHi,commClose
236            ENDIF
237            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
238            iLo  = K
239            iHi  = K
240            xOld = xNew
241           ELSE
242            iHi = K
243         ENDIF         ENDIF
244          ENDDO
245          punc = ' '
246          IF ( markEnd ) punc = ','
247          nDup = iHi-iLo+1
248          IF    ( nDup .EQ. 1 ) THEN
249           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
250           IF ( index_type .NE. INDEX_NONE )
251         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
252         &  commOpen,index_lab,iLo,commClose
253          ELSEIF( nDup .GT. 1 ) THEN
254           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
255           IF ( index_type .NE. INDEX_NONE )
256         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
257         &  commOpen,index_lab,iLo,':',iHi,commClose
258        ENDIF        ENDIF
259  C        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
260    
261        RETURN        RETURN
262        END        END
263    
264  CStartofinterface  CBOP
265        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )  C     !ROUTINE: PRINT_LIST_L
266  CEndifinterface  
267  C     /==========================================================\  C     !INTERFACE:
268  C     | o SUBROUTINE PRINT_LIST_R8                               |        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
269  C     |==========================================================|       &                         compact, ioUnit )
270  C     | Routine for producing list of values for a field with    |        IMPLICIT NONE
271  C     | duplicate values collected into                          |  C     !DESCRIPTION:
272  C     |    n @ value                                             |  C     *==========================================================*
273  C     | record.                                                  |  C     | o SUBROUTINE PRINT\_LIST\_L                                
274  C     \==========================================================/  C     *==========================================================*
275    C     | Routine for producing list of values for a field with    
276    C     | duplicate values collected into                          
277    C     |    n \@ value                                              
278    C     | record.                                                  
279    C     *==========================================================*
280    
281    C     !USES:
282  C     == Global data ==    C     == Global data ==  
283  #include "SIZE.h"  #include "SIZE.h"
284  #include "EEPARAMS.h"  #include "EEPARAMS.h"
285    
286    C     !INPUT/OUTPUT PARAMETERS:
287  C     == Routine arguments ==  C     == Routine arguments ==
288  C     fld    -  Data to be printed  C     fld    -  Data to be printed
289  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 119  C                  INDEX_K    => /* K = Line 292  C                  INDEX_K    => /* K =
292  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
293  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
294  C                  INDEX_NONE =>  C                  INDEX_NONE =>
295    C     compact -  Flag to control use of repeat symbol for same valued
296    C                fields.
297    C     markEnd -  Flag to control whether there is a separator after the
298    C                last element
299    C     ioUnit -  Unit number for IO.
300          INTEGER lFld
301          INTEGER index_type
302          LOGICAL fld(lFld)
303          LOGICAL markEnd
304          LOGICAL compact
305          INTEGER ioUnit
306    
307    C     !LOCAL VARIABLES:
308    C     == Local variables ==
309    C     iLo  - Range index holders for selecting elements with
310    C     iHi    with the same value
311    C     nDup - Number of duplicates
312    C     xNew, xOld - Hold current and previous values of field
313    C     punc - Field separator
314    C     msgBuf - IO buffer
315    C     index_lab - Index for labelling elements
316    C     K    - Loop counter
317          INTEGER iLo
318          INTEGER iHi
319          INTEGER nDup
320          LOGICAL xNew, xOld
321          CHARACTER punc
322          CHARACTER*(MAX_LEN_MBUF) msgBuf
323          CHARACTER*2 commOpen,commClose
324          CHARACTER*3 index_lab
325          INTEGER K
326    CEOP
327    
328          IF     ( index_type .EQ. INDEX_I ) THEN
329           index_lab = 'I ='
330          ELSEIF ( index_type .EQ. INDEX_J ) THEN
331           index_lab = 'J ='
332          ELSEIF ( index_type .EQ. INDEX_K ) THEN
333           index_lab = 'K ='
334          ELSE
335           index_lab = '?='
336          ENDIF
337          commOpen  = '/*'
338          commClose = '*/'
339          iLo = 1
340          iHi = 1
341          punc = ','
342          xOld = fld(1)
343          DO K=2,lFld
344           xNew = fld(K  )
345           IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
346            nDup = iHi-iLo+1
347            IF ( nDup .EQ. 1 ) THEN
348             WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
349             IF ( index_type .NE. INDEX_NONE )
350         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
351         &    commOpen,index_lab,iLo,commClose
352            ELSE
353             WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
354             IF ( index_type .NE. INDEX_NONE )
355         &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
356         &    commOpen,index_lab,iLo,':',iHi,commClose
357            ENDIF
358            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
359            iLo  = K
360            iHi  = K
361            xOld = xNew
362           ELSE
363            iHi = K
364           ENDIF
365          ENDDO
366          punc = ' '
367          IF ( markEnd ) punc = ','
368          nDup = iHi-iLo+1
369          IF    ( nDup .EQ. 1 ) THEN
370           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
371           IF ( index_type .NE. INDEX_NONE )
372         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
373         &    commOpen,index_lab,iLo,commClose
374          ELSEIF( nDup .GT. 1 ) THEN
375           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
376           IF ( index_type .NE. INDEX_NONE )
377         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
378         &  commOpen,index_lab,iLo,':',iHi,commClose
379          ENDIF
380          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
381    
382          RETURN
383          END
384    
385    CBOP
386    C     !ROUTINE: PRINT_LIST_R8
387    C     !INTERFACE:
388          SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
389         &    markEnd, compact, ioUnit )
390          IMPLICIT NONE
391    C     !DESCRIPTION:
392    C     *==========================================================*
393    C     | o SUBROUTINE PRINT\_LIST\_R8                                
394    C     *==========================================================*
395    C     | Routine for producing list of values for a field with    
396    C     | duplicate values collected into                          
397    C     |    n \@ value                                              
398    C     | record.                                                  
399    C     *==========================================================*
400    
401    C     !USES:
402    C     == Global data ==
403    #include "SIZE.h"
404    #include "EEPARAMS.h"
405    
406    C     !INPUT/OUTPUT PARAMETERS:
407    C     == Routine arguments ==
408    C     fld    -  Data to be printed
409    C     lFld   -  Number of elements to be printed
410    C     index_type - Flag indicating which type of index to print
411    C                  INDEX_K    => /* K = nnn */
412    C                  INDEX_I    => /* I = nnn */
413    C                  INDEX_J    => /* J = nnn */
414    C                  INDEX_NONE =>
415    C     compact -  Flag to control use of repeat symbol for same valued
416    C                fields.
417    C     markEnd -  Flag to control whether there is a separator after the
418    C                last element
419  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
420        INTEGER lFld        INTEGER lFld
421        INTEGER index_type        INTEGER index_type
422        Real*8  fld(lFld)        Real*8  fld(lFld)
423          LOGICAL markEnd
424          LOGICAL compact
425        INTEGER ioUnit        INTEGER ioUnit
426    
427    C     !LOCA VARIABLES:
428  C     == Local variables ==  C     == Local variables ==
429  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
430  C     iHi    with the same value  C     iHi    with the same value
# Line 139  C     K    - Loop counter Line 439  C     K    - Loop counter
439        INTEGER nDup        INTEGER nDup
440        Real*8 xNew, xOld        Real*8 xNew, xOld
441        CHARACTER punc        CHARACTER punc
442        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
443        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
444        CHARACTER*3 index_lab        CHARACTER*3 index_lab
445        INTEGER K        INTEGER K
446    CEOP
447    
448        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
449         index_lab = 'I ='         index_lab = 'I ='
# Line 161  C     K    - Loop counter Line 462  C     K    - Loop counter
462        xOld = fld(1)        xOld = fld(1)
463        DO K=2,lFld        DO K=2,lFld
464         xNew = fld(K  )         xNew = fld(K  )
465         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
466          nDup = iHi-iLo+1          nDup = iHi-iLo+1
467          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
468           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
469           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
470       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
471         &    commOpen,index_lab,iLo,commClose
472          ELSE          ELSE
473           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
474           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
475       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
476       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
477          ENDIF          ENDIF
478          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
479         &    SQUEEZE_RIGHT , 1)
480          iLo  = K          iLo  = K
481          iHi  = K          iHi  = K
482          xOld = xNew          xOld = xNew
# Line 182  C     K    - Loop counter Line 485  C     K    - Loop counter
485         ENDIF         ENDIF
486        ENDDO        ENDDO
487        punc = ' '        punc = ' '
488          IF ( markEnd ) punc = ','
489        nDup = iHi-iLo+1        nDup = iHi-iLo+1
490        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
491         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
492         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
493       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
494         &    commOpen,index_lab,iLo,commClose
495        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
496         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
497         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
498       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
499       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
500        ENDIF        ENDIF
501        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
502         &    SQUEEZE_RIGHT , 1)
503    
504        RETURN        RETURN
505        END        END
506    
507  CStartOfInterface  CBOP
508        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,  C     !ROUTINE: PRINT_MAPRS
509    C     !INTERFACE:
510          SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
511       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
512       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
513       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
514       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
515       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
516       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
517  C     /==========================================================\        IMPLICIT NONE
518  C     | SUBROUTINE PRINT_MAPR4                                   |  C     !DESCRIPTION:
519  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
520  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPR4                                    
521  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.              
522  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
523  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data      
524  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the    
525  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.      
526  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like          
527  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYR4( ... ) rather than this code directly.    
528  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation    
529  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the    
530  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the  
531  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)    
532  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for    
533  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.  
534  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).  
535  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
536  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.    
537  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr    
538    C     |      and jMin:jMax step jStr.                            
539    C     *==========================================================*
540    
541    C     !USES:
542  C     == Global variables ==  C     == Global variables ==
543  #include "SIZE.h"  #include "SIZE.h"
544  #include "EEPARAMS.h"  #include "EEPARAMS.h"
545  #include "EESUPPORT.h"  #include "EESUPPORT.h"
546          INTEGER  IFNBLNK
547          EXTERNAL IFNBLNK
548          INTEGER  ILNBLNK
549          EXTERNAL ILNBLNK
550    
551    C     !INPUT/OUTPUT PARAMETERS:
552  C     == Routine arguments ==  C     == Routine arguments ==
553  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
554  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 254  C     kStr Line 570  C     kStr
570        INTEGER jLo, jHi        INTEGER jLo, jHi
571        INTEGER kLo, kHi        INTEGER kLo, kHi
572        INTEGER nBx, nBy        INTEGER nBx, nBy
573        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
574        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
575        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
576        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
577        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
578        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
579    
580    C     !LOCAL VARIABLES:
581  C     == Local variables ==  C     == Local variables ==
582  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
583  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 296  C               Str  - stride within blo Line 607  C               Str  - stride within blo
607        INTEGER lChList        INTEGER lChList
608        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
609        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
610        REAL fMin        _RL  fMin
611        REAL fMax        _RL  fMax
612        REAL fRange        _RL  fRange
613        REAL val        _RL  val
614        REAL small        _RL  small
615        CHARACTER*2  accLab        CHARACTER*2  accLab
616        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
617        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 315  C               Str  - stride within blo Line 626  C               Str  - stride within blo
626        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
627        INTEGER bi, bj, bk        INTEGER bi, bj, bk
628        LOGICAL validRange        LOGICAL validRange
629    CEOP
630    
631        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
632        small  = 1. _d -15        small  =  1. _d -15
633        fMin   =  1. _d 32        fMin   =  1. _d  32
634        fMax   = -1. _d 32        fMax   = -1. _d  32
635        validRange = .FALSE.        validRange = .FALSE.
636    
637  C--   Calculate field range  C--   Calculate field range
# Line 328  C--   Calculate field range Line 640  C--   Calculate field range
640          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
641           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
642            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
643             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
644              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
645       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
646              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 340  C--   Calculate field range Line 652  C--   Calculate field range
652         ENDDO         ENDDO
653        ENDDO        ENDDO
654        fRange = fMax-fMin        fRange = fMax-fMin
655        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
656         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
657        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
658    
659  C--   Write field title and statistics  C--   Write field title and statistics
660        msgBuf = '// ======================================================='        msgBuf =
661         & '// ======================================================='
662        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
663       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
664        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 365  C--   Write field title and statistics Line 678  C--   Write field title and statistics
678       & '// CMAX = ', fMax       & '// CMAX = ', fMax
679        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
680       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
681        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
682       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
683         &  '// CINT = ', fRange/FLOAT(lChlist-1)
684          ELSE
685           WRITE(msgBuf,'(A,1PE30.15)')
686         &  '// CINT = ', 0.
687          ENDIF
688        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
689       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
690        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 398  C--   Write field title and statistics Line 716  C--   Write field title and statistics
716       &  ':',kStr,')'       &  ':',kStr,')'
717        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
718       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
719        msgBuf = '// ======================================================='        msgBuf =
720         & '// ======================================================='
721        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
722       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
723    
724          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
725           msgBuf =
726         &  'Model domain too big to print to terminal - skipping I/O'
727           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
728         &                   SQUEEZE_RIGHT, 1)
729           RETURN
730          endif
731    
732  C--   Write field  C--   Write field
733  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
734  C     acc = accross the page  C     acc = accross the page
# Line 499  C      Header Line 826  C      Header
826  C      Data  C      Data
827         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
828          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
829           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
830       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
831           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
832       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 534  C      Data Line 861  C      Data
861             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
862              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
863             ELSE             ELSE
864              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
865             ENDIF             ENDIF
866            ENDDO            ENDDO
867           ENDDO           ENDDO
# Line 556  C      Data Line 883  C      Data
883               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
884                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
885               ENDIF               ENDIF
886               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
887                  IDX = NINT(
888       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
889       &             )+1       &             )+1
890                 ELSE
891                  IDX = 1
892                 ENDIF
893               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
894       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
895               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 576  C      Data Line 907  C      Data
907         ENDDO         ENDDO
908        ENDIF        ENDIF
909  C--   Write delimiter  C--   Write delimiter
910        msgBuf = '// ======================================================='        msgBuf =
911         & '// ======================================================='
912        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
913       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
914        msgBuf = '// END OF FIELD                                          ='        msgBuf =
915         & '// END OF FIELD                                          ='
916        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
917       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
918        msgBuf = '// ======================================================='        msgBuf =
919         & '// ======================================================='
920        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
921       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
922        msgBuf = ' '        msgBuf = ' '
# Line 592  C--   Write delimiter Line 926  C--   Write delimiter
926        RETURN        RETURN
927        END        END
928    
929  CStartOfInterface  CBOP
930        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,  C     !ROUTINE: PRINT_MAPRL
931    
932    C     !INTERFACE:
933          SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
934       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
935       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
936       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
937       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
938       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
939       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
940  C     /==========================================================\        IMPLICIT NONE
 C     | SUBROUTINE PRINT_MAPR8                                   |  
 C     | o Does textual mapping printing of a field.              |  
 C     |==========================================================|  
 C     | This routine does the actual formatting of the data      |  
 C     | and printing to a file. It assumes an array using the    |  
 C     | MITgcm UV indexing scheme and base index variables.      |  
 C     | User code should call an interface routine like          |  
 C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  
 C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  
 C     | is specficied through the "plotMode" argument. All the   |  
 C     | plots made by a single call to this routine will use the |  
 C     | same contour interval. The plot range (iMin,...,byStr)   |  
 C     | can be three-dimensional. A separate plot is made for    |  
 C     | each point in the plot range normal to the orientation.  |  
 C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  
 C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  
 C     |      plots - one for K=1, one for K=3 and one for K=5.   |  
 C     |      Each plot would have extents iMin:iMax step iStr    |  
 C     |      and jMin:jMax step jStr.                            |  
 C     \==========================================================/  
941    
942    C     !DESCRIPTION:
943    C     *==========================================================*
944    C     | SUBROUTINE PRINT\_MAPRL                                    
945    C     | o Does textual mapping printing of a field.              
946    C     *==========================================================*
947    C     | This routine does the actual formatting of the data      
948    C     | and printing to a file. It assumes an array using the    
949    C     | MITgcm UV indexing scheme and base index variables.      
950    C     | User code should call an interface routine like          
951    C     | PLOT\_FIELD\_XYR8( ... ) rather than this code directly.    
952    C     | Text plots can be oriented XY, YZ, XZ. An orientation    
953    C     | is specficied through the "plotMode" argument. All the    
954    C     | plots made by a single call to this routine will use the  
955    C     | same contour interval. The plot range (iMin,...,byStr)    
956    C     | can be three-dimensional. A separate plot is made for    
957    C     | each point in the plot range normal to the orientation.  
958    C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).  
959    C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
960    C     |      plots - one for K=1, one for K=3 and one for K=5.    
961    C     |      Each plot would have extents iMin:iMax step iStr    
962    C     |      and jMin:jMax step jStr.                            
963    C     *==========================================================*
964    
965    C     !USES:
966  C     == Global variables ==  C     == Global variables ==
967  #include "SIZE.h"  #include "SIZE.h"
968  #include "EEPARAMS.h"  #include "EEPARAMS.h"
969  #include "EESUPPORT.h"  #include "EESUPPORT.h"
970          INTEGER  IFNBLNK
971          EXTERNAL IFNBLNK
972          INTEGER  ILNBLNK
973          EXTERNAL ILNBLNK
974    
975    C     !INPUT/OUTPUT PARAMETERS:
976  C     == Routine arguments ==  C     == Routine arguments ==
977  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
978  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 648  C     kStr Line 994  C     kStr
994        INTEGER jLo, jHi        INTEGER jLo, jHi
995        INTEGER kLo, kHi        INTEGER kLo, kHi
996        INTEGER nBx, nBy        INTEGER nBx, nBy
997        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
998        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
999        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
1000        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
1001        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
1002        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1003    
1004    C     !LOCAL VARIABLES:
1005  C     == Local variables ==  C     == Local variables ==
1006  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
1007  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 690  C               Str  - stride within blo Line 1031  C               Str  - stride within blo
1031        INTEGER lChList        INTEGER lChList
1032        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1033        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1034        REAL fMin        _RL  fMin
1035        REAL fMax        _RL  fMax
1036        REAL fRange        _RL  fRange
1037        REAL val        _RL  val
1038        REAL small        _RL  small
1039        CHARACTER*2  accLab        CHARACTER*2  accLab
1040        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1041        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 709  C               Str  - stride within blo Line 1050  C               Str  - stride within blo
1050        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1051        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1052        LOGICAL validRange        LOGICAL validRange
1053    CEOP
1054    
1055        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1056        small  = 1. _d -15        small  = 1. _d -15
# Line 722  C--   Calculate field range Line 1064  C--   Calculate field range
1064          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1065           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1066            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1067  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1068         &     THEN
1069              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
1070       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1071              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1072       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1073  C          ENDIF             ENDIF
1074            ENDDO            ENDDO
1075           ENDDO           ENDDO
1076          ENDDO          ENDDO
1077         ENDDO         ENDDO
1078        ENDDO        ENDDO
1079        fRange = fMax-fMin        fRange = fMax-fMin
1080        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
1081         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
1082        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
1083    
1084  C--   Write field title and statistics  C--   Write field title and statistics
1085        msgBuf = '// ======================================================='        msgBuf =
1086         & '// ======================================================='
1087        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1088       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1089        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 759  C--   Write field title and statistics Line 1103  C--   Write field title and statistics
1103       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1104        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1105       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1106        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1107           WRITE(msgBuf,'(A,1PE30.15)')
1108       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1109          ELSE
1110           WRITE(msgBuf,'(A,1PE30.15)')
1111         & '// CINT = ', 0.
1112          ENDIF
1113        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1114       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1115        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 792  C--   Write field title and statistics Line 1141  C--   Write field title and statistics
1141       &  ':',kStr,')'       &  ':',kStr,')'
1142        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1143       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1144        msgBuf = '// ======================================================='        msgBuf =
1145         & '// ======================================================='
1146        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1147       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1148    
1149          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1150           msgBuf =
1151         &  'Model domain too big to print to terminal - skipping I/O'
1152           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1153         &                   SQUEEZE_RIGHT, 1)
1154           RETURN
1155          endif
1156    
1157  C--   Write field  C--   Write field
1158  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1159  C     acc = accross the page  C     acc = accross the page
# Line 893  C      Header Line 1251  C      Header
1251  C      Data  C      Data
1252         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1253          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1254           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1255       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1256           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1257       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 948  C      Data Line 1306  C      Data
1306               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1307                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1308               ENDIF               ENDIF
1309               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1310       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1311       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1312         &              )+1
1313                 ELSE
1314                  IDX = 1
1315                 ENDIF
1316               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1317       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1318               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 967  C      Data Line 1329  C      Data
1329         ENDDO         ENDDO
1330        ENDIF        ENDIF
1331  C--   Write delimiter  C--   Write delimiter
1332        msgBuf = '// ======================================================='        msgBuf =
1333         & '// ======================================================='
1334        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1335       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1336        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1337         & '// END OF FIELD                                          ='
1338        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1339       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1340        msgBuf = '// ======================================================='        msgBuf =
1341         & '// ======================================================='
1342        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1343       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1344        msgBuf = ' '        msgBuf = ' '
# Line 983  C--   Write delimiter Line 1348  C--   Write delimiter
1348        RETURN        RETURN
1349        END        END
1350    
1351  CStartOfInterface  CBOP
1352    C     !ROUTINE: PRINT_MESSAGE
1353    
1354    C     !INTERFACE:
1355        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
1356  C     /============================================================\        IMPLICIT NONE
1357  C     | SUBROUTINE PRINT_MESSAGE                                   |  C     !DESCRIPTION:
1358  C     | o Write out informational message using "standard" format. |  C     *============================================================*
1359  C     | Notes                                                      |  C     | SUBROUTINE PRINT\_MESSAGE                                    
1360  C     | =====                                                      |  C     | o Write out informational message using "standard" format.  
1361  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     *============================================================*
1362  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     | Notes                                                      
1363  C     |   critical region is defined around the write here. In some|  C     | =====                                                      
1364  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     | o Some system   I/O is not "thread-safe". For this reason  
1365  C     |   for thread number 1 - writes for other threads are       |  C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
1366  C     |   ignored!                                                 |  C     |   critical region is defined around the write here. In some
1367  C     | o In a non-parallel form these routines can still be used. |  C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
1368  C     |   to produce pretty printed output!                        |  C     |   for thread number 1 - writes for other threads are        
1369  C     \============================================================/  C     |   ignored!                                                  
1370    C     | o In a non-parallel form these routines can still be used.  
1371    C     |   to produce pretty printed output!                        
1372    C     *============================================================*
1373    
1374    C     !USES:
1375  C     == Global data ==  C     == Global data ==
1376  #include "SIZE.h"  #include "SIZE.h"
1377  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1378  #include "EESUPPORT.h"  #include "EESUPPORT.h"
1379          INTEGER  IFNBLNK
1380          EXTERNAL IFNBLNK
1381          INTEGER  ILNBLNK
1382          EXTERNAL ILNBLNK
1383    
1384    C     !INPUT/OUTPUT PARAMETERS:
1385  C     == Routine arguments ==  C     == Routine arguments ==
1386  C     message - Message to write  C     message :: Message to write
1387  C     unit    - Unit number to write to  C     unit    :: Unit number to write to
1388  C     sq      - Justification option  C     sq      :: Justification option
1389        CHARACTER*(*) message        CHARACTER*(*) message
1390        INTEGER       unit        INTEGER       unit
1391        CHARACTER*(*) sq        CHARACTER*(*) sq
1392        INTEGER  myThid        INTEGER  myThid
1393  CEndOfInterface  
1394        INTEGER  IFNBLNK  C     !LOCAL VARIABLES:
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1395  C     == Local variables ==  C     == Local variables ==
1396    C     iStart, iEnd :: String indexing variables
1397    C     idString     :: Temp. for building prefix.
1398        INTEGER iStart        INTEGER iStart
1399        INTEGER iEnd        INTEGER iEnd
1400        CHARACTER*9 idString        CHARACTER*9 idString
1401    CEOP
1402    
1403  C--   Find beginning and end of message  C--   Find beginning and end of message
1404        IF ( sq .EQ. SQUEEZE_BOTH .OR.        IF ( sq .EQ. SQUEEZE_BOTH .OR.
1405       &     sq .EQ. SQUEEZE_LEFT ) THEN       &     sq .EQ. SQUEEZE_LEFT ) THEN
# Line 1057  C       The write statement may need to Line 1437  C       The write statement may need to
1437  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1438          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1439  #endif  #endif
1440           WRITE(unit,'(A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
1441       &   '(',PROCESS_HEADER,' ',idString,')',' '       &   '(',PROCESS_HEADER,' ',idString,')',' '
1442  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1443          _END_CRIT(myThid)          _END_CRIT(myThid)
# Line 1066  C       The write statement may need to Line 1446  C       The write statement may need to
1446  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1447          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1448  #endif  #endif
1449           WRITE(unit,'(A,A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
1450       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',
1451       &   message(iStart:iEnd)       &   message(iStart:iEnd)
1452  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 1074  C       The write statement may need to Line 1454  C       The write statement may need to
1454  #endif  #endif
1455         ENDIF         ENDIF
1456        ENDIF        ENDIF
1457    
1458    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
1459    C--   if error message, also write directly to unit 0 :
1460          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
1461         &     .AND. unit.EQ.errorMessageUnit ) THEN
1462            iEnd   = ILNBLNK( message )
1463            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
1464          ENDIF
1465    #endif
1466  C  C
1467     1000 CONTINUE
1468        RETURN        RETURN
1469      999 CONTINUE
1470           ioErrorCount(myThid) = ioErrorCount(myThid)+1
1471          GOTO 1000
1472    
1473        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22