/[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.5 by cnh, Mon Apr 27 04:24:22 1998 UTC revision 1.11 by cnh, Sat Sep 5 17:52:13 1998 UTC
# Line 77  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 87  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 96  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        RETURN
101    
102      999 CONTINUE
103           ioErrorCount(myThid) = ioErrorCount(myThid)+1
104          GOTO 1000
105        END        END
106    
107  CStartofinterface  CStartofinterface
108        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, markEnd, compact, ioUnit )
109  C     /==========================================================\  C     /==========================================================\
110  C     | o SUBROUTINE PRINT_LIST_I                                |  C     | o SUBROUTINE PRINT_LIST_I                                |
111  C     |==========================================================|  C     |==========================================================|
# Line 122  C                  INDEX_K    => /* K = Line 127  C                  INDEX_K    => /* K =
127  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
128  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
129  C                  INDEX_NONE =>  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.  C     ioUnit -  Unit number for IO.
135        INTEGER lFld        INTEGER lFld
136        INTEGER index_type        INTEGER index_type
137        INTEGER fld(lFld)        INTEGER fld(lFld)
138          LOGICAL markEnd
139          LOGICAL compact
140        INTEGER ioUnit        INTEGER ioUnit
141  CEndifinterface  CEndifinterface
142    
# Line 143  C     K    - Loop counter Line 154  C     K    - Loop counter
154        INTEGER nDup        INTEGER nDup
155        INTEGER xNew, xOld        INTEGER xNew, xOld
156        CHARACTER punc        CHARACTER punc
157        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
158        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
159        CHARACTER*3 index_lab        CHARACTER*3 index_lab
160        INTEGER K        INTEGER K
# Line 165  C     K    - Loop counter Line 176  C     K    - Loop counter
176        xOld = fld(1)        xOld = fld(1)
177        DO K=2,lFld        DO K=2,lFld
178         xNew = fld(K  )         xNew = fld(K  )
179         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
180          nDup = iHi-iLo+1          nDup = iHi-iLo+1
181          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
182           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
183           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
184       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
185          ELSE          ELSE
186           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
187           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
188       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
189       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
190          ENDIF          ENDIF
191          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
192          iLo  = K          iLo  = K
193          iHi  = K          iHi  = K
194          xOld = xNew          xOld = xNew
# Line 186  C     K    - Loop counter Line 197  C     K    - Loop counter
197         ENDIF         ENDIF
198        ENDDO        ENDDO
199        punc = ' '        punc = ' '
200          IF ( markEnd ) punc = ','
201        nDup = iHi-iLo+1        nDup = iHi-iLo+1
202        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
203         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
204         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
205       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
206        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
207         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
208         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
209       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
210       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
211        ENDIF        ENDIF
212        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
213    
214        RETURN        RETURN
215        END        END
216    
217  CStartofinterface  CStartofinterface
218        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd, compact, ioUnit )
219  C     /==========================================================\  C     /==========================================================\
220  C     | o SUBROUTINE PRINT_LIST_L                                |  C     | o SUBROUTINE PRINT_LIST_L                                |
221  C     |==========================================================|  C     |==========================================================|
# Line 225  C                  INDEX_K    => /* K = Line 237  C                  INDEX_K    => /* K =
237  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
238  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
239  C                  INDEX_NONE =>  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.  C     ioUnit -  Unit number for IO.
245        INTEGER lFld        INTEGER lFld
246        INTEGER index_type        INTEGER index_type
247        LOGICAL fld(lFld)        LOGICAL fld(lFld)
248          LOGICAL markEnd
249          LOGICAL compact
250        INTEGER ioUnit        INTEGER ioUnit
251  CEndifinterface  CEndifinterface
252    
# Line 246  C     K    - Loop counter Line 264  C     K    - Loop counter
264        INTEGER nDup        INTEGER nDup
265        LOGICAL xNew, xOld        LOGICAL xNew, xOld
266        CHARACTER punc        CHARACTER punc
267        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
268        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
269        CHARACTER*3 index_lab        CHARACTER*3 index_lab
270        INTEGER K        INTEGER K
# Line 268  C     K    - Loop counter Line 286  C     K    - Loop counter
286        xOld = fld(1)        xOld = fld(1)
287        DO K=2,lFld        DO K=2,lFld
288         xNew = fld(K  )         xNew = fld(K  )
289         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
290          nDup = iHi-iLo+1          nDup = iHi-iLo+1
291          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
292           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
# Line 280  C     K    - Loop counter Line 298  C     K    - Loop counter
298       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
299       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
300          ENDIF          ENDIF
301          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
302          iLo  = K          iLo  = K
303          iHi  = K          iHi  = K
304          xOld = xNew          xOld = xNew
# Line 289  C     K    - Loop counter Line 307  C     K    - Loop counter
307         ENDIF         ENDIF
308        ENDDO        ENDDO
309        punc = ' '        punc = ' '
310          IF ( markEnd ) punc = ','
311        nDup = iHi-iLo+1        nDup = iHi-iLo+1
312        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
313         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
# Line 300  C     K    - Loop counter Line 319  C     K    - Loop counter
319       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
320       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
321        ENDIF        ENDIF
322        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT , 1)
323    
324        RETURN        RETURN
325        END        END
326    
327  CStartofinterface  CStartofinterface
328        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, markEnd, compact, ioUnit )
329  C     /==========================================================\  C     /==========================================================\
330  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     | o SUBROUTINE PRINT_LIST_R8                               |
331  C     |==========================================================|  C     |==========================================================|
# Line 328  C                  INDEX_K    => /* K = Line 347  C                  INDEX_K    => /* K =
347  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
348  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
349  C                  INDEX_NONE =>  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.  C     ioUnit -  Unit number for IO.
355        INTEGER lFld        INTEGER lFld
356        INTEGER index_type        INTEGER index_type
357        Real*8  fld(lFld)        Real*8  fld(lFld)
358          LOGICAL markEnd
359          LOGICAL compact
360        INTEGER ioUnit        INTEGER ioUnit
361  CEndifinterface  CEndifinterface
362    
# Line 349  C     K    - Loop counter Line 374  C     K    - Loop counter
374        INTEGER nDup        INTEGER nDup
375        Real*8 xNew, xOld        Real*8 xNew, xOld
376        CHARACTER punc        CHARACTER punc
377        CHARACTER(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
378        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
379        CHARACTER*3 index_lab        CHARACTER*3 index_lab
380        INTEGER K        INTEGER K
# Line 371  C     K    - Loop counter Line 396  C     K    - Loop counter
396        xOld = fld(1)        xOld = fld(1)
397        DO K=2,lFld        DO K=2,lFld
398         xNew = fld(K  )         xNew = fld(K  )
399         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
400          nDup = iHi-iLo+1          nDup = iHi-iLo+1
401          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
402           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
# Line 392  C     K    - Loop counter Line 417  C     K    - Loop counter
417         ENDIF         ENDIF
418        ENDDO        ENDDO
419        punc = ' '        punc = ' '
420          IF ( markEnd ) punc = ','
421        nDup = iHi-iLo+1        nDup = iHi-iLo+1
422        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
423         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
# Line 409  C     K    - Loop counter Line 435  C     K    - Loop counter
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 464  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 538  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 575  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 704  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 766  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 784  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 803  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 811  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 858  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 932  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 969  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 1098  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 1158  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 1175  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 1267  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 1276  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 1285  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.5  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22