/[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.17 by cnh, Sun Feb 4 14:38:44 2001 UTC revision 1.25 by jmc, Sat Sep 2 22:47:10 2006 UTC
# Line 19  C--    o print_mapr8    Formats ABCD... Line 19  C--    o print_mapr8    Formats ABCD...
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    
22  CStartOfInterface  CBOP              
23    
24    C     !ROUTINE: PRINT_ERROR
25    
26    C     !INTERFACE:
27        SUBROUTINE PRINT_ERROR( message , myThid )        SUBROUTINE PRINT_ERROR( message , myThid )
 C     /============================================================\  
 C     | SUBROUTINE PRINT_ERROR                                     |  
 C     | o Write out error message using "standard" format.         |  
 C     | Notes                                                      |  
 C     | =====                                                      |  
 C     | o Some system   I/O is not "thread-safe". For this reason  |  
 C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  
 C     |   critical region is defined around the write here. In some|  
 C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  
 C     |   for thread number 1 - writes for other threads are       |  
 C     |   ignored!                                                 |  
 C     | o In a non-parallel form these routines can still be used. |  
 C     |   to produce pretty printed output!                        |  
 C     \============================================================/  
28        IMPLICIT NONE        IMPLICIT NONE
29    
30    C     !DESCRIPTION:
31    C     *============================================================*
32    C     | SUBROUTINE PRINT\_ERROR                                      
33    C     | o Write out error message using "standard" format.          
34    C     *============================================================*
35    C     | Notes                                                      
36    C     | =====                                                      
37    C     | o Some system   I/O is not "thread-safe". For this reason  
38    C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
39    C     |   critical region is defined around the write here. In some
40    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
41    C     |   for thread number 1 - writes for other threads are        
42    C     |   ignored!                                                  
43    C     | o In a non-parallel form these routines are still used  
44    C     |   to produce pretty printed output. The process and thread
45    C     |   id prefix is omitted in this case.
46    C     *============================================================*
47    
48    C     !USES:
49  C     == Global data ==  C     == Global data ==
50  #include "SIZE.h"  #include "SIZE.h"
51  #include "EEPARAMS.h"  #include "EEPARAMS.h"
52  #include "EESUPPORT.h"  #include "EESUPPORT.h"
 C     == Routine arguments ==  
       CHARACTER*(*) message  
       INTEGER       myThid  
 CEndOfInterface  
53        INTEGER  IFNBLNK        INTEGER  IFNBLNK
54        EXTERNAL IFNBLNK        EXTERNAL IFNBLNK
55        INTEGER  ILNBLNK        INTEGER  ILNBLNK
56        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
57    
58    C     !INPUT/OUTPUT PARAMETERS:
59    C     == Routine arguments ==
60    C     message :: Text string to print
61    C     myThid  :: Thread number of this instance
62          CHARACTER*(*) message
63          INTEGER       myThid
64    
65    C     !LOCAL VARIABLES:
66  C     == Local variables ==  C     == Local variables ==
67    C     iStart, iEnd :: Temps. for string indexing
68    C     idString     :: Temp. for building message prefix
69        INTEGER iStart        INTEGER iStart
70        INTEGER iEnd        INTEGER iEnd
71        CHARACTER*9 idString        CHARACTER*9 idString
72    CEOP
73    
74  C--   Find beginning and end of message  C--   Find beginning and end of message
75        iStart = IFNBLNK( message )        iStart = IFNBLNK( message )
76        iEnd   = ILNBLNK( message )        iEnd   = ILNBLNK( message )
# Line 65  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  CStartofinterface  CBOP
144    C     !ROUTINE: PRINT_LIST_I
145    
146    C     !INTERFACE:
147        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type,
148       &                         markEnd, compact, ioUnit )       &                         markEnd, compact, ioUnit )
 C     /==========================================================\  
 C     | o SUBROUTINE PRINT_LIST_I                                |  
 C     |==========================================================|  
 C     | Routine for producing list of values for a field with    |  
 C     | duplicate values collected into                          |  
 C     |    n @ value                                             |  
 C     | record.                                                  |  
 C     \==========================================================/  
