/[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.10 - (hide annotations) (download)
Fri May 23 12:40:37 2008 UTC (16 years ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint60, checkpoint59r
Changes since 1.9: +194 -1 lines
add some attributes to standard 1D-coordinate variables

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

  ViewVC Help
Powered by ViewVC 1.1.22