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