/[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.28 by jmc, Wed Jul 25 21:05:37 2007 UTC revision 1.29 by jmc, Tue Apr 21 16:02:42 2009 UTC
# Line 3  C $Name$ Line 3  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_i   Prints one-deimensional list of INTEGER  C--   o PRINT_ERROR    Does IO with **ERROR** highlighted header
11  C--                     numbers.  C--   o PRINT_LIST_I   Prints one-deimensional list of INTEGER
12  C--    o print_list_l   Prints one-deimensional list of LOGICAL  C--                    numbers.
13  C--                     variables.  C--   o PRINT_LIST_L   Prints one-deimensional list of LOGICAL
14  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--                    variables.
15  C--                     numbers.  C--   o PRINT_LIST_R8  Prints one-deimensional list of Real*8
16  C--    o print_maprs    Formats ABCD... contour map of a Real(_RS) field  C--                    numbers.
17  C--                     Uses print_message for writing  C--   o PRINT_MAPRS    Formats ABCD... contour map of a Real(_RS) field
18  C--    o print_maprl    Formats ABCD... contour map of a Real(_RL) field  C--                    Uses print_message for writing
19  C--                     Uses print_message for writing  C--   o PRINT_MAPRL    Formats ABCD... contour map of a Real(_RL) field
20  C--    o print_message  Does IO with unhighlighted header  C--                    Uses print_message for writing
21    
22  CBOP                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     !ROUTINE: PRINT_ERROR  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    
48    C     == Global data ==
49    #include "SIZE.h"
50    #include "EEPARAMS.h"
51    #include "EESUPPORT.h"
52          INTEGER  IFNBLNK
53          EXTERNAL IFNBLNK
54          INTEGER  ILNBLNK
55          EXTERNAL ILNBLNK
56    
57    C     !INPUT/OUTPUT PARAMETERS:
58    C     == Routine arguments ==
59    C     message :: Message to write
60    C     unit    :: Unit number to write to
61    C     sq      :: Justification option
62          CHARACTER*(*) message
63          INTEGER       unit
64          CHARACTER*(*) sq
65          INTEGER  myThid
66    
67    C     !LOCAL VARIABLES:
68    C     == Local variables ==
69    C     iStart, iEnd :: String indexing variables
70    C     idString     :: Temp. for building prefix.
71          INTEGER iStart
72          INTEGER iEnd
73          CHARACTER*9 idString
74    CEOP
75    
76    C--   Find beginning and end of message
77          IF ( sq .EQ. SQUEEZE_BOTH .OR.
78         &     sq .EQ. SQUEEZE_LEFT ) THEN
79           iStart = IFNBLNK( message )
80          ELSE
81           iStart = 1
82          ENDIF
83          IF ( sq .EQ. SQUEEZE_BOTH .OR.
84         &     sq .EQ. SQUEEZE_RIGHT ) THEN
85           iEnd   = ILNBLNK( message )
86          ELSE
87           iEnd   = LEN(message)
88          ENDIF
89    C--   Test to see if in multi-process ( or multi-threaded ) mode.
90    C     If so include process or thread identifier.
91          IF ( numberOfProcs .EQ. 0 .AND. nThreads .EQ. 1 ) THEN
92    C--    Write single process format
93           IF ( message .EQ. ' ' ) THEN
94            WRITE(unit,'(A)') ' '
95           ELSE
96            WRITE(unit,'(A)') message(iStart:iEnd)
97           ENDIF
98          ELSEIF ( pidIO .EQ. myProcId ) THEN
99    C--    Write multi-process format
100    #ifndef FMTFTN_IO_THREAD_SAFE
101           _BEGIN_CRIT(myThid)
102    #endif
103            WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
104    #ifndef FMTFTN_IO_THREAD_SAFE
105           _END_CRIT(myThid)
106    #endif
107           IF ( message .EQ. ' ' ) THEN
108    C       PRINT can be called by several threads simultaneously.
109    C       The write statement may need to ne marked as a critical section.
110    #ifndef FMTFTN_IO_THREAD_SAFE
111            _BEGIN_CRIT(myThid)
112    #endif
113             WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
114         &   '(',PROCESS_HEADER,' ',idString,')',' '
115    #ifndef FMTFTN_IO_THREAD_SAFE
116            _END_CRIT(myThid)
117    #endif
118           ELSE
119    #ifndef FMTFTN_IO_THREAD_SAFE
120            _BEGIN_CRIT(myThid)
121    #endif
122             WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
123         &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',
124         &   message(iStart:iEnd)
125    #ifndef FMTFTN_IO_THREAD_SAFE
126            _END_CRIT(myThid)
127    #endif
128           ENDIF
129          ENDIF
130    
131    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
132    C--   if error message, also write directly to unit 0 :
133          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
134         &     .AND. unit.EQ.errorMessageUnit ) THEN
135            iEnd   = ILNBLNK( message )
136            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
137          ENDIF
138    #endif
139    C
140     1000 CONTINUE
141          RETURN
142      999 CONTINUE
143           ioErrorCount(myThid) = ioErrorCount(myThid)+1
144          GOTO 1000
145    
146          END
147    
148    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
149    CBOP
150    C     !ROUTINE: PRINT_ERROR
151  C     !INTERFACE:  C     !INTERFACE:
152        SUBROUTINE PRINT_ERROR( message , myThid )        SUBROUTINE PRINT_ERROR( message , myThid )
       IMPLICIT NONE  
