/[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.3 by cnh, Thu Apr 23 20:56:54 1998 UTC revision 1.4 by cnh, Sun Apr 26 23:41:54 1998 UTC
# Line 6  C--   File printf.F: Routines for perfor Line 6  C--   File printf.F: Routines for perfor
6  C--                  in the MITgcm UV implementation environment.  C--                  in the MITgcm UV implementation environment.
7  C--    Contents  C--    Contents
8  C--    o print_error    Does IO with **ERROR** highlighted header  C--    o print_error    Does IO with **ERROR** highlighted header
9    C--    o print_list_r8  Prints one-deimensional list of Real*8
10    C--                     numbers.
11    C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field
12    C--                     Uses print_message for writing
13  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field
14  C--                     Uses print_message for writing  C--                     Uses print_message for writing
15  C--    o print_message  Does IO with unhighlighted header  C--    o print_message  Does IO with unhighlighted header
# Line 91  C Line 95  C
95        RETURN        RETURN
96        END        END
97    
98    CStartofinterface
99          SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )
100    CEndifinterface
101    C     /==========================================================\
102    C     | o SUBROUTINE PRINT_LIST_R8                               |
103    C     |==========================================================|
104    C     | Routine for producing list of values for a field with    |
105    C     | duplicate values collected into                          |
106    C     |    n @ value                                             |
107    C     | record.                                                  |
108    C     \==========================================================/
109    
110    C     == Global data ==  
111    #include "SIZE.h"
112    #include "EEPARAMS.h"
113    
114    C     == Routine arguments ==
115    C     fld    -  Data to be printed
116    C     lFld   -  Number of elements to be printed
117    C     index_type - Flag indicating which type of index to print
118    C                  INDEX_K    => /* K = nnn */
119    C                  INDEX_I    => /* I = nnn */
120    C                  INDEX_J    => /* J = nnn */
121    C                  INDEX_NONE =>
122    C     ioUnit -  Unit number for IO.
123          INTEGER lFld
124          INTEGER index_type
125          Real*8  fld(lFld)
126          INTEGER ioUnit
127    
128    C     == Local variables ==
129    C     iLo  - Range index holders for selecting elements with
130    C     iHi    with the same value
131    C     nDup - Number of duplicates
132    C     xNew, xOld - Hold current and previous values of field
133    C     punc - Field separator
134    C     msgBuf - IO buffer
135    C     index_lab - Index for labelling elements
136    C     K    - Loop counter
137          INTEGER iLo
138          INTEGER iHi
139          INTEGER nDup
140          Real*8 xNew, xOld
141          CHARACTER punc
142          CHARACTER(MAX_LEN_MBUF) msgBuf
143          CHARACTER*2 commOpen,commClose
144          CHARACTER*3 index_lab
145          INTEGER K
146    
147          IF     ( index_type .EQ. INDEX_I ) THEN
148           index_lab = 'I ='
149          ELSEIF ( index_type .EQ. INDEX_J ) THEN
150           index_lab = 'J ='
151          ELSEIF ( index_type .EQ. INDEX_K ) THEN
152           index_lab = 'K ='
153          ELSE
154           index_lab = '?='
155          ENDIF
156          commOpen  = '/*'
157          commClose = '*/'
158          iLo = 1
159          iHi = 1
160          punc = ','
161          xOld = fld(1)
162          DO K=2,lFld
163           xNew = fld(K  )
164           IF ( xNew .NE. xOld ) THEN
165            nDup = iHi-iLo+1
166            IF ( nDup .EQ. 1 ) THEN
167             WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
168             IF ( index_type .NE. INDEX_NONE )
169         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
170            ELSE
171             WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
172             IF ( index_type .NE. INDEX_NONE )
173         &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
174         &    commOpen,index_lab,iLo,':',iHi,commClose
175            ENDIF
176            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
177            iLo  = K
178            iHi  = K
179            xOld = xNew
180           ELSE
181            iHi = K
182           ENDIF
183          ENDDO
184          punc = ' '
185          nDup = iHi-iLo+1
186          IF    ( nDup .EQ. 1 ) THEN
187           WRITE(msgBuf,'(A,1PE23.15,A)') '              ',xOld,punc
188           IF ( index_type .NE. INDEX_NONE )
189         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
190          ELSEIF( nDup .GT. 1 ) THEN
191           WRITE(msgBuf,'(I,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc
192           IF ( index_type .NE. INDEX_NONE )
193         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
194         &  commOpen,index_lab,iLo,':',iHi,commClose
195          ENDIF
196          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
197    
198          RETURN
199          END
200    
201  CStartOfInterface  CStartOfInterface
202        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,        SUBROUTINE PRINT_MAPR4 ( fld, fldTitle, plotMode,
203       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,       I        iLo,   iHi,   jLo,   jHi,  kLo,  kHi, nBx, nBy,
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22