/[MITgcm]/MITgcm_contrib/cg2d_bench/print.F
ViewVC logotype

Contents of /MITgcm_contrib/cg2d_bench/print.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (show annotations) (download)
Fri May 12 22:25:15 2006 UTC (17 years, 10 months ago) by ce107
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +9 -10 lines
Fixed for single/double precision and line length > 72 columns

1 C $Id: $
2 C-- File printf.F: Routines for performing formatted textual I/O
3 C-- in the MITgcm UV implementation environment.
4 C-- Contents
5 C-- o print_mapr8 Formats ABCD... contour map of a Real*8 field
6 C-- Uses print_message for writing
7
8
9 CStartOfInterface
10 SUBROUTINE PRINT_MAPR8 ( fld, fldTitle,
11 I iLo, iHi, jLo, jHi, kLo, kHi, nBx, nBy,
12 I iMin, iMax, iStr,
13 I jMin, jMax, jStr,
14 I kMin, kMax, kStr,
15 I bxMin, bxMax, bxStr,
16 I byMin, byMax, byStr )
17 C /==========================================================\
18 C | SUBROUTINE PRINT_MAPR8 |
19 C | o Does textual mapping printing of a field. |
20 C |==========================================================|
21 C | This routine does the actual formatting of the data. |
22 C | User code should call an interface routine like |
23 C | PRINT_MAP_XYR8 |
24 C \==========================================================/
25 IMPLICIT NONE
26
27 C == Global variables ==
28 #include "SIZE.h"
29 #include "EEPARAMS.h"
30
31 C == Routine arguments ==
32 CHARACTER*(*) fldTitle
33 INTEGER iLo, iHi
34 INTEGER jLo, jHi
35 INTEGER kLo, kHi
36 INTEGER nBx, nBy
37 Real fld(iLo:iHi,jLo:jHi,kLo:kHi,nBx,nBy)
38 INTEGER iMin, iMax, iStr
39 INTEGER jMin, jMax, jStr
40 INTEGER kMin, kMax, kStr
41 INTEGER bxMin, bxMax, bxStr
42 INTEGER byMin, byMax, byStr
43 CEndOfInterface
44 C == Local variables ==
45 INTEGER IFNBLNK
46 EXTERNAL IFNBLNK
47 INTEGER ILNBLNK
48 EXTERNAL ILNBLNK
49
50 C == Local variables ==
51 INTEGER MAX_LEN_PLOTBUF
52 PARAMETER ( MAX_LEN_PLOTBUF = 8192 )
53 CHARACTER*(MAX_LEN_PLOTBUF) plotBuf
54 CHARACTER*(MAX_LEN_MBUF) msgBuf
55 INTEGER lChList
56 PARAMETER ( lChList = 28 )
57 CHARACTER*(lChList) chList
58 Real fMin
59 Real fMax
60 Real fRange
61 Real small
62 INTEGER I, J, K, bi, bj, iStrngLo, iStrngHi, iBuf, iDx
63 LOGICAL validRange
64
65 chList = '-abcdefghijklmnopqrstuvwxyz+'
66 small = 1. _d -15
67 fMin = 1. _d 32
68 fMax = -1. _d 32
69 validRange = .FALSE.
70
71 C-- Calculate field range
72 DO bj=byMin, byMax, byStr
73 DO bi=bxMin, bxMax, bxStr
74 DO K=kMin, kMax, kStr
75 DO J=jMin, jMax, jStr
76 DO I=iMin, iMax, iStr
77 IF ( fld(I,J,K,bi,bj) .LT. fMin )
78 & fMin = fld(I,J,K,bi,bj)
79 IF ( fld(I,J,K,bi,bj) .GT. fMax )
80 & fMax = fld(I,J,K,bi,bj)
81 ENDDO
82 ENDDO
83 ENDDO
84 ENDDO
85 ENDDO
86 fRange = fMax-fMin
87 IF ( fRange .GT. small ) THEN
88 validRange = .TRUE.
89 ENDIF
90
91 C-- Write field title and statistics
92 msgBuf = '================================================'
93 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
94 & SQUEEZE_RIGHT, 1)
95 iStrngLo = IFNBLNK(fldTitle)
96 iStrngHi = ILNBLNK(fldTitle)
97 IF ( iStrngLo .LE. iStrngHi ) THEN
98 WRITE(msgBuf,'(A)') fldTitle(iStrngLo:iStrngHi)
99 ELSE
100 msgBuf = 'UNKNOWN FIELD'
101 ENDIF
102 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
103 & SQUEEZE_RIGHT, 1)
104 WRITE(msgBuf,'(4X,3(A,E12.5))')
105 & ' CMIN = ',fMin,
106 & ', CMAX = ',fMax,
107 & ', CINT = ',fRange/FLOAT(lChlist)
108 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
109 & SQUEEZE_RIGHT, 1)
110 WRITE(msgBuf,'(4X,A,1024A1)')
111 & ' SYMBOLS (CMIN->CMAX): ',(chList(I:I),I=1,lChList)
112 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
113 & SQUEEZE_RIGHT, 1)
114 WRITE(msgBuf,'(4X,A,1024A1)')
115 & ' 0.0: ','*'
116 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
117 & SQUEEZE_RIGHT, 1)
118 WRITE(msgBuf,'(4X,A,3(A,I4),A)')
119 & ' RANGE I (Lo:Hi:Step):',
120 & '(',myXGlobalLo-1+(bxMin-1)*sNx+iMin,
121 & ':',myXGlobalLo-1+(bxMax-1)*sNx+iMax,
122 & ':',iStr,')'
123 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
124 & SQUEEZE_RIGHT, 1)
125 WRITE(msgBuf,'(4X,A,3(A,I4),A)')
126 & ' RANGE J (Lo:Hi:Step):',
127 & '(',myYGlobalLo-1+(byMin-1)*sNy+jMin,
128 & ':',myYGlobalLo-1+(byMax-1)*sNy+jMax,
129 & ':',jStr,')'
130 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
131 & SQUEEZE_RIGHT, 1)
132 WRITE(msgBuf,'(4X,A,3(A,I4),A)')
133 & ' RANGE K (Lo:Hi:Step):',
134 & '(',kMin,
135 & ':',kMax,
136 & ':',kStr,')'
137 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
138 & SQUEEZE_RIGHT, 1)
139 msgBuf = '================================================'
140 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
141 & SQUEEZE_RIGHT, 1)
142
143 C-- Write field
144 IF ( validRange ) THEN
145 C Header
146 plotBuf = ' '
147 iBuf = 6
148 DO bi=bxMin, bxMax, bxStr
149 DO I=iMin, iMax, iStr
150 iDx = myXGlobalLo-1+(bi-1)*sNx+I
151 iBuf = iBuf + 1
152 IF ( 10*((iBuf-6)/10) .EQ. iBuf-6 ) THEN
153 IF ( iDx. LT. 10 ) THEN
154 WRITE(plotBuf(iBuf:),'(A,I1)') 'I=',iDx
155 ELSEIF ( iDx. LT. 100 ) THEN
156 WRITE(plotBuf(iBuf:),'(A,I2)') 'I=',iDx
157 ELSEIF ( iDx. LT. 1000 ) THEN
158 WRITE(plotBuf(iBuf:),'(A,I3)') 'I=',iDx
159 ELSEIF ( iDx. LT. 10000 ) THEN
160 WRITE(plotBuf(iBuf:),'(A,I4)') 'I=',iDx
161 ENDIF
162 ENDIF
163 ENDDO
164 ENDDO
165 CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
166 & SQUEEZE_RIGHT, 1)
167 plotBuf = '|--J--|'
168 iBuf = 7
169 DO bi=bxMin, bxMax, bxStr
170 DO I=iMin, iMax, iStr
171 iDx = myXGlobalLo-1+(bi-1)*sNx+I
172 iBuf = iBuf+1
173 IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
174 WRITE(plotBuf(iBuf:),'(A)') '|'
175 ELSE
176 WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)
177 ENDIF
178 ENDDO
179 ENDDO
180 CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
181 & SQUEEZE_RIGHT, 1)
182 C Data
183 DO K=kMin, kMax, kStr
184 DO bj=byMin, byMax, byStr
185 DO J=jMin, jMax, jStr
186 WRITE(plotBuf,'(1X,I5,1X)')
187 & myYGlobalLo-1+(bj-1)*sNy+J
188 iBuf = 7
189 DO bi=bxMin, bxMax, bxStr
190 DO I=iMin, iMax, iStr
191 iBuf = iBuf + 1
192 IDX = NINT(
193 & FLOAT( lChList-1 )*( fld(I,J,K,bi,bj)-fMin ) / (fRange)
194 $ )+1
195 IF ( iBuf .LE. MAX_LEN_PLOTBUF )
196 & plotBuf(iBuf:iBuf) = chList(IDX:IDX)
197 IF ( fld(I,J,K,bi,bj) .EQ. 0. _d 0) THEN
198 IF ( iBuf .LE. MAX_LEN_PLOTBUF )
199 & plotBuf(iBuf:iBuf) = '*'
200 ENDIF
201 ENDDO
202 ENDDO
203 CALL PRINT_MESSAGE(plotBuf, standardMessageUnit,
204 & SQUEEZE_RIGHT, 1)
205 ENDDO
206 ENDDO
207 ENDDO
208 ENDIF
209 C-- Write delimiter
210 msgBuf = '================================================'
211 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
212 & SQUEEZE_RIGHT, 1)
213 msgBuf = '= END OF FIELD ='
214 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
215 & SQUEEZE_RIGHT, 1)
216 msgBuf = '================================================'
217 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
218 & SQUEEZE_RIGHT, 1)
219
220 RETURN
221 END
222
223
224
225 CStartOfInterface
226 SUBROUTINE PRINT_MESSAGE( message, unit, sq , myThid )
227 C /============================================================\
228 C | SUBROUTINE PRINT_MESSAGE |
229 C | o Write out informational message using "standard" format. |
230 C | Notes |
231 C | ===== |
232 C | o Some system's I/O is not "thread-safe". For this reason |
233 C | without the FMTFTN_IO_THREAD_SAFE directive set a |
234 C | critical region is defined around the write here. In some|
235 C | cases BEGIN_CRIT() is approximated by only doing writes |
236 C | for thread number 1 - writes for other threads are |
237 C | ignored! |
238 C | o In a non-parallel form these routines can still be used. |
239 C | to produce pretty printed output! |
240 C \============================================================/
241 IMPLICIT NONE
242 C == Global data ==
243 #include "SIZE.h"
244 #include "EEPARAMS.h"
245 C == Routine arguments ==
246 C message - Message to write
247 C unit - Unit number to write to
248 C sq - Justification option
249 CHARACTER*(*) message
250 INTEGER unit
251 CHARACTER*(*) sq
252 INTEGER myThid
253 CEndOfInterface
254 INTEGER IFNBLNK
255 EXTERNAL IFNBLNK
256 INTEGER ILNBLNK
257 EXTERNAL ILNBLNK
258 C == Local variables ==
259 INTEGER iStart
260 INTEGER iEnd
261 CHARACTER*9 idString
262 C-- Find beginning and end of message
263 IF ( sq .EQ. SQUEEZE_BOTH .OR.
264 & sq .EQ. SQUEEZE_LEFT ) THEN
265 iStart = IFNBLNK( message )
266 ELSE
267 iStart = 1
268 ENDIF
269 IF ( sq .EQ. SQUEEZE_BOTH .OR.
270 & sq .EQ. SQUEEZE_RIGHT ) THEN
271 iEnd = ILNBLNK( message )
272 ELSE
273 iEnd = LEN(message)
274 ENDIF
275 IF ( message .EQ. ' ' ) THEN
276 WRITE(unit,'(A)') ' '
277 ELSE
278 WRITE(unit,'(A)') message(iStart:iEnd)
279 ENDIF
280 C
281 RETURN
282 END

  ViewVC Help
Powered by ViewVC 1.1.22