153    
154  C     !DESCRIPTION:  C     !DESCRIPTION:
155  C     *============================================================*  C     *============================================================*
156  C     | SUBROUTINE PRINT\_ERROR                                        C     | SUBROUTINE PRINT\_ERROR
157  C     | o Write out error message using "standard" format.            C     | o Write out error message using "standard" format.
158  C     *============================================================*  C     *============================================================*
159  C     | Notes                                                        C     | Notes
160  C     | =====                                                        C     | =====
161  C     | o Some system   I/O is not "thread-safe". For this reason    C     | o Some system   I/O is not "thread-safe". For this reason
162  C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a          C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a
163  C     |   critical region is defined around the write here. In some  C     |   critical region is defined around the write here. In some
164  C     |   cases  BEGIN\_CRIT() is approximated by only doing writes    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes
165  C     |   for thread number 1 - writes for other threads are          C     |   for thread number 1 - writes for other threads are
166  C     |   ignored!                                                    C     |   ignored!
167  C     | o In a non-parallel form these routines are still used    C     | o In a non-parallel form these routines are still used
168  C     |   to produce pretty printed output. The process and thread  C     |   to produce pretty printed output. The process and thread
169  C     |   id prefix is omitted in this case.  C     |   id prefix is omitted in this case.
170  C     *============================================================*  C     *============================================================*
171    
172  C     !USES:  C     !USES:
173          IMPLICIT NONE
174    
175  C     == Global data ==  C     == Global data ==
176  #include "SIZE.h"  #include "SIZE.h"
177  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 81  C--    Write single process format Line 207  C--    Write single process format
207         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
208          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
209         ELSE         ELSE
210          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
211       &   message(iStart:iEnd)       &   message(iStart:iEnd)
212         ENDIF         ENDIF
213        ELSE        ELSE
# Line 99  C--    Write multi-process format Line 225  C--    Write multi-process format
225           WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid           WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
226    
227           IF ( iEnd.EQ.0 ) THEN           IF ( iEnd.EQ.0 ) THEN
228  c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
229            WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')            WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
230       &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
231       &    ' '       &    ' '
232           ELSE           ELSE
233  c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
234            WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')            WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
235       &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
236       &    message(iStart:iEnd)       &    message(iStart:iEnd)
237           ENDIF           ENDIF
238         ENDIF         ENDIF
# Line 140  c      ioErrorCount(myThid) = ioErrorCou Line 266  c      ioErrorCount(myThid) = ioErrorCou
266  c     GOTO 1000  c     GOTO 1000
267        END        END
268    
269    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
270  CBOP  CBOP
271  C     !ROUTINE: PRINT_LIST_I  C     !ROUTINE: PRINT_LIST_I
   
