/[MITgcm]/MITgcm/pkg/mnc/mnc_cw_cvars.F
ViewVC logotype

Annotation of /MITgcm/pkg/mnc/mnc_cw_cvars.F

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


Revision 1.16 - (hide annotations) (download)
Mon May 23 01:08:22 2011 UTC (13 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62z, checkpoint62y, HEAD
Changes since 1.15: +1 -2 lines
remove unused EESUPPORT.h include.

1 jmc 1.16 C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cw_cvars.F,v 1.15 2009/06/28 01:08:25 jmc Exp $
2 edhill 1.1 C $Name: $
3 jmc 1.15
4 edhill 1.1 #include "MNC_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7     CBOP 1
8     C !ROUTINE: MNC_CW_WRITE_CVAR
9 jmc 1.15
10 edhill 1.1 C !INTERFACE:
11 jmc 1.15 SUBROUTINE MNC_CW_WRITE_CVAR(
12     I fname,
13     I cvname,
14     I fid,
15     I did,
16     I bi, bj,
17 edhill 1.1 I myThid )
18    
19     C !DESCRIPTION:
20     C Write a CF-convention coordinate variable (a vector).
21    
22     C !USES:
23     implicit none
24 mlosch 1.9 #include "MNC_COMMON.h"
25 edhill 1.1 #include "SIZE.h"
26     #include "EEPARAMS.h"
27     #include "PARAMS.h"
28     #include "GRID.h"
29 edhill 1.4 #ifdef ALLOW_EXCH2
30 jmc 1.14 #include "W2_EXCH2_SIZE.h"
31 edhill 1.4 #include "W2_EXCH2_TOPOLOGY.h"
32     #endif
33 utke 1.11 #include "netcdf.inc"
34 edhill 1.4
35     C Functions
36     integer IFNBLNK, ILNBLNK
37 edhill 1.1
38     C !INPUT PARAMETERS:
39     character*(*) fname
40     character*(*) cvname
41     integer fid, did, bi,bj
42     integer myThid
43     CEOP
44    
45     C !LOCAL VARIABLES:
46 mlosch 1.7 integer i, vid, nnf, nnl, doit, err
47 edhill 1.4 integer nids, cv_did(1), xtmin,ytmin
48 edhill 1.1 character*(MAX_LEN_MBUF) msgbuf
49     integer cv_start(1), cv_count(1)
50 edhill 1.3 _RS rtmp(sNx + 2*OLx + sNy + 2*OLy + Nr)
51 mlosch 1.10 C variables for text attributes
52     integer MAX_LEN_NAME, ia
53     PARAMETER ( MAX_LEN_NAME = 128 )
54     character*(MAX_LEN_NAME) units, long_name, positive
55    
56     DO i=1,MAX_LEN_NAME
57     units(i:i) = ' '
58     long_name(i:i) = ' '
59     positive(i:i) = ' '
60     ENDDO
61 edhill 1.1
62     nnf = IFNBLNK(cvname)
63     nnl = ILNBLNK(cvname)
64    
65 edhill 1.4 xtmin = 0
66     ytmin = 0
67     #ifdef ALLOW_EXCH2
68 jmc 1.15 xtmin = exch2_tbasex(W2_myTileList(bi,bj))
69     ytmin = exch2_tbasey(W2_myTileList(bi,bj))
70 mlosch 1.13 #else
71     IF ( .NOT. useCubedSphereExchange ) THEN
72     C make sure for a non-cubed-sphere curvi-linear grid,
73     C that the X/Y coordinate variables are monotonous
74     C bi+(myXGlobalLo-1)/sNx is the i-tile number
75     C bj+(myYGlobalLo-1)/sNy is the j-tile number
76     xtmin = sNx * ( bi+(myXGlobalLo-1)/sNx - 1 )
77     ytmin = sNy * ( bj+(myYGlobalLo-1)/sNy - 1 )
78     ENDIF
79 edhill 1.4 #endif
80     doit = 1
81 edhill 1.1 nids = 1
82     cv_did(1)= did
83    
84     C Check all the coordinate variables that we know about
85     IF (cvname(nnf:nnl) .EQ. 'X') THEN
86    
87     cv_start(1) = 1
88     cv_count(1) = sNx
89 mlosch 1.7 #ifdef ALLOW_EXCH2
90 edhill 1.1 DO i = cv_start(1),cv_count(1)
91 mlosch 1.7 rtmp(i) = xtmin + i
92     ENDDO
93     #else
94 mlosch 1.8 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
95 mlosch 1.7 DO i = cv_start(1),cv_count(1)
96 edhill 1.4 rtmp(i) = xtmin + i
97 mlosch 1.7 ENDDO
98     ELSE
99     DO i = cv_start(1),cv_count(1)
100 edhill 1.1 rtmp(i) = xC(i,1,bi,bj)
101 mlosch 1.7 ENDDO
102     ENDIF
103 edhill 1.4 #endif
104 mlosch 1.10 IF ( usingCartesianGrid ) THEN
105     long_name = 'X-coordinate of cell center'
106     units = 'meters'
107     ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
108 jmc 1.15 long_name = 'i-index of cell center'
109 mlosch 1.10 units = 'none'
110     ELSEIF ( usingSphericalPolarGrid ) THEN
111     long_name = 'longitude of cell center'
112     units = 'degrees_east'
113     ELSEIF ( usingCylindricalGrid ) THEN
114     long_name = 'polar angle coordinate of cell center'
115     units = 'degrees'
116     ELSE
117     C unknown grid type
118     print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
119     ENDIF
120 edhill 1.1
121     ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN
122    
123     cv_start(1) = 1
124     cv_count(1) = sNx + 1
125 mlosch 1.7 #ifdef ALLOW_EXCH2
126 edhill 1.1 DO i = cv_start(1),cv_count(1)
127 mlosch 1.7 rtmp(i) = xtmin + i
128     ENDDO
129     #else
130 mlosch 1.8 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
131 mlosch 1.7 DO i = cv_start(1),cv_count(1)
132 edhill 1.4 rtmp(i) = xtmin + i
133 mlosch 1.7 ENDDO
134     ELSE
135     DO i = cv_start(1),cv_count(1)
136 edhill 1.1 rtmp(i) = xG(i,1,bi,bj)
137 mlosch 1.7 ENDDO
138     ENDIF
139 edhill 1.4 #endif
140 mlosch 1.10 IF ( usingCartesianGrid ) THEN
141     long_name = 'X-Coordinate of cell corner'
142     units = 'meters'
143     ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
144 jmc 1.15 long_name = 'i-index of cell corner'
145 mlosch 1.10 units = 'none'
146     ELSEIF ( usingSphericalPolarGrid ) THEN
147     long_name = 'longitude of cell corner'
148     units = 'degrees_east'
149     ELSEIF ( usingCylindricalGrid ) THEN
150     long_name = 'polar angle of cell corner'
151     units = 'degrees'
152     ELSE
153     C unknown grid type
154     print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
155     ENDIF
156 edhill 1.1
157 edhill 1.3 ELSEIF (cvname(nnf:nnl) .EQ. 'Xwh') THEN
158    
159     cv_start(1) = 1
160     cv_count(1) = sNx + 2*OLx
161 mlosch 1.7 #ifdef ALLOW_EXCH2
162 edhill 1.3 DO i = cv_start(1),cv_count(1)
163 mlosch 1.7 rtmp(i) = xtmin + i
164     ENDDO
165     #else
166 mlosch 1.8 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
167 mlosch 1.7 DO i = cv_start(1),cv_count(1)
168 edhill 1.4 rtmp(i) = xtmin - OLx + i
169 mlosch 1.7 ENDDO
170     ELSE
171     DO i = cv_start(1),cv_count(1)
172 edhill 1.3 rtmp(i) = xC(i,1,bi,bj)
173 mlosch 1.10 CML???? rtmp(i) = xC(i-Olx,1,bi,bj)
174 mlosch 1.7 ENDDO
175     ENDIF
176 edhill 1.4 #endif
177 mlosch 1.10 IF ( usingCartesianGrid ) THEN
178     long_name = 'X-Coordinate of cell center including overlaps'
179     units = 'meters'
180     ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
181 jmc 1.15 long_name = 'i-index of cell center including overlaps'
182 mlosch 1.10 units = 'none'
183     ELSEIF ( usingSphericalPolarGrid ) THEN
184     long_name = 'longitude of cell center including overlaps'
185     units = 'degrees_east'
186     ELSEIF ( usingCylindricalGrid ) THEN
187 jmc 1.15 long_name =
188 mlosch 1.10 & 'polar angle coordinate of cell center including overlaps'
189     units = 'degrees'
190     ELSE
191     C unknown grid type
192     print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
193     ENDIF
194 jmc 1.15
195 edhill 1.1 ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN
196    
197     cv_start(1) = 1
198     cv_count(1) = sNy
199 mlosch 1.7 #ifdef ALLOW_EXCH2
200 edhill 1.1 DO i = cv_start(1),cv_count(1)
201 mlosch 1.7 rtmp(i) = ytmin + i
202     ENDDO
203     #else
204 mlosch 1.8 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
205 mlosch 1.7 DO i = cv_start(1),cv_count(1)
206 edhill 1.4 rtmp(i) = ytmin + i
207 mlosch 1.7 ENDDO
208     ELSE
209     DO i = cv_start(1),cv_count(1)
210 edhill 1.1 rtmp(i) = yC(1,i,bi,bj)
211 mlosch 1.7 ENDDO
212     ENDIF
213 edhill 1.4 #endif
214 mlosch 1.10 IF ( usingCartesianGrid ) THEN
215     long_name = 'Y-Coordinate of cell center'
216     units = 'meters'
217     ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
218 jmc 1.15 long_name = 'j-index of cell center'
219 mlosch 1.10 units = 'none'
220     ELSEIF ( usingSphericalPolarGrid ) THEN
221     long_name = 'latitude of cell center'
222     units = 'degrees_north'
223     ELSEIF ( usingCylindricalGrid ) THEN
224     long_name = 'radial coordinate of cell center'
225     units = 'meters'
226     ELSE
227     C unknown grid type
228     print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
229     ENDIF
230 edhill 1.1
231     ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN
232    
233     cv_start(1) = 1
234     cv_count(1) = sNy + 1
235 mlosch 1.7 #ifdef ALLOW_EXCH2
236 edhill 1.1 DO i = cv_start(1),cv_count(1)
237 mlosch 1.7 rtmp(i) = ytmin + i
238     ENDDO
239     #else
240 mlosch 1.8 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
241 mlosch 1.7 DO i = cv_start(1),cv_count(1)
242 edhill 1.4 rtmp(i) = ytmin + i
243 mlosch 1.7 ENDDO
244     ELSE
245     DO i = cv_start(1),cv_count(1)
246 edhill 1.1 rtmp(i) = yG(1,i,bi,bj)
247 mlosch 1.7 ENDDO
248     ENDIF
249 edhill 1.4 #endif
250 mlosch 1.10 IF ( usingCartesianGrid ) THEN
251     long_name = 'Y-Coordinate of cell corner'
252     units = 'meters'
253     ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
254 jmc 1.15 long_name = 'j-index of cell corner'
255 mlosch 1.10 units = 'none'
256     ELSEIF ( usingSphericalPolarGrid ) THEN
257     long_name = 'latitude of cell corner'
258     units = 'degrees_north'
259     ELSEIF ( usingCylindricalGrid ) THEN
260     long_name = 'radial coordinate of cell corner'
261     units = 'meters'
262     ELSE
263     C unknown grid type
264     print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
265     ENDIF
266 edhill 1.1
267 edhill 1.3 ELSEIF (cvname(nnf:nnl) .EQ. 'Ywh') THEN
268    
269     cv_start(1) = 1
270     cv_count(1) = sNy + 2*OLy
271 mlosch 1.7 #ifdef ALLOW_EXCH2
272 edhill 1.3 DO i = cv_start(1),cv_count(1)
273 mlosch 1.7 rtmp(i) = ytmin + i
274     ENDDO
275     #else
276 mlosch 1.8 IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
277 mlosch 1.7 DO i = cv_start(1),cv_count(1)
278 edhill 1.4 rtmp(i) = ytmin - OLy + i
279 mlosch 1.7 ENDDO
280     ELSE
281     DO i = cv_start(1),cv_count(1)
282 edhill 1.3 rtmp(i) = yC(1,i-OLy,bi,bj)
283 mlosch 1.7 ENDDO
284     ENDIF
285 edhill 1.4 #endif
286 mlosch 1.10 IF ( usingCartesianGrid ) THEN
287     long_name = 'Y-Coordinate of cell center including overlaps'
288     units = 'meters'
289     ELSEIF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
290 jmc 1.15 long_name = 'j-index of cell center including overlaps'
291 mlosch 1.10 units = 'none'
292     ELSEIF ( usingSphericalPolarGrid ) THEN
293     long_name = 'latitude of cell center including overlaps'
294     units = 'degrees_north'
295     ELSEIF ( usingCylindricalGrid ) THEN
296 jmc 1.15 long_name =
297 mlosch 1.10 & 'radial coordinate of cell center including overlaps'
298     units = 'meters'
299     ELSE
300     C unknown grid type
301     print *, 'S/R MNC_CW_CVARS: Ooops, unknown horizontal grid!'
302     ENDIF
303 edhill 1.3
304 edhill 1.1 ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN
305    
306     cv_start(1) = 1
307     cv_count(1) = Nr
308     DO i = cv_start(1),cv_count(1)
309     rtmp(i) = rC(i)
310     ENDDO
311 jmc 1.15 C
312 mlosch 1.10 long_name = 'vertical coordinate of cell center'
313     IF ( usingZCoords ) THEN
314     units = 'meters'
315     positive = 'up'
316     ELSEIF ( usingPCoords ) THEN
317     units = 'pascal'
318     ELSE
319     C unknown grid type
320     print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
321     ENDIF
322 edhill 1.1
323     ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN
324    
325     cv_start(1) = 1
326     cv_count(1) = Nr + 1
327     DO i = cv_start(1),cv_count(1)
328     rtmp(i) = rF(i)
329     ENDDO
330 mlosch 1.10 C
331     long_name = 'vertical coordinate of cell interface'
332     IF ( usingZCoords ) THEN
333     units = 'meters'
334     positive = 'up'
335     ELSEIF ( usingPCoords ) THEN
336     units = 'pascal'
337     ELSE
338     C unknown grid type
339     print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
340     ENDIF
341 edhill 1.4
342 edhill 1.5 ELSEIF (cvname(nnf:nnl) .EQ. 'Zu') THEN
343    
344     cv_start(1) = 1
345     cv_count(1) = Nr
346     DO i = cv_start(1),cv_count(1)
347     rtmp(i) = rF(i + 1)
348     ENDDO
349 mlosch 1.10 C
350     IF ( usingZCoords ) THEN
351     long_name = 'vertical coordinate of lower cell interface'
352     units = 'meters'
353     positive = 'up'
354     ELSEIF ( usingPCoords ) THEN
355     long_name = 'vertical coordinate of upper cell interface'
356     units = 'pascal'
357     ELSE
358     C unknown grid type
359     print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
360     ENDIF
361 edhill 1.5
362     ELSEIF (cvname(nnf:nnl) .EQ. 'Zl') THEN
363    
364     cv_start(1) = 1
365     cv_count(1) = Nr
366     DO i = cv_start(1),cv_count(1)
367     rtmp(i) = rF(i)
368     ENDDO
369 mlosch 1.10 C
370     IF ( usingZCoords ) THEN
371     long_name = 'vertical coordinate of upper cell interface'
372     units = 'meters'
373     positive = 'up'
374     ELSEIF ( usingPCoords ) THEN
375     long_name = 'vertical coordinate of lower cell interface'
376     units = 'pascal'
377     ELSE
378     C unknown grid type
379     print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
380     ENDIF
381 edhill 1.5
382     ELSEIF (cvname(nnf:nnl) .EQ. 'Zm1') THEN
383    
384     cv_start(1) = 1
385     cv_count(1) = Nr - 1
386     DO i = cv_start(1),cv_count(1)
387     rtmp(i) = rF(i + 1)
388     ENDDO
389 mlosch 1.10 C
390     IF ( usingZCoords ) THEN
391     long_name = 'vertical coordinate of lower cell interface'
392     units = 'meters'
393     positive = 'up'
394     ELSEIF ( usingPCoords ) THEN
395     long_name = 'vertical coordinate of upper cell interface'
396     units = 'pascal'
397     ELSE
398     C unknown grid type
399     print *, 'S/R MNC_CW_CVARS: Ooops, unknown vertical grid!'
400     ENDIF
401 edhill 1.5
402 edhill 1.4 ELSE
403    
404     doit = 0
405 edhill 1.1
406     ENDIF
407    
408     IF ( doit .EQ. 1 ) THEN
409    
410     CALL MNC_FILE_REDEF(fname, myThid)
411 mlosch 1.12 #ifdef REAL4_IS_SLOW
412 jmc 1.15 err = NF_DEF_VAR(fid, cvname, NF_DOUBLE,
413 edhill 1.1 & nids, cv_did, vid)
414 mlosch 1.12 #else
415 jmc 1.15 err = NF_DEF_VAR(fid, cvname, NF_FLOAT,
416 mlosch 1.12 & nids, cv_did, vid)
417     #endif /* REAL4_IS_SLOW */
418 edhill 1.6 i = ILNBLNK( fname )
419 jmc 1.15 write(msgbuf,'(5a)') 'defining coordinate variable ''',
420 edhill 1.6 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
421 edhill 1.1 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
422 mlosch 1.10 C add attributes if set
423     ia = ILNBLNK(long_name)
424     IF ( ia .GT. 0 ) THEN
425     err = NF_PUT_ATT_TEXT(fid, vid, 'long_name', ia, long_name)
426 jmc 1.15 write(msgbuf,'(5a)')
427     & 'adding attribute ''long_name'' to coordinate variable ''',
428 mlosch 1.10 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
429     CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
430     ENDIF
431     ia = ILNBLNK(units)
432     IF ( ia .GT. 0 ) THEN
433     err = NF_PUT_ATT_TEXT(fid, vid, 'units', ia, units)
434 jmc 1.15 write(msgbuf,'(5a)')
435     & 'adding attribute ''units'' to coordinate variable ''',
436 mlosch 1.10 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
437     CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
438     ENDIF
439     ia = ILNBLNK(positive)
440     IF ( ia .GT. 0 ) THEN
441     err = NF_PUT_ATT_TEXT(fid, vid, 'positive', ia, positive)
442 jmc 1.15 write(msgbuf,'(5a)')
443     & 'adding attribute ''positive'' to coordinate variable ''',
444 mlosch 1.10 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
445     CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
446     ENDIF
447 jmc 1.15 C
448 edhill 1.1 CALL MNC_FILE_ENDDEF(fname, myThid)
449 mlosch 1.12 #ifdef REAL4_IS_SLOW
450 jmc 1.15 err = NF_PUT_VARA_DOUBLE(fid, vid,
451 edhill 1.1 & cv_start, cv_count, rtmp)
452 mlosch 1.12 #else
453 jmc 1.15 err = NF_PUT_VARA_REAL(fid, vid,
454 mlosch 1.12 & cv_start, cv_count, rtmp)
455     #endif /* REAL4_IS_SLOW */
456 jmc 1.15 write(msgbuf,'(5a)') 'writing coordinate variable ''',
457 edhill 1.6 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
458 edhill 1.1 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
459 jmc 1.15
460 edhill 1.1 ENDIF
461    
462     RETURN
463     END
464    
465     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
466    

  ViewVC Help
Powered by ViewVC 1.1.22