149        IMPLICIT NONE        IMPLICIT NONE
150    C     !DESCRIPTION:
151    C     *==========================================================*
152    C     | o SUBROUTINE PRINT\_LIST\_I                                
153    C     *==========================================================*
154    C     | Routine for producing list of values for a field with    
155    C     | duplicate values collected into                          
156    C     |    n \@ value                                              
157    C     | record.                                                  
158    C     *==========================================================*
159    
160    C     !USES:
161  C     == Global data ==    C     == Global data ==  
162  #include "SIZE.h"  #include "SIZE.h"
163  #include "EEPARAMS.h"  #include "EEPARAMS.h"
164    
165    C     !INPUT/OUTPUT PARAMETERS:
166  C     == Routine arguments ==  C     == Routine arguments ==
167  C     fld    -  Data to be printed  C     fld    ::  Data to be printed
168  C     lFld   -  Number of elements to be printed  C     lFld   ::  Number of elements to be printed
169  C     index_type - Flag indicating which type of index to print  C     index_type :: Flag indicating which type of index to print
170  C                  INDEX_K    => /* K = nnn */  C                   INDEX_K    => /* K = nnn */
171  C                  INDEX_I    => /* I = nnn */  C                   INDEX_I    => /* I = nnn */
172  C                  INDEX_J    => /* J = nnn */  C                   INDEX_J    => /* J = nnn */
173  C                  INDEX_NONE =>  C                   INDEX_NONE =>
174  C     compact -  Flag to control use of repeat symbol for same valued  C     compact ::  Flag to control use of repeat symbol for same valued
175  C                fields.  C                 fields.
176  C     markEnd -  Flag to control whether there is a separator after the  C     markEnd ::  Flag to control whether there is a separator after the
177  C                last element  C                 last element
178  C     ioUnit -  Unit number for IO.  C     ioUnit ::   Unit number for IO.
179        INTEGER lFld        INTEGER lFld
180        INTEGER index_type        INTEGER index_type
181        INTEGER fld(lFld)        INTEGER fld(lFld)
182        LOGICAL markEnd        LOGICAL markEnd
183        LOGICAL compact        LOGICAL compact
184        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
185    
186    C     !LOCAL VARIABLES:
187  C     == Local variables ==  C     == Local variables ==
188  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
189  C     iHi    with the same value  C     iHi    with the same value
# Line 163  C     K    - Loop counter Line 202  C     K    - Loop counter
202        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
203        CHARACTER*3 index_lab        CHARACTER*3 index_lab
204        INTEGER K        INTEGER K
205    CEOP
206    
207        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
208         index_lab = 'I ='         index_lab = 'I ='
# Line 221  C     K    - Loop counter Line 261  C     K    - Loop counter
261        RETURN        RETURN
262        END        END
263    
264  CStartofinterface  CBOP
265    C     !ROUTINE: PRINT_LIST_L
266    
267    C     !INTERFACE:
268        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,        SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, markEnd,
269       &                         compact, ioUnit )       &                         compact, ioUnit )
 C     /==========================================================\  
 C     | o SUBROUTINE PRINT_LIST_L                                |  
 C     |==========================================================|  
 C     | Routine for producing list of values for a field with    |  
 C     | duplicate values collected into                          |  
 C     |    n @ value                                             |  
 C     | record.                                                  |  
 C     \==========================================================/  