272  C     !INTERFACE:  C     !INTERFACE:
273        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,        SUBROUTINE PRINT_LIST_I( fld, iFirst, iLast, index_type,
274       &                         markEnd, compact, ioUnit )       &                         markEnd, compact, ioUnit )
275        IMPLICIT NONE  
276  C     !DESCRIPTION:  C     !DESCRIPTION:
277  C     *==========================================================*  C     *==========================================================*
278  C     | o SUBROUTINE PRINT\_LIST\_I                                  C     | o SUBROUTINE PRINT\_LIST\_I
279  C     *==========================================================*  C     *==========================================================*
280  C     | Routine for producing list of values for a field with      C     | Routine for producing list of values for a field with
281  C     | duplicate values collected into                            C     | duplicate values collected into
282  C     |    n \@ value                                                C     |    n \@ value
283  C     | record.                                                    C     | record.
284  C     *==========================================================*  C     *==========================================================*
285    
286  C     !USES:  C     !USES:
287  C     == Global data ==          IMPLICIT NONE
288    
289    C     == Global data ==
290  #include "SIZE.h"  #include "SIZE.h"
291  #include "EEPARAMS.h"  #include "EEPARAMS.h"
292    
293  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
294  C     == Routine arguments ==  C     == Routine arguments ==
295  C     fld    ::  Data to be printed  C     fld     :: Data to be printed
296  C     lFld   ::  Number of elements to be printed  C     iFirst  :: First element to print
297  C     index_type :: Flag indicating which type of index to print  C     iLast   :: Last element to print
298  C                   INDEX_K    => /* K = nnn */  C  index_type :: Flag indicating which type of index to print
299  C                   INDEX_I    => /* I = nnn */  C                  INDEX_K    => /* K = nnn */
300  C                   INDEX_J    => /* J = nnn */  C                  INDEX_I    => /* I = nnn */
301  C                   INDEX_NONE =>  C                  INDEX_J    => /* J = nnn */
302  C     compact ::  Flag to control use of repeat symbol for same valued  C                  INDEX_NONE =>
303  C                 fields.  C     markEnd :: Flag to control whether there is a separator after the
304  C     markEnd ::  Flag to control whether there is a separator after the  C                last element
305  C                 last element  C     compact :: Flag to control use of repeat symbol for same valued
306  C     ioUnit ::   Unit number for IO.  C                fields.
307        INTEGER lFld  C     ioUnit  :: Unit number for IO.
308          INTEGER iFirst, iLast
309          INTEGER fld(iFirst:iLast)
310        INTEGER index_type        INTEGER index_type
       INTEGER fld(lFld)  
311        LOGICAL markEnd        LOGICAL markEnd
312        LOGICAL compact        LOGICAL compact
313        INTEGER ioUnit        INTEGER ioUnit
# Line 201  C     K    - Loop counter Line 330  C     K    - Loop counter
330        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
331        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
332        CHARACTER*3 index_lab        CHARACTER*3 index_lab
333          CHARACTER*25 fmt1, fmt2
334        INTEGER K        INTEGER K
335  CEOP  CEOP
336    
# Line 213  CEOP Line 343  CEOP
343        ELSE        ELSE
344         index_lab = '?='         index_lab = '?='
345        ENDIF        ENDIF
346    C-    fortran format to write 1 or 2 indices:
347          fmt1='(A,1X,A,I3,1X,A)'
348          fmt2='(A,1X,A,I3,A,I3,1X,A)'
349          IF ( iLast.GE.1000 ) THEN
350            K = 1+INT(LOG10(FLOAT(iLast)))
351            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
352            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
353          ENDIF
354        commOpen  = '/*'        commOpen  = '/*'
355        commClose = '*/'        commClose = '*/'
356        iLo = 1        iLo = iFirst
357        iHi = 1        iHi = iFirst
358        punc = ','        punc = ','
359        xOld = fld(1)        xOld = fld(iFirst)
360        DO K=2,lFld        DO K = iFirst+1,iLast
361         xNew = fld(K  )         xNew = fld(K  )
362         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
363          nDup = iHi-iLo+1          nDup = iHi-iLo+1
364          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
365           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
366           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
367       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt1)
368       &    commOpen,index_lab,iLo,commClose       &    commOpen,index_lab,iLo,commClose
369          ELSE          ELSE
370           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
371           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
372       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
373       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
374          ENDIF          ENDIF
375          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 247  CEOP Line 385  CEOP
385        nDup = iHi-iLo+1        nDup = iHi-iLo+1
386        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
387         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
388         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
389       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
390       &  commOpen,index_lab,iLo,commClose       &  commOpen,index_lab,iLo,commClose
391        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
392         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
393         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
394       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
395       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
396        ENDIF        ENDIF
397        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 261  CEOP Line 399  CEOP
399        RETURN        RETURN
400        END        END
401    
402    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
403  CBOP  CBOP
404  C     !ROUTINE: PRINT_LIST_L  C     !ROUTINE: PRINT_LIST_L
   
