/[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.6 - (hide annotations) (download)
Fri Mar 10 16:09:31 2006 UTC (18 years, 2 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58c_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post
Changes since 1.5: +4 -3 lines 
fix a bunch of formatted internal writes that need explicit string lengths
  for certain compilers (eg. PGI)
1 edhill 1.6 C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cw_cvars.F,v 1.5 2005/02/23 05:17:36 edhill 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     #include "mnc_common.h"
26     #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 edhill 1.4 integer i,j, vid, nnf,nnl, doit, err
48     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 edhill 1.1
53     nnf = IFNBLNK(cvname)
54     nnl = ILNBLNK(cvname)
55    
56 edhill 1.4 xtmin = 0
57     ytmin = 0
58     #ifdef ALLOW_EXCH2
59     xtmin = exch2_tbasex(W2_myTileList(bi))
60     ytmin = exch2_tbasey(W2_myTileList(bi))
61     #endif
62     doit = 1
63 edhill 1.1 nids = 1
64     cv_did(1)= did
65    
66     C Check all the coordinate variables that we know about
67     IF (cvname(nnf:nnl) .EQ. 'X') THEN
68    
69     cv_start(1) = 1
70     cv_count(1) = sNx
71     DO i = cv_start(1),cv_count(1)
72 edhill 1.4 #ifdef ALLOW_EXCH2
73     rtmp(i) = xtmin + i
74     #else
75 edhill 1.1 rtmp(i) = xC(i,1,bi,bj)
76 edhill 1.4 #endif
77 edhill 1.1 ENDDO
78    
79     ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN
80    
81     cv_start(1) = 1
82     cv_count(1) = sNx + 1
83     DO i = cv_start(1),cv_count(1)
84 edhill 1.4 #ifdef ALLOW_EXCH2
85     rtmp(i) = xtmin + i
86     #else
87 edhill 1.1 rtmp(i) = xG(i,1,bi,bj)
88 edhill 1.4 #endif
89 edhill 1.1 ENDDO
90    
91 edhill 1.3 ELSEIF (cvname(nnf:nnl) .EQ. 'Xwh') THEN
92    
93     cv_start(1) = 1
94     cv_count(1) = sNx + 2*OLx
95     DO i = cv_start(1),cv_count(1)
96 edhill 1.4 #ifdef ALLOW_EXCH2
97     rtmp(i) = xtmin - OLx + i
98     #else
99 edhill 1.3 rtmp(i) = xC(i,1,bi,bj)
100 edhill 1.4 #endif
101 edhill 1.3 ENDDO
102 edhill 1.4
103 edhill 1.1 ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN
104    
105     cv_start(1) = 1
106     cv_count(1) = sNy
107     DO i = cv_start(1),cv_count(1)
108 edhill 1.4 #ifdef ALLOW_EXCH2
109     rtmp(i) = ytmin + i
110     #else
111 edhill 1.1 rtmp(i) = yC(1,i,bi,bj)
112 edhill 1.4 #endif
113 edhill 1.1 ENDDO
114    
115     ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN
116    
117     cv_start(1) = 1
118     cv_count(1) = sNy + 1
119     DO i = cv_start(1),cv_count(1)
120 edhill 1.4 #ifdef ALLOW_EXCH2
121     rtmp(i) = ytmin + i
122     #else
123 edhill 1.1 rtmp(i) = yG(1,i,bi,bj)
124 edhill 1.4 #endif
125 edhill 1.1 ENDDO
126    
127 edhill 1.3 ELSEIF (cvname(nnf:nnl) .EQ. 'Ywh') THEN
128    
129     cv_start(1) = 1
130     cv_count(1) = sNy + 2*OLy
131     DO i = cv_start(1),cv_count(1)
132 edhill 1.4 #ifdef ALLOW_EXCH2
133     rtmp(i) = ytmin - OLy + i
134     #else
135 edhill 1.3 rtmp(i) = yC(1,i-OLy,bi,bj)
136 edhill 1.4 #endif
137 edhill 1.3 ENDDO
138    
139 edhill 1.1 ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN
140    
141     cv_start(1) = 1
142     cv_count(1) = Nr
143     DO i = cv_start(1),cv_count(1)
144     rtmp(i) = rC(i)
145     ENDDO
146    
147     ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN
148    
149     cv_start(1) = 1
150     cv_count(1) = Nr + 1
151     DO i = cv_start(1),cv_count(1)
152     rtmp(i) = rF(i)
153     ENDDO
154 edhill 1.4
155 edhill 1.5 ELSEIF (cvname(nnf:nnl) .EQ. 'Zu') THEN
156    
157     cv_start(1) = 1
158     cv_count(1) = Nr
159     DO i = cv_start(1),cv_count(1)
160     rtmp(i) = rF(i + 1)
161     ENDDO
162    
163     ELSEIF (cvname(nnf:nnl) .EQ. 'Zl') THEN
164    
165     cv_start(1) = 1
166     cv_count(1) = Nr
167     DO i = cv_start(1),cv_count(1)
168     rtmp(i) = rF(i)
169     ENDDO
170    
171     ELSEIF (cvname(nnf:nnl) .EQ. 'Zm1') THEN
172    
173     cv_start(1) = 1
174     cv_count(1) = Nr - 1
175     DO i = cv_start(1),cv_count(1)
176     rtmp(i) = rF(i + 1)
177     ENDDO
178    
179 edhill 1.4 ELSE
180    
181     doit = 0
182 edhill 1.1
183     ENDIF
184    
185     IF ( doit .EQ. 1 ) THEN
186    
187     CALL MNC_FILE_REDEF(fname, myThid)
188     err = NF_DEF_VAR(fid, cvname, NF_DOUBLE,
189     & nids, cv_did, vid)
190 edhill 1.6 i = ILNBLNK( fname )
191 edhill 1.1 write(msgbuf,'(5a)') 'defining coordinate variable ''',
192 edhill 1.6 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
193 edhill 1.1 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
194     CALL MNC_FILE_ENDDEF(fname, myThid)
195     err = NF_PUT_VARA_DOUBLE(fid, vid,
196     & cv_start, cv_count, rtmp)
197     write(msgbuf,'(5a)') 'writing coordinate variable ''',
198 edhill 1.6 & cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
199 edhill 1.1 CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
200    
201     ENDIF
202    
203     RETURN
204     END
205    
206     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
207    
  ViewVC Help
Powered by ViewVC 1.1.22