/[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.19 by adcroft, Fri Sep 21 14:31:12 2001 UTC revision 1.25 by jmc, Sat Sep 2 22:47:10 2006 UTC
# Line 29  C     !INTERFACE: Line 29  C     !INTERFACE:
29    
30  C     !DESCRIPTION:  C     !DESCRIPTION:
31  C     *============================================================*  C     *============================================================*
32  C     | SUBROUTINE PRINT_ERROR                                        C     | SUBROUTINE PRINT\_ERROR                                      
33  C     | o Write out error message using "standard" format.            C     | o Write out error message using "standard" format.          
34  C     *============================================================*  C     *============================================================*
35  C     | Notes                                                        C     | Notes                                                      
36  C     | =====                                                        C     | =====                                                      
37  C     | o Some system   I/O is not "thread-safe". For this reason    C     | o Some system   I/O is not "thread-safe". For this reason  
38  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a          C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
39  C     |   critical region is defined around the write here. In some  C     |   critical region is defined around the write here. In some
40  C     |   cases  BEGIN_CRIT() is approximated by only doing writes    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
41  C     |   for thread number 1 - writes for other threads are          C     |   for thread number 1 - writes for other threads are        
42  C     |   ignored!                                                    C     |   ignored!                                                  
43  C     | o In a non-parallel form these routines are still used    C     | o In a non-parallel form these routines are still used  
# Line 84  C--    Write single process format Line 84  C--    Write single process format
84          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,          WRITE(errorMessageUnit,'(A,1X,A)') ERROR_HEADER,
85       &   message(iStart:iEnd)       &   message(iStart:iEnd)
86         ENDIF         ENDIF
87        ELSEIF ( pidIO .EQ. myProcId ) THEN        ELSE
 C--    Write multi-process format  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _BEGIN_CRIT(myThid)  
 #endif  
         WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid  
 #ifndef FMTFTN_IO_THREAD_SAFE  
        _END_CRIT(myThid)  
 #endif  
        IF ( message .EQ. ' ' ) THEN  
88  C       PRINT_ERROR can be called by several threads simulataneously.  C       PRINT_ERROR can be called by several threads simulataneously.
89  C       The write statement may need to be marked as a critical section.  C       The write statement may need to be marked as a critical section.
90  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
91          _BEGIN_CRIT(myThid)  # ifdef USE_OMP_THREADING
92  #endif  C$OMP CRITICAL
93          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  # else
94       &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',         _BEGIN_CRIT(myThid)
95       &  ' '  # endif
 #ifndef FMTFTN_IO_THREAD_SAFE  
         _END_CRIT(myThid)  
96  #endif  #endif
97         ELSE         IF ( pidIO .EQ. myProcId ) THEN
98  #ifndef FMTFTN_IO_THREAD_SAFE  C--    Write multi-process format
99          _BEGIN_CRIT(myThid)           WRITE(idString,'(I4.4,A,I4.4)') myProcId,'.',myThid
100    
101             IF ( iEnd.EQ.0 ) THEN
102    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
103              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
104         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
105         &    ' '
106             ELSE
107    c         WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)
108              WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)')
109         &    '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',
110         &    message(iStart:iEnd)
111             ENDIF
112           ENDIF
113    
114    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
115    C--    also write directly to unit 0 :
116           IF ( numberOfProcs.EQ.1 .AND. iEnd.NE.0 ) THEN
117            IF ( nThreads.LE.1 ) THEN
118              WRITE(0,'(A)') message(1:iEnd)
119            ELSE
120              WRITE(0,'(A,I4.4,A,A)') '(TID ', myThid, ') ',
121         &                   message(1:iEnd)
122            ENDIF
123           ENDIF
124  #endif  #endif
125          WRITE(errorMessageUnit,'(A,A,1X,A,A,A,A,A)',ERR=999)  
      &  '(',PROCESS_HEADER,idString,')',ERROR_HEADER,' ',  
      &  message(iStart:iEnd)  
126  #ifndef FMTFTN_IO_THREAD_SAFE  #ifndef FMTFTN_IO_THREAD_SAFE
127    # ifdef USE_OMP_THREADING
128    C$OMP END CRITICAL
129    # else
130          _END_CRIT(myThid)          _END_CRIT(myThid)
131    # endif
132  #endif  #endif
        ENDIF  