405  C     !INTERFACE:  C     !INTERFACE:
406        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,        SUBROUTINE PRINT_LIST_L( fld, iFirst, iLast, index_type,
407       &                         compact, ioUnit )       &                         markEnd, compact, ioUnit )
408        IMPLICIT NONE  
409  C     !DESCRIPTION:  C     !DESCRIPTION:
410  C     *==========================================================*  C     *==========================================================*
411  C     | o SUBROUTINE PRINT\_LIST\_L                                  C     | o SUBROUTINE PRINT\_LIST\_L
412  C     *==========================================================*  C     *==========================================================*
413  C     | Routine for producing list of values for a field with      C     | Routine for producing list of values for a field with
414  C     | duplicate values collected into                            C     | duplicate values collected into
415  C     |    n \@ value                                                C     |    n \@ value
416  C     | record.                                                    C     | record.
417  C     *==========================================================*  C     *==========================================================*
418    
419  C     !USES:  C     !USES:
420  C     == Global data ==          IMPLICIT NONE
421    
422    C     == Global data ==
423  #include "SIZE.h"  #include "SIZE.h"
424  #include "EEPARAMS.h"  #include "EEPARAMS.h"
425    
426  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
427  C     == Routine arguments ==  C     == Routine arguments ==
428  C     fld    -  Data to be printed  C     fld     :: Data to be printed
429  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
430  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
431    C  index_type :: Flag indicating which type of index to print
432  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
433  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
434  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
435  C                  INDEX_NONE =>  C                  INDEX_NONE =>
436  C     compact -  Flag to control use of repeat symbol for same valued  C     markEnd :: Flag to control whether there is a separator after the
 C                fields.  
 C     markEnd -  Flag to control whether there is a separator after the  
437  C                last element  C                last element
438  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
439        INTEGER lFld  C                fields.
440    C     ioUnit  :: Unit number for IO.
441          INTEGER iFirst, iLast
442          LOGICAL fld(iFirst:iLast)
443        INTEGER index_type        INTEGER index_type
       LOGICAL fld(lFld)  
