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