/[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.8 by cnh, Mon Jun 15 05:13:55 1998 UTC revision 1.12 by cnh, Wed Oct 28 03:11:35 1998 UTC
# Line 25  C     | SUBROUTINE PRINT_ERROR Line 25  C     | SUBROUTINE PRINT_ERROR
25  C     | o Write out error message using "standard" format.         |  C     | o Write out error message using "standard" format.         |
26  C     | Notes                                                      |  C     | Notes                                                      |
27  C     | =====                                                      |  C     | =====                                                      |
28  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  |
29  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
30  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
31  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
# Line 60  C--    Write single process format Line 60  C--    Write single process format
60         IF ( message .EQ. ' ' ) THEN         IF ( message .EQ. ' ' ) THEN
61          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, ' '
62         ELSE         ELSE
63          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER, message(iStart:iEnd)          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
64         &   message(iStart:iEnd)
65         ENDIF         ENDIF
66        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSEIF ( pidIO .EQ. myProcId ) THEN
67  C--    Write multi-process format  C--    Write multi-process format
# Line 105  C Line 106  C
106        END        END
107    
108  CStartofinterface  CStartofinterface
109        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
110         &                         markEnd, compact, ioUnit )
111  C     /==========================================================\  C     /==========================================================\
112  C     | o SUBROUTINE PRINT_LIST_I                                |  C     | o SUBROUTINE PRINT_LIST_I                                |
113  C     |==========================================================|  C     |==========================================================|
# Line 127  C                  INDEX_K    => /* K = Line 129  C                  INDEX_K    => /* K =
129  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
130  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
131  C                  INDEX_NONE =>  C                  INDEX_NONE =>
132    C     compact -  Flag to control use of repeat symbol for same valued
133    C                fields.
134    C     markEnd -  Flag to control whether there is a separator after the
135    C                last element
136  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
137        INTEGER lFld        INTEGER lFld
138        INTEGER index_type        INTEGER index_type
139        INTEGER fld(lFld)        INTEGER fld(lFld)
140          LOGICAL markEnd
141          LOGICAL compact
142        INTEGER ioUnit        INTEGER ioUnit
143  CEndifinterface  CEndifinterface
144    
# Line 170  C     K    - Loop counter Line 178  C     K    - Loop counter
178        xOld = fld(1)        xOld = fld(1)
179        DO K=2,lFld        DO K=2,lFld
180         xNew = fld(K  )         xNew = fld(K  )
181         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
182          nDup = iHi-iLo+1          nDup = iHi-iLo+1
183          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
184           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
185           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
186       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
187         &    commOpen,index_lab,iLo,commClose
188          ELSE          ELSE
189           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
190           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
191       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
192       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
# Line 191  C     K    - Loop counter Line 200  C     K    - Loop counter
200         ENDIF         ENDIF
201        ENDDO        ENDDO
202        punc = ' '        punc = ' '
203          IF ( markEnd ) punc = ','
204        nDup = iHi-iLo+1        nDup = iHi-iLo+1
205        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
206         WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,I9,A)') '              ',xOld,punc
207         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
208       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
209         &  commOpen,index_lab,iLo,commClose
210        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
211         WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I,'' '',A,I9,A)') nDup,'@',xOld,punc
212         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
213       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
214       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
# Line 208  C     K    - Loop counter Line 219  C     K    - Loop counter
219        END        END
220    
221  CStartofinterface  CStartofinterface
222        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
223         &                         compact, ioUnit )
224  C     /==========================================================\  C     /==========================================================\
225  C     | o SUBROUTINE PRINT_LIST_L                                |  C     | o SUBROUTINE PRINT_LIST_L                                |
226  C     |==========================================================|  C     |==========================================================|
# Line 230  C                  INDEX_K    => /* K = Line 242  C                  INDEX_K    => /* K =
242  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
243  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
244  C                  INDEX_NONE =>  C                  INDEX_NONE =>
245    C     compact -  Flag to control use of repeat symbol for same valued
246    C                fields.
247    C     markEnd -  Flag to control whether there is a separator after the
248    C                last element
249  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
250        INTEGER lFld        INTEGER lFld
251        INTEGER index_type        INTEGER index_type
252        LOGICAL fld(lFld)        LOGICAL fld(lFld)
253          LOGICAL markEnd
254          LOGICAL compact
255        INTEGER ioUnit        INTEGER ioUnit
256  CEndifinterface  CEndifinterface
257    
# Line 273  C     K    - Loop counter Line 291  C     K    - Loop counter
291        xOld = fld(1)        xOld = fld(1)
292        DO K=2,lFld        DO K=2,lFld
293         xNew = fld(K  )         xNew = fld(K  )
294         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NEQV. xOld ) THEN
295          nDup = iHi-iLo+1          nDup = iHi-iLo+1
296          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
297           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
298           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
299       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
300         &    commOpen,index_lab,iLo,commClose
301          ELSE          ELSE
302           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
303           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
# Line 294  C     K    - Loop counter Line 313  C     K    - Loop counter
313         ENDIF         ENDIF
314        ENDDO        ENDDO
315        punc = ' '        punc = ' '
316          IF ( markEnd ) punc = ','
317        nDup = iHi-iLo+1        nDup = iHi-iLo+1
318        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
319         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
320         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
321       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
322         &    commOpen,index_lab,iLo,commClose
323        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
324         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
325         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
# Line 311  C     K    - Loop counter Line 332  C     K    - Loop counter
332        END        END
333    
334  CStartofinterface  CStartofinterface
335        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
336         &    markEnd, compact, ioUnit )
337  C     /==========================================================\  C     /==========================================================\
338  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     | o SUBROUTINE PRINT_LIST_R8                               |
339  C     |==========================================================|  C     |==========================================================|
# Line 333  C                  INDEX_K    => /* K = Line 355  C                  INDEX_K    => /* K =
355  C                  INDEX_I    => /* I = nnn */  C                  INDEX_I    => /* I = nnn */
356  C                  INDEX_J    => /* J = nnn */  C                  INDEX_J    => /* J = nnn */
357  C                  INDEX_NONE =>  C                  INDEX_NONE =>
358    C     compact -  Flag to control use of repeat symbol for same valued
359    C                fields.
360    C     markEnd -  Flag to control whether there is a separator after the
361    C                last element
362  C     ioUnit -  Unit number for IO.  C     ioUnit -  Unit number for IO.
363        INTEGER lFld        INTEGER lFld
364        INTEGER index_type        INTEGER index_type
365        Real*8  fld(lFld)        Real*8  fld(lFld)
366          LOGICAL markEnd
367          LOGICAL compact
368        INTEGER ioUnit        INTEGER ioUnit
369  CEndifinterface  CEndifinterface
370    
# Line 376  C     K    - Loop counter Line 404  C     K    - Loop counter
404        xOld = fld(1)        xOld = fld(1)
405        DO K=2,lFld        DO K=2,lFld
406         xNew = fld(K  )         xNew = fld(K  )
407         IF ( xNew .NE. xOld ) THEN         IF ( .NOT. compact .OR. xNew .NE. xOld ) THEN
408          nDup = iHi-iLo+1          nDup = iHi-iLo+1
409          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
410           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
411           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
412       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
413         &    commOpen,index_lab,iLo,commClose
414          ELSE          ELSE
415           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
416           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
417       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
418       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
419          ENDIF          ENDIF
420          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
421         &    SQUEEZE_RIGHT , 1)
422          iLo  = K          iLo  = K
423          iHi  = K          iHi  = K
424          xOld = xNew          xOld = xNew
# Line 397  C     K    - Loop counter Line 427  C     K    - Loop counter
427         ENDIF         ENDIF
428        ENDDO        ENDDO
429        punc = ' '        punc = ' '
430          IF ( markEnd ) punc = ','
431        nDup = iHi-iLo+1        nDup = iHi-iLo+1
432        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
433         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
434         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
435       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')
436         &    commOpen,index_lab,iLo,commClose
437        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
438         WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
439         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
440       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
441       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
442        ENDIF        ENDIF
443        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
444         &    SQUEEZE_RIGHT , 1)
445    
446        RETURN        RETURN
447        END        END
# Line 543  C--   Calculate field range Line 576  C--   Calculate field range
576          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
577           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
578            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
579             IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF (printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0.) THEN
580              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
581       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
582              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
# Line 560  C--   Calculate field range Line 593  C--   Calculate field range
593        ENDIF        ENDIF
594    
595  C--   Write field title and statistics  C--   Write field title and statistics
596        msgBuf = '// ======================================================='        msgBuf =
597         & '// ======================================================='
598        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
599       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
600        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 580  C--   Write field title and statistics Line 614  C--   Write field title and statistics
614       & '// CMAX = ', fMax       & '// CMAX = ', fMax
615        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
616       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
617        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
618       & '// CINT = ', fRange/FLOAT(lChlist-1)         WRITE(msgBuf,'(A,1PE30.15)')
619         &  '// CINT = ', fRange/FLOAT(lChlist-1)
620          ELSE
621           WRITE(msgBuf,'(A,1PE30.15)')
622         &  '// CINT = ', 0.
623          ENDIF
624        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
625       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
626        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 613  C--   Write field title and statistics Line 652  C--   Write field title and statistics
652       &  ':',kStr,')'       &  ':',kStr,')'
653        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
654       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
655        msgBuf = '// ======================================================='        msgBuf =
656         & '// ======================================================='
657        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
658       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
659    
# Line 709  C      X across, Z down slice Line 749  C      X across, Z down slice
749         pltStep = sNy         pltStep = sNy
750         pltLab  = 'J ='         pltLab  = 'J ='
751        ENDIF        ENDIF
752        IF ( validRange ) THEN  C     IF ( validRange ) THEN
753  C      Header  C      Header
754  C      Data  C      Data
755         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
756          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
757           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
758       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
759           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
760       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 771  C      Data Line 811  C      Data
811               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
812                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
813               ENDIF               ENDIF
814               IDX = NINT(               IF ( validRange ) THEN
815                  IDX = NINT(
816       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)
817       &             )+1       &             )+1
818                 ELSE
819                  IDX = 1
820                 ENDIF
821               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
822       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
823               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 789  C      Data Line 833  C      Data
833           ENDDO           ENDDO
834          ENDDO          ENDDO
835         ENDDO         ENDDO
836        ENDIF  C     ENDIF
837  C--   Write delimiter  C--   Write delimiter
838        msgBuf = '// ======================================================='        msgBuf =
839         & '// ======================================================='
840        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
841       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
842        msgBuf = '// END OF FIELD                                          ='        msgBuf =
843         & '// END OF FIELD                                          ='
844        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
845       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
846        msgBuf = '// ======================================================='        msgBuf =
847         & '// ======================================================='
848        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
849       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
850        msgBuf = ' '        msgBuf = ' '
# Line 937  C--   Calculate field range Line 984  C--   Calculate field range
984          DO K=kMin, kMax, kStr          DO K=kMin, kMax, kStr
985           DO J=jMin, jMax, jStr           DO J=jMin, jMax, jStr
986            DO I=iMin, iMax, iStr            DO I=iMin, iMax, iStr
987  C          IF ( fld(I,J,K,bi,bj) .NE. 0. ) THEN             IF ( printMapIncludesZeros .OR. fld(I,J,K,bi,bj) .NE. 0. )
988         &     THEN
989              IF ( fld(I,J,K,bi,bj) .LT. fMin )              IF ( fld(I,J,K,bi,bj) .LT. fMin )
990       &       fMin = fld(I,J,K,bi,bj)       &       fMin = fld(I,J,K,bi,bj)
991              IF ( fld(I,J,K,bi,bj) .GT. fMax )              IF ( fld(I,J,K,bi,bj) .GT. fMax )
992       &       fMax = fld(I,J,K,bi,bj)       &       fMax = fld(I,J,K,bi,bj)
993  C          ENDIF             ENDIF
994            ENDDO            ENDDO
995           ENDDO           ENDDO
996          ENDDO          ENDDO
# Line 954  C          ENDIF Line 1002  C          ENDIF
1002        ENDIF        ENDIF
1003    
1004  C--   Write field title and statistics  C--   Write field title and statistics
1005        msgBuf = '// ======================================================='        msgBuf =
1006         & '// ======================================================='
1007        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1008       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1009        iStrngLo = IFNBLNK(fldTitle)        iStrngLo = IFNBLNK(fldTitle)
# Line 974  C--   Write field title and statistics Line 1023  C--   Write field title and statistics
1023       & '// CMAX = ', fMax       & '// CMAX = ', fMax
1024        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1025       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1026        WRITE(msgBuf,'(A,1PE30.15)')        IF ( validRange ) THEN
1027           WRITE(msgBuf,'(A,1PE30.15)')
1028       & '// CINT = ', fRange/FLOAT(lChlist-1)       & '// CINT = ', fRange/FLOAT(lChlist-1)
1029          ELSE
1030           WRITE(msgBuf,'(A,1PE30.15)')
1031         & '// CINT = ', 0.
1032          ENDIF
1033        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1034       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1035        WRITE(msgBuf,'(A,1024A1)')        WRITE(msgBuf,'(A,1024A1)')
# Line 1007  C--   Write field title and statistics Line 1061  C--   Write field title and statistics
1061       &  ':',kStr,')'       &  ':',kStr,')'
1062        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1063       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1064        msgBuf = '// ======================================================='        msgBuf =
1065         & '// ======================================================='
1066        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1067       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1068    
# Line 1103  C      X across, Z down slice Line 1158  C      X across, Z down slice
1158         pltStep = sNy         pltStep = sNy
1159         pltLab  = 'J ='         pltLab  = 'J ='
1160        ENDIF        ENDIF
1161        IF ( validRange ) THEN  C     IF ( validRange ) THEN
1162  C      Header  C      Header
1163  C      Data  C      Data
1164         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
1165          DO K=pltMin,pltMax,pltStr          DO K=pltMin,pltMax,pltStr
1166           WRITE(plotBuf,'(A,I,I,I,I)') pltLab,           WRITE(plotBuf,'(A,I4,I4,I4,I4)') pltLab,
1167       &   pltBase-1+(bk-1)*pltStep+K       &   pltBase-1+(bk-1)*pltStep+K
1168           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,           CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
1169       &                      SQUEEZE_RIGHT, 1)       &                      SQUEEZE_RIGHT, 1)
# Line 1163  C      Data Line 1218  C      Data
1218               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN               ELSEIF ( plotMode .EQ. PRINT_MAP_YZ ) THEN
1219                val = fld(K,I,J,bk,bi)                val = fld(K,I,J,bk,bi)
1220               ENDIF               ENDIF
1221               IDX = NINT(               IF ( validRange ) THEN
1222       &              FLOAT( lChList-1 )*( val-fMin ) / (fRange)                IDX = NINT(
1223       &             )+1       &               FLOAT( lChList-1 )*( val-fMin ) / (fRange)
1224         &              )+1
1225                 ELSE
1226                  IDX = 1
1227                 ENDIF
1228               IF ( iBuf .LE. MAX_LEN_PLOTBUF )               IF ( iBuf .LE. MAX_LEN_PLOTBUF )
1229       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)       &        plotBuf(iBuf:iBuf) = chList(IDX:IDX)
1230               IF ( val .EQ. 0. ) THEN               IF ( val .EQ. 0. ) THEN
# Line 1180  C      Data Line 1239  C      Data
1239           ENDDO           ENDDO
1240          ENDDO          ENDDO
1241         ENDDO         ENDDO
1242        ENDIF  C     ENDIF
1243  C--   Write delimiter  C--   Write delimiter
1244        msgBuf = '// ======================================================='        msgBuf =
1245         & '// ======================================================='
1246        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1247       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1248        msgBuf = '// END OF FIELD                                          ='        msgBuf =
1249         & '// END OF FIELD                                          ='
1250        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1251       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1252        msgBuf = '// ======================================================='        msgBuf =
1253         & '// ======================================================='
1254        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1255       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1256        msgBuf = ' '        msgBuf = ' '
# Line 1205  C     | SUBROUTINE PRINT_MESSAGE Line 1267  C     | SUBROUTINE PRINT_MESSAGE
1267  C     | o Write out informational message using "standard" format. |  C     | o Write out informational message using "standard" format. |
1268  C     | Notes                                                      |  C     | Notes                                                      |
1269  C     | =====                                                      |  C     | =====                                                      |
1270  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  |
1271  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |
1272  C     |   critical region is defined around the write here. In some|  C     |   critical region is defined around the write here. In some|
1273  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  C     |   cases  BEGIN_CRIT() is approximated by only doing writes |
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22