444        LOGICAL markEnd        LOGICAL markEnd
445        LOGICAL compact        LOGICAL compact
446        INTEGER ioUnit        INTEGER ioUnit
# Line 322  C     K    - Loop counter Line 463  C     K    - Loop counter
463        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
464        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
465        CHARACTER*3 index_lab        CHARACTER*3 index_lab
466          CHARACTER*25 fmt1, fmt2
467        INTEGER K        INTEGER K
468  CEOP  CEOP
469    
# Line 334  CEOP Line 476  CEOP
476        ELSE        ELSE
477         index_lab = '?='         index_lab = '?='
478        ENDIF        ENDIF
479    C-    fortran format to write 1 or 2 indices:
480          fmt1='(A,1X,A,I3,1X,A)'
481          fmt2='(A,1X,A,I3,A,I3,1X,A)'
482          IF ( iLast.GE.1000 ) THEN
483            K = 1+INT(LOG10(FLOAT(iLast)))
484            WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
485            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
486          ENDIF
487        commOpen  = '/*'        commOpen  = '/*'
488        commClose = '*/'        commClose = '*/'
489        iLo = 1        iLo = iFirst
490        iHi = 1        iHi = iFirst
491        punc = ','        punc = ','
492        xOld = fld(1)        xOld = fld(iFirst)
493        DO K=2,lFld        DO K = iFirst+1,iLast
494         xNew = fld(K  )         xNew = fld(K  )
495         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN         IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
496          nDup = iHi-iLo+1          nDup = iHi-iLo+1
497          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
498           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
499           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
500       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt1)
501       &    commOpen,index_lab,iLo,commClose       &    commOpen,index_lab,iLo,commClose
502          ELSE          ELSE
503           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
504           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
505       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
506       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
507          ENDIF          ENDIF
508          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 368  CEOP Line 518  CEOP
518        nDup = iHi-iLo+1        nDup = iHi-iLo+1
519        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
520         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
521         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
522       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
523       &    commOpen,index_lab,iLo,commClose       &    commOpen,index_lab,iLo,commClose
524        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
525         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
526         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
527       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
528       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
529        ENDIF        ENDIF
530        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
# Line 382  CEOP Line 532  CEOP
532        RETURN        RETURN
533        END        END
534    
535    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
536  CBOP  CBOP
537  C     !ROUTINE: PRINT_LIST_R8  C     !ROUTINE: PRINT_LIST_R8
538  C     !INTERFACE:  C     !INTERFACE:
539        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,        SUBROUTINE PRINT_LIST_R8( fld, iFirst, iLast, index_type,
540       &    markEnd, compact, ioUnit )       &                          markEnd, compact, ioUnit )
541        IMPLICIT NONE  
542  C     !DESCRIPTION:  C     !DESCRIPTION:
543  C     *==========================================================*  C     *==========================================================*
544  C     | o SUBROUTINE PRINT\_LIST\_R8  C     | o SUBROUTINE PRINT\_LIST\_R8
545  C     *==========================================================*  C     *==========================================================*
546  C     | Routine for producing list of values for a field with      C     | Routine for producing list of values for a field with
547  C     | duplicate values collected into                            C     | duplicate values collected into
548  C     |    n \@ value                                                C     |    n \@ value
549  C     | record.                                                    C     | record.
550  C     *==========================================================*  C     *==========================================================*
551    
552  C     !USES:  C     !USES:
553          IMPLICIT NONE
554    
555  C     == Global data ==  C     == Global data ==
556  #include "SIZE.h"  #include "SIZE.h"
557  #include "EEPARAMS.h"  #include "EEPARAMS.h"
558    
559  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
560  C     == Routine arguments ==  C     == Routine arguments ==
561  C     fld    -  Data to be printed  C     fld     :: Data to be printed
562  C     lFld   -  Number of elements to be printed  C     iFirst  :: First element to print
563  C     index_type - Flag indicating which type of index to print  C     iLast   :: Last element to print
564    C  index_type :: Flag indicating which type of index to print
565  C                  INDEX_K    => /* K = nnn */  C                  INDEX_K    => /* K = nnn */
566  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
567  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
568  C                  INDEX_NONE =>  C                  INDEX_NONE =>
569  C     compact -  Flag to control use of repeat symbol for same valued  C     markEnd :: Flag to control whether there is a separator after the
 C                fields.  
 C     markEnd -  Flag to control whether there is a separator after the  
570  C                last element  C                last element
571  C     ioUnit -  Unit number for IO.  C     compact :: Flag to control use of repeat symbol for same valued
572        INTEGER lFld  C                fields.
573    C     ioUnit  :: Unit number for IO.
574          INTEGER iFirst, iLast
575          Real*8  fld(iFirst:iLast)
576        INTEGER index_type        INTEGER index_type
       Real*8  fld(lFld)  
