/[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.20 by dimitri, Sat Jan 10 16:59:08 2004 UTC revision 1.27 by jmc, Tue Mar 20 23:42:16 2007 UTC
# Line 13  C--    o print_list_l   Prints one-deime Line 13  C--    o print_list_l   Prints one-deime
13  C--                     variables.  C--                     variables.
14  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--    o print_list_r8  Prints one-deimensional list of Real*8
15  C--                     numbers.  C--                     numbers.
16  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field  C--    o print_maprs    Formats ABCD... contour map of a Real(_RS) field
17  C--                     Uses print_message for writing  C--                     Uses print_message for writing
18  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field  C--    o print_maprl    Formats ABCD... contour map of a Real(_RL) field
19  C--                     Uses print_message for writing  C--                     Uses print_message for writing
20  C--    o print_message  Does IO with unhighlighted header  C--    o print_message  Does IO with unhighlighted header
21    
# 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 428  C     K    - Loop counter Line 442  C     K    - Loop counter
442        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
443        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
444        CHARACTER*3 index_lab        CHARACTER*3 index_lab
445          CHARACTER*25 fmt1, fmt2
446        INTEGER K        INTEGER K
447  CEOP  CEOP
448    
# Line 440  CEOP Line 455  CEOP
455        ELSE        ELSE
456         index_lab = '?='         index_lab = '?='
457        ENDIF        ENDIF
458    C-    fortran format to write 1 or 2 indices:
459          fmt1='(A,1X,A,I3,1X,A)'
460          fmt2='(A,1X,A,I3,A,I3,1X,A)'
461          IF ( lFld.GE.1000 ) THEN
462            K = 1+INT(LOG10(FLOAT(lFld)))
463            WRITE(fmt1,'(A,I1,A)') '(A,1X,A,I',K,',1X,A)'
464            WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)'
465          ENDIF
466        commOpen  = '/*'        commOpen  = '/*'
467        commClose = '*/'        commClose = '*/'
468        iLo = 1        iLo = 1
# Line 452  CEOP Line 475  CEOP
475          nDup = iHi-iLo+1          nDup = iHi-iLo+1
476          IF ( nDup .EQ. 1 ) THEN          IF ( nDup .EQ. 1 ) THEN
477           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
478           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
479       &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt1)
480       &    commOpen,index_lab,iLo,commClose       &    commOpen,index_lab,iLo,commClose
481          ELSE          ELSE
482           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc           WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
483           IF ( index_type .NE. INDEX_NONE )           IF ( index_type .NE. INDEX_NONE )
484       &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &    WRITE(msgBuf(45:),fmt2)
485       &    commOpen,index_lab,iLo,':',iHi,commClose       &    commOpen,index_lab,iLo,':',iHi,commClose
486          ENDIF          ENDIF
487          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
488       &    SQUEEZE_RIGHT , 1)       &    SQUEEZE_RIGHT , 1)
489          iLo  = K          iLo  = K
490          iHi  = K          iHi  = K
# Line 475  CEOP Line 498  CEOP
498        nDup = iHi-iLo+1        nDup = iHi-iLo+1
499        IF    ( nDup .EQ. 1 ) THEN        IF    ( nDup .EQ. 1 ) THEN
500         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc         WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
501         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
502       &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)')       &  WRITE(msgBuf(45:),fmt1)
503       &    commOpen,index_lab,iLo,commClose       &    commOpen,index_lab,iLo,commClose
504        ELSEIF( nDup .GT. 1 ) THEN        ELSEIF( nDup .GT. 1 ) THEN
505         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc         WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
506         IF ( index_type .NE. INDEX_NONE )         IF ( index_type .NE. INDEX_NONE )
507       &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')       &  WRITE(msgBuf(45:),fmt2)
508       &  commOpen,index_lab,iLo,':',iHi,commClose       &  commOpen,index_lab,iLo,':',iHi,commClose
509        ENDIF        ENDIF
510        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
511       &    SQUEEZE_RIGHT , 1)       &    SQUEEZE_RIGHT , 1)
512    
513        RETURN        RETURN
# Line 503  C     !INTERFACE: Line 526  C     !INTERFACE:
526        IMPLICIT NONE        IMPLICIT NONE
527  C     !DESCRIPTION:  C     !DESCRIPTION:
528  C     *==========================================================*  C     *==========================================================*
529  C     | SUBROUTINE PRINT_MAPR4                                      C     | SUBROUTINE PRINT\_MAPRS                                    
530  C     | o Does textual mapping printing of a field.                C     | o Does textual mapping printing of a field.              
531  C     *==========================================================*  C     *==========================================================*
532  C     | This routine does the actual formatting of the data        C     | This routine does the actual formatting of the data      
533  C     | and printing to a file. It assumes an array using the      C     | and printing to a file. It assumes an array using the    
534  C     | MITgcm UV indexing scheme and base index variables.        C     | MITgcm UV indexing scheme and base index variables.      
535  C     | User code should call an interface routine like            C     | User code should call an interface routine like          
536  C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.      C     | PLOT\_FIELD\_XYRS( ... ) rather than this code directly.    
537  C     | Text plots can be oriented XY, YZ, XZ. An orientation      C     | Text plots can be oriented XY, YZ, XZ. An orientation    
538  C     | is specficied through the "plotMode" argument. All the      C     | is specficied through the "plotMode" argument. All the    
539  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  
540  C     | same contour interval. The plot range (iMin,...,byStr)      C     | same contour interval. The plot range (iMin,...,byStr)    
541  C     | can be three-dimensional. A separate plot is made for      C     | can be three-dimensional. A separate plot is made for    
542  C     | each point in the plot range normal to the orientation.    C     | each point in the plot range normal to the orientation.  
543  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).    C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).  
544  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
545  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.    
546  C     |      Each plot would have extents iMin:iMax step iStr      C     |      Each plot would have extents iMin:iMax step iStr    
# Line 707  C--   Write field title and statistics Line 730  C--   Write field title and statistics
730        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
731       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
732    
733          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
734           msgBuf =
735         &  'Model domain too big to print to terminal - skipping I/O'
736           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
737         &                   SQUEEZE_RIGHT, 1)
738           RETURN
739          endif
740    
741  C--   Write field  C--   Write field
742  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
743  C     acc = accross the page  C     acc = accross the page
# Line 839  C      Data Line 870  C      Data
870             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
871              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
872             ELSE             ELSE
873              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
874             ENDIF             ENDIF
875            ENDDO            ENDDO
876           ENDDO           ENDDO
# Line 919  C     !INTERFACE: Line 950  C     !INTERFACE:
950    
951  C     !DESCRIPTION:  C     !DESCRIPTION:
952  C     *==========================================================*  C     *==========================================================*
953  C     | SUBROUTINE PRINT_MAPRL                                      C     | SUBROUTINE PRINT\_MAPRL                                    
954  C     | o Does textual mapping printing of a field.                C     | o Does textual mapping printing of a field.              
955  C     *==========================================================*  C     *==========================================================*
956  C     | This routine does the actual formatting of the data        C     | This routine does the actual formatting of the data      
957  C     | and printing to a file. It assumes an array using the      C     | and printing to a file. It assumes an array using the    
958  C     | MITgcm UV indexing scheme and base index variables.        C     | MITgcm UV indexing scheme and base index variables.      
959  C     | User code should call an interface routine like            C     | User code should call an interface routine like          
960  C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.      C     | PLOT\_FIELD\_XYRL( ... ) rather than this code directly.    
961  C     | Text plots can be oriented XY, YZ, XZ. An orientation      C     | Text plots can be oriented XY, YZ, XZ. An orientation    
962  C     | is specficied through the "plotMode" argument. All the      C     | is specficied through the "plotMode" argument. All the    
963  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  
964  C     | same contour interval. The plot range (iMin,...,byStr)      C     | same contour interval. The plot range (iMin,...,byStr)    
965  C     | can be three-dimensional. A separate plot is made for      C     | can be three-dimensional. A separate plot is made for    
966  C     | each point in the plot range normal to the orientation.    C     | each point in the plot range normal to the orientation.  
967  C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY).    C     | e.g. if the orientation is XY (plotMode = PRINT\_MAP\_XY).  
968  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY  C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY
969  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.    
970  C     |      Each plot would have extents iMin:iMax step iStr      C     |      Each plot would have extents iMin:iMax step iStr    
# Line 1124  C--   Write field title and statistics Line 1155  C--   Write field title and statistics
1155        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,        CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1156       &                   SQUEEZE_RIGHT, 1)       &                   SQUEEZE_RIGHT, 1)
1157    
1158          if (Nx.gt.MAX_LEN_PLOTBUF-20) THEN
1159           msgBuf =
1160         &  'Model domain too big to print to terminal - skipping I/O'
1161           CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
1162         &                   SQUEEZE_RIGHT, 1)
1163           RETURN
1164          endif
1165    
1166  C--   Write field  C--   Write field
1167  C     Figure out slice type and set plotting parameters appropriately  C     Figure out slice type and set plotting parameters appropriately
1168  C     acc = accross the page  C     acc = accross the page
# Line 1255  C      Data Line 1294  C      Data
1294             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1295              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1296             ELSE             ELSE
1297              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1298             ENDIF             ENDIF
1299            ENDDO            ENDDO
1300           ENDDO           ENDDO
# Line 1326  C     !INTERFACE: Line 1365  C     !INTERFACE:
1365        IMPLICIT NONE        IMPLICIT NONE
1366  C     !DESCRIPTION:  C     !DESCRIPTION:
1367  C     *============================================================*  C     *============================================================*
1368  C     | SUBROUTINE PRINT_MESSAGE                                      C     | SUBROUTINE PRINT\_MESSAGE                                    
1369  C     | o Write out informational message using "standard" format.    C     | o Write out informational message using "standard" format.  
1370  C     *============================================================*  C     *============================================================*
1371  C     | Notes                                                        C     | Notes                                                      
1372  C     | =====                                                        C     | =====                                                      
1373  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  
1374  C     |   without the FMTFTN_IO_THREAD_SAFE directive set a          C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
1375  C     |   critical region is defined around the write here. In some  C     |   critical region is defined around the write here. In some
1376  C     |   cases  BEGIN_CRIT() is approximated by only doing writes    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
1377  C     |   for thread number 1 - writes for other threads are          C     |   for thread number 1 - writes for other threads are        
1378  C     |   ignored!                                                    C     |   ignored!                                                  
1379  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 1463  C       The write statement may need to
1463  #endif  #endif
1464         ENDIF         ENDIF
1465        ENDIF        ENDIF
1466    
1467    #ifndef DISABLE_WRITE_TO_UNIT_ZERO
1468    C--   if error message, also write directly to unit 0 :
1469          IF ( numberOfProcs .EQ. 1 .AND. nThreads .EQ. 1
1470         &     .AND. unit.EQ.errorMessageUnit ) THEN
1471            iEnd   = ILNBLNK( message )
1472            IF (iEnd.NE.0) WRITE(0,'(A)') message(1:iEnd)
1473          ENDIF
1474    #endif
1475  C  C
1476   1000 CONTINUE   1000 CONTINUE
1477        RETURN        RETURN
Legend:
Removed from v.1.20  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22