/[MITgcm]/MITgcm/eesupp/src/print.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/print.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by cnh, Sun Apr 26 23:41:54 1998 UTC revision 1.31 by jmc, Fri Jun 19 03:05:13 2009 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
6  C--   File printf.F: Routines for performing formatted textual I/O  C--  File printf.F: Routines for performing formatted textual I/O
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_MESSAGE  Does IO with unhighlighted header
10  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--   o PRINT_ERROR    Does IO with **ERROR** highlighted header
11  C--                     numbers.  C--   o PRINT_LIST_I   Prints one-dimensional list of INTEGER
12  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field  C--                    numbers.
13  C--                     Uses print_message for writing  C--   o PRINT_LIST_L   Prints one-dimensional list of LOGICAL
14  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field  C--                    variables.
15  C--                     Uses print_message for writing  C--   o PRINT_LIST_RL  Prints one-dimensional list of Real(_RL)
16  C--    o print_message  Does IO with unhighlighted header  C--                    numbers.
17    C--   o PRINT_MAPRS    Formats ABCD... contour map of a Real(_RS) field
18    C--                    Uses print_message for writing
19    C--   o PRINT_MAPRL    Formats ABCD... contour map of a Real(_RL) field
20    C--                    Uses print_message for writing
21    
22    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
23    CBOP
24    C     !ROUTINE: PRINT_MESSAGE
25    C     !INTERFACE:
26          SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
27    
28    C     !DESCRIPTION:
29    C     *============================================================*
30    C     | SUBROUTINE PRINT\_MESSAGE
31    C     | o Write out informational message using "standard" format.
32    C     *============================================================*
33    C     | Notes
34    C     | =====
35    C     | o Some system   I/O is not "thread-safe". For this reason
36    C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
37    C     |   critical region is defined around the write here. In some
38    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
39    C     |   for thread number 1 - writes for other threads are
40    C     |   ignored!
41    C     | o In a non-parallel form these routines can still be used.
42    C     |   to produce pretty printed output!
43    C     *============================================================*
44    
45    C     !USES:
46          IMPLICIT NONE
47    
 CStartOfInterface  
       SUBROUTINE PRINT_ERROR( message , myThid )  
 C     /============================================================\  
 C     | SUBROUTINE PRINT_ERROR                                     |  
 C     | o Write out error message using "standard" format.         |  
 C     | Notes                                                      |  
 C     | =====                                                      |  
 C     | o Some system's I/O is not "thread-safe". For this reason  |  
 C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  
 C     |   critical region is defined around the write here. In some|  
 C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  
 C     |   for thread number 1 - writes for other threads are       |  
 C     |   ignored!                                                 |  
 C     | o In a non-parallel form these routines can still be used. |  
 C     |   to produce pretty printed output!                        |  
 C     \============================================================/  
48  C     == Global data ==  C     == Global data ==
49  #include "SIZE.h"  #include "SIZE.h"
50  #include "EEPARAMS.h"  #include "EEPARAMS.h"
51  #include "EESUPPORT.h"  #include "EESUPPORT.h"
52    
53    C     !INPUT/OUTPUT PARAMETERS:
54  C     == Routine arguments ==  C     == Routine arguments ==
55    C     message :: Message to write
56    C     unit    :: Unit number to write to
57    C     sq      :: Justification option
58        CHARACTER*(*) message        CHARACTER*(*) message
59        INTEGER       myThid        INTEGER       unit
60  CEndOfInterface        CHARACTER*(*) sq
61          INTEGER  myThid
62    
63    C     !FUNCTIONS:
64        INTEGER  IFNBLNK        INTEGER  IFNBLNK
65        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
66        INTEGER  ILNBLNK        INTEGER  ILNBLNK
67        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
68    
69    C     !LOCAL VARIABLES:
70  C     == Local variables ==  C     == Local variables ==
71    C     iStart, iEnd :: String indexing variables
72    C     idString     :: Temp. for building prefix.
73        INTEGER iStart        INTEGER iStart
74        INTEGER iEnd        INTEGER iEnd
75        CHARACTER*9 idString        CHARACTER*9 idString
76    CEOP
77    
78  C--   Find beginning and end of message  C--   Find beginning and end of message
79        iStart = IFNBLNK( message )        IF ( sq .EQ. SQUEEZE_BOTH .OR.
80        iEnd   = ILNBLNK( message )       &     sq .EQ. SQUEEZE_LEFT ) THEN
81           iStart = IFNBLNK( message )
82          ELSE
83           iStart = 1
84          ENDIF
85          IF ( sq .EQ. SQUEEZE_BOTH .OR.
86         &     sq .EQ. SQUEEZE_RIGHT ) THEN
87           iEnd   = ILNBLNK( message )
88          ELSE
89           iEnd   = LEN(message)
90          ENDIF
91  C--   Test to see if in multi-process ( or multi-threaded ) mode.  C--   Test to see if in multi-process ( or multi-threaded ) mode.
92  C     If so include process or thread identifier.  C     If so include process or thread identifier.
93        IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN        IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
94  C--    Write single process format  C--    Write single process format
95         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
96          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(unit,'(A)') ' '
97         ELSE         ELSE
98          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(unit,'(A)') message(iStart:iEnd)
99         ENDIF         ENDIF
100        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSEIF ( pidIO .EQ. myProcId ) THEN
101  C--    Write multi-process format  C--    Write multi-process format
# Line 68  C--    Write multi-process format Line 107  C--    Write multi-process format
107         _END_CRIT(myThid)         _END_CRIT(myThid)
108  #endif  #endif
109         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
110  C       PRINT_ERROR can be called by several threads simulataneously.  C       PRINT can be called by several threads simultaneously.
111  C       The write statement may need to be marked as a critical section.  C       The write statement may need to ne marked as a critical section.
112  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
113          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
114  #endif  #endif
115          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
116       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &   '(',PROCESS_HEADER,' ',idString,')',' '
      &  ' '  