577        LOGICAL markEnd        LOGICAL markEnd
578        LOGICAL compact        LOGICAL compact
579        INTEGER ioUnit        INTEGER ioUnit
# Line 458  CEOP Line 612  CEOP
612  C-    fortran format to write 1 or 2 indices:  C-    fortran format to write 1 or 2 indices:
613        fmt1='(A,1X,A,I3,1X,A)'        fmt1='(A,1X,A,I3,1X,A)'
614        fmt2='(A,1X,A,I3,A,I3,1X,A)'        fmt2='(A,1X,A,I3,A,I3,1X,A)'
615        IF ( lFld.GE.1000 ) THEN        IF ( iLast.GE.1000 ) THEN
616          K = 1+INT(LOG10(FLOAT(lFld)))          K = 1+INT(LOG10(FLOAT(iLast)))
617          WRITE(fmt1,'(A,I1,A)') '(A,1X,A,I',K,',1X,A)'          WRITE(fmt1,'(A,I1,A)')      '(A,1X,A,I',K,',1X,A)'
618          WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'          WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
619        ENDIF        ENDIF
620        commOpen  = '/*'        commOpen  = '/*'
621        commClose = '*/'        commClose = '*/'
622        iLo = 1        iLo = iFirst
623        iHi = 1        iHi = iFirst
624        punc = ','        punc = ','
625        xOld = fld(1)        xOld = fld(iFirst)
626        DO K=2,lFld        DO K = iFirst+1,iLast
627         xNew = fld(K  )         xNew = fld(K  )
628         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN         IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
629          nDup = iHi-iLo+1          nDup = iHi-iLo+1
# Line 484  C-    fortran format to write 1 or 2 ind Line 638  C-    fortran format to write 1 or 2 ind
638       &    WRITE(msgBuf(45:),fmt2)       &    WRITE(msgBuf(45:),fmt2)
639       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
640          ENDIF          ENDIF
641          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
      &    SQUEEZE_RIGHT , 1)  
642          iLo  = K          iLo  = K
643          iHi  = K          iHi  = K
644          xOld = xNew          xOld = xNew
# Line 507  C-    fortran format to write 1 or 2 ind Line 660  C-    fortran format to write 1 or 2 ind
660       &  WRITE(msgBuf(45:),fmt2)       &  WRITE(msgBuf(45:),fmt2)
661       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
662        ENDIF        ENDIF
663        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
      &    SQUEEZE_RIGHT , 1)  
664    
665        RETURN        RETURN
666        END        END
667    
668    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
669  CBOP  CBOP
670  C     !ROUTINE: PRINT_MAPRS  C     !ROUTINE: PRINT_MAPRS
671  C     !INTERFACE:  C     !INTERFACE:
# Line 553  C     !USES: Line 706  C     !USES:
706  C     == Global variables ==  C     == Global variables ==
707  #include "SIZE.h"  #include "SIZE.h"
708  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
709        INTEGER  IFNBLNK        INTEGER  IFNBLNK
710        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
711        INTEGER  ILNBLNK        INTEGER  ILNBLNK
# Line 570  C     jLo, jHi     be five-dimensional. Line 722  C     jLo, jHi     be five-dimensional.
722  C     kLo, kHi  C     kLo, kHi
723  C     nBx, nBy  C     nBx, nBy
724  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
725  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
726  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
727  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
728  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 652  C--   Calculate field range Line 804  C--   Calculate field range
804           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
805            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
806             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
807              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
808       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
809              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
810       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
811             ENDIF             ENDIF
812            ENDDO            ENDDO
# Line 666  C--   Calculate field range Line 818  C--   Calculate field range
818        IF ( fRange .GT. small ) validRange = .TRUE.        IF ( fRange .GT. small ) validRange = .TRUE.
819    
820  C--   Write field title and statistics  C--   Write field title and statistics
821        msgBuf =        msgBuf =
822       & '// ======================================================='       & '// ======================================================='
823        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
824       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
# Line 725  C--   Write field title and statistics Line 877  C--   Write field title and statistics
877       &  ':',kStr,')'       &  ':',kStr,')'
878        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
879       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
880        msgBuf =        msgBuf =
881       & '// ======================================================='       & '// ======================================================='
882        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
883       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
# Line 849  C      Data Line 1001  C      Data
1001           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1002       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1003           plotBuf = ' '           plotBuf = ' '
1004           iBuf = 6           iBuf = 6
1005           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1006            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1007             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 871  C      Data Line 1023  C      Data
1023           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1024       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1025           plotBuf = dwnLab           plotBuf = dwnLab
1026           iBuf = 7           iBuf = 7
1027           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1028            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1029             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 888  C      Data Line 1040  C      Data
1040       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1041           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1042            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1043             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1044       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1045             iBuf = 7             iBuf = 7
1046             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 902  C      Data Line 1054  C      Data
1054                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1055               ENDIF               ENDIF
1056               IF ( validRange .AND. val .NE. 0. ) THEN               IF ( validRange .AND. val .NE. 0. ) THEN
1057                IDX = NINT(                IDX = NINT(
1058       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1059       &             )+1       &             )+1
1060               ELSE               ELSE
1061                IDX = 1                IDX = 1
1062               ENDIF               ENDIF
1063               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1064       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1065               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1066                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1067       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1068               ENDIF               ENDIF
1069              ENDDO              ENDDO
# Line 925  C      Data Line 1077  C      Data
1077         ENDDO         ENDDO
1078        ENDIF        ENDIF
1079  C--   Write delimiter  C--   Write delimiter
1080        msgBuf =        msgBuf =
1081       & '// ======================================================='       & '// ======================================================='
1082        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1083       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1084        msgBuf =        msgBuf =
1085       & '// END OF FIELD                                          ='       & '// END OF FIELD                                          ='
1086        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1087       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1088        msgBuf =        msgBuf =
1089       & '// ======================================================='       & '// ======================================================='
1090        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1091       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
# Line 944  C--   Write delimiter Line 1096  C--   Write delimiter
1096        RETURN        RETURN
1097        END        END
1098    
1099    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1100  CBOP  CBOP
1101  C     !ROUTINE: PRINT_MAPRL  C     !ROUTINE: PRINT_MAPRL
   