133        ENDIF        ENDIF
134  C  
135   1000 CONTINUE   1000 CONTINUE
136        RETURN        RETURN
137    
138    999 CONTINUE  c 999 CONTINUE
139         ioErrorCount(myThid) = ioErrorCount(myThid)+1  c      ioErrorCount(myThid) = ioErrorCount(myThid)+1
140        GOTO 1000  c     GOTO 1000
141        END        END
142    
143  CBOP  CBOP
# Line 135  C     !INTERFACE: Line 149  C     !INTERFACE:
149        IMPLICIT NONE        IMPLICIT NONE
150  C     !DESCRIPTION:  C     !DESCRIPTION:
151  C     *==========================================================*  C     *==========================================================*
152  C     | o SUBROUTINE PRINT_LIST_I                                  C     | o SUBROUTINE PRINT\_LIST\_I                                
153  C     *==========================================================*  C     *==========================================================*
154  C     | Routine for producing list of values for a field with      C     | Routine for producing list of values for a field with    
155  C     | duplicate values collected into                            C     | duplicate values collected into                          
156  C     |    n @ value                                                C     |    n \@ value                                              
157  C     | record.                                                    C     | record.                                                  
158  C     *==========================================================*  C     *==========================================================*
159    
# Line 256  C     !INTERFACE: Line 270  C     !INTERFACE:
270        IMPLICIT NONE        IMPLICIT NONE
271  C     !DESCRIPTION:  C     !DESCRIPTION:
272  C     *==========================================================*  C     *==========================================================*
273  C     | o SUBROUTINE PRINT_LIST_L                                  C     | o SUBROUTINE PRINT\_LIST\_L                                
274  C     *==========================================================*  C     *==========================================================*
275  C     | Routine for producing list of values for a field with      C     | Routine for producing list of values for a field with    
276  C     | duplicate values collected into                            C     | duplicate values collected into                          
277  C     |    n @ value                                                C     |    n \@ value                                              
278  C     | record.                                                    C     | record.                                                  
279  C     *==========================================================*  C     *==========================================================*
280    
# Line 376  C     !INTERFACE: Line 390  C     !INTERFACE:
390        IMPLICIT NONE        IMPLICIT NONE
391  C     !DESCRIPTION:  C     !DESCRIPTION:
392  C     *==========================================================*  C     *==========================================================*
393  C     | o SUBROUTINE PRINT_LIST_R8                                  C     | o SUBROUTINE PRINT\_LIST\_R8                                
394  C     *==========================================================*  C     *==========================================================*
395  C     | Routine for producing list of values for a field with      C     | Routine for producing list of values for a field with    
396  C     | duplicate values collected into                            C     | duplicate values collected into                          
397  C     |    n @ value                                                C     |    n \@ value                                              
398  C     | record.                                                    C     | record.                                                  
399  C     *==========================================================*  C     *==========================================================*
400    
# Line 503  C     !INTERFACE: Line 517  C     !INTERFACE:
517        IMPLICIT NONE        IMPLICIT NONE
518  C     !DESCRIPTION:  C     !DESCRIPTION:
519  C     *==========================================================*  C     *==========================================================*
520  C     | SUBROUTINE PRINT_MAPR4                                      C     | SUBROUTINE PRINT\_MAPR4                                    
521  C     | o Does textual mapping printing of a field.                C     | o Does textual mapping printing of a field.              
522  C     *==========================================================*  C     *==========================================================*
523  C     | This routine does the actual formatting of the data        C     | This routine does the actual formatting of the data      
524  C     | and printing to a file. It assumes an array using the      C     | and printing to a file. It assumes an array using the    
525  C     | MITgcm UV indexing scheme and base index variables.        C     | MITgcm UV indexing scheme and base index variables.      
526  C     | User code should call an interface routine like            C     | User code should call an interface routine like          
527  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.      C     | PLOT\_FIELD\_XYR4( ... ) rather than this code directly.    
528  C     | Text plots can be oriented XY, YZ, XZ. An orientation      C     | Text plots can be oriented XY, YZ, XZ. An orientation    
529  C     | is specficied through the "plotMode" argument. All the      C     | is specficied through the "plotMode" argument. All the    
530  C     | plots made by a single call to this routine will use the    C     | plots made by a single call to this routine will use the  
531  C     | same contour interval. The plot range (iMin,...,byStr)      C     | same contour interval. The plot range (iMin,...,byStr)    
532  C     | can be three-dimensional. A separate plot is made for      C     | can be three-dimensional. A separate plot is made for    
533  C     | each point in the plot range normal to the orientation.    C     | each point in the plot range normal to the orientation.  
534  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).    C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).  
535  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
536  C     |      plots - one for K=1, one for K=3 and one for K=5.      C     |      plots - one for K=1, one for K=3 and one for K=5.    
537  C     |      Each plot would have extents iMin:iMax step iStr      C     |      Each plot would have extents iMin:iMax step iStr    
# Line 638  C--   Calculate field range Line 652  C--   Calculate field range
652         ENDDO         ENDDO
653        ENDDO        ENDDO
654        fRange = fMax-fMin        fRange = fMax-fMin
655        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
656         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
657        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
658    
659  C--   Write field title and statistics  C--   Write field title and statistics
660        msgBuf =        msgBuf =
# Line 707  C--   Write field title and statistics Line 721  C--   Write field title and statistics
721        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
722       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
723    
724          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
725           msgBuf =
726         &  'Model domain too big to print to terminal - skipping I/O'
727           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
728         &                   SQUEEZE_RIGHT, 1)
729           RETURN
730          endif
731    
732  C--   Write field  C--   Write field
733  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
734  C     acc = accross the page  C     acc = accross the page
# Line 799  C      X across, Z down slice Line 821  C      X across, Z down slice
821         pltStep = sNy         pltStep = sNy
822         pltLab  = 'J ='         pltLab  = 'J ='
823        ENDIF        ENDIF
824  C     IF ( validRange ) THEN        IF ( validRange ) THEN
825  C      Header  C      Header
826  C      Data  C      Data
827         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
# Line 839  C      Data Line 861  C      Data
861             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
862              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
863             ELSE             ELSE
864              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
865             ENDIF             ENDIF
866            ENDDO            ENDDO
867           ENDDO           ENDDO
# Line 883  C      Data Line 905  C      Data
905           ENDDO           ENDDO
906          ENDDO          ENDDO
907         ENDDO         ENDDO
908  C     ENDIF        ENDIF
909  C--   Write delimiter  C--   Write delimiter
910        msgBuf =        msgBuf =
911       & '// ======================================================='       & '// ======================================================='
# Line 919  C     !INTERFACE: Line 941  C     !INTERFACE:
941    
942  C     !DESCRIPTION:  C     !DESCRIPTION:
943  C     *==========================================================*  C     *==========================================================*
944  C     | SUBROUTINE PRINT_MAPRL                                      C     | SUBROUTINE PRINT\_MAPRL                                    
945  C     | o Does textual mapping printing of a field.                C     | o Does textual mapping printing of a field.              
946  C     *==========================================================*  C     *==========================================================*
947  C     | This routine does the actual formatting of the data        C     | This routine does the actual formatting of the data      
948  C     | and printing to a file. It assumes an array using the      C     | and printing to a file. It assumes an array using the    
949  C     | MITgcm UV indexing scheme and base index variables.        C     | MITgcm UV indexing scheme and base index variables.      
950  C     | User code should call an interface routine like            C     | User code should call an interface routine like          
951  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.      C     | PLOT\_FIELD\_XYR8( ... ) rather than this code directly.    
952  C     | Text plots can be oriented XY, YZ, XZ. An orientation      C     | Text plots can be oriented XY, YZ, XZ. An orientation    
953  C     | is specficied through the "plotMode" argument. All the      C     | is specficied through the "plotMode" argument. All the    
954  C     | plots made by a single call to this routine will use the    C     | plots made by a single call to this routine will use the  
955  C     | same contour interval. The plot range (iMin,...,byStr)      C     | same contour interval. The plot range (iMin,...,byStr)    
956  C     | can be three-dimensional. A separate plot is made for      C     | can be three-dimensional. A separate plot is made for    
957  C     | each point in the plot range normal to the orientation.    C     | each point in the plot range normal to the orientation.  
958  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).    C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).  
959  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
960  C     |      plots - one for K=1, one for K=3 and one for K=5.      C     |      plots - one for K=1, one for K=3 and one for K=5.    
961  C     |      Each plot would have extents iMin:iMax step iStr      C     |      Each plot would have extents iMin:iMax step iStr    
# Line 1055  C--   Calculate field range Line 1077  C--   Calculate field range
1077         ENDDO         ENDDO
1078        ENDDO        ENDDO
1079        fRange = fMax-fMin        fRange = fMax-fMin
1080        IF ( fRange .GT. small ) THEN        IF ( fRange .GT. small .AND.
1081         validRange = .TRUE.       &     (MAX_LEN_PLOTBUF-35) .GT. sNx*nSx .AND.
1082        ENDIF       &     (MAX_LEN_PLOTBUF-35) .GT. sNy*nSy ) validRange = .TRUE.
1083    
1084  C--   Write field title and statistics  C--   Write field title and statistics
1085        msgBuf =        msgBuf =
# Line 1124  C--   Write field title and statistics Line 1146  C--   Write field title and statistics
1146        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1147       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1148    
1149          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1150           msgBuf =
1151         &  'Model domain too big to print to terminal - skipping I/O'
1152           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1153         &                   SQUEEZE_RIGHT, 1)
1154           RETURN
1155          endif
1156    
1157  C--   Write field  C--   Write field
1158  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1159  C     acc = accross the page  C     acc = accross the page
# Line 1216  C      X across, Z down slice Line 1246  C      X across, Z down slice
1246         pltStep = sNy         pltStep = sNy
1247         pltLab  = 'J ='         pltLab  = 'J ='
1248        ENDIF        ENDIF
1249  C     IF ( validRange ) THEN        IF ( validRange ) THEN
1250  C      Header  C      Header
1251  C      Data  C      Data
1252         DO bk=pltBlo, pltBhi, pltBstr         DO bk=pltBlo, pltBhi, pltBstr
# Line 1297  C      Data Line 1327  C      Data
1327           ENDDO           ENDDO
1328          ENDDO          ENDDO
1329         ENDDO         ENDDO
1330  C     ENDIF        ENDIF
1331  C--   Write delimiter  C--   Write delimiter
1332        msgBuf =        msgBuf =
1333       & '// ======================================================='       & '// ======================================================='
# Line 1326  C     !INTERFACE: Line 1356  C     !INTERFACE:
1356        IMPLICIT NONE        IMPLICIT NONE
1357  C     !DESCRIPTION:  C     !DESCRIPTION:
1358  C     *============================================================*  C     *============================================================*
1359  C     | SUBROUTINE PRINT_MESSAGE                                      C     | SUBROUTINE PRINT\_MESSAGE                                    
1360  C     | o Write out informational message using "standard" format.    C     | o Write out informational message using "standard" format.  
1361  C     *============================================================*  C     *============================================================*
1362  C     | Notes                                                        C     | Notes                                                      
1363  C     | =====                                                        C     | =====                                                      
1364  C     | o Some system   I/O is not "thread-safe". For this reason    C     | o Some system   I/O is not "thread-safe". For this reason  
1365  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a          C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
1366  C     |   critical region is defined around the write here. In some  C     |   critical region is defined around the write here. In some
1367  C     |   cases  BEGIN_CRIT() is approximated by only doing writes    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
1368  C     |   for thread number 1 - writes for other threads are          C     |   for thread number 1 - writes for other threads are        
1369  C     |   ignored!                                                    C     |   ignored!                                                  
1370  C     | o In a non-parallel form these routines can still be used.    C     | o In a non-parallel form these routines can still be used.  
# Line 1424  C       The write statement may need to Line 1454  C       The write statement may need to
1454  #endif  #endif
1455         ENDIF         ENDIF
1456        ENDIF        ENDIF
1457    
1458    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
1459    C--   if error message, also write directly to unit 0 :
1460          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
1461         &     .AND. unit.EQ.errorMessageUnit ) THEN
1462            iEnd   = ILNBLNK( message )
1463            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
1464          ENDIF
1465    #endif
1466  C  C
1467   1000 CONTINUE   1000 CONTINUE
1468        RETURN        RETURN
Legend:
Removed from v.1.19  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22