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

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

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

revision 1.2 by edhill, Sat Dec 18 19:18:08 2004 UTC revision 1.9 by mlosch, Thu May 22 12:21:19 2008 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5    
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
 C CBOP 1  
 C C     !ROUTINE: MNC_CW_DEF_CVAR  
         
 C C     !INTERFACE:  
 C       SUBROUTINE MNC_CW_DEF_CVAR(  
 C      I     cvname,  
 C      I     cvnum,  
 C      I     cvdat,  
 C      I     myThid )  
   
 C C     !DESCRIPTION:  
 C C     Store data for a CF-convention coordinate variable (a vector) for  
 C C     the given dimension name.  
   
 C C     !USES:  
 C       implicit none  
 C #include "mnc_common.h"  
 C #include "EEPARAMS.h"  
   
 C C     !INPUT PARAMETERS:  
 C       character*(*) cvname  
 C       _RL cvdat(*)  
 C       integer cvnum, myThid  
 C CEOP  
   
 C C     !LOCAL VARIABLES:  
 C       integer i, imx, ind, nnf,nnl  
 C       character*(MAX_LEN_MBUF) msgbuf  
   
 C C     Functions  
 C       integer IFNBLNK, ILNBLNK  
   
 C       nnf = IFNBLNK(cvname)  
 C       nnl = ILNBLNK(cvname)  
   
 C C     Check that this name is not already defined  
 C       CALL MNC_GET_IND(MNC_MAX_ID, cvname, mnc_cw_cvnm, ind, myThid)  
 C       IF (ind .GT. 0) THEN  
 C         write(msgbuf,'(3a)') 'MNC_CW_DEF_CVAR ERROR: ''',  
 C      &       cvname(nnf:nnl), ''' is already defined'  
 C         CALL print_error(msgbuf, mythid)  
 C         stop 'ABNORMAL END: S/R MNC_CW_DEF_CVAR'  
 C       ENDIF  
 C       CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_cvnm,  
 C      &     ind, myThid)  
   
 C       imx = 0  
 C       DO i = 1,MNC_MAX_ID  
 C         IF (mnc_cw_cvnm(i)(1:1) .NE. ' ') THEN  
 C           imx = max(imx, mnc_cw_cvse(2,i))  
 C         ENDIF  
 C       ENDDO  
   
 C       IF ((MNC_CW_CVDAT - imx - 1) .LT. cvnum) THEN  
 C         write(msgbuf,'(3a)') 'MNC_CW_DEF_CVAR ERROR: out of space',  
 C      &       '--please increase size of MNC_CW_CVDAT in the file ',  
 C      &       '''mnc_common.h'''  
 C         CALL print_error(msgbuf, mythid)  
 C         stop 'ABNORMAL END: S/R MNC_CW_DEF_CVAR'  
 C       ENDIF  
   
 C       DO i = 1,cvnum  
 C         mnc_cw_cvdt(imx+i) = cvdat(i)  
 C       ENDDO  
 C       mnc_cw_cvse(1,ind) = imx + 1  
 C       mnc_cw_cvse(2,ind) = imx + cvnum  
   
 C       RETURN  
 C       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
7  CBOP 1  CBOP 1
8  C     !ROUTINE: MNC_CW_WRITE_CVAR  C     !ROUTINE: MNC_CW_WRITE_CVAR
9                
# Line 93  C     Write a CF-convention coordinate v Line 22  C     Write a CF-convention coordinate v
22  C     !USES:  C     !USES:
23        implicit none        implicit none
24  #include "netcdf.inc"  #include "netcdf.inc"
25  #include "mnc_common.h"  #include "MNC_COMMON.h"
26  #include "SIZE.h"  #include "SIZE.h"
27  #include "EEPARAMS.h"  #include "EEPARAMS.h"
28  #include "EESUPPORT.h"  #include "EESUPPORT.h"
29  #include "PARAMS.h"  #include "PARAMS.h"
30  #include "GRID.h"  #include "GRID.h"
31    #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    
39  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
40        character*(*) fname        character*(*) fname
# Line 108  C     !INPUT PARAMETERS: Line 44  C     !INPUT PARAMETERS:
44  CEOP  CEOP
45    
46  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
47        integer i, vid, nnf,nnl, doit, err        integer i, vid, nnf, nnl, doit, err
48        integer nids, cv_did(1)        integer nids, cv_did(1), xtmin,ytmin
49        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
50        integer cv_start(1), cv_count(1)        integer cv_start(1), cv_count(1)
51        _RS rtmp(sNx + sNy + Nr)        _RS rtmp(sNx + 2*OLx + sNy + 2*OLy + Nr)
   
 C     Functions  
       integer IFNBLNK, ILNBLNK  
52    
53        nnf = IFNBLNK(cvname)        nnf = IFNBLNK(cvname)
54        nnl = ILNBLNK(cvname)        nnl = ILNBLNK(cvname)
55    
56        doit = 0        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        nids = 1        nids = 1
64        cv_did(1)= did        cv_did(1)= did
65    
# Line 129  C     Check all the coordinate variables Line 68  C     Check all the coordinate variables
68    
69          cv_start(1) = 1          cv_start(1) = 1
70          cv_count(1) = sNx          cv_count(1) = sNx
71    #ifdef ALLOW_EXCH2
72          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
73            rtmp(i) = xC(i,1,bi,bj)           rtmp(i) = xtmin + i
74          ENDDO          ENDDO
75          doit = 1  #else
76            IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
77             DO i = cv_start(1),cv_count(1)
78              rtmp(i) = xtmin + i
79             ENDDO
80            ELSE
81             DO i = cv_start(1),cv_count(1)
82              rtmp(i) = xC(i,1,bi,bj)
83             ENDDO
84            ENDIF
85    #endif
86    
87        ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN
88    
89          cv_start(1) = 1          cv_start(1) = 1
90          cv_count(1) = sNx + 1          cv_count(1) = sNx + 1
91    #ifdef ALLOW_EXCH2
92          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
93            rtmp(i) = xG(i,1,bi,bj)           rtmp(i) = xtmin + i
94          ENDDO          ENDDO
95          doit = 1  #else
96            IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
97             DO i = cv_start(1),cv_count(1)
98              rtmp(i) = xtmin + i
99             ENDDO
100            ELSE
101             DO i = cv_start(1),cv_count(1)
102              rtmp(i) = xG(i,1,bi,bj)
103             ENDDO
104            ENDIF
105    #endif
106    
107          ELSEIF (cvname(nnf:nnl) .EQ. 'Xwh') THEN
108    
109            cv_start(1) = 1
110            cv_count(1) = sNx + 2*OLx
111    #ifdef ALLOW_EXCH2
112            DO i = cv_start(1),cv_count(1)
113             rtmp(i) = xtmin + i
114            ENDDO
115    #else
116            IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
117             DO i = cv_start(1),cv_count(1)
118              rtmp(i) = xtmin - OLx + i
119             ENDDO
120            ELSE
121             DO i = cv_start(1),cv_count(1)
122              rtmp(i) = xC(i,1,bi,bj)
123             ENDDO
124            ENDIF
125    #endif
126            
127        ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN
128    
129          cv_start(1) = 1          cv_start(1) = 1
130          cv_count(1) = sNy          cv_count(1) = sNy
131    #ifdef ALLOW_EXCH2
132          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
133            rtmp(i) = yC(1,i,bi,bj)           rtmp(i) = ytmin + i
134          ENDDO          ENDDO
135          doit = 1  #else
136            IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
137             DO i = cv_start(1),cv_count(1)
138              rtmp(i) = ytmin + i
139             ENDDO
140            ELSE
141             DO i = cv_start(1),cv_count(1)
142              rtmp(i) = yC(1,i,bi,bj)
143             ENDDO
144            ENDIF
145    #endif
146    
147        ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN
148    
149          cv_start(1) = 1          cv_start(1) = 1
150          cv_count(1) = sNy + 1          cv_count(1) = sNy + 1
151    #ifdef ALLOW_EXCH2
152          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
153            rtmp(i) = yG(1,i,bi,bj)           rtmp(i) = ytmin + i
154          ENDDO          ENDDO
155          doit = 1  #else
156            IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
157             DO i = cv_start(1),cv_count(1)
158              rtmp(i) = ytmin + i
159             ENDDO
160            ELSE
161             DO i = cv_start(1),cv_count(1)
162              rtmp(i) = yG(1,i,bi,bj)
163             ENDDO
164            ENDIF
165    #endif
166    
167          ELSEIF (cvname(nnf:nnl) .EQ. 'Ywh') THEN
168    
169            cv_start(1) = 1
170            cv_count(1) = sNy + 2*OLy
171    #ifdef ALLOW_EXCH2
172            DO i = cv_start(1),cv_count(1)
173             rtmp(i) = ytmin + i
174            ENDDO
175    #else
176            IF ( usingCurvilinearGrid .OR. rotateGrid ) THEN
177             DO i = cv_start(1),cv_count(1)
178              rtmp(i) = ytmin - OLy + i
179             ENDDO
180            ELSE
181             DO i = cv_start(1),cv_count(1)
182              rtmp(i) = yC(1,i-OLy,bi,bj)
183             ENDDO
184            ENDIF
185    #endif
186    
187        ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN
188    
# Line 168  C     Check all the coordinate variables Line 191  C     Check all the coordinate variables
191          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
192            rtmp(i) = rC(i)            rtmp(i) = rC(i)
193          ENDDO          ENDDO
         doit = 1  
194    
195        ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN
196    
# Line 177  C     Check all the coordinate variables Line 199  C     Check all the coordinate variables
199          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
200            rtmp(i) = rF(i)            rtmp(i) = rF(i)
201          ENDDO          ENDDO
202          doit = 1  
203          ELSEIF (cvname(nnf:nnl) .EQ. 'Zu') THEN
204    
205            cv_start(1) = 1
206            cv_count(1) = Nr
207            DO i = cv_start(1),cv_count(1)
208              rtmp(i) = rF(i + 1)
209            ENDDO
210    
211          ELSEIF (cvname(nnf:nnl) .EQ. 'Zl') THEN
212    
213            cv_start(1) = 1
214            cv_count(1) = Nr
215            DO i = cv_start(1),cv_count(1)
216              rtmp(i) = rF(i)
217            ENDDO
218    
219          ELSEIF (cvname(nnf:nnl) .EQ. 'Zm1') THEN
220    
221            cv_start(1) = 1
222            cv_count(1) = Nr - 1
223            DO i = cv_start(1),cv_count(1)
224              rtmp(i) = rF(i + 1)
225            ENDDO
226    
227          ELSE
228    
229            doit = 0
230    
231        ENDIF        ENDIF
232    
# Line 186  C     Check all the coordinate variables Line 235  C     Check all the coordinate variables
235          CALL MNC_FILE_REDEF(fname, myThid)          CALL MNC_FILE_REDEF(fname, myThid)
236          err = NF_DEF_VAR(fid, cvname, NF_DOUBLE,          err = NF_DEF_VAR(fid, cvname, NF_DOUBLE,
237       &       nids, cv_did, vid)       &       nids, cv_did, vid)
238            i = ILNBLNK( fname )
239          write(msgbuf,'(5a)') 'defining coordinate variable ''',          write(msgbuf,'(5a)') 'defining coordinate variable ''',
240       &       cvname(nnf:nnl), ''' in file ''', fname, ''''       &       cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
241          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
242          CALL MNC_FILE_ENDDEF(fname, myThid)          CALL MNC_FILE_ENDDEF(fname, myThid)
243          err = NF_PUT_VARA_DOUBLE(fid, vid,          err = NF_PUT_VARA_DOUBLE(fid, vid,
244       &       cv_start, cv_count, rtmp)       &       cv_start, cv_count, rtmp)
245          write(msgbuf,'(5a)') 'writing coordinate variable ''',          write(msgbuf,'(5a)') 'writing coordinate variable ''',
246       &       cvname(nnf:nnl), ''' in file ''', fname, ''''       &       cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
247          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
248                    
249        ENDIF        ENDIF
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22