/[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.11 by cnh, Sat Sep 5 17:52:13 1998 UTC
# Line 6  C--   File printf.F: Routines for perfor Line 6  C--   File printf.F: Routines for perfor
6  C--                  in the MITgcm UV implementation environment.  C--                  in the MITgcm UV implementation environment.
7  C--    Contents  C--    Contents
8  C--    o print_error    Does IO with **ERROR** highlighted header  C--    o print_error    Does IO with **ERROR** highlighted header
9    C--    o print_list_i   Prints one-deimensional list of INTEGER
10    C--                     numbers.
11    C--    o print_list_l   Prints one-deimensional list of LOGICAL
12    C--                     variables.
13    C--    o print_list_r8  Prints one-deimensional list of Real*8
14    C--                     numbers.
15    C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field
16    C--                     Uses print_message for writing
17  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
18  C--                     Uses print_message for writing  C--                     Uses print_message for writing
19  C--    o print_message  Does IO with unhighlighted header  C--    o print_message  Does IO with unhighlighted header
# Line 69  C       The write statement may need to Line 77  C       The write statement may need to
77  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
78          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
79  #endif  #endif
80          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
81       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
82       &  ' '       &  ' '
83  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 79  C       The write statement may need to Line 87  C       The write statement may need to
87  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
88          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
89  #endif  #endif
90          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
91       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
92       &  message(iStart:iEnd)       &  message(iStart:iEnd)
93  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 88  C       The write statement may need to Line 96  C       The write statement may need to
96         ENDIF         ENDIF
97        ENDIF        ENDIF
98  C  C
99     1000 CONTINUE
100          RETURN
101    
102      999 CONTINUE
103           ioErrorCount(myThid) = ioErrorCount(myThid)+1
104          GOTO 1000
105          END
106    
107    CStartofinterface
108          SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit )
109    C     /==========================================================\
110    C     | o SUBROUTINE PRINT_LIST_I                                |
111    C     |==========================================================|
112    C     | Routine for producing list of values for a field with    |
113    C     | duplicate values collected into                          |
114    C     |    n @ value                                             |
115    C     | record.                                                  |
116    C     \==========================================================/
117    
118    C     == Global data ==  
119    #include "SIZE.h"
120    #include "EEPARAMS.h"
121    
122    C     == Routine arguments ==
123    C     fld    -  Data to be printed
124    C     lFld   -  Number of elements to be printed
125    C     index_type - Flag indicating which type of index to print
126    C                  INDEX_K    => /* K = nnn */
127    C                  INDEX_I    => /* I = nnn */
128    C                  INDEX_J    => /* J = nnn */
129    C                  INDEX_NONE =>
130    C     compact -  Flag to control use of repeat symbol for same valued
131    C                fields.
132    C     markEnd -  Flag to control whether there is a separator after the
133    C                last element
134    C     ioUnit -  Unit number for IO.
135          INTEGER lFld
136          INTEGER index_type
137          INTEGER fld(lFld)
138          LOGICAL markEnd
139          LOGICAL compact
140          INTEGER ioUnit
141    CEndifinterface
142    
143    C     == Local variables ==
144    C     iLo  - Range index holders for selecting elements with
145    C     iHi    with the same value
146    C     nDup - Number of duplicates
147    C     xNew, xOld - Hold current and previous values of field
148    C     punc - Field separator
149    C     msgBuf - IO buffer
150    C     index_lab - Index for labelling elements
151    C     K    - Loop counter
152          INTEGER iLo
153          INTEGER iHi
154          INTEGER nDup
155          INTEGER xNew, xOld
156          CHARACTER punc
157          CHARACTER*(MAX_LEN_MBUF) msgBuf
158          CHARACTER*2 commOpen,commClose
159          CHARACTER*3 index_lab
160          INTEGER K
161    
162          IF     ( index_type .EQ. INDEX_I ) THEN
163           index_lab = 'I ='
164          ELSEIF ( index_type .EQ. INDEX_J ) THEN
165           index_lab = 'J ='
166          ELSEIF ( index_type .EQ. INDEX_K ) THEN
167           index_lab = 'K ='
168          ELSE
169           index_lab = '?='
170          ENDIF
171          commOpen  = '/*'
172          commClose = '*/'
173          iLo = 1
174          iHi = 1
175          punc = ','
176          xOld = fld(1)
177          DO K=2,lFld
178           xNew = fld(K  )
179           IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
180            nDup = iHi-iLo+1
181            IF ( nDup .EQ. 1 ) THEN
182             WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
183             IF ( index_type .NE. INDEX_NONE )
184         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
185            ELSE
186             WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
187             IF ( index_type .NE. INDEX_NONE )
188         &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
189         &    commOpen,index_lab,iLo,':',iHi,commClose
190            ENDIF
191            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
192            iLo  = K
193            iHi  = K
194            xOld = xNew
195           ELSE
196            iHi = K
197           ENDIF
198          ENDDO
199          punc = ' '
200          IF ( markEnd ) punc = ','
201          nDup = iHi-iLo+1
202          IF    ( nDup .EQ. 1 ) THEN
203           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
204           IF ( index_type .NE. INDEX_NONE )
205         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
206          ELSEIF( nDup .GT. 1 ) THEN
207           WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
208           IF ( index_type .NE. INDEX_NONE )
209         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
210         &  commOpen,index_lab,iLo,':',iHi,commClose
211          ENDIF
212          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
213    
214          RETURN
215          END
216    
217    CStartofinterface
218          SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit )
219    C     /==========================================================\
220    C     | o SUBROUTINE PRINT_LIST_L                                |
221    C     |==========================================================|
222    C     | Routine for producing list of values for a field with    |
223    C     | duplicate values collected into                          |
224    C     |    n @ value                                             |
225    C     | record.                                                  |
226    C     \==========================================================/
227    
228    C     == Global data ==  
229    #include "SIZE.h"
230    #include "EEPARAMS.h"
231    
232    C     == Routine arguments ==
233    C     fld    -  Data to be printed
234    C     lFld   -  Number of elements to be printed
235    C     index_type - Flag indicating which type of index to print
236    C                  INDEX_K    => /* K = nnn */
237    C                  INDEX_I    => /* I = nnn */
238    C                  INDEX_J    => /* J = nnn */
239    C                  INDEX_NONE =>
240    C     compact -  Flag to control use of repeat symbol for same valued
241    C                fields.
242    C     markEnd -  Flag to control whether there is a separator after the
243    C                last element
244    C     ioUnit -  Unit number for IO.
245          INTEGER lFld
246          INTEGER index_type
247          LOGICAL fld(lFld)
248          LOGICAL markEnd
249          LOGICAL compact
250          INTEGER ioUnit
251    CEndifinterface
252    
253    C     == Local variables ==
254    C     iLo  - Range index holders for selecting elements with
255    C     iHi    with the same value
256    C     nDup - Number of duplicates
257    C     xNew, xOld - Hold current and previous values of field
258    C     punc - Field separator
259    C     msgBuf - IO buffer
260    C     index_lab - Index for labelling elements
261    C     K    - Loop counter
262          INTEGER iLo
263          INTEGER iHi
264          INTEGER nDup
265          LOGICAL xNew, xOld
266          CHARACTER punc
267          CHARACTER*(MAX_LEN_MBUF) msgBuf
268          CHARACTER*2 commOpen,commClose
269          CHARACTER*3 index_lab
270          INTEGER K
271    
272          IF     ( index_type .EQ. INDEX_I ) THEN
273           index_lab = 'I ='
274          ELSEIF ( index_type .EQ. INDEX_J ) THEN
275           index_lab = 'J ='
276          ELSEIF ( index_type .EQ. INDEX_K ) THEN
277           index_lab = 'K ='
278          ELSE
279           index_lab = '?='
280          ENDIF
281          commOpen  = '/*'
282          commClose = '*/'
283          iLo = 1
284          iHi = 1
285          punc = ','
286          xOld = fld(1)
287          DO K=2,lFld
288           xNew = fld(K  )
289           IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
290            nDup = iHi-iLo+1
291            IF ( nDup .EQ. 1 ) THEN
292             WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
293             IF ( index_type .NE. INDEX_NONE )
294         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
295            ELSE
296             WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
297             IF ( index_type .NE. INDEX_NONE )
298         &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
299         &    commOpen,index_lab,iLo,':',iHi,commClose
300            ENDIF
301            CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
302            iLo  = K
303            iHi  = K
304            xOld = xNew
305           ELSE
306            iHi = K
307           ENDIF
308          ENDDO
309          punc = ' '
310          IF ( markEnd ) punc = ','
311          nDup = iHi-iLo+1
312          IF    ( nDup .EQ. 1 ) THEN
313           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
314           IF ( index_type .NE. INDEX_NONE )
315         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
316          ELSEIF( nDup .GT. 1 ) THEN
317           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
318           IF ( index_type .NE. INDEX_NONE )
319         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
320         &  commOpen,index_lab,iLo,':',iHi,commClose
321          ENDIF
322          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
323    
324          RETURN
325          END
326    
327    CStartofinterface
328          SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit )
329    C     /==========================================================\
330    C     | o SUBROUTINE PRINT_LIST_R8                               |
331    C     |==========================================================|
332    C     | Routine for producing list of values for a field with    |
333    C     | duplicate values collected into                          |
334    C     |    n @ value                                             |
335    C     | record.                                                  |
336    C     \==========================================================/
337    
338    C     == Global data ==  
339    #include "SIZE.h"
340    #include "EEPARAMS.h"
341    
342    C     == Routine arguments ==
343    C     fld    -  Data to be printed
344    C     lFld   -  Number of elements to be printed
345    C     index_type - Flag indicating which type of index to print
346    C                  INDEX_K    => /* K = nnn */
347    C                  INDEX_I    => /* I = nnn */
348    C                  INDEX_J    => /* J = nnn */
349    C                  INDEX_NONE =>
350    C     compact -  Flag to control use of repeat symbol for same valued
351    C                fields.
352    C     markEnd -  Flag to control whether there is a separator after the
353    C                last element
354    C     ioUnit -  Unit number for IO.
355          INTEGER lFld
356          INTEGER index_type
357          Real*8  fld(lFld)
358          LOGICAL markEnd
359          LOGICAL compact
360          INTEGER ioUnit
361    CEndifinterface
362    
363    C     == Local variables ==
364    C     iLo  - Range index holders for selecting elements with
365    C     iHi    with the same value
366    C     nDup - Number of duplicates
367    C     xNew, xOld - Hold current and previous values of field
368    C     punc - Field separator
369    C     msgBuf - IO buffer
370    C     index_lab - Index for labelling elements
371    C     K    - Loop counter
372          INTEGER iLo
373          INTEGER iHi
374          INTEGER nDup
375          Real*8 xNew, xOld
376          CHARACTER punc
377          CHARACTER*(MAX_LEN_MBUF) msgBuf
378          CHARACTER*2 commOpen,commClose
379          CHARACTER*3 index_lab
380          INTEGER K
381    
382          IF     ( index_type .EQ. INDEX_I ) THEN
383           index_lab = 'I ='
384          ELSEIF ( index_type .EQ. INDEX_J ) THEN
385           index_lab = 'J ='
386          ELSEIF ( index_type .EQ. INDEX_K ) THEN
387           index_lab = 'K ='
388          ELSE
389           index_lab = '?='
390          ENDIF
391          commOpen  = '/*'
392          commClose = '*/'
393          iLo = 1
394          iHi = 1
395          punc = ','
396          xOld = fld(1)
397          DO K=2,lFld
398           xNew = fld(K  )
399           IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
400            nDup = iHi-iLo+1
401            IF ( nDup .EQ. 1 ) THEN
402             WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
403             IF ( index_type .NE. INDEX_NONE )
404         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
405            ELSE
406             WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
407             IF ( index_type .NE. INDEX_NONE )
408         &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
409         &    commOpen,index_lab,iLo,':',iHi,commClose
410            ENDIF
411            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
412            iLo  = K
413            iHi  = K
414            xOld = xNew
415           ELSE
416            iHi = K
417           ENDIF
418          ENDDO
419          punc = ' '
420          IF ( markEnd ) punc = ','
421          nDup = iHi-iLo+1
422          IF    ( nDup .EQ. 1 ) THEN
423           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
424           IF ( index_type .NE. INDEX_NONE )
425         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
426          ELSEIF( nDup .GT. 1 ) THEN
427           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
428           IF ( index_type .NE. INDEX_NONE )
429         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
430         &  commOpen,index_lab,iLo,':',iHi,commClose
431          ENDIF
432          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
433    
434        RETURN        RETURN
435        END        END
436    
437  CStartOfInterface  CStartOfInterface
438        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
439       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
440       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
441       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 147  C     kStr Line 490  C     kStr
490        INTEGER jLo, jHi        INTEGER jLo, jHi
491        INTEGER kLo, kHi        INTEGER kLo, kHi
492        INTEGER nBx, nBy        INTEGER nBx, nBy
493        Real*4 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RS fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
494        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
495        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
496        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 221  C--   Calculate field range Line 564  C--   Calculate field range
564          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
565           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
566            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
567             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
568              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
569       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
570              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 258  C--   Write field title and statistics Line 601  C--   Write field title and statistics
601       & '// CMAX = ', fMax       & '// CMAX = ', fMax
602        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
603       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
604        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
605       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
606         &  '// CINT = ', fRange/FLOAT(lChlist-1)
607          ELSE
608           WRITE(msgBuf,'(A,1PE30.15)')
609         &  '// CINT = ', 0.
610          ENDIF
611        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
612       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
613        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 387  C      X across, Z down slice Line 735  C      X across, Z down slice
735         pltStep = sNy         pltStep = sNy
736         pltLab  = 'J ='         pltLab  = 'J ='
737        ENDIF        ENDIF
738        IF ( validRange ) THEN  C     IF ( validRange ) THEN
739  C      Header  C      Header
740  C      Data  C      Data
741         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
# Line 449  C      Data Line 797  C      Data
797               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
798                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
799               ENDIF               ENDIF
800               IDX = NINT(               IF ( validRange ) THEN
801                  IDX = NINT(
802       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
803       &             )+1       &             )+1
804                 ELSE
805                  IDX = 1
806                 ENDIF
807               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
808       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
809               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 467  C      Data Line 819  C      Data
819           ENDDO           ENDDO
820          ENDDO          ENDDO
821         ENDDO         ENDDO
822        ENDIF  C     ENDIF
823  C--   Write delimiter  C--   Write delimiter
824        msgBuf = '// ======================================================='        msgBuf = '// ======================================================='
825        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
# Line 486  C--   Write delimiter Line 838  C--   Write delimiter
838        END        END
839    
840  CStartOfInterface  CStartOfInterface
841        SUBROUTINE PRINT_MAPR8 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
842       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
843       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
844       I       jMin,  jMax,  jStr,       I       jMin,  jMax,  jStr,
# Line 494  CStartOfInterface Line 846  CStartOfInterface
846       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
847       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
848  C     /==========================================================\  C     /==========================================================\
849  C     | SUBROUTINE PRINT_MAPR8                                   |  C     | SUBROUTINE PRINT_MAPRL                                   |
850  C     | o Does textual mapping printing of a field.              |  C     | o Does textual mapping printing of a field.              |
851  C     |==========================================================|  C     |==========================================================|
852  C     | This routine does the actual formatting of the data      |  C     | This routine does the actual formatting of the data      |
# Line 541  C     kStr Line 893  C     kStr
893        INTEGER jLo, jHi        INTEGER jLo, jHi
894        INTEGER kLo, kHi        INTEGER kLo, kHi
895        INTEGER nBx, nBy        INTEGER nBx, nBy
896        Real*8 fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)        _RL fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
897        INTEGER iMin, iMax, iStr        INTEGER iMin, iMax, iStr
898        INTEGER jMin, jMax, jStr        INTEGER jMin, jMax, jStr
899        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
# Line 615  C--   Calculate field range Line 967  C--   Calculate field range
967          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
968           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
969            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
970  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. ) THEN
971              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
972       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
973              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
974       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
975  C          ENDIF             ENDIF
976            ENDDO            ENDDO
977           ENDDO           ENDDO
978          ENDDO          ENDDO
# Line 652  C--   Write field title and statistics Line 1004  C--   Write field title and statistics
1004       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1005        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1006       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1007        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1008           WRITE(msgBuf,'(A,1PE30.15)')
1009       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1010          ELSE
1011           WRITE(msgBuf,'(A,1PE30.15)')
1012         & '// CINT = ', 0.
1013          ENDIF
1014        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1015       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1016        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 781  C      X across, Z down slice Line 1138  C      X across, Z down slice
1138         pltStep = sNy         pltStep = sNy
1139         pltLab  = 'J ='         pltLab  = 'J ='
1140        ENDIF        ENDIF
1141        IF ( validRange ) THEN  C     IF ( validRange ) THEN
1142  C      Header  C      Header
1143  C      Data  C      Data
1144         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
# Line 841  C      Data Line 1198  C      Data
1198               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1199                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1200               ENDIF               ENDIF
1201               IDX = NINT(               IF ( validRange ) THEN
1202       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1203       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1204         &              )+1
1205                 ELSE
1206                  IDX = 1
1207                 ENDIF
1208               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1209       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1210               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 858  C      Data Line 1219  C      Data
1219           ENDDO           ENDDO
1220          ENDDO          ENDDO
1221         ENDDO         ENDDO
1222        ENDIF  C     ENDIF
1223  C--   Write delimiter  C--   Write delimiter
1224        msgBuf = '// ======================================================='        msgBuf = '// ======================================================='
1225        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
# Line 950  C       The write statement may need to Line 1311  C       The write statement may need to
1311  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1312          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1313  #endif  #endif
1314           WRITE(unit,'(A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A)',ERR=999)
1315       &   '(',PROCESS_HEADER,' ',idString,')',' '       &   '(',PROCESS_HEADER,' ',idString,')',' '
1316  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1317          _END_CRIT(myThid)          _END_CRIT(myThid)
# Line 959  C       The write statement may need to Line 1320  C       The write statement may need to
1320  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
1321          _BEGIN_CRIT(myThid)          _BEGIN_CRIT(myThid)
1322  #endif  #endif
1323           WRITE(unit,'(A,A,A,A,A,A,A)')           WRITE(unit,'(A,A,A,A,A,A,A)',ERR=999)
1324       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',       &   '(',PROCESS_HEADER,' ',idString(1:ILNBLNK(idString)),')',' ',
1325       &   message(iStart:iEnd)       &   message(iStart:iEnd)
1326  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
# Line 968  C       The write statement may need to Line 1329  C       The write statement may need to
1329         ENDIF         ENDIF
1330        ENDIF        ENDIF
1331  C  C
1332     1000 CONTINUE
1333        RETURN        RETURN
1334      999 CONTINUE
1335           ioErrorCount(myThid) = ioErrorCount(myThid)+1
1336          GOTO 1000
1337    
1338        END        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22