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

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

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

revision 1.3 by cnh, Thu Apr 23 20:56:54 1998 UTC revision 1.17 by cnh, Sun Feb 4 14:38:44 2001 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "CPP_EEOPTIONS.h"
5    
# Line 6  C--   File printf.F: Routines for perfor Line 7  C--   File printf.F: Routines for perfor
7  C--                  in the MITgcm UV implementation environment.  C--                  in the MITgcm UV implementation environment.
8  C--    Contents  C--    Contents
9  C--    o print_error    Does IO with **ERROR** highlighted header  C--    o print_error    Does IO with **ERROR** highlighted header
10    C--    o print_list_i   Prints one-deimensional list of INTEGER
11    C--                     numbers.
12    C--    o print_list_l   Prints one-deimensional list of LOGICAL
13    C--                     variables.
14    C--    o print_list_r8  Prints one-deimensional list of Real*8
15    C--                     numbers.
16    C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field
17    C--                     Uses print_message for writing
18  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field
19  C--                     Uses print_message for writing  C--                     Uses print_message for writing
20  C--    o print_message  Does IO with unhighlighted header  C--    o print_message  Does IO with unhighlighted header
# Line 17  C     | SUBROUTINE PRINT_ERROR Line 26  C     | SUBROUTINE PRINT_ERROR
26  C     | o Write out error message using "standard" format.         |  C     | o Write out error message using "standard" format.         |
27  C     | Notes                                                      |  C     | Notes                                                      |
28  C     | =====                                                      |  C     | =====                                                      |
29  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     | o Some system   I/O is not "thread-safe". For this reason  |
30  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
31  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
32  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
# Line 26  C     |   ignored! Line 35  C     |   ignored!
35  C     | o In a non-parallel form these routines can still be used. |  C     | o In a non-parallel form these routines can still be used. |
36  C     |   to produce pretty printed output!                        |  C     |   to produce pretty printed output!                        |
37  C     \============================================================/  C     \============================================================/
38          IMPLICIT NONE
39  C     == Global data ==  C     == Global data ==
40  #include "SIZE.h"  #include "SIZE.h"
41  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 52  C--    Write single process format Line 62  C--    Write single process format
62         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
63          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
64         ELSE         ELSE
65          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
66         &   message(iStart:iEnd)
67         ENDIF         ENDIF
68        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSEIF ( pidIO .EQ. myProcId ) THEN
69  C--    Write multi-process format  C--    Write multi-process format
# Line 69  C       The write statement may need to Line 80  C       The write statement may need to
80  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
81          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
82  #endif  #endif
83          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
84       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
85       &  ' '       &  ' '
86  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 79  C       The write statement may need to Line 90  C       The write statement may need to
90  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
91          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
92  #endif  #endif
93          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
94       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
95       &  message(iStart:iEnd)       &  message(iStart:iEnd)
96  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 88  C       The write statement may need to Line 99  C       The write statement may need to
99         ENDIF         ENDIF
100        ENDIF        ENDIF
101  C  C
102     1000 CONTINUE
103          RETURN
104    
105      999 CONTINUE
106           ioErrorCount(myThid) = ioErrorCount(myThid)+1
107          GOTO 1000
108          END
109    
110    CStartofinterface
111          SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
112         &                         markEnd, compact, ioUnit )
113    C     /==========================================================\
114    C     | o SUBROUTINE PRINT_LIST_I                                |
115    C     |==========================================================|
116    C     | Routine for producing list of values for a field with    |
117    C     | duplicate values collected into                          |
118    C     |    n @ value                                             |
119    C     | record.                                                  |
120    C     \==========================================================/
121          IMPLICIT NONE
122    
123    C     == Global data ==  
124    #include "SIZE.h"
125    #include "EEPARAMS.h"
126    
127    C     == Routine arguments ==
128    C     fld    -  Data to be printed
129    C     lFld   -  Number of elements to be printed
130    C     index_type - Flag indicating which type of index to print
131    C                  INDEX_K    => /* K = nnn */
132    C                  INDEX_I    => /* I = nnn */
133    C                  INDEX_J    => /* J = nnn */
134    C                  INDEX_NONE =>
135    C     compact -  Flag to control use of repeat symbol for same valued
136    C                fields.
137    C     markEnd -  Flag to control whether there is a separator after the
138    C                last element
139    C     ioUnit -  Unit number for IO.
140          INTEGER lFld
141          INTEGER index_type
142          INTEGER fld(lFld)
143          LOGICAL markEnd
144          LOGICAL compact
145          INTEGER ioUnit
146    CEndifinterface
147    
148    C     == Local variables ==
149    C     iLo  - Range index holders for selecting elements with
150    C     iHi    with the same value
151    C     nDup - Number of duplicates
152    C     xNew, xOld - Hold current and previous values of field
153    C     punc - Field separator
154    C     msgBuf - IO buffer
155    C     index_lab - Index for labelling elements
156    C     K    - Loop counter
157          INTEGER iLo
158          INTEGER iHi
159          INTEGER nDup
160          INTEGER xNew, xOld
161          CHARACTER punc
162          CHARACTER*(MAX_LEN_MBUF) msgBuf
163          CHARACTER*2 commOpen,commClose
164          CHARACTER*3 index_lab
165          INTEGER K
166    
167          IF     ( index_type .EQ. INDEX_I ) THEN
168           index_lab = 'I ='
169          ELSEIF ( index_type .EQ. INDEX_J ) THEN
170           index_lab = 'J ='
171          ELSEIF ( index_type .EQ. INDEX_K ) THEN
172           index_lab = 'K ='
173          ELSE
174           index_lab = '?='
175          ENDIF
176          commOpen  = '/*'
177          commClose = '*/'
178          iLo = 1
179          iHi = 1
180          punc = ','
181          xOld = fld(1)
182          DO K=2,lFld
183           xNew = fld(K  )
184           IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
185            nDup = iHi-iLo+1
186            IF ( nDup .EQ. 1 ) THEN
187             WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
188             IF ( index_type .NE. INDEX_NONE )
189         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
190         &    commOpen,index_lab,iLo,commClose
191            ELSE
192             WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
193             IF ( index_type .NE. INDEX_NONE )
194         &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
195         &    commOpen,index_lab,iLo,':',iHi,commClose
196            ENDIF
197            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
198            iLo  = K
199            iHi  = K
200            xOld = xNew
201           ELSE
202            iHi = K
203           ENDIF
204          ENDDO
205          punc = ' '
206          IF ( markEnd ) punc = ','
207          nDup = iHi-iLo+1
208          IF    ( nDup .EQ. 1 ) THEN
209           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
210           IF ( index_type .NE. INDEX_NONE )
211         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
212         &  commOpen,index_lab,iLo,commClose
213          ELSEIF( nDup .GT. 1 ) THEN
214           WRITE(msgBuf,'(I5,'' '',A,I9,A)') nDup,'@',xOld,punc
215           IF ( index_type .NE. INDEX_NONE )
216         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
217         &  commOpen,index_lab,iLo,':',iHi,commClose
218          ENDIF
219          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
220    
221          RETURN
222          END
223    
224    CStartofinterface
225          SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
226         &                         compact, ioUnit )
227    C     /==========================================================\
228    C     | o SUBROUTINE PRINT_LIST_L                                |
229    C     |==========================================================|
230    C     | Routine for producing list of values for a field with    |
231    C     | duplicate values collected into                          |
232    C     |    n @ value                                             |
233    C     | record.                                                  |
234    C     \==========================================================/
235          IMPLICIT NONE
236    
237    C     == Global data ==  
238    #include "SIZE.h"
239    #include "EEPARAMS.h"
240    
241    C     == Routine arguments ==
242    C     fld    -  Data to be printed
243    C     lFld   -  Number of elements to be printed
244    C     index_type - Flag indicating which type of index to print
245    C                  INDEX_K    => /* K = nnn */
246    C                  INDEX_I    => /* I = nnn */
247    C                  INDEX_J    => /* J = nnn */
248    C                  INDEX_NONE =>
249    C     compact -  Flag to control use of repeat symbol for same valued
250    C                fields.
251    C     markEnd -  Flag to control whether there is a separator after the
252    C                last element
253    C     ioUnit -  Unit number for IO.
254          INTEGER lFld
255          INTEGER index_type
256          LOGICAL fld(lFld)
257          LOGICAL markEnd
258          LOGICAL compact
259          INTEGER ioUnit
260    CEndifinterface
261    
262    C     == Local variables ==
263    C     iLo  - Range index holders for selecting elements with
264    C     iHi    with the same value
265    C     nDup - Number of duplicates
266    C     xNew, xOld - Hold current and previous values of field
267    C     punc - Field separator
268    C     msgBuf - IO buffer
269    C     index_lab - Index for labelling elements
270    C     K    - Loop counter
271          INTEGER iLo
272          INTEGER iHi
273          INTEGER nDup
274          LOGICAL xNew, xOld
275          CHARACTER punc
276          CHARACTER*(MAX_LEN_MBUF) msgBuf
277          CHARACTER*2 commOpen,commClose
278          CHARACTER*3 index_lab
279          INTEGER K
280    
281          IF     ( index_type .EQ. INDEX_I ) THEN
282           index_lab = 'I ='
283          ELSEIF ( index_type .EQ. INDEX_J ) THEN
284           index_lab = 'J ='
285          ELSEIF ( index_type .EQ. INDEX_K ) THEN
286           index_lab = 'K ='
287          ELSE
288           index_lab = '?='
289          ENDIF
290          commOpen  = '/*'
291          commClose = '*/'
292          iLo = 1
293          iHi = 1
294          punc = ','
295          xOld = fld(1)
296          DO K=2,lFld
297           xNew = fld(K  )
298           IF ( .NOT. compact .OR. (xNew .NEQV. xOld) ) THEN
299            nDup = iHi-iLo+1
300            IF ( nDup .EQ. 1 ) THEN
301             WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
302             IF ( index_type .NE. INDEX_NONE )
303         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
304         &    commOpen,index_lab,iLo,commClose
305            ELSE
306             WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
307             IF ( index_type .NE. INDEX_NONE )
308         &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
309         &    commOpen,index_lab,iLo,':',iHi,commClose
310            ENDIF
311            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
312            iLo  = K
313            iHi  = K
314            xOld = xNew
315           ELSE
316            iHi = K
317           ENDIF
318          ENDDO
319          punc = ' '
320          IF ( markEnd ) punc = ','
321          nDup = iHi-iLo+1
322          IF    ( nDup .EQ. 1 ) THEN
323           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
324           IF ( index_type .NE. INDEX_NONE )
325         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
326         &    commOpen,index_lab,iLo,commClose
327          ELSEIF( nDup .GT. 1 ) THEN
328           WRITE(msgBuf,'(I5,'' '',A,L5,A)') nDup,'@',xOld,punc
329           IF ( index_type .NE. INDEX_NONE )
330         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
331         &  commOpen,index_lab,iLo,':',iHi,commClose
332          ENDIF
333          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
334    
335          RETURN
336          END
337    
338    CStartofinterface
339          SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
340         &    markEnd, compact, ioUnit )
341    C     /==========================================================\
342    C     | o SUBROUTINE PRINT_LIST_R8                               |
343    C     |==========================================================|
344    C     | Routine for producing list of values for a field with    |
345    C     | duplicate values collected into                          |
346    C     |    n @ value                                             |
347    C     | record.                                                  |
348    C     \==========================================================/
349          IMPLICIT NONE
350    
351    C     == Global data ==  
352    #include "SIZE.h"
353    #include "EEPARAMS.h"
354    
355    C     == Routine arguments ==
356    C     fld    -  Data to be printed
357    C     lFld   -  Number of elements to be printed
358    C     index_type - Flag indicating which type of index to print
359    C                  INDEX_K    => /* K = nnn */
360    C                  INDEX_I    => /* I = nnn */
361    C                  INDEX_J    => /* J = nnn */
362    C                  INDEX_NONE =>
363    C     compact -  Flag to control use of repeat symbol for same valued
364    C                fields.
365    C     markEnd -  Flag to control whether there is a separator after the
366    C                last element
367    C     ioUnit -  Unit number for IO.
368          INTEGER lFld
369          INTEGER index_type
370          Real*8  fld(lFld)
371          LOGICAL markEnd
372          LOGICAL compact
373          INTEGER ioUnit
374    CEndifinterface
375    
376    C     == Local variables ==
377    C     iLo  - Range index holders for selecting elements with
378    C     iHi    with the same value
379    C     nDup - Number of duplicates
380    C     xNew, xOld - Hold current and previous values of field
381    C     punc - Field separator
382    C     msgBuf - IO buffer
383    C     index_lab - Index for labelling elements
384    C     K    - Loop counter
385          INTEGER iLo
386          INTEGER iHi
387          INTEGER nDup
388          Real*8 xNew, xOld
389          CHARACTER punc
390          CHARACTER*(MAX_LEN_MBUF) msgBuf
391          CHARACTER*2 commOpen,commClose
392          CHARACTER*3 index_lab
393          INTEGER K
394    
395          IF     ( index_type .EQ. INDEX_I ) THEN
396           index_lab = 'I ='
397          ELSEIF ( index_type .EQ. INDEX_J ) THEN
398           index_lab = 'J ='
399          ELSEIF ( index_type .EQ. INDEX_K ) THEN
400           index_lab = 'K ='
401          ELSE
402           index_lab = '?='
403          ENDIF
404          commOpen  = '/*'
405          commClose = '*/'
406          iLo = 1
407          iHi = 1
408          punc = ','
409          xOld = fld(1)
410          DO K=2,lFld
411           xNew = fld(K  )
412           IF ( .NOT. compact .OR. (xNew .NE. xOld) ) THEN
413            nDup = iHi-iLo+1
414            IF ( nDup .EQ. 1 ) THEN
415             WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
416             IF ( index_type .NE. INDEX_NONE )
417         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
418         &    commOpen,index_lab,iLo,commClose
419            ELSE
420             WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
421             IF ( index_type .NE. INDEX_NONE )
422         &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
423         &    commOpen,index_lab,iLo,':',iHi,commClose
424            ENDIF
425            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
426         &    SQUEEZE_RIGHT , 1)
427            iLo  = K
428            iHi  = K
429            xOld = xNew
430           ELSE
431            iHi = K
432           ENDIF
433          ENDDO
434          punc = ' '
435          IF ( markEnd ) punc = ','
436          nDup = iHi-iLo+1
437          IF    ( nDup .EQ. 1 ) THEN
438           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
439           IF ( index_type .NE. INDEX_NONE )
440         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
441         &    commOpen,index_lab,iLo,commClose
442          ELSEIF( nDup .GT. 1 ) THEN
443           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
444           IF ( index_type .NE. INDEX_NONE )
445         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
446         &  commOpen,index_lab,iLo,':',iHi,commClose
447          ENDIF
448          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
449         &    SQUEEZE_RIGHT , 1)
450    
451        RETURN        RETURN
452        END        END
453    
454  CStartOfInterface  CStartOfInterface
455        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
456       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
457       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
458       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 120  C     |      plots - one for K=1, one fo Line 480  C     |      plots - one for K=1, one fo
480  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      Each plot would have extents iMin:iMax step iStr    |
481  C     |      and jMin:jMax step jStr.                            |  C     |      and jMin:jMax step jStr.                            |
482  C     \==========================================================/  C     \==========================================================/
483          IMPLICIT NONE
484    
485  C     == Global variables ==  C     == Global variables ==
486  #include "SIZE.h"  #include "SIZE.h"
# Line 147  C     kStr Line 508  C     kStr
508        INTEGER jLo, jHi        INTEGER jLo, jHi
509        INTEGER kLo, kHi        INTEGER kLo, kHi
510        INTEGER nBx, nBy        INTEGER nBx, nBy
511        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
512        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
513        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
514        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 189  C               Str  - stride within blo Line 550  C               Str  - stride within blo
550        INTEGER lChList        INTEGER lChList
551        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
552        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
553        REAL fMin        _RL  fMin
554        REAL fMax        _RL  fMax
555        REAL fRange        _RL  fRange
556        REAL val        _RL  val
557        REAL small        _RL  small
558        CHARACTER*2  accLab        CHARACTER*2  accLab
559        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
560        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 210  C               Str  - stride within blo Line 571  C               Str  - stride within blo
571        LOGICAL validRange        LOGICAL validRange
572    
573        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
574        small  = 1. _d -15        small  =  1. _d -15
575        fMin   =  1. _d 32        fMin   =  1. _d  32
576        fMax   = -1. _d 32        fMax   = -1. _d  32
577        validRange = .FALSE.        validRange = .FALSE.
578    
579  C--   Calculate field range  C--   Calculate field range
# Line 221  C--   Calculate field range Line 582  C--   Calculate field range
582          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
583           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
584            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
585             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
586              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
587       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
588              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 238  C--   Calculate field range Line 599  C--   Calculate field range
599        ENDIF        ENDIF
600    
601  C--   Write field title and statistics  C--   Write field title and statistics
602        msgBuf = '// ======================================================='        msgBuf =
603         & '// ======================================================='
604        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
605       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
606        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 258  C--   Write field title and statistics Line 620  C--   Write field title and statistics
620       & '// CMAX = ', fMax       & '// CMAX = ', fMax
621        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
622       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
623        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
624       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
625         &  '// CINT = ', fRange/FLOAT(lChlist-1)
626          ELSE
627           WRITE(msgBuf,'(A,1PE30.15)')
628         &  '// CINT = ', 0.
629          ENDIF
630        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
631       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
632        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 291  C--   Write field title and statistics Line 658  C--   Write field title and statistics
658       &  ':',kStr,')'       &  ':',kStr,')'
659        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
660       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
661        msgBuf = '// ======================================================='        msgBuf =
662         & '// ======================================================='
663        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
664       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
665    
# Line 387  C      X across, Z down slice Line 755  C      X across, Z down slice
755         pltStep = sNy         pltStep = sNy
756         pltLab  = 'J ='         pltLab  = 'J ='
757        ENDIF        ENDIF
758        IF ( validRange ) THEN  C     IF ( validRange ) THEN
759  C      Header  C      Header
760  C      Data  C      Data
761         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
762          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
763           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
764       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
765           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
766       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 449  C      Data Line 817  C      Data
817               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
818                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
819               ENDIF               ENDIF
820               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
821                  IDX = NINT(
822       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
823       &             )+1       &             )+1
824                 ELSE
825                  IDX = 1
826                 ENDIF
827               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
828       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
829               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 467  C      Data Line 839  C      Data
839           ENDDO           ENDDO
840          ENDDO          ENDDO
841         ENDDO         ENDDO
842        ENDIF  C     ENDIF
843  C--   Write delimiter  C--   Write delimiter
844        msgBuf = '// ======================================================='        msgBuf =
845         & '// ======================================================='
846        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
847       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
848        msgBuf = '// END OF FIELD                                          ='        msgBuf =
849         & '// END OF FIELD                                          ='
850        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
851       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
852        msgBuf = '// ======================================================='        msgBuf =
853         & '// ======================================================='
854        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
855       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
856        msgBuf = ' '        msgBuf = ' '
# Line 486  C--   Write delimiter Line 861  C--   Write delimiter
861        END        END
862    
863  CStartOfInterface  CStartOfInterface
864        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
865       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
866       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
867       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 494  CStartOfInterface Line 869  CStartOfInterface
869       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
870       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
871  C     /==========================================================\  C     /==========================================================\
872  C     | SUBROUTINE PRINT_MAPR8                                   |  C     | SUBROUTINE PRINT_MAPRL                                   |
873  C     | o Does textual mapping printing of a field.              |  C     | o Does textual mapping printing of a field.              |
874  C     |==========================================================|  C     |==========================================================|
875  C     | This routine does the actual formatting of the data      |  C     | This routine does the actual formatting of the data      |
# Line 514  C     |      plots - one for K=1, one fo Line 889  C     |      plots - one for K=1, one fo
889  C     |      Each plot would have extents iMin:iMax step iStr    |  C     |      Each plot would have extents iMin:iMax step iStr    |
890  C     |      and jMin:jMax step jStr.                            |  C     |      and jMin:jMax step jStr.                            |
891  C     \==========================================================/  C     \==========================================================/
892          IMPLICIT NONE
893    
894  C     == Global variables ==  C     == Global variables ==
895  #include "SIZE.h"  #include "SIZE.h"
# Line 541  C     kStr Line 917  C     kStr
917        INTEGER jLo, jHi        INTEGER jLo, jHi
918        INTEGER kLo, kHi        INTEGER kLo, kHi
919        INTEGER nBx, nBy        INTEGER nBx, nBy
920        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
921        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
922        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
923        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 583  C               Str  - stride within blo Line 959  C               Str  - stride within blo
959        INTEGER lChList        INTEGER lChList
960        PARAMETER ( lChList = 28 )        PARAMETER ( lChList = 28 )
961        CHARACTER*(lChList) chList        CHARACTER*(lChList) chList
962        REAL fMin        _RL  fMin
963        REAL fMax        _RL  fMax
964        REAL fRange        _RL  fRange
965        REAL val        _RL  val
966        REAL small        _RL  small
967        CHARACTER*2  accLab        CHARACTER*2  accLab
968        CHARACTER*7  dwnLab        CHARACTER*7  dwnLab
969        CHARACTER*3  pltLab        CHARACTER*3  pltLab
# Line 615  C--   Calculate field range Line 991  C--   Calculate field range
991          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
992           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
993            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
994  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
995         &     THEN
996              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
997       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
998              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
999       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
1000  C          ENDIF             ENDIF
1001            ENDDO            ENDDO
1002           ENDDO           ENDDO
1003          ENDDO          ENDDO
# Line 632  C          ENDIF Line 1009  C          ENDIF
1009        ENDIF        ENDIF
1010    
1011  C--   Write field title and statistics  C--   Write field title and statistics
1012        msgBuf = '// ======================================================='        msgBuf =
1013         & '// ======================================================='
1014        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1015       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1016        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 652  C--   Write field title and statistics Line 1030  C--   Write field title and statistics
1030       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1031        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1032       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1033        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1034           WRITE(msgBuf,'(A,1PE30.15)')
1035       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1036          ELSE
1037           WRITE(msgBuf,'(A,1PE30.15)')
1038         & '// CINT = ', 0.
1039          ENDIF
1040        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1041       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1042        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 685  C--   Write field title and statistics Line 1068  C--   Write field title and statistics
1068       &  ':',kStr,')'       &  ':',kStr,')'
1069        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1070       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1071        msgBuf = '// ======================================================='        msgBuf =
1072         & '// ======================================================='
1073        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1074       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1075    
# Line 781  C      X across, Z down slice Line 1165  C      X across, Z down slice
1165         pltStep = sNy         pltStep = sNy
1166         pltLab  = 'J ='         pltLab  = 'J ='
1167        ENDIF        ENDIF
1168        IF ( validRange ) THEN  C     IF ( validRange ) THEN
1169  C      Header  C      Header
1170  C      Data  C      Data
1171         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1172          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1173           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1174       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1175           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1176       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 841  C      Data Line 1225  C      Data
1225               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1226                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1227               ENDIF               ENDIF
1228               IDX = NINT(               IF ( validRange .AND. val .NE. 0. ) THEN
1229       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1230       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1231         &              )+1
1232                 ELSE
1233                  IDX = 1
1234                 ENDIF
1235               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1236       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1237               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 858  C      Data Line 1246  C      Data
1246           ENDDO           ENDDO
1247          ENDDO          ENDDO
1248         ENDDO         ENDDO
1249        ENDIF  C     ENDIF
1250  C--   Write delimiter  C--   Write delimiter
1251        msgBuf = '// ======================================================='        msgBuf =
1252         & '// ======================================================='
1253        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1254       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1255        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1256         & '// END OF FIELD                                          ='
1257        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1258       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1259        msgBuf = '// ======================================================='        msgBuf =
1260         & '// ======================================================='
1261        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1262       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1263        msgBuf = ' '        msgBuf = ' '
# Line 883  C     | SUBROUTINE PRINT_MESSAGE Line 1274  C     | SUBROUTINE PRINT_MESSAGE
1274  C     | o Write out informational message using "standard" format. |  C     | o Write out informational message using "standard" format. |
1275  C     | Notes                                                      |  C     | Notes                                                      |
1276  C     | =====                                                      |  C     | =====                                                      |
1277  C     | o Some system's I/O is not "thread-safe". For this reason  |  C     | o Some system   I/O is not "thread-safe". For this reason  |
1278  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
1279  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
1280  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
# Line 892  C     |   ignored! Line 1283  C     |   ignored!
1283  C     | o In a non-parallel form these routines can still be used. |  C     | o In a non-parallel form these routines can still be used. |
1284  C     |   to produce pretty printed output!                        |  C     |   to produce pretty printed output!                        |
1285  C     \============================================================/  C     \============================================================/
1286          IMPLICIT NONE
1287  C     == Global data ==  C     == Global data ==
1288  #include "SIZE.h"  #include "SIZE.h"
1289  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 950  C       The write statement may need to Line 1342  C       The write statement may need to
1342  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1343          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1344  #endif  #endif
1345           WRITE(unit,'(A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
1346       &   '(',PROCESS_HEADER,' ',idString,')',' '       &   '(',PROCESS_HEADER,' ',idString,')',' '
1347  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1348          _END_CRIT(myThid)          _END_CRIT(myThid)
# Line 959  C       The write statement may need to Line 1351  C       The write statement may need to
1351  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1352          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1353  #endif  #endif
1354           WRITE(unit,'(A,A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
1355       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',
1356       &   message(iStart:iEnd)       &   message(iStart:iEnd)
1357  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 968  C       The write statement may need to Line 1360  C       The write statement may need to
1360         ENDIF         ENDIF
1361        ENDIF        ENDIF
1362  C  C
1363     1000 CONTINUE
1364        RETURN        RETURN
1365      999 CONTINUE
1366           ioErrorCount(myThid) = ioErrorCount(myThid)+1
1367          GOTO 1000
1368    
1369        END        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22