1102  C     !INTERFACE:  C     !INTERFACE:
1103        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
1104       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
# Line 985  C     !USES: Line 1137  C     !USES:
1137  C     == Global variables ==  C     == Global variables ==
1138  #include "SIZE.h"  #include "SIZE.h"
1139  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "EESUPPORT.h"  
1140        INTEGER  IFNBLNK        INTEGER  IFNBLNK
1141        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
1142        INTEGER  ILNBLNK        INTEGER  ILNBLNK
# Line 1002  C     jLo, jHi     be five-dimensional. Line 1153  C     jLo, jHi     be five-dimensional.
1153  C     kLo, kHi  C     kLo, kHi
1154  C     nBx, nBy  C     nBx, nBy
1155  C     iMin, iMax - Indexing for points to plot. Points from  C     iMin, iMax - Indexing for points to plot. Points from
1156  C     iStr         iMin -> iMax in steps of iStr are plotted  C     iStr         iMin -> iMax in steps of iStr are plotted
1157  C     jMin. jMax   and similarly for jMin, jMax, jStr and  C     jMin. jMax   and similarly for jMin, jMax, jStr and
1158  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr  C     jStr         kMin, kMax, kStr and bxMin, bxMax, bxStr
1159  C     kMin, kMax   byMin, byMax, byStr.  C     kMin, kMax   byMin, byMax, byStr.
# Line 1083  C--   Calculate field range Line 1234  C--   Calculate field range
1234          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
1235           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
1236            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
1237             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
1238       &     THEN       &     THEN
1239              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
1240       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
1241              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
1242       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1243             ENDIF             ENDIF
1244            ENDDO            ENDDO
# Line 1099  C--   Calculate field range Line 1250  C--   Calculate field range
1250        IF ( fRange .GT. small ) validRange = .TRUE.        IF ( fRange .GT. small ) validRange = .TRUE.
1251    
1252  C--   Write field title and statistics  C--   Write field title and statistics
1253        msgBuf =        msgBuf =
1254       & '// ======================================================='       & '// ======================================================='
1255        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1256       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
# Line 1158  C--   Write field title and statistics Line 1309  C--   Write field title and statistics
1309       &  ':',kStr,')'       &  ':',kStr,')'
1310        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1311       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1312        msgBuf =        msgBuf =
1313       & '// ======================================================='       & '// ======================================================='
1314        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1315       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
# Line 1282  C      Data Line 1433  C      Data
1433           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1434       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1435           plotBuf = ' '           plotBuf = ' '
1436           iBuf = 6           iBuf = 6
1437           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1438            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1439             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 1303  C      Data Line 1454  C      Data
1454           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1455       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
1456           plotBuf = dwnLab           plotBuf = dwnLab
1457           iBuf = 7           iBuf = 7
1458           DO bi=accBlo, accBhi, accBstr           DO bi=accBlo, accBhi, accBstr
1459            DO I=accMin, accMax, accStr            DO I=accMin, accMax, accStr
1460             iDx = accBase-1+(bi-1)*accStep+I             iDx = accBase-1+(bi-1)*accStep+I
# Line 1319  C      Data Line 1470  C      Data
1470       &                    SQUEEZE_RIGHT, 1)       &                    SQUEEZE_RIGHT, 1)
1471           DO bj=dwnBlo, dwnBhi, dwnBStr           DO bj=dwnBlo, dwnBhi, dwnBStr
1472            DO J=dwnMin, dwnMax, dwnStr            DO J=dwnMin, dwnMax, dwnStr
1473             WRITE(plotBuf,'(1X,I5,1X)')             WRITE(plotBuf,'(1X,I5,1X)')
1474       &      dwnBase-1+(bj-1)*dwnStep+J       &      dwnBase-1+(bj-1)*dwnStep+J
1475             iBuf = 7             iBuf = 7
1476             DO bi=accBlo,accBhi,accBstr             DO bi=accBlo,accBhi,accBstr
# Line 1333  C      Data Line 1484  C      Data
1484                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1485               ENDIF               ENDIF
1486               IF ( validRange .AND. val .NE. 0. ) THEN               IF ( validRange .AND. val .NE. 0. ) THEN
1487                IDX = NINT(                IDX = NINT(
1488       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1489       &              )+1       &              )+1
1490               ELSE               ELSE
1491                IDX = 1                IDX = 1
1492               ENDIF               ENDIF
1493               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1494       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1495               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
1496                IF ( iBuf .LE. MAX_LEN_PLOTBUF )                IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1497       &         plotBuf(iBuf:iBuf) = '.'       &         plotBuf(iBuf:iBuf) = '.'
1498               ENDIF               ENDIF
1499              ENDDO              ENDDO
# Line 1355  C      Data Line 1506  C      Data
1506         ENDDO         ENDDO
1507        ENDIF        ENDIF
1508  C--   Write delimiter  C--   Write delimiter
1509        msgBuf =        msgBuf =
1510       & '// ======================================================='       & '// ======================================================='
1511        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1512       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1513        msgBuf =        msgBuf =
1514       & '// END OF FIELD                                          ='       & '// END OF FIELD                                          ='
1515        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1516       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1517        msgBuf =        msgBuf =
1518       & '// ======================================================='       & '// ======================================================='
1519        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1520       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
# Line 1373  C--   Write delimiter Line 1524  C--   Write delimiter
1524    
1525        RETURN        RETURN
1526        END        END
   
 CBOP  
 C     !ROUTINE: PRINT_MESSAGE  
   
 C     !INTERFACE:  
       SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )  
       IMPLICIT NONE  
 C     !DESCRIPTION:  
 C     *============================================================*  
 C     | SUBROUTINE PRINT\_MESSAGE                                      
 C     | o Write out informational message using "standard" format.    
 C     *============================================================*  
 C     | Notes                                                        
 C     | =====                                                        
 C     | o Some system   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     !USES:  
 C     == Global data ==  
 #include "SIZE.h"  
 #include "EEPARAMS.h"  
 #include "EESUPPORT.h"  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
   
 C     !INPUT/OUTPUT PARAMETERS:  
 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  
   
 C     !LOCAL VARIABLES:  
 C     == Local variables ==  
 C     iStart, iEnd :: String indexing variables  
 C     idString     :: Temp. for building prefix.  
       INTEGER iStart  
       INTEGER iEnd  
       CHARACTER*9 idString  
 CEOP  
   
 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)',ERR=999)  
      &   '(',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)',ERR=999)  
      &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',  
      &   message(iStart:iEnd)  
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
 #endif  
        ENDIF  
       ENDIF  
   
 #ifndef DISABLE_WRITE_TO_UNIT_ZERO  
 C--   if error message, also write directly to unit 0 :  
       IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1  
      &     .AND. unit.EQ.errorMessageUnit ) THEN  
         iEnd   = ILNBLNK( message )  
         IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)  
       ENDIF  
 #endif  
 C  
  1000 CONTINUE  
       RETURN  
   999 CONTINUE  
        ioErrorCount(myThid) = ioErrorCount(myThid)+1  
       GOTO 1000  
   
       END  
Legend:
Removed from v.1.28  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.22