/[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.11 by cnh, Sat Sep 5 17:52:13 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, markEnd, compact, 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 181  C     K    - Loop counter Line 183  C     K    - Loop counter
183          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
184           WRITE(msgBuf,'(A,I9,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,I9,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 )
# Line 202  C     K    - Loop counter Line 205  C     K    - Loop counter
205        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
206         WRITE(msgBuf,'(A,I9,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,I9,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 )
# Line 215  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, markEnd, compact, 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 286  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 ( .NOT. compact .OR. 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 312  C     K    - Loop counter Line 318  C     K    - Loop counter
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 325  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, markEnd, compact, 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 401  C     K    - Loop counter Line 409  C     K    - Loop counter
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 422  C     K    - Loop counter Line 432  C     K    - Loop counter
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 581  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 639  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 740  C      Header Line 754  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 821  C      Data Line 835  C      Data
835         ENDDO         ENDDO
836  C     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 967  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             IF ( printMapIncludesZeros .OR. 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 )
# Line 984  C--   Calculate field range Line 1002  C--   Calculate field range
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 1042  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 1143  C      Header Line 1163  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 1221  C      Data Line 1241  C      Data
1241         ENDDO         ENDDO
1242  C     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 1244  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.11  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22