270        IMPLICIT NONE        IMPLICIT NONE
271    C     !DESCRIPTION:
272    C     *==========================================================*
273    C     | o SUBROUTINE PRINT\_LIST\_L                                
274    C     *==========================================================*
275    C     | Routine for producing list of values for a field with    
276    C     | duplicate values collected into                          
277    C     |    n \@ value                                              
278    C     | record.                                                  
279    C     *==========================================================*
280    
281    C     !USES:
282  C     == Global data ==    C     == Global data ==  
283  #include "SIZE.h"  #include "SIZE.h"
284  #include "EEPARAMS.h"  #include "EEPARAMS.h"
285    
286    C     !INPUT/OUTPUT PARAMETERS:
287  C     == Routine arguments ==  C     == Routine arguments ==
288  C     fld    -  Data to be printed  C     fld    -  Data to be printed
289  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 257  C     ioUnit -  Unit number for IO. Line 303  C     ioUnit -  Unit number for IO.
303        LOGICAL markEnd        LOGICAL markEnd
304        LOGICAL compact        LOGICAL compact
305        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
306    
307    C     !LOCAL VARIABLES:
308  C     == Local variables ==  C     == Local variables ==
309  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
310  C     iHi    with the same value  C     iHi    with the same value
# Line 277  C     K    - Loop counter Line 323  C     K    - Loop counter
323        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
324        CHARACTER*3 index_lab        CHARACTER*3 index_lab
325        INTEGER K        INTEGER K
326    CEOP
327    
328        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
329         index_lab = 'I ='         index_lab = 'I ='
# Line 335  C     K    - Loop counter Line 382  C     K    - Loop counter
382        RETURN        RETURN
383        END        END
384    
385  CStartofinterface  CBOP
386    C     !ROUTINE: PRINT_LIST_R8
387    C     !INTERFACE:
388        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type,
389       &    markEnd, compact, ioUnit )       &    markEnd, compact, ioUnit )
 C     /==========================================================\  
 C     | o SUBROUTINE PRINT_LIST_R8                               |  
 C     |==========================================================|  
 C     | Routine for producing list of values for a field with    |  
 C     | duplicate values collected into                          |  
 C     |    n @ value                                             |  
 C     | record.                                                  |  
 C     \==========================================================/  
390        IMPLICIT NONE        IMPLICIT NONE
391    C     !DESCRIPTION:
392    C     *==========================================================*
393    C     | o SUBROUTINE PRINT\_LIST\_R8                                
394    C     *==========================================================*
395    C     | Routine for producing list of values for a field with    
396    C     | duplicate values collected into                          
397    C     |    n \@ value                                              
398    C     | record.                                                  
399    C     *==========================================================*
400    
401  C     == Global data ==    C     !USES:
402    C     == Global data ==
403  #include "SIZE.h"  #include "SIZE.h"
404  #include "EEPARAMS.h"  #include "EEPARAMS.h"
405    
406    C     !INPUT/OUTPUT PARAMETERS:
407  C     == Routine arguments ==  C     == Routine arguments ==
408  C     fld    -  Data to be printed  C     fld    -  Data to be printed
409  C     lFld   -  Number of elements to be printed  C     lFld   -  Number of elements to be printed
# Line 371  C     ioUnit -  Unit number for IO. Line 423  C     ioUnit -  Unit number for IO.
423        LOGICAL markEnd        LOGICAL markEnd
424        LOGICAL compact        LOGICAL compact
425        INTEGER ioUnit        INTEGER ioUnit
 CEndifinterface  
