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