117  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
118          _END_CRIT(myThid)          _END_CRIT(myThid)
119  #endif  #endif
# Line 83  C       The write statement may need to Line 121  C       The write statement may need to
121  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
122          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
123  #endif  #endif
124          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
125       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',
126       &  message(iStart:iEnd)       &   message(iStart:iEnd)
127  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
128          _END_CRIT(myThid)          _END_CRIT(myThid)
129  #endif  #endif
130         ENDIF         ENDIF
131        ENDIF        ENDIF
132    
133    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
134    C--   if error message, also write directly to unit 0 :
135          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
136         &     .AND. unit.EQ.errorMessageUnit ) THEN
137            iEnd   = ILNBLNK( message )
138            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
139          ENDIF
140    #endif
141  C  C
142     1000 CONTINUE
143          RETURN
144      999 CONTINUE
145           ioErrorCount(myThid) = ioErrorCount(myThid)+1
146          GOTO 1000
147    
148          END
149    
150    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
151    CBOP
152    C     !ROUTINE: PRINT_ERROR
153    C     !INTERFACE:
154          SUBROUTINE PRINT_ERROR( message , myThid )
155    
156    C     !DESCRIPTION:
157    C     *============================================================*
158    C     | SUBROUTINE PRINT\_ERROR
159    C     | o Write out error message using "standard" format.
160    C     *============================================================*
161    C     | Notes
162    C     | =====
163    C     | o Some system   I/O is not "thread-safe". For this reason
164    C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
165    C     |   critical region is defined around the write here. In some
166    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
167    C     |   for thread number 1 - writes for other threads are
168    C     |   ignored!
169    C     | o In a non-parallel form these routines are still used
170    C     |   to produce pretty printed output. The process and thread
171    C     |   id prefix is omitted in this case.
172    C     *============================================================*
173    
174    C     !USES:
175          IMPLICIT NONE
176    
177    C     == Global data ==
178    #include "SIZE.h"
179    #include "EEPARAMS.h"
180    #include "EESUPPORT.h"
181    
182    C     !INPUT/OUTPUT PARAMETERS:
183    C     == Routine arguments ==
184    C     message :: Text string to print
185    C     myThid  :: Thread number of this instance
186          CHARACTER*(*) message
187          INTEGER       myThid
188    
189    C     !FUNCTIONS:
190    c     INTEGER  IFNBLNK
191    c     EXTERNAL IFNBLNK
192          INTEGER  ILNBLNK
193          EXTERNAL ILNBLNK
194    
195    C     !LOCAL VARIABLES:
196    C     == Local variables ==
197    C     iStart, iEnd :: Temps. for string indexing
198    C     idString     :: Temp. for building message prefix
199    c     INTEGER iStart
200          INTEGER iEnd
201          CHARACTER*9 idString
202    CEOP
203    
204    C--   Find beginning and end of message
205    c     iStart = IFNBLNK( message )
206          iEnd   = ILNBLNK( message )
207    C--   Test to see if in multi-process ( or multi-threaded ) mode.
208    C     If so include process or thread identifier.
209          IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
210    C--    Write single process format
211           IF ( iEnd.EQ.0 ) THEN
212            WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
213           ELSE
214            WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
215         &        message(1:iEnd)
216    c    &    message(iStart:iEnd)
217           ENDIF
218          ELSE
219    C       PRINT_ERROR can be called by several threads simulataneously.
220    C       The write statement may need to be marked as a critical section.
221    #ifndef FMTFTN_IO_THREAD_SAFE
222    # ifdef USE_OMP_THREADING
223    C$OMP CRITICAL
224    # else
225           _BEGIN_CRIT(myThid)
226    # endif
227    #endif
228           IF ( pidIO .EQ. myProcId ) THEN
229    C--    Write multi-process format
230             WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
231    
232             IF ( iEnd.EQ.0 ) THEN
233    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
234              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
235         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
236         &    ' '
237             ELSE
238    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
239              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
240         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
241         &        message(1:iEnd)
242    c    &    message(iStart:iEnd)
243             ENDIF
244           ENDIF
245    
246    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
247    C--    also write directly to unit 0 :
248           IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN
249            IF ( nThreads.LE.1 ) THEN
250              WRITE(0,'(A)') message(1:iEnd)
251            ELSE
252              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
253         &                   message(1:iEnd)
254            ENDIF
255           ENDIF
256    #endif
257    
258    #ifndef FMTFTN_IO_THREAD_SAFE
259    # ifdef USE_OMP_THREADING
260    C$OMP END CRITICAL
261    # else
262            _END_CRIT(myThid)
263    # endif
264    #endif
265          ENDIF
266    
267     1000 CONTINUE
268          RETURN
269    
270    c 999 CONTINUE
271    c      ioErrorCount(myThid) = ioErrorCount(myThid)+1
272    c     GOTO 1000
273          END
274    
275    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
276    CBOP
277    C     !ROUTINE: PRINT_LIST_I
278    C     !INTERFACE:
279          SUBROUTINE PRINT_LIST_I( fld, iFirst, iLast, index_type,
280         &                         markEnd, compact, ioUnit )
281    
282    C     !DESCRIPTION:
283    C     *==========================================================*
284    C     | o SUBROUTINE PRINT\_LIST\_I
285    C     *==========================================================*
286    C     | Routine for producing list of values for a field with
287    C     | duplicate values collected into
288    C     |    n \@ value
289    C     | record.
290    C     *==========================================================*
291    
292    C     !USES:
293          IMPLICIT NONE
294    
295    C     == Global data ==
296    #include "SIZE.h"
297    #include "EEPARAMS.h"
298    
299    C     !INPUT/OUTPUT PARAMETERS:
300    C     == Routine arguments ==
301    C     fld     :: Data to be printed
302    C     iFirst  :: First element to print
303    C     iLast   :: Last element to print
304    C  index_type :: Flag indicating which type of index to print
305    C                  INDEX_K    => /* K = nnn */
306    C                  INDEX_I    => /* I = nnn */
307    C                  INDEX_J    => /* J = nnn */
308    C                  INDEX_NONE =>
309    C     markEnd :: Flag to control whether there is a separator after the
310    C                last element
311    C     compact :: Flag to control use of repeat symbol for same valued
312    C                fields.
313    C     ioUnit  :: Unit number for IO.
314          INTEGER iFirst, iLast
315          INTEGER fld(iFirst:iLast)
316          INTEGER index_type
317          LOGICAL markEnd
318          LOGICAL compact
319          INTEGER ioUnit
320    
321    C     !LOCAL VARIABLES:
322    C     == Local variables ==
323    C     iLo  - Range index holders for selecting elements with
324    C     iHi    with the same value
325    C     nDup - Number of duplicates
326    C     xNew, xOld - Hold current and previous values of field
327    C     punc - Field separator
328    C     msgBuf - IO buffer
329    C     index_lab - Index for labelling elements
330    C     K    - Loop counter
331          INTEGER iLo
332          INTEGER iHi
333          INTEGER nDup
334          INTEGER xNew, xOld
335          CHARACTER punc
336          CHARACTER*(MAX_LEN_MBUF) msgBuf
337          CHARACTER*2 commOpen,commClose
338          CHARACTER*3 index_lab
339          CHARACTER*25 fmt1, fmt2
340          INTEGER K
341    CEOP
342    
343          IF     ( index_type .EQ. INDEX_I ) THEN
344           index_lab = 'I ='
345          ELSEIF ( index_type .EQ. INDEX_J ) THEN
346           index_lab = 'J ='
347          ELSEIF ( index_type .EQ. INDEX_K ) THEN
348           index_lab = 'K ='
349          ELSE
350           index_lab = '?='
351          ENDIF
352    C-    fortran format to write 1 or 2 indices:
353          fmt1='(A,1X,A,I3,1X,A)'
354          fmt2='(A,1X,A,I3,A,I3,1X,A)'
355          IF ( iLast.GE.1000 ) THEN
356            K = 1+INT(LOG10(FLOAT(iLast)))
357            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
358            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
359          ENDIF
360          commOpen  = '/*'
361          commClose = '*/'
362          iLo = iFirst
363          iHi = iFirst
364          punc = ','
365          xOld = fld(iFirst)
366          DO K = iFirst+1,iLast
367           xNew = fld(K  )
368           IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
369            nDup = iHi-iLo+1
370            IF ( nDup .EQ. 1 ) THEN
371             WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
372             IF ( index_type .NE. INDEX_NONE )
373         &    WRITE(msgBuf(45:),fmt1)
374         &    commOpen,index_lab,iLo,commClose
375            ELSE
376             WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
377             IF ( index_type .NE. INDEX_NONE )
378         &    WRITE(msgBuf(45:),fmt2)
379         &    commOpen,index_lab,iLo,':',iHi,commClose
380            ENDIF
381            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
382            iLo  = K
383            iHi  = K
384            xOld = xNew
385           ELSE
386            iHi = K
387           ENDIF
388          ENDDO
389          punc = ' '
390          IF ( markEnd ) punc = ','
391          nDup = iHi-iLo+1
392          IF    ( nDup .EQ. 1 ) THEN
393           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
394           IF ( index_type .NE. INDEX_NONE )
395         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
396         &  commOpen,index_lab,iLo,commClose
397          ELSEIF( nDup .GT. 1 ) THEN
398           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
399           IF ( index_type .NE. INDEX_NONE )
400         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
401         &  commOpen,index_lab,iLo,':',iHi,commClose
402          ENDIF
403          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
404    
405          RETURN
406          END
407    
408    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
409    CBOP
410    C     !ROUTINE: PRINT_LIST_L
411    C     !INTERFACE:
412          SUBROUTINE PRINT_LIST_L( fld, iFirst, iLast, index_type,
413         &                         markEnd, compact, ioUnit )
414    
415    C     !DESCRIPTION:
416    C     *==========================================================*
417    C     | o SUBROUTINE PRINT\_LIST\_L
418    C     *==========================================================*
419    C     | Routine for producing list of values for a field with
420    C     | duplicate values collected into
421    C     |    n \@ value
422    C     | record.
423    C     *==========================================================*
424    
425    C     !USES:
426          IMPLICIT NONE
427    
428    C     == Global data ==
429    #include "SIZE.h"
430    #include "EEPARAMS.h"
431    
432    C     !INPUT/OUTPUT PARAMETERS:
433    C     == Routine arguments ==
434    C     fld     :: Data to be printed
435    C     iFirst  :: First element to print
436    C     iLast   :: Last element to print
437    C  index_type :: Flag indicating which type of index to print
438    C                  INDEX_K    => /* K = nnn */
439    C                  INDEX_I    => /* I = nnn */
440    C                  INDEX_J    => /* J = nnn */
441    C                  INDEX_NONE =>
442    C     markEnd :: Flag to control whether there is a separator after the
443    C                last element
444    C     compact :: Flag to control use of repeat symbol for same valued
445    C                fields.
446    C     ioUnit  :: Unit number for IO.
447          INTEGER iFirst, iLast
448          LOGICAL fld(iFirst:iLast)
449          INTEGER index_type
450          LOGICAL markEnd
451          LOGICAL compact
452          INTEGER ioUnit
453    
454    C     !LOCAL VARIABLES:
455    C     == Local variables ==
456    C     iLo  - Range index holders for selecting elements with
457    C     iHi    with the same value
458    C     nDup - Number of duplicates
459    C     xNew, xOld - Hold current and previous values of field
460    C     punc - Field separator
461    C     msgBuf - IO buffer
462    C     index_lab - Index for labelling elements
463    C     K    - Loop counter
464          INTEGER iLo
465          INTEGER iHi
466          INTEGER nDup
467          LOGICAL xNew, xOld
468          CHARACTER punc
469          CHARACTER*(MAX_LEN_MBUF) msgBuf
470          CHARACTER*2 commOpen,commClose
471          CHARACTER*3 index_lab
472          CHARACTER*25 fmt1, fmt2
473          INTEGER K
474    CEOP
475    
476          IF     ( index_type .EQ. INDEX_I ) THEN
477           index_lab = 'I ='
478          ELSEIF ( index_type .EQ. INDEX_J ) THEN
479           index_lab = 'J ='
480          ELSEIF ( index_type .EQ. INDEX_K ) THEN
481           index_lab = 'K ='
482          ELSE
483           index_lab = '?='
484          ENDIF
485    C-    fortran format to write 1 or 2 indices:
486          fmt1='(A,1X,A,I3,1X,A)'
487          fmt2='(A,1X,A,I3,A,I3,1X,A)'
488          IF ( iLast.GE.1000 ) THEN
489            K = 1+INT(LOG10(FLOAT(iLast)))
490            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
491            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
492          ENDIF
493          commOpen  = '/*'
494          commClose = '*/'
495          iLo = iFirst
496          iHi = iFirst
497          punc = ','
498          xOld = fld(iFirst)
499          DO K = iFirst+1,iLast
500           xNew = fld(K  )
501           IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
502            nDup = iHi-iLo+1
503            IF ( nDup .EQ. 1 ) THEN
504             WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
505             IF ( index_type .NE. INDEX_NONE )
506         &    WRITE(msgBuf(45:),fmt1)
507         &    commOpen,index_lab,iLo,commClose
508            ELSE
509             WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
510             IF ( index_type .NE. INDEX_NONE )
511         &    WRITE(msgBuf(45:),fmt2)
512         &    commOpen,index_lab,iLo,':',iHi,commClose
513            ENDIF
514            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
515            iLo  = K
516            iHi  = K
517            xOld = xNew
518           ELSE
519            iHi = K
520           ENDIF
521          ENDDO
522          punc = ' '
523          IF ( markEnd ) punc = ','
524          nDup = iHi-iLo+1
525          IF    ( nDup .EQ. 1 ) THEN
526           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
527           IF ( index_type .NE. INDEX_NONE )
528         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
529         &    commOpen,index_lab,iLo,commClose
530          ELSEIF( nDup .GT. 1 ) THEN
531           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
532           IF ( index_type .NE. INDEX_NONE )
533         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
534         &  commOpen,index_lab,iLo,':',iHi,commClose
535          ENDIF
536          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
537    
538        RETURN        RETURN
539        END        END
540    
541  CStartofinterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
542        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )  CBOP
543  CEndifinterface  C     !ROUTINE: PRINT_LIST_RL
544  C     /==========================================================\  C     !INTERFACE:
545  C     | o SUBROUTINE PRINT_LIST_R8                               |        SUBROUTINE PRINT_LIST_RL( fld, iFirst, iLast, index_type,
546  C     |==========================================================|       &                          markEnd, compact, ioUnit )
547  C     | Routine for producing list of values for a field with    |  
548  C     | duplicate values collected into                          |  C     !DESCRIPTION:
549  C     |    n @ value                                             |  C     *==========================================================*
550  C     | record.                                                  |  C     | o SUBROUTINE PRINT\_LIST\_RL
551  C     \==========================================================/  C     *==========================================================*
552    C     | Routine for producing list of values for a field with
553    C     | duplicate values collected into
554    C     |    n \@ value
555    C     | record.
556    C     *==========================================================*
557    
558    C     !USES:
559          IMPLICIT NONE
560    
561  C     == Global data ==    C     == Global data ==
562  #include "SIZE.h"  #include "SIZE.h"
563  #include "EEPARAMS.h"  #include "EEPARAMS.h"
564    
565    C     !INPUT/OUTPUT PARAMETERS:
566  C     == Routine arguments ==  C     == Routine arguments ==
567  C     fld    -  Data to be printed  C     fld     :: Data to be printed
568  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
569  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
570    C  index_type :: Flag indicating which type of index to print
571  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
572  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
573  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
574  C                  INDEX_NONE =>  C                  INDEX_NONE =>
575  C     ioUnit -  Unit number for IO.  C     markEnd :: Flag to control whether there is a separator after the
576        INTEGER lFld  C                last element
577    C     compact :: Flag to control use of repeat symbol for same valued
578    C                fields.
579    C     ioUnit  :: Unit number for IO.
580          INTEGER iFirst, iLast
581          _RL     fld(iFirst:iLast)
582        INTEGER index_type        INTEGER index_type
583        Real*8  fld(lFld)        LOGICAL markEnd
584          LOGICAL compact
585        INTEGER ioUnit        INTEGER ioUnit
586    
587    C     !LOCA VARIABLES:
588  C     == Local variables ==  C     == Local variables ==
589  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
590  C     iHi    with the same value  C     iHi    with the same value
# Line 137  C     K    - Loop counter Line 597  C     K    - Loop counter
597        INTEGER iLo        INTEGER iLo
598        INTEGER iHi        INTEGER iHi
599        INTEGER nDup        INTEGER nDup
600        Real*8 xNew, xOld        _RL     xNew, xOld
601        CHARACTER punc        CHARACTER punc
602        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
603        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
604        CHARACTER*3 index_lab        CHARACTER*3 index_lab
605          CHARACTER*25 fmt1, fmt2
606        INTEGER K        INTEGER K
607    CEOP
608    
609        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
610         index_lab = 'I ='         index_lab = 'I ='
# Line 153  C     K    - Loop counter Line 615  C     K    - Loop counter
615        ELSE        ELSE
616         index_lab = '?='         index_lab = '?='
617        ENDIF        ENDIF
618    C-    fortran format to write 1 or 2 indices:
619          fmt1='(A,1X,A,I3,1X,A)'
620          fmt2='(A,1X,A,I3,A,I3,1X,A)'
621          IF ( iLast.GE.1000 ) THEN
622            K = 1+INT(LOG10(FLOAT(iLast)))
623            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
624            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
625          ENDIF
626        commOpen  = '/*'        commOpen  = '/*'
627        commClose = '*/'        commClose = '*/'
628        iLo = 1        iLo = iFirst
629        iHi = 1        iHi = iFirst
630        punc = ','        punc = ','
631        xOld = fld(1)        xOld = fld(iFirst)
632        DO K=2,lFld        DO K = iFirst+1,iLast
633         xNew = fld(K  )         xNew = fld(K  )
634         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
635          nDup = iHi-iLo+1          nDup = iHi-iLo+1
636          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
637           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
638           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
639       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),fmt1)
640         &    commOpen,index_lab,iLo,commClose
641          ELSE          ELSE
642           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
643           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
644       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
645       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
646          ENDIF          ENDIF
647          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
648          iLo  = K          iLo  = K
649          iHi  = K          iHi  = K
650          xOld = xNew          xOld = xNew
# Line 182  C     K    - Loop counter Line 653  C     K    - Loop counter
653         ENDIF         ENDIF
654        ENDDO        ENDDO
655        punc = ' '        punc = ' '
656          IF ( markEnd ) punc = ','
657        nDup = iHi-iLo+1        nDup = iHi-iLo+1
658        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
659         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
660         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
661       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),fmt1)
662         &    commOpen,index_lab,iLo,commClose
663        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
664         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
665         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
666       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),fmt2)
667       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
668        ENDIF        ENDIF
669        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
670    
671        RETURN        RETURN
672        END        END
673    
674  CStartOfInterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
675        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,  CBOP
676    C     !ROUTINE: PRINT_MAPRS
677    C     !INTERFACE:
678          SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
679       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
680       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
681       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
682       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
683       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
684       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
685  C     /==========================================================\  
686  C     | SUBROUTINE PRINT_MAPR4                                   |  C     !DESCRIPTION:
687  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
688  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPRS
689  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.
690  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
691  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data
692  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the
693  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.
694  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like
695  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYRS( ... ) rather than this code directly.
696  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation
697  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the
698  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the
699  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)
700  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for
701  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.
702  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).
703  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
704  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.
705  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr
706    C     |      and jMin:jMax step jStr.
707    C     *==========================================================*
708    
709    C     !USES:
710          IMPLICIT NONE
711    
712  C     == Global variables ==  C     == Global variables ==
713  #include "SIZE.h"  #include "SIZE.h"
714  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
715    
716    C     !INPUT/OUTPUT PARAMETERS:
717  C     == Routine arguments ==  C     == Routine arguments ==
718  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
719  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 243  C     jLo, jHi     be five-dimensional. Line 724  C     jLo, jHi     be five-dimensional.
724  C     kLo, kHi  C     kLo, kHi
725  C     nBx, nBy  C     nBx, nBy
726  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
727  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
728  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
729  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
730  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 254  C     kStr Line 735  C     kStr
735        INTEGER jLo, jHi        INTEGER jLo, jHi
736        INTEGER kLo, kHi        INTEGER kLo, kHi
737        INTEGER nBx, nBy        INTEGER nBx, nBy
738        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
739        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
740        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
741        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
742        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
743        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
744  CEndOfInterface  
745  C     == Local variables ==  C     !FUNCTIONS:
746        INTEGER  IFNBLNK        INTEGER  IFNBLNK
747        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
748        INTEGER  ILNBLNK        INTEGER  ILNBLNK
749        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
750    
751    C     !LOCAL VARIABLES:
752  C     == Local variables ==  C     == Local variables ==
753  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
754  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 290  C               Min  - Start index withi Line 772  C               Min  - Start index withi
772  C               Max  - End index within block  C               Max  - End index within block
773  C               Str  - stride within block  C               Str  - stride within block
774        INTEGER MAX_LEN_PLOTBUF        INTEGER MAX_LEN_PLOTBUF
775        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
776        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
777        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
778        INTEGER lChList        INTEGER lChList
779        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
780        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
781        REAL fMin        _RL  fMin
782        REAL fMax        _RL  fMax
783        REAL fRange        _RL  fRange
784        REAL val        _RL  val
785        REAL small        _RL  small
786        CHARACTER*2  accLab        CHARACTER*2  accLab
787        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
788        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 315  C               Str  - stride within blo Line 797  C               Str  - stride within blo
797        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
798        INTEGER bi, bj, bk        INTEGER bi, bj, bk
799        LOGICAL validRange        LOGICAL validRange
800    CEOP
801    
802        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
803        small  = 1. _d -15        small  =  1. _d -15
804        fMin   =  1. _d 32        fMin   =  1. _d  32
805        fMax   = -1. _d 32        fMax   = -1. _d  32
806        validRange = .FALSE.        validRange = .FALSE.
807    
808  C--   Calculate field range  C--   Calculate field range
# Line 328  C--   Calculate field range Line 811  C--   Calculate field range
811          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
812           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
813            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
814             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
815              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
816       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
817              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
818       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
819             ENDIF             ENDIF
820            ENDDO            ENDDO
# Line 340  C--   Calculate field range Line 823  C--   Calculate field range
823         ENDDO         ENDDO
824        ENDDO        ENDDO
825        fRange = fMax-fMin        fRange = fMax-fMin
826        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small ) validRange = .TRUE.
        validRange = .TRUE.  
       ENDIF  