426    
427    C     !LOCA VARIABLES:
428  C     == Local variables ==  C     == Local variables ==
429  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
430  C     iHi    with the same value  C     iHi    with the same value
# Line 391  C     K    - Loop counter Line 443  C     K    - Loop counter
443        CHARACTER*2 commOpen,commClose        CHARACTER*2 commOpen,commClose
444        CHARACTER*3 index_lab        CHARACTER*3 index_lab
445        INTEGER K        INTEGER K
446    CEOP
447    
448        IF     ( index_type .EQ. INDEX_I ) THEN        IF     ( index_type .EQ. INDEX_I ) THEN
449         index_lab = 'I ='         index_lab = 'I ='
# Line 451  C     K    - Loop counter Line 504  C     K    - Loop counter
504        RETURN        RETURN
505        END        END
506    
507  CStartOfInterface  CBOP
508    C     !ROUTINE: PRINT_MAPRS
509    C     !INTERFACE:
510        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRS ( fld, fldTitle, plotMode,
511       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
512       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 459  CStartOfInterface Line 514  CStartOfInterface
514       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
515       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
516       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
 C     /==========================================================\  
 C     | SUBROUTINE PRINT_MAPR4                                   |  
 C     | o Does textual mapping printing of a field.              |  
 C     |==========================================================|  
 C     | This routine does the actual formatting of the data      |  
 C     | and printing to a file. It assumes an array using the    |  
 C     | MITgcm UV indexing scheme and base index variables.      |  
 C     | User code should call an interface routine like          |  
 C     | PLOT_FIELD_XYR4( ... ) rather than this code directly.   |  
 C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  
 C     | is specficied through the "plotMode" argument. All the   |  
 C     | plots made by a single call to this routine will use the |  
 C     | same contour interval. The plot range (iMin,...,byStr)   |  
 C     | can be three-dimensional. A separate plot is made for    |  
 C     | each point in the plot range normal to the orientation.  |  
 C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  
 C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  
 C     |      plots - one for K=1, one for K=3 and one for K=5.   |  
 C     |      Each plot would have extents iMin:iMax step iStr    |  
 C     |      and jMin:jMax step jStr.                            |  
 C     \==========================================================/  
517        IMPLICIT NONE        IMPLICIT NONE
518    C     !DESCRIPTION:
519    C     *==========================================================*
520    C     | SUBROUTINE PRINT\_MAPR4                                    
521    C     | o Does textual mapping printing of a field.              
522    C     *==========================================================*
523    C     | This routine does the actual formatting of the data      
524    C     | and printing to a file. It assumes an array using the    
525    C     | MITgcm UV indexing scheme and base index variables.      
526    C     | User code should call an interface routine like          
527    C     | PLOT\_FIELD\_XYR4( ... ) rather than this code directly.    
528    C     | Text plots can be oriented XY, YZ, XZ. An orientation    
529    C     | is specficied through the "plotMode" argument. All the    
530    C     | plots made by a single call to this routine will use the  
531    C     | same contour interval. The plot range (iMin,...,byStr)    
532    C     | can be three-dimensional. A separate plot is made for    
533    C     | each point in the plot range normal to the orientation.  
534    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
536    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    
538    C     |      and jMin:jMax step jStr.                            
539    C     *==========================================================*
540    
541    C     !USES:
542  C     == Global variables ==  C     == Global variables ==
543  #include "SIZE.h"  #include "SIZE.h"
544  #include "EEPARAMS.h"  #include "EEPARAMS.h"
545  #include "EESUPPORT.h"  #include "EESUPPORT.h"
546          INTEGER  IFNBLNK
547          EXTERNAL IFNBLNK
548          INTEGER  ILNBLNK
549          EXTERNAL ILNBLNK
550    
551    C     !INPUT/OUTPUT PARAMETERS:
552  C     == Routine arguments ==  C     == Routine arguments ==
553  C     fld        - Real*4 array holding data to be plotted  C     fld        - Real*4 array holding data to be plotted
554  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 514  C     kStr Line 576  C     kStr
576        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
577        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
578        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
579    
580    C     !LOCAL VARIABLES:
581  C     == Local variables ==  C     == Local variables ==
582  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
583  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 569  C               Str  - stride within blo Line 626  C               Str  - stride within blo
626        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
627        INTEGER bi, bj, bk        INTEGER bi, bj, bk
628        LOGICAL validRange        LOGICAL validRange
629    CEOP
630    
631        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
632        small  =  1. _d -15        small  =  1. _d -15
# Line 594  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 663  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 755  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 795  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 839  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 860  C--   Write delimiter Line 926  C--   Write delimiter
926        RETURN        RETURN
927        END        END
928    
929  CStartOfInterface  CBOP
930    C     !ROUTINE: PRINT_MAPRL
931    
932    C     !INTERFACE:
933        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPRL ( fld, fldTitle, plotMode,
934       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
935       I       iMin,  iMax,  iStr,       I       iMin,  iMax,  iStr,
# Line 868  CStartOfInterface Line 937  CStartOfInterface
937       I       kMin, kMax,   kStr,       I       kMin, kMax,   kStr,
938       I      bxMin, bxMax,  bxStr,       I      bxMin, bxMax,  bxStr,
939       I      byMin, byMax,  byStr )       I      byMin, byMax,  byStr )
 C     /==========================================================\  
 C     | SUBROUTINE PRINT_MAPRL                                   |  
 C     | o Does textual mapping printing of a field.              |  
 C     |==========================================================|  
 C     | This routine does the actual formatting of the data      |  
 C     | and printing to a file. It assumes an array using the    |  
 C     | MITgcm UV indexing scheme and base index variables.      |  
 C     | User code should call an interface routine like          |  
 C     | PLOT_FIELD_XYR8( ... ) rather than this code directly.   |  
 C     | Text plots can be oriented XY, YZ, XZ. An orientation    |  
 C     | is specficied through the "plotMode" argument. All the   |  
 C     | plots made by a single call to this routine will use the |  
 C     | same contour interval. The plot range (iMin,...,byStr)   |  
 C     | can be three-dimensional. A separate plot is made for    |  
 C     | each point in the plot range normal to the orientation.  |  
 C     | e.g. if the orientation is XY (plotMode = PRINT_MAP_XY). |  
 C     |      kMin =1, kMax = 5 and kStr = 2 will produce three XY|  
 C     |      plots - one for K=1, one for K=3 and one for K=5.   |  
 C     |      Each plot would have extents iMin:iMax step iStr    |  
 C     |      and jMin:jMax step jStr.                            |  
 C     \==========================================================/  
