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

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

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

revision 1.3 by edhill, Wed Jan 7 07:29:13 2004 UTC revision 1.4 by edhill, Wed Jan 7 19:50:52 2004 UTC
# Line 29  C     Functions Line 29  C     Functions
29    
30  C     Local Variables  C     Local Variables
31        integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err        integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err
32        integer vid, nv        integer vid, nv, ind_g_finfo
33        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
34        integer rids(10), ids(10)        integer rids(10), ids(10)
35        integer lenf,leng,lenv        integer lenf,leng,lenv
# Line 63  C     Get the grid information Line 63  C     Get the grid information
63          n = ILNBLNK(mnc_g_names(k))          n = ILNBLNK(mnc_g_names(k))
64          IF ((leng .EQ. n)          IF ((leng .EQ. n)
65       &       .AND. (mnc_g_names(k)(1:n) .EQ. gname(1:n))) THEN       &       .AND. (mnc_g_names(k)(1:n) .EQ. gname(1:n))) THEN
66              ind_g_finfo = j
67            is = mnc_f_info(indf,(j+1))            is = mnc_f_info(indf,(j+1))
68            ie = mnc_f_info(indf,(j+2))            ie = mnc_f_info(indf,(j+2))
69            nd = 0            nd = 0
# Line 92  C     Success, so save the variable info Line 93  C     Success, so save the variable info
93        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
94        i = 2 + nv*2        i = 2 + nv*2
95        j = i + 1        j = i + 1
96          k = i + 2
97        mnc_fv_ids(indf,i) = indv        mnc_fv_ids(indf,i) = indv
98        mnc_fv_ids(indf,j) = vid        mnc_fv_ids(indf,j) = vid
99          mnc_fv_ids(indf,k) = ind_g_finfo
100        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
101    
102        RETURN        RETURN
# Line 124  C     Functions Line 127  C     Functions
127        integer ILNBLNK        integer ILNBLNK
128    
129  C     Local Variables  C     Local Variables
130        integer i,j,k, n, nv, indf, fid,vid, err        integer i,j,k, n, nv, indf,ind_fv_ids, fid,vid, err
131        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
132        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
133    
# Line 134  C     Strip trailing spaces Line 137  C     Strip trailing spaces
137        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
138        lens = ILNBLNK(sval)        lens = ILNBLNK(sval)
139    
140  C     Check that the file is open        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
141        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
142        IF (indf .LT. 1) THEN          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
143          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),       &       ''' is not open or does not contain variable ''',
144       &       ''' must be opened first'       &       vname(1:lenv), ''''
145          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
146          stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'          stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
147        ENDIF        ENDIF
148        fid = mnc_f_info(indf,2)        fid = mnc_f_info(indf,2)
149          vid = mnc_fv_ids(indf,(ind_fv_ids+1))
 C     Find the vID  
       nv = mnc_fv_ids(indf,1)  
       DO i = 1,nv  
         k = 2*i  
         j = mnc_fv_ids(indf,k)  
         n = ILNBLNK(mnc_v_names(j))  
         IF ((n .EQ. lenv)  
      &       .AND. (mnc_v_names(j)(1:n) .EQ. vname(1:n))) THEN  
           k = k + 1  
           vid = mnc_fv_ids(indf,k)  
           GOTO 10  
         ENDIF  
       ENDDO  
       write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),  
      &     ''' does not contain variable ''', vname(1:lenv), ''''  
       CALL print_error(msgbuf, mythid)  
       stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'  
  10   CONTINUE  
150    
151  C     Set the attribute  C     Set the attribute
152        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(myThid, fname)
# Line 170  C     Set the attribute Line 155  C     Set the attribute
155       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
156        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
157    
158          RETURN
159          END
160    
161    C==================================================================
162    
163          SUBROUTINE MNC_VAR_WRITE_DBL(
164         I     myThid,
165         I     fname,
166         I     vname,
167         I     var )
168    
169          implicit none
170    #include "netcdf.inc"
171    #include "mnc_common.h"
172    #include "EEPARAMS.h"
173    
174    C     Arguments
175          integer myThid
176          character*(*) fname
177          character*(*) vname
178          _RL var(*)
179    
180    C     Functions
181          integer ILNBLNK
182    
183    C     Local Variables
184          integer i,j,k, n, indf,ind_fv_ids, fid,vid,did, ig, err, ds,de
185          character*(MAX_LEN_MBUF) msgbuf
186          integer lenf,lenv, lend
187          integer vstart(100), vcount(100)
188          integer rvstart(100), rvcount(100)
189    
190    C     Strip trailing spaces
191          lenf = ILNBLNK(fname)
192          lenv = ILNBLNK(vname)
193    
194          CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
195          IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
196            write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
197         &       ''' is not open or does not contain variable ''',
198         &       vname(1:lenv), ''''
199            CALL print_error(msgbuf, mythid)
200            stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
201          ENDIF
202          fid = mnc_f_info(indf,2)
203          vid = mnc_fv_ids(indf,(ind_fv_ids+1))
204    
205    C     Get the lengths from the dim IDs
206          ig = mnc_fv_ids(indf,(ind_fv_ids+2))
207          ds = mnc_f_info(indf,ig+1)
208          de = mnc_f_info(indf,ig+2)
209          k = 0
210          DO i = ds,de
211            k = k + 1
212            vstart(k) = 1
213            vcount(k) = mnc_d_size( mnc_fd_ind(indf,i) )
214          ENDDO
215    
216    C     Check for the unlimited dimension
217          j = mnc_d_size( mnc_fd_ind(indf,de) )
218          IF (j .LT. 1) THEN
219            did = mnc_fg_ids(indf,de)
220            err = NF_INQ_DIMLEN(fid, did, lend)
221            write(msgbuf,'(a)') 'reading current length of unlimited dim'
222            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
223            IF (lend .LT. 1)  lend = lend + 1
224            vstart(k) = lend
225            vcount(k) = 1
226          ENDIF
227    
228          CALL MNC_FILE_ENDDEF(myThid, fname)
229          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, var)
230          write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
231         &     ''' to file ''', fname(1:lenf), ''''
232          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
233    
234        RETURN        RETURN
235        END        END
236    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22