1 |
C $Id$ |
C $Header$ |
2 |
|
|
3 |
#include "CPP_EEOPTIONS.h" |
#include "CPP_EEOPTIONS.h" |
4 |
|
|
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 |
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, |
1077 |
C |
C |
1078 |
RETURN |
RETURN |
1079 |
END |
END |
|
|
|
|
C $Id$ |
|