940        IMPLICIT NONE        IMPLICIT NONE
941    
942    C     !DESCRIPTION:
943    C     *==========================================================*
944    C     | SUBROUTINE PRINT\_MAPRL                                    
945    C     | o Does textual mapping printing of a field.              
946    C     *==========================================================*
947    C     | This routine does the actual formatting of the data      
948    C     | and printing to a file. It assumes an array using the    
949    C     | MITgcm UV indexing scheme and base index variables.      
950    C     | User code should call an interface routine like          
951    C     | PLOT\_FIELD\_XYR8( ... ) rather than this code directly.    
952    C     | Text plots can be oriented XY, YZ, XZ. An orientation    
953    C     | is specficied through the "plotMode" argument. All the    
954    C     | plots made by a single call to this routine will use the  
955    C     | same contour interval. The plot range (iMin,...,byStr)    
956    C     | can be three-dimensional. A separate plot is made for    
957    C     | each point in the plot range normal to the orientation.  
958    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
960    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    
962    C     |      and jMin:jMax step jStr.                            
963    C     *==========================================================*
964    
965    C     !USES:
966  C     == Global variables ==  C     == Global variables ==
967  #include "SIZE.h"  #include "SIZE.h"
968  #include "EEPARAMS.h"  #include "EEPARAMS.h"
969  #include "EESUPPORT.h"  #include "EESUPPORT.h"
970          INTEGER  IFNBLNK
971          EXTERNAL IFNBLNK
972          INTEGER  ILNBLNK
973          EXTERNAL ILNBLNK
974    
975    C     !INPUT/OUTPUT PARAMETERS:
976  C     == Routine arguments ==  C     == Routine arguments ==
977  C     fld        - Real*8 array holding data to be plotted  C     fld        - Real*8 array holding data to be plotted
978  C     fldTitle   - Name of field to be plotted  C     fldTitle   - Name of field to be plotted
# Line 923  C     kStr Line 1000  C     kStr
1000        INTEGER kMin, kMax, kStr        INTEGER kMin, kMax, kStr
1001        INTEGER bxMin, bxMax, bxStr        INTEGER bxMin, bxMax, bxStr
1002        INTEGER byMin, byMax, byStr        INTEGER byMin, byMax, byStr
 CEndOfInterface  
 C     == Local variables ==  
       INTEGER  IFNBLNK  
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1003    
1004    C     !LOCAL VARIABLES:
1005  C     == Local variables ==  C     == Local variables ==
1006  C     plotBuf - Buffer for building plot record  C     plotBuf - Buffer for building plot record
1007  C     chList  - Character string used for plot  C     chList  - Character string used for plot
# Line 978  C               Str  - stride within blo Line 1050  C               Str  - stride within blo
1050        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx        INTEGER I, J, K, iStrngLo, iStrngHi, iBuf, iDx
1051        INTEGER bi, bj, bk        INTEGER bi, bj, bk
1052        LOGICAL validRange        LOGICAL validRange
1053    CEOP
1054    
1055        chList = '-abcdefghijklmnopqrstuvwxyz+'        chList = '-abcdefghijklmnopqrstuvwxyz+'
1056        small  = 1. _d -15        small  = 1. _d -15
# Line 1004  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 1073  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 1165  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 1246  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 1267  C--   Write delimiter Line 1348  C--   Write delimiter
1348        RETURN        RETURN
1349        END        END
1350    
1351  CStartOfInterface  CBOP
1352    C     !ROUTINE: PRINT_MESSAGE
1353    
1354    C     !INTERFACE:
1355        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )        SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
 C     /============================================================\  
 C     | SUBROUTINE PRINT_MESSAGE                                   |  
 C     | o Write out informational message using "standard" format. |  
 C     | Notes                                                      |  
 C     | =====                                                      |  
 C     | o Some system   I/O is not "thread-safe". For this reason  |  
 C     |   without the FMTFTN_IO_THREAD_SAFE directive set a        |  
 C     |   critical region is defined around the write here. In some|  
 C     |   cases  BEGIN_CRIT() is approximated by only doing writes |  
 C     |   for thread number 1 - writes for other threads are       |  
 C     |   ignored!                                                 |  
 C     | o In a non-parallel form these routines can still be used. |  
 C     |   to produce pretty printed output!                        |  
 C     \============================================================/  
1356        IMPLICIT NONE        IMPLICIT NONE
1357    C     !DESCRIPTION:
1358    C     *============================================================*
1359    C     | SUBROUTINE PRINT\_MESSAGE                                    
1360    C     | o Write out informational message using "standard" format.  
1361    C     *============================================================*
1362    C     | Notes                                                      
1363    C     | =====                                                      
1364    C     | o Some system   I/O is not "thread-safe". For this reason  
1365    C     |   without the FMTFTN\_IO\_THREAD\_SAFE directive set a        
1366    C     |   critical region is defined around the write here. In some
1367    C     |   cases  BEGIN\_CRIT() is approximated by only doing writes  
1368    C     |   for thread number 1 - writes for other threads are        
1369    C     |   ignored!                                                  
1370    C     | o In a non-parallel form these routines can still be used.  
1371    C     |   to produce pretty printed output!                        
1372    C     *============================================================*
1373    
1374    C     !USES:
1375  C     == Global data ==  C     == Global data ==
1376  #include "SIZE.h"  #include "SIZE.h"
1377  #include "EEPARAMS.h"  #include "EEPARAMS.h"
1378  #include "EESUPPORT.h"  #include "EESUPPORT.h"
1379          INTEGER  IFNBLNK
1380          EXTERNAL IFNBLNK
1381          INTEGER  ILNBLNK
1382          EXTERNAL ILNBLNK
1383    
1384    C     !INPUT/OUTPUT PARAMETERS:
1385  C     == Routine arguments ==  C     == Routine arguments ==
1386  C     message - Message to write  C     message :: Message to write
1387  C     unit    - Unit number to write to  C     unit    :: Unit number to write to
1388  C     sq      - Justification option  C     sq      :: Justification option
1389        CHARACTER*(*) message        CHARACTER*(*) message
1390        INTEGER       unit        INTEGER       unit
1391        CHARACTER*(*) sq        CHARACTER*(*) sq
1392        INTEGER  myThid        INTEGER  myThid
1393  CEndOfInterface  
1394        INTEGER  IFNBLNK  C     !LOCAL VARIABLES:
       EXTERNAL IFNBLNK  
       INTEGER  ILNBLNK  
       EXTERNAL ILNBLNK  
1395  C     == Local variables ==  C     == Local variables ==
1396    C     iStart, iEnd :: String indexing variables
1397    C     idString     :: Temp. for building prefix.
1398        INTEGER iStart        INTEGER iStart
1399        INTEGER iEnd        INTEGER iEnd
1400        CHARACTER*9 idString        CHARACTER*9 idString
1401    CEOP
1402    
1403  C--   Find beginning and end of message  C--   Find beginning and end of message
1404        IF ( sq .EQ. SQUEEZE_BOTH .OR.        IF ( sq .EQ. SQUEEZE_BOTH .OR.
1405       &     sq .EQ. SQUEEZE_LEFT ) THEN       &     sq .EQ. SQUEEZE_LEFT ) THEN
# Line 1359  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.17  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22