/[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.4 by cnh, Sun Apr 26 23:41:54 1998 UTC revision 1.5 by cnh, Mon Apr 27 04:24:22 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_i   Prints one-deimensional list of INTEGER
10    C--                     numbers.
11    C--    o print_list_l   Prints one-deimensional list of LOGICAL
12    C--                     variables.
13  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--    o print_list_r8  Prints one-deimensional list of Real*8
14  C--                     numbers.  C--                     numbers.
15  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field
# Line 96  C Line 100  C
100        END        END
101    
102  CStartofinterface  CStartofinterface
103        SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )        SUBROUTINE PRINT_LIST_I( fld, lFld, index_type, ioUnit )
104    C     /==========================================================\
105    C     | o SUBROUTINE PRINT_LIST_I                                |
106    C     |==========================================================|
107    C     | Routine for producing list of values for a field with    |
108    C     | duplicate values collected into                          |
109    C     |    n @ value                                             |
110    C     | record.                                                  |
111    C     \==========================================================/
112    
113    C     == Global data ==  
114    #include "SIZE.h"
115    #include "EEPARAMS.h"
116    
117    C     == Routine arguments ==
118    C     fld    -  Data to be printed
119    C     lFld   -  Number of elements to be printed
120    C     index_type - Flag indicating which type of index to print
121    C                  INDEX_K    => /* K = nnn */
122    C                  INDEX_I    => /* I = nnn */
123    C                  INDEX_J    => /* J = nnn */
124    C                  INDEX_NONE =>
125    C     ioUnit -  Unit number for IO.
126          INTEGER lFld
127          INTEGER index_type
128          INTEGER fld(lFld)
129          INTEGER ioUnit
130  CEndifinterface  CEndifinterface
131    
132    C     == Local variables ==
133    C     iLo  - Range index holders for selecting elements with
134    C     iHi    with the same value
135    C     nDup - Number of duplicates
136    C     xNew, xOld - Hold current and previous values of field
137    C     punc - Field separator
138    C     msgBuf - IO buffer
139    C     index_lab - Index for labelling elements
140    C     K    - Loop counter
141          INTEGER iLo
142          INTEGER iHi
143          INTEGER nDup
144          INTEGER xNew, xOld
145          CHARACTER punc
146          CHARACTER(MAX_LEN_MBUF) msgBuf
147          CHARACTER*2 commOpen,commClose
148          CHARACTER*3 index_lab
149          INTEGER K
150    
151          IF     ( index_type .EQ. INDEX_I ) THEN
152           index_lab = 'I ='
153          ELSEIF ( index_type .EQ. INDEX_J ) THEN
154           index_lab = 'J ='
155          ELSEIF ( index_type .EQ. INDEX_K ) THEN
156           index_lab = 'K ='
157          ELSE
158           index_lab = '?='
159          ENDIF
160          commOpen  = '/*'
161          commClose = '*/'
162          iLo = 1
163          iHi = 1
164          punc = ','
165          xOld = fld(1)
166          DO K=2,lFld
167           xNew = fld(K  )
168           IF ( xNew .NE. xOld ) THEN
169            nDup = iHi-iLo+1
170            IF ( nDup .EQ. 1 ) THEN
171             WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc
172             IF ( index_type .NE. INDEX_NONE )
173         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
174            ELSE
175             WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc
176             IF ( index_type .NE. INDEX_NONE )
177         &    WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
178         &    commOpen,index_lab,iLo,':',iHi,commClose
179            ENDIF
180            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
181            iLo  = K
182            iHi  = K
183            xOld = xNew
184           ELSE
185            iHi = K
186           ENDIF
187          ENDDO
188          punc = ' '
189          nDup = iHi-iLo+1
190          IF    ( nDup .EQ. 1 ) THEN
191           WRITE(msgBuf,'(A,I5,A)') '              ',xOld,punc
192           IF ( index_type .NE. INDEX_NONE )
193         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
194          ELSEIF( nDup .GT. 1 ) THEN
195           WRITE(msgBuf,'(I,'' '',A,I5,A)') nDup,'@',xOld,punc
196           IF ( index_type .NE. INDEX_NONE )
197         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
198         &  commOpen,index_lab,iLo,':',iHi,commClose
199          ENDIF
200          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
201    
202          RETURN
203          END
204    
205    CStartofinterface
206          SUBROUTINE PRINT_LIST_L( fld, lFld, index_type, ioUnit )
207    C     /==========================================================\
208    C     | o SUBROUTINE PRINT_LIST_L                                |
209    C     |==========================================================|
210    C     | Routine for producing list of values for a field with    |
211    C     | duplicate values collected into                          |
212    C     |    n @ value                                             |
213    C     | record.                                                  |
214    C     \==========================================================/
215    
216    C     == Global data ==  
217    #include "SIZE.h"
218    #include "EEPARAMS.h"
219    
220    C     == Routine arguments ==
221    C     fld    -  Data to be printed
222    C     lFld   -  Number of elements to be printed
223    C     index_type - Flag indicating which type of index to print
224    C                  INDEX_K    => /* K = nnn */
225    C                  INDEX_I    => /* I = nnn */
226    C                  INDEX_J    => /* J = nnn */
227    C                  INDEX_NONE =>
228    C     ioUnit -  Unit number for IO.
229          INTEGER lFld
230          INTEGER index_type
231          LOGICAL fld(lFld)
232          INTEGER ioUnit
233    CEndifinterface
234    
235    C     == Local variables ==
236    C     iLo  - Range index holders for selecting elements with
237    C     iHi    with the same value
238    C     nDup - Number of duplicates
239    C     xNew, xOld - Hold current and previous values of field
240    C     punc - Field separator
241    C     msgBuf - IO buffer
242    C     index_lab - Index for labelling elements
243    C     K    - Loop counter
244          INTEGER iLo
245          INTEGER iHi
246          INTEGER nDup
247          LOGICAL xNew, xOld
248          CHARACTER punc
249          CHARACTER(MAX_LEN_MBUF) msgBuf
250          CHARACTER*2 commOpen,commClose
251          CHARACTER*3 index_lab
252          INTEGER K
253    
254          IF     ( index_type .EQ. INDEX_I ) THEN
255           index_lab = 'I ='
256          ELSEIF ( index_type .EQ. INDEX_J ) THEN
257           index_lab = 'J ='
258          ELSEIF ( index_type .EQ. INDEX_K ) THEN
259           index_lab = 'K ='
260          ELSE
261           index_lab = '?='
262          ENDIF
263          commOpen  = '/*'
264          commClose = '*/'
265          iLo = 1
266          iHi = 1
267          punc = ','
268          xOld = fld(1)
269          DO K=2,lFld
270           xNew = fld(K  )
271           IF ( xNew .NE. xOld ) THEN
272            nDup = iHi-iLo+1
273            IF ( nDup .EQ. 1 ) THEN
274             WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
275             IF ( index_type .NE. INDEX_NONE )
276         &    WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
277            ELSE
278             WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
279             IF ( index_type .NE. INDEX_NONE )
280         &    WRITE(msgBuf(45:),'(A,1X,A,L3,A,I3,1X,A)')
281         &    commOpen,index_lab,iLo,':',iHi,commClose
282            ENDIF
283            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
284            iLo  = K
285            iHi  = K
286            xOld = xNew
287           ELSE
288            iHi = K
289           ENDIF
290          ENDDO
291          punc = ' '
292          nDup = iHi-iLo+1
293          IF    ( nDup .EQ. 1 ) THEN
294           WRITE(msgBuf,'(A,L5,A)') '              ',xOld,punc
295           IF ( index_type .NE. INDEX_NONE )
296         &  WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') commOpen,index_lab,iLo,commClose
297          ELSEIF( nDup .GT. 1 ) THEN
298           WRITE(msgBuf,'(I,'' '',A,L5,A)') nDup,'@',xOld,punc
299           IF ( index_type .NE. INDEX_NONE )
300         &  WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)')
301         &  commOpen,index_lab,iLo,':',iHi,commClose
302          ENDIF
303          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
304    
305          RETURN
306          END
307    
308    CStartofinterface
309          SUBROUTINE PRINT_LIST_R8( fld, lFld, index_type, ioUnit )
310  C     /==========================================================\  C     /==========================================================\
311  C     | o SUBROUTINE PRINT_LIST_R8                               |  C     | o SUBROUTINE PRINT_LIST_R8                               |
312  C     |==========================================================|  C     |==========================================================|
# Line 124  C     ioUnit -  Unit number for IO. Line 333  C     ioUnit -  Unit number for IO.
333        INTEGER index_type        INTEGER index_type
334        Real*8  fld(lFld)        Real*8  fld(lFld)
335        INTEGER ioUnit        INTEGER ioUnit
336    CEndifinterface
337    
338  C     == Local variables ==  C     == Local variables ==
339  C     iLo  - Range index holders for selecting elements with  C     iLo  - Range index holders for selecting elements with
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22