827    
828  C--   Write field title and statistics  C--   Write field title and statistics
829        msgBuf = '// ======================================================='        msgBuf =
830         & '// ======================================================='
831        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
832       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
833        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 365  C--   Write field title and statistics Line 847  C--   Write field title and statistics
847       & '// CMAX = ', fMax       & '// CMAX = ', fMax
848        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
849       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
850        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
851       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
852         &  '// CINT = ', fRange/FLOAT(lChlist-1)
853          ELSE
854           WRITE(msgBuf,'(A,1PE30.15)')
855         &  '// CINT = ', 0.
856          ENDIF
857        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
858       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
859        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 398  C--   Write field title and statistics Line 885  C--   Write field title and statistics
885       &  ':',kStr,')'       &  ':',kStr,')'
886        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
887       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
888        msgBuf = '// ======================================================='        msgBuf =
889         & '// ======================================================='
890        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
891       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
892    
893    c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
894    c      msgBuf =
895    c    &  'Model domain too big to print to terminal - skipping I/O'
896    c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
897    c    &                   SQUEEZE_RIGHT, 1)
898    c      RETURN
899    c     endif
900    
901  C--   Write field  C--   Write field
902  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
903  C     acc = accross the page  C     acc = accross the page
# Line 494  C      X across, Z down slice Line 990  C      X across, Z down slice
990         pltStep = sNy         pltStep = sNy
991         pltLab  = 'J ='         pltLab  = 'J ='
992        ENDIF        ENDIF
993    C-    check if it fits into buffer (-10 should be enough but -12 is safer):
994          IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
995         &     .AND. validRange ) THEN
996           msgBuf =
997         &  'Model domain too big to print to terminal - skipping I/O'
998           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
999         &                   SQUEEZE_RIGHT, 1)
1000           validRange = .FALSE.
1001          ENDIF
1002        IF ( validRange ) THEN        IF ( validRange ) THEN
1003  C      Header  C      Header
1004  C      Data  C      Data
1005         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1006          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1007           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1008       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1009           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1010       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1011           plotBuf = ' '           plotBuf = ' '
1012           iBuf = 6           iBuf = 6
1013           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1014            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1015             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 526  C      Data Line 1031  C      Data
1031           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1032       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1033           plotBuf = dwnLab           plotBuf = dwnLab
1034           iBuf = 7           iBuf = 7
1035           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1036            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1037             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 534  C      Data Line 1039  C      Data
1039             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1040              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1041             ELSE             ELSE
1042              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1043             ENDIF             ENDIF
1044            ENDDO            ENDDO
1045           ENDDO           ENDDO
# Line 543  C      Data Line 1048  C      Data
1048       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1049           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1050            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1051             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1052       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1053             iBuf = 7             iBuf = 7
1054             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 556  C      Data Line 1061  C      Data
1061               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1062                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1063               ENDIF               ENDIF
1064               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1065       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1066         &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1067       &             )+1       &             )+1
1068               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               ELSE
1069                  IDX = 1
1070                 ENDIF
1071                 IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1072       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1073               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1074                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1075       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1076               ENDIF               ENDIF
1077              ENDDO              ENDDO
# Line 576  C      Data Line 1085  C      Data
1085         ENDDO         ENDDO
1086        ENDIF        ENDIF
1087  C--   Write delimiter  C--   Write delimiter
1088        msgBuf = '// ======================================================='        msgBuf =
1089         & '// ======================================================='
1090        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1091       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1092        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1093         & '// END OF FIELD                                          ='
1094        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1095       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1096        msgBuf = '// ======================================================='        msgBuf =
1097         & '// ======================================================='
1098        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1099       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1100        msgBuf = ' '        msgBuf = ' '
# Line 592  C--   Write delimiter Line 1104  C--   Write delimiter
1104        RETURN        RETURN
1105        END        END
1106    
1107  CStartOfInterface  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1108        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,  CBOP
1109    C     !ROUTINE: PRINT_MAPRL
1110    C     !INTERFACE:
1111          SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
1112       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
1113       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
1114       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
1115       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
1116       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
1117       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
1118  C     /==========================================================\  
1119  C     | SUBROUTINE PRINT_MAPR8                                   |  C     !DESCRIPTION:
1120  C     | o Does textual mapping printing of a field.              |  C     *==========================================================*
1121  C     |==========================================================|  C     | SUBROUTINE PRINT\_MAPRL
1122  C     | This routine does the actual formatting of the data      |  C     | o Does textual mapping printing of a field.
1123  C     | and printing to a file. It assumes an array using the    |  C     *==========================================================*
1124  C     | MITgcm UV indexing scheme and base index variables.      |  C     | This routine does the actual formatting of the data
1125  C     | User code should call an interface routine like          |  C     | and printing to a file. It assumes an array using the
1126  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  C     | MITgcm UV indexing scheme and base index variables.
1127  C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  C     | User code should call an interface routine like
1128  C     | is specficied through the "plotMode" argument. All the   |  C     | PLOT\_FIELD\_XYRL( ... ) rather than this code directly.
1129  C     | plots made by a single call to this routine will use the |  C     | Text plots can be oriented XY, YZ, XZ. An orientation
1130  C     | same contour interval. The plot range (iMin,...,byStr)   |  C     | is specficied through the "plotMode" argument. All the
1131  C     | can be three-dimensional. A separate plot is made for    |  C     | plots made by a single call to this routine will use the
1132  C     | each point in the plot range normal to the orientation.  |  C     | same contour interval. The plot range (iMin,...,byStr)
1133  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  C     | can be three-dimensional. A separate plot is made for
1134  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  C     | each point in the plot range normal to the orientation.
1135  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).
1136  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
1137  C     |      and jMin:jMax step jStr.                            |  C     |      plots - one for K=1, one for K=3 and one for K=5.
1138  C     \==========================================================/  C     |      Each plot would have extents iMin:iMax step iStr
1139    C     |      and jMin:jMax step jStr.
1140    C     *==========================================================*
1141    
1142    C     !USES:
1143          IMPLICIT NONE
1144    
1145  C     == Global variables ==  C     == Global variables ==
1146  #include "SIZE.h"  #include "SIZE.h"
1147  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
1148    
1149    C     !INPUT/OUTPUT PARAMETERS:
1150  C     == Routine arguments ==  C     == Routine arguments ==
1151  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
1152  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 637  C     jLo, jHi     be five-dimensional. Line 1157  C     jLo, jHi     be five-dimensional.
1157  C     kLo, kHi  C     kLo, kHi
1158  C     nBx, nBy  C     nBx, nBy
1159  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
1160  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
1161  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
1162  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
1163  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 648  C     kStr Line 1168  C     kStr
1168        INTEGER jLo, jHi        INTEGER jLo, jHi
1169        INTEGER kLo, kHi        INTEGER kLo, kHi
1170        INTEGER nBx, nBy        INTEGER nBx, nBy
1171        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
1172        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
1173        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
1174        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
1175        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
1176        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
1177  CEndOfInterface  
1178  C     == Local variables ==  C     !FUNCTIONS:
1179        INTEGER  IFNBLNK        INTEGER  IFNBLNK
1180        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
1181        INTEGER  ILNBLNK        INTEGER  ILNBLNK
1182        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
1183    
1184    C     !LOCAL VARIABLES:
1185  C     == Local variables ==  C     == Local variables ==
1186  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
1187  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 684  C               Min  - Start index withi Line 1205  C               Min  - Start index withi
1205  C               Max  - End index within block  C               Max  - End index within block
1206  C               Str  - stride within block  C               Str  - stride within block
1207        INTEGER MAX_LEN_PLOTBUF        INTEGER MAX_LEN_PLOTBUF
1208        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-4 )        PARAMETER ( MAX_LEN_PLOTBUF = MAX_LEN_MBUF-20 )
1209        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf        CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
1210        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
1211        INTEGER lChList        INTEGER lChList
1212        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
1213        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
1214        REAL fMin        _RL  fMin
1215        REAL fMax        _RL  fMax
1216        REAL fRange        _RL  fRange
1217        REAL val        _RL  val
1218        REAL small        _RL  small
1219        CHARACTER*2  accLab        CHARACTER*2  accLab
1220        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
1221        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 709  C               Str  - stride within blo Line 1230  C               Str  - stride within blo
1230        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1231        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1232        LOGICAL validRange        LOGICAL validRange
1233    CEOP
1234    
1235        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1236        small  = 1. _d -15        small  = 1. _d -15
# Line 722  C--   Calculate field range Line 1244  C--   Calculate field range
1244          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1245           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1246            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1247  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1248              IF ( fld(I,J,K,bi,bj) .LT. fMin )       &     THEN
1249                IF ( fld(I,J,K,bi,bj) .LT. fMin )
1250       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1251              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1252       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1253  C          ENDIF             ENDIF
1254            ENDDO            ENDDO
1255           ENDDO           ENDDO
1256          ENDDO          ENDDO
1257         ENDDO         ENDDO
1258        ENDDO        ENDDO
1259        fRange = fMax-fMin        fRange = fMax-fMin
1260        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small ) validRange = .TRUE.
        validRange = .TRUE.  
       ENDIF  
1261    
1262  C--   Write field title and statistics  C--   Write field title and statistics
1263        msgBuf = '// ======================================================='        msgBuf =
1264         & '// ======================================================='
1265        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1266       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1267        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 759  C--   Write field title and statistics Line 1281  C--   Write field title and statistics
1281       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1282        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1283       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1284        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1285           WRITE(msgBuf,'(A,1PE30.15)')
1286       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1287          ELSE
1288           WRITE(msgBuf,'(A,1PE30.15)')
1289         & '// CINT = ', 0.
1290          ENDIF
1291        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1292       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1293        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 792  C--   Write field title and statistics Line 1319  C--   Write field title and statistics
1319       &  ':',kStr,')'       &  ':',kStr,')'
1320        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1321       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1322        msgBuf = '// ======================================================='        msgBuf =
1323         & '// ======================================================='
1324        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1325       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1326    
1327    c     if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1328    c      msgBuf =
1329    c    &  'Model domain too big to print to terminal - skipping I/O'
1330    c      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1331    c    &                   SQUEEZE_RIGHT, 1)
1332    c      RETURN
1333    c     endif
1334    
1335  C--   Write field  C--   Write field
1336  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1337  C     acc = accross the page  C     acc = accross the page
# Line 888  C      X across, Z down slice Line 1424  C      X across, Z down slice
1424         pltStep = sNy         pltStep = sNy
1425         pltLab  = 'J ='         pltLab  = 'J ='
1426        ENDIF        ENDIF
1427    C-    check if it fits into buffer (-10 should be enough but -12 is safer):
1428          IF ( (accMax-accMin+1)*(accBhi-accBlo+1).GT.MAX_LEN_PLOTBUF-12
1429         &     .AND. validRange ) THEN
1430           msgBuf =
1431         &  'Model domain too big to print to terminal - skipping I/O'
1432           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1433         &                   SQUEEZE_RIGHT, 1)
1434           validRange = .FALSE.
1435          ENDIF
1436        IF ( validRange ) THEN        IF ( validRange ) THEN
1437  C      Header  C      Header
1438  C      Data  C      Data
1439         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1440          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1441           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1442       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1443           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1444       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1445           plotBuf = ' '           plotBuf = ' '
1446           iBuf = 6           iBuf = 6
1447           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1448            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1449             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 919  C      Data Line 1464  C      Data
1464           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1465       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1466           plotBuf = dwnLab           plotBuf = dwnLab
1467           iBuf = 7           iBuf = 7
1468           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1469            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1470             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 927  C      Data Line 1472  C      Data
1472             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1473              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1474             ELSE             ELSE
1475              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1476             ENDIF             ENDIF
1477            ENDDO            ENDDO
1478           ENDDO           ENDDO
# Line 935  C      Data Line 1480  C      Data
1480       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1481           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1482            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1483             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1484       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1485             iBuf = 7             iBuf = 7
1486             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 948  C      Data Line 1493  C      Data
1493               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1494                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1495               ENDIF               ENDIF
1496               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1497       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1498       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1499               IF ( iBuf .LE. MAX_LEN_PLOTBUF )       &              )+1
1500                 ELSE
1501                  IDX = 1
1502                 ENDIF
1503                 IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1504       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1505               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1506                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1507       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1508               ENDIF               ENDIF
1509              ENDDO              ENDDO
# Line 967  C      Data Line 1516  C      Data
1516         ENDDO         ENDDO
1517        ENDIF        ENDIF
1518  C--   Write delimiter  C--   Write delimiter
1519        msgBuf = '// ======================================================='        msgBuf =
1520         & '// ======================================================='
1521        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1522       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1523        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1524         & '// END OF FIELD                                          ='
1525        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1526       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1527        msgBuf = '// ======================================================='        msgBuf =
1528         & '// ======================================================='
1529        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1530       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1531        msgBuf = ' '        msgBuf = ' '
# Line 982  C--   Write delimiter Line 1534  C--   Write delimiter
1534    
1535        RETURN        RETURN
1536        END        END
   
 CStartOfInterface  
       SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )  
 C     /============================================================\  
 C     | SUBROUTINE PRINT_MESSAGE                                   |  
 C     | o Write out informational message using "standard" format. |  
 C     | Notes                                                      |  
 C     | =====                                                      |  
 C     | o Some system's I/O is not "thread-safe". For this reason  |  
 C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  
 C     |   critical region is defined around the write here. In some|  
 C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  
 C     |   for thread number 1 - writes for other threads are       |  
 C     |   ignored!                                                 |  
 C     | o In a non-parallel form these routines can still be used. |  
 C     |   to produce pretty printed output!                        |  
 C     \============================================================/  
 C     == Global data ==  
 #include "SIZE.h"  
 #include "EEPARAMS.h"  
 #include "EESUPPORT.h"  
 C     == Routine arguments ==  
 C     message - Message to write  
 C     unit    - Unit number to write to  
 C     sq      - Justification option  
       CHARACTER*(*) message  
       INTEGER       unit  
       CHARACTER*(*) sq  
       INTEGER  myThid  
 CEndOfInterface  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
 C     == Local variables ==  
       INTEGER iStart  
       INTEGER iEnd  
       CHARACTER*9 idString  
 C--   Find beginning and end of message  
       IF ( sq .EQ. SQUEEZE_BOTH .OR.  
      &     sq .EQ. SQUEEZE_LEFT ) THEN  
        iStart = IFNBLNK( message )  
       ELSE  
        iStart = 1  
       ENDIF  
       IF ( sq .EQ. SQUEEZE_BOTH .OR.  
      &     sq .EQ. SQUEEZE_RIGHT ) THEN  
        iEnd   = ILNBLNK( message )  
       ELSE  
        iEnd   = LEN(message)  
       ENDIF  
 C--   Test to see if in multi-process ( or multi-threaded ) mode.  
 C     If so include process or thread identifier.  
       IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN  
 C--    Write single process format  
        IF ( message .EQ. ' ' ) THEN  
         WRITE(unit,'(A)') ' '  
        ELSE  
         WRITE(unit,'(A)') message(iStart:iEnd)  
        ENDIF  
       ELSEIF ( pidIO .EQ. myProcId ) THEN  
 C--    Write multi-process format  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _BEGIN_CRIT(myThid)  
 #endif  
         WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _END_CRIT(myThid)  
 #endif  
        IF ( message .EQ. ' ' ) THEN  
 C       PRINT can be called by several threads simultaneously.  
 C       The write statement may need to ne marked as a critical section.  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _BEGIN_CRIT(myThid)  
 #endif  
          WRITE(unit,'(A,A,A,A,A,A)')  
      &   '(',PROCESS_HEADER,' ',idString,')',' '  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
 #endif  
        ELSE  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _BEGIN_CRIT(myThid)  
 #endif  
          WRITE(unit,'(A,A,A,A,A,A,A)')  
      &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',  
      &   message(iStart:iEnd)  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
 #endif  
        ENDIF  
       ENDIF  
 C  
       RETURN  
       END  
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.31
  ViewVC Help
Powered by ViewVC 1.1.22