/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_mnc_out.F
ViewVC logotype

Contents of /MITgcm/pkg/diagnostics/diagnostics_mnc_out.F

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


Revision 1.3 - (show annotations) (download)
Thu Jun 23 15:29:01 2011 UTC (12 years, 10 months ago) by jmc
Branch: MAIN
Changes since 1.2: +49 -41 lines
Extend the use of "missing_value" setting from data.diagnostics
for the case of counter-diagnostics (where fraction-weight is zero).
This applies both to MNC and MDS output file.

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_mnc_out.F,v 1.2 2011/06/12 13:58:33 jmc Exp $
2 C $Name: $
3
4 #include "DIAG_OPTIONS.h"
5 #undef DIAG_MNC_COORD_NEEDSWORK
6
7 C-- File diagnostics_mnc_out.F: Routines to write MNC diagnostics output
8 C-- Contents:
9 C-- o DIAGNOSTICS_MNC_SET
10 C-- o DIAGNOSTICS_MNC_OUT
11
12 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
13 CBOP 0
14 C !ROUTINE: DIAGNOSTICS_MNC_SET
15
16 C !INTERFACE:
17 SUBROUTINE DIAGNOSTICS_MNC_SET(
18 I nLevOutp, listId, lm,
19 O diag_mnc_bn, missingValFillsMask,
20 I misValLoc, myTime, myIter, myThid )
21
22 C !DESCRIPTION:
23 C Set MNC file for writing diagnostics fields.
24
25 C !USES:
26 IMPLICIT NONE
27 #include "SIZE.h"
28 #include "EEPARAMS.h"
29 #include "PARAMS.h"
30 #include "GRID.h"
31 #include "DIAGNOSTICS_SIZE.h"
32 #include "DIAGNOSTICS.h"
33
34
35 C !INPUT/OUTPUT PARAMETERS:
36 C nLevOutp :: number of levels to write in output file
37 C listId :: Diagnostics list number being written
38 C lm :: loop index (averageCycle)
39 C diag_mnc_bn :: NetCDF output file name
40 C missingValFillsMask :: fill output-field with Missing-Value where mask=0
41 C misValLoc :: local Missing Value
42 C myTime :: current time of simulation (s)
43 C myIter :: current iteration number
44 C myThid :: my Thread Id number
45 INTEGER nLevOutp
46 INTEGER listId, lm
47 CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
48 LOGICAL missingValFillsMask
49 _RL misValLoc
50 _RL myTime
51 INTEGER myIter, myThid
52 CEOP
53
54 #ifdef ALLOW_MNC
55 C !FUNCTIONS:
56 INTEGER ILNBLNK
57 EXTERNAL ILNBLNK
58
59 C !LOCAL VARIABLES:
60 _RL tmpLev
61 INTEGER iLen
62
63 c CHARACTER*(MAX_LEN_MBUF) msgBuf
64 INTEGER ii, klev
65 INTEGER CW_DIMS, NLEN
66 PARAMETER ( CW_DIMS = 10 )
67 PARAMETER ( NLEN = 80 )
68 INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
69 CHARACTER*(NLEN) dn(CW_DIMS)
70 c CHARACTER*(NLEN) d_cw_name
71 c CHARACTER*(NLEN) dn_blnk
72 #ifdef DIAG_MNC_COORD_NEEDSWORK
73 INTEGER NrMax
74 PARAMETER( NrMax = numLevels )
75 INTEGER i, j
76 CHARACTER*(5) ctmp
77 _RS ztmp(NrMax)
78 #endif
79 INTEGER misvalIntLoc
80 REAL*8 misval_r8(2)
81 REAL*4 misval_r4(2)
82 INTEGER misval_int(2)
83
84 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
85 c IF (useMNC .AND. diag_mnc) THEN
86
87 C Handle missing value attribute (land points)
88 missingValFillsMask = .FALSE.
89 #ifdef DIAGNOSTICS_MISSING_VALUE
90 missingValFillsMask = .TRUE.
91 #endif /* DIAGNOSTICS_MISSING_VALUE */
92 C Defaults to UNSET_I
93 misvalIntLoc = misvalInt(listId)
94 DO ii=1,2
95 misval_r4(ii) = misValLoc
96 misval_r8(ii) = misValLoc
97 misval_int(ii) = UNSET_I
98 ENDDO
99 c DO i = 1,MAX_LEN_FNAM
100 c diag_mnc_bn(i:i) = ' '
101 c ENDDO
102 c DO i = 1,NLEN
103 c dn_blnk(i:i) = ' '
104 c ENDDO
105 iLen = ILNBLNK(fnames(listId))
106 WRITE( diag_mnc_bn, '(A)' ) fnames(listId)(1:iLen)
107
108 C Update the record dimension by writing the iteration number
109 klev = myIter + lm - averageCycle(listId)
110 tmpLev = myTime + deltaTClock*( lm - averageCycle(listId) )
111 CALL MNC_CW_SET_UDIM(diag_mnc_bn, -1, myThid)
112 CALL MNC_CW_RL_W_S('D',diag_mnc_bn,0,0,'T',tmpLev,myThid)
113 CALL MNC_CW_SET_UDIM(diag_mnc_bn, 0, myThid)
114 CALL MNC_CW_I_W_S('I',diag_mnc_bn,0,0,'iter',klev,myThid)
115
116 C NOTE: at some point it would be a good idea to add a time_bounds
117 C variable that has dimension (2,T) and clearly denotes the
118 C beginning and ending times for each diagnostics period
119
120 c dn(1)(1:NLEN) = dn_blnk(1:NLEN)
121 WRITE(dn(1),'(a,i6.6)') 'Zmd', nLevOutp
122 dim(1) = nLevOutp
123 ib(1) = 1
124 ie(1) = nLevOutp
125
126 CALL MNC_CW_ADD_GNAME('diag_levels', 1,
127 & dim, dn, ib, ie, myThid)
128 CALL MNC_CW_ADD_VNAME('diag_levels', 'diag_levels',
129 & 0,0, myThid)
130 CALL MNC_CW_ADD_VATTR_TEXT('diag_levels','description',
131 & 'Idicies of vertical levels within the source arrays',
132 & myThid)
133 C suppress the missing value attribute (iflag = 0)
134 CALL MNC_CW_VATTR_MISSING('diag_levels', 0,
135 I misval_r8, misval_r4, misval_int, myThid )
136
137 CALL MNC_CW_RL_W('D',diag_mnc_bn,0,0,
138 & 'diag_levels', levs(1,listId), myThid)
139
140 CALL MNC_CW_DEL_VNAME('diag_levels', myThid)
141 CALL MNC_CW_DEL_GNAME('diag_levels', myThid)
142
143 #ifdef DIAG_MNC_COORD_NEEDSWORK
144 C This part has been placed in an #ifdef because, as its currently
145 C written, it will only work with variables defined on a dynamics
146 C grid. As we start using diagnostics for physics grids, ice
147 C levels, land levels, etc. the different vertical coordinate
148 C dimensions will have to be taken into account.
149
150 C 20051021 JMC & EH3 : We need to extend this so that a few
151 C variables each defined on different grids do not have the same
152 C vertical dimension names so we should be using a pattern such
153 C as: Z[uml]td000000 where the 't' is the type as specified by
154 C gdiag(10)
155
156 C Now define: Zmdxxxxxx, Zudxxxxxx, Zldxxxxxx
157 ctmp(1:5) = 'mul '
158 DO i = 1,3
159 c dn(1)(1:NLEN) = dn_blnk(1:NLEN)
160 WRITE(dn(1),'(3a,i6.6)') 'Z',ctmp(i:i),'d',nlevels(listId)
161 CALL MNC_CW_ADD_GNAME(dn(1), 1, dim, dn, ib, ie, myThid)
162 CALL MNC_CW_ADD_VNAME(dn(1), dn(1), 0,0, myThid)
163
164 C The following three ztmp() loops should eventually be modified
165 C to reflect the fractional nature of levs(j,l) -- they should
166 C do something like:
167 C ztmp(j) = rC(INT(FLOOR(levs(j,l))))
168 C + ( rC(INT(FLOOR(levs(j,l))))
169 C + rC(INT(CEIL(levs(j,l)))) )
170 C / ( levs(j,l) - FLOOR(levs(j,l)) )
171 C for averaged levels.
172 IF (i .EQ. 1) THEN
173 DO j = 1,nlevels(listId)
174 ztmp(j) = rC(NINT(levs(j,listId)))
175 ENDDO
176 CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
177 & 'Dimensional coordinate value at the mid point',
178 & myThid)
179 ELSEIF (i .EQ. 2) THEN
180 DO j = 1,nlevels(listId)
181 ztmp(j) = rF(NINT(levs(j,listId)) + 1)
182 ENDDO
183 CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
184 & 'Dimensional coordinate value at the upper point',
185 & myThid)
186 ELSEIF (i .EQ. 3) THEN
187 DO j = 1,nlevels(listId)
188 ztmp(j) = rF(NINT(levs(j,listId)))
189 ENDDO
190 CALL MNC_CW_ADD_VATTR_TEXT(dn(1),'description',
191 & 'Dimensional coordinate value at the lower point',
192 & myThid)
193 ENDIF
194 C suppress the missing value attribute (iflag = 0)
195 IF (missingValFillsMask)
196 & CALL MNC_CW_VATTR_MISSING(dn(1), 0,
197 I misval_r8, misval_r4, misval_int, myThid )
198 CALL MNC_CW_RS_W('D',diag_mnc_bn,0,0, dn(1), ztmp, myThid)
199 CALL MNC_CW_DEL_VNAME(dn(1), myThid)
200 CALL MNC_CW_DEL_GNAME(dn(1), myThid)
201 ENDDO
202 #endif /* DIAG_MNC_COORD_NEEDSWORK */
203
204 c ENDIF
205 #endif /* ALLOW_MNC */
206
207 RETURN
208 END
209
210 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
211 CBOP 0
212 C !ROUTINE: DIAGNOSTICS_MNC_OUT
213
214 C !INTERFACE:
215 SUBROUTINE DIAGNOSTICS_MNC_OUT(
216 I NrMax, nLevOutp, listId, ndId, mate,
217 I diag_mnc_bn,
218 I missingValFillsMask, misValLoc,
219 I qtmp,
220 I myTime, myIter, myThid )
221
222 C !DESCRIPTION:
223 C write diagnostics fields to MNC file.
224
225 C !USES:
226 IMPLICIT NONE
227 #include "SIZE.h"
228 #include "EEPARAMS.h"
229 #include "PARAMS.h"
230 #include "GRID.h"
231 #include "DIAGNOSTICS_SIZE.h"
232 #include "DIAGNOSTICS.h"
233
234 C !INPUT PARAMETERS:
235 C NrMax :: 3rd dimension of output-field array to write
236 C nLevOutp :: number of levels to write in output file
237 C listId :: Diagnostics list number being written
238 C ndId :: diagnostics Id number (in available diagnostics list)
239 C mate :: counter diagnostic number if any ; 0 otherwise
240 C diag_mnc_bn :: NetCDF output file name
241 C missingValFillsMask :: fill output-field with Missing-Value where mask=0
242 C misValLoc :: local Missing Value
243 C qtmp :: output-field array to write
244 C myTime :: current time of simulation (s)
245 C myIter :: current iteration number
246 C myThid :: my Thread Id number
247 INTEGER NrMax
248 INTEGER nLevOutp
249 INTEGER listId, ndId, mate
250 CHARACTER*(MAX_LEN_FNAM) diag_mnc_bn
251 LOGICAL missingValFillsMask
252 _RL misValLoc
253 _RL qtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy,NrMax,nSx,nSy)
254 _RL myTime
255 INTEGER myIter, myThid
256 CEOP
257
258 #ifdef ALLOW_MNC
259 C !FUNCTIONS:
260 c INTEGER ILNBLNK
261 c EXTERNAL ILNBLNK
262
263 C !LOCAL VARIABLES:
264 C i,j,k :: loop indices
265 C bi,bj :: tile indices
266 INTEGER i, j, k
267 INTEGER bi, bj
268
269 c CHARACTER*(MAX_LEN_MBUF) msgBuf
270 c INTEGER ll, llMx, jj, jjMx
271 INTEGER ii, klev
272 INTEGER CW_DIMS, NLEN
273 PARAMETER ( CW_DIMS = 10 )
274 PARAMETER ( NLEN = 80 )
275 INTEGER dim(CW_DIMS), ib(CW_DIMS), ie(CW_DIMS)
276 CHARACTER*(NLEN) dn(CW_DIMS)
277 CHARACTER*(NLEN) d_cw_name
278 c CHARACTER*(NLEN) dn_blnk
279 LOGICAL useMisValForThisDiag
280 REAL*8 misval_r8(2)
281 REAL*4 misval_r4(2)
282 INTEGER misval_int(2)
283
284 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
285 c IF (useMNC .AND. diag_mnc) THEN
286
287 _BEGIN_MASTER( myThid )
288
289 DO ii = 1,CW_DIMS
290 c d_cw_name(1:NLEN) = dn_blnk(1:NLEN)
291 c dn(ii)(1:NLEN) = dn_blnk(1:NLEN)
292 dn(ii) = ' '
293 ENDDO
294 DO ii=1,2
295 misval_r4(ii) = misValLoc
296 misval_r8(ii) = misValLoc
297 misval_int(ii) = UNSET_I
298 ENDDO
299
300 C Note that the "d_cw_name" variable is a hack that hides a
301 C subtlety within MNC. Basically, each MNC-wrapped file is
302 C caching its own concept of what each "grid name" (that is, a
303 C dimension group name) means. So one cannot re-use the same
304 C "grid" name for different collections of dimensions within a
305 C given file. By appending the "ndId" values to each name, we
306 C guarantee uniqueness within each MNC-produced file.
307 WRITE(d_cw_name,'(a,i6.6)') 'd_cw_',ndId
308
309 C XY dimensions
310 dim(1) = sNx + 2*OLx
311 dim(2) = sNy + 2*OLy
312 ib(1) = OLx + 1
313 ib(2) = OLy + 1
314 IF (gdiag(ndId)(2:2) .EQ. 'M') THEN
315 dn(1)(1:2) = 'X'
316 ie(1) = OLx + sNx
317 dn(2)(1:2) = 'Y'
318 ie(2) = OLy + sNy
319 ELSEIF (gdiag(ndId)(2:2) .EQ. 'U') THEN
320 dn(1)(1:3) = 'Xp1'
321 ie(1) = OLx + sNx + 1
322 dn(2)(1:2) = 'Y'
323 ie(2) = OLy + sNy
324 ELSEIF (gdiag(ndId)(2:2) .EQ. 'V') THEN
325 dn(1)(1:2) = 'X'
326 ie(1) = OLx + sNx
327 dn(2)(1:3) = 'Yp1'
328 ie(2) = OLy + sNy + 1
329 ELSEIF (gdiag(ndId)(2:2) .EQ. 'Z') THEN
330 dn(1)(1:3) = 'Xp1'
331 ie(1) = OLx + sNx + 1
332 dn(2)(1:3) = 'Yp1'
333 ie(2) = OLy + sNy + 1
334 ENDIF
335
336 C Z is special since it varies
337 WRITE(dn(3),'(a,i6.6)') 'Zd', nLevOutp
338 IF ( (gdiag(ndId)(10:10) .EQ. 'R')
339 & .AND. (gdiag(ndId)(9:9) .EQ. 'M') ) THEN
340 WRITE(dn(3),'(a,i6.6)') 'Zmd', nLevOutp
341 ENDIF
342 IF ( (gdiag(ndId)(10:10) .EQ. 'R')
343 & .AND. (gdiag(ndId)(9:9) .EQ. 'L') ) THEN
344 WRITE(dn(3),'(a,i6.6)') 'Zld', nLevOutp
345 ENDIF
346 IF ( (gdiag(ndId)(10:10) .EQ. 'R')
347 & .AND. (gdiag(ndId)(9:9) .EQ. 'U') ) THEN
348 WRITE(dn(3),'(a,i6.6)') 'Zud', nLevOutp
349 ENDIF
350 dim(3) = NrMax
351 ib(3) = 1
352 ie(3) = nLevOutp
353
354 C Time dimension
355 dn(4)(1:1) = 'T'
356 dim(4) = -1
357 ib(4) = 1
358 ie(4) = 1
359
360 CALL MNC_CW_ADD_GNAME( d_cw_name, 4,
361 & dim, dn, ib, ie, myThid )
362 CALL MNC_CW_ADD_VNAME( cdiag(ndId), d_cw_name,
363 & 4, 5, myThid )
364 CALL MNC_CW_ADD_VATTR_TEXT( cdiag(ndId),'description',
365 & tdiag(ndId), myThid )
366 CALL MNC_CW_ADD_VATTR_TEXT( cdiag(ndId),'units',
367 & udiag(ndId), myThid )
368
369 useMisValForThisDiag = mate.GT.0
370 C Use the missing values for masking out the land points:
371 C only for scalar diagnostics at mass points (so far)
372 IF ( missingValFillsMask.AND.gdiag(ndId)(1:2).EQ.'SM' ) THEN
373 useMisValForThisDiag = .TRUE.
374 C note: better to use 2-D mask if kdiag <> Nr or vert.integral
375 DO bj = myByLo(myThid), myByHi(myThid)
376 DO bi = myBxLo(myThid), myBxHi(myThid)
377 DO k = 1,nLevOutp
378 klev = NINT(levs(k,listId))
379 IF ( fflags(listId)(2:2).EQ.'I' ) kLev = 1
380 DO j = 1-OLy,sNy+OLy
381 DO i = 1-OLx,sNx+OLx
382 IF ( maskC(i,j,klev,bi,bj) .EQ. 0. )
383 & qtmp(i,j,k,bi,bj) = misValLoc
384 ENDDO
385 ENDDO
386 ENDDO
387 ENDDO
388 ENDDO
389 ENDIF
390 IF ( useMisValForThisDiag ) THEN
391 C assign missing values and set flag for adding the netCDF atttibute
392 CALL MNC_CW_VATTR_MISSING(cdiag(ndId), 2,
393 I misval_r8, misval_r4, misval_int, myThid )
394 ELSE
395 C suppress the missing value attribute (iflag = 0)
396 C Note: We have to call the following subroutine for each mnc that has
397 C been created "on the fly" by mnc_cw_add_vname and will be deleted
398 C by mnc_cw_del_vname, because all of these variables use the same
399 C identifier so that mnc_cw_vfmv(indv) needs to be overwritten for
400 C each of these variables
401 CALL MNC_CW_VATTR_MISSING( cdiag(ndId), 0,
402 I misval_r8, misval_r4, misval_int, myThid )
403 ENDIF
404
405 IF ( ((writeBinaryPrec .EQ. precFloat32).AND.
406 & (fflags(listId)(1:1) .NE. 'D'))
407 & .OR. (fflags(listId)(1:1) .EQ. 'R') ) THEN
408 CALL MNC_CW_RL_W( 'R',diag_mnc_bn,0,0,
409 & cdiag(ndId), qtmp, myThid)
410 ELSEIF ( (writeBinaryPrec .EQ. precFloat64)
411 & .OR. (fflags(listId)(1:1) .EQ. 'D') ) THEN
412 CALL MNC_CW_RL_W( 'D',diag_mnc_bn,0,0,
413 & cdiag(ndId), qtmp, myThid)
414 ENDIF
415
416 CALL MNC_CW_DEL_VNAME(cdiag(ndId), myThid)
417 CALL MNC_CW_DEL_GNAME(d_cw_name, myThid)
418
419 _END_MASTER( myThid )
420
421 c ENDIF
422 #endif /* ALLOW_MNC */
423
424 RETURN
425 END

  ViewVC Help
Powered by ViewVC 1.1.22