/[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.1 by edhill, Fri Dec 17 21:28:25 2004 UTC revision 1.6 by edhill, Fri Mar 10 16:09:31 2006 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 99  C     !USES: Line 28  C     !USES:
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,j, 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)        _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 130  C     Check all the coordinate variables Line 69  C     Check all the coordinate variables
69          cv_start(1) = 1          cv_start(1) = 1
70          cv_count(1) = sNx          cv_count(1) = sNx
71          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
72    #ifdef ALLOW_EXCH2
73              rtmp(i) = xtmin + i
74    #else
75            rtmp(i) = xC(i,1,bi,bj)            rtmp(i) = xC(i,1,bi,bj)
76    #endif
77          ENDDO          ENDDO
         doit = 1  
78    
79        ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Xp1') THEN
80    
81          cv_start(1) = 1          cv_start(1) = 1
82          cv_count(1) = sNx + 1          cv_count(1) = sNx + 1
83          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
84    #ifdef ALLOW_EXCH2
85              rtmp(i) = xtmin + i
86    #else
87            rtmp(i) = xG(i,1,bi,bj)            rtmp(i) = xG(i,1,bi,bj)
88    #endif
89          ENDDO          ENDDO
         doit = 1  
90    
91          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    #ifdef ALLOW_EXCH2
97              rtmp(i) = xtmin - OLx + i
98    #else
99              rtmp(i) = xC(i,1,bi,bj)
100    #endif
101            ENDDO
102            
103        ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Y') THEN
104    
105          cv_start(1) = 1          cv_start(1) = 1
106          cv_count(1) = sNy          cv_count(1) = sNy
107          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
108    #ifdef ALLOW_EXCH2
109              rtmp(i) = ytmin + i
110    #else
111            rtmp(i) = yC(1,i,bi,bj)            rtmp(i) = yC(1,i,bi,bj)
112    #endif
113          ENDDO          ENDDO
         doit = 1  
114    
115        ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Yp1') THEN
116    
117          cv_start(1) = 1          cv_start(1) = 1
118          cv_count(1) = sNy + 1          cv_count(1) = sNy + 1
119          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
120    #ifdef ALLOW_EXCH2
121              rtmp(i) = ytmin + i
122    #else
123            rtmp(i) = yG(1,i,bi,bj)            rtmp(i) = yG(1,i,bi,bj)
124    #endif
125            ENDDO
126    
127          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    #ifdef ALLOW_EXCH2
133              rtmp(i) = ytmin - OLy + i
134    #else
135              rtmp(i) = yC(1,i-OLy,bi,bj)
136    #endif
137          ENDDO          ENDDO
         doit = 1  
138    
139        ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Z') THEN
140    
# Line 168  C     Check all the coordinate variables Line 143  C     Check all the coordinate variables
143          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
144            rtmp(i) = rC(i)            rtmp(i) = rC(i)
145          ENDDO          ENDDO
         doit = 1  
146    
147        ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN        ELSEIF (cvname(nnf:nnl) .EQ. 'Zp1') THEN
148    
# Line 177  C     Check all the coordinate variables Line 151  C     Check all the coordinate variables
151          DO i = cv_start(1),cv_count(1)          DO i = cv_start(1),cv_count(1)
152            rtmp(i) = rF(i)            rtmp(i) = rF(i)
153          ENDDO          ENDDO
154          doit = 1  
155          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          ELSE
180    
181            doit = 0
182    
183        ENDIF        ENDIF
184    
# Line 186  C     Check all the coordinate variables Line 187  C     Check all the coordinate variables
187          CALL MNC_FILE_REDEF(fname, myThid)          CALL MNC_FILE_REDEF(fname, myThid)
188          err = NF_DEF_VAR(fid, cvname, NF_DOUBLE,          err = NF_DEF_VAR(fid, cvname, NF_DOUBLE,
189       &       nids, cv_did, vid)       &       nids, cv_did, vid)
190            i = ILNBLNK( fname )
191          write(msgbuf,'(5a)') 'defining coordinate variable ''',          write(msgbuf,'(5a)') 'defining coordinate variable ''',
192       &       cvname(nnf:nnl), ''' in file ''', fname, ''''       &       cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
193          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
194          CALL MNC_FILE_ENDDEF(fname, myThid)          CALL MNC_FILE_ENDDEF(fname, myThid)
195          err = NF_PUT_VARA_DOUBLE(fid, vid,          err = NF_PUT_VARA_DOUBLE(fid, vid,
196       &       cv_start, cv_count, rtmp)       &       cv_start, cv_count, rtmp)
197          write(msgbuf,'(5a)') 'writing coordinate variable ''',          write(msgbuf,'(5a)') 'writing coordinate variable ''',
198       &       cvname(nnf:nnl), ''' in file ''', fname, ''''       &       cvname(nnf:nnl), ''' in file ''', fname(1:i), ''''
199          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
200                    
201        ENDIF        ENDIF
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22