/[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.6 by edhill, Thu Jan 8 07:34:01 2004 UTC revision 1.15 by edhill, Fri Apr 2 05:13:33 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3                
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5                
6  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    CBOP
8    C     !ROUTINE: MNC_VAR_INIT_DBL
9    
10    C     !INTERFACE:
11        SUBROUTINE MNC_VAR_INIT_DBL(        SUBROUTINE MNC_VAR_INIT_DBL(
      I     myThid,  
12       I     fname,       I     fname,
13       I     gname,       I     gname,
14       I     vname,       I     vname,
15       I     units )       I     myThid )
16    
17    C     !DESCRIPTION:
18    C     Create a double-precision real variable within a NetCDF file
19    C     context.
20          
21    C     !USES:
22        implicit none        implicit none
23  #include "netcdf.inc"  #include "netcdf.inc"
24    
25  C     Arguments  C     !INPUT PARAMETERS:
26        integer myThid        integer myThid
27        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
28    CEOP
29    
30        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, myThid)
31        RETURN        RETURN
32        END        END
33    
34  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
35    CBOP
36    C     !ROUTINE: MNC_VAR_INIT_REAL
37    
38    C     !INTERFACE:
39        SUBROUTINE MNC_VAR_INIT_REAL(        SUBROUTINE MNC_VAR_INIT_REAL(
      I     myThid,  
40       I     fname,       I     fname,
41       I     gname,       I     gname,
42       I     vname,       I     vname,
43       I     units )       I     myThid )
44    
45    C     !DESCRIPTION:
46    C     Create a single-precision real variable within a NetCDF file
47    C     context.
48          
49    C     !USES:
50        implicit none        implicit none
51  #include "netcdf.inc"  #include "netcdf.inc"
52    
53  C     Arguments  C     !INPUT PARAMETERS:
54        integer myThid        integer myThid
55        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
56    CEOP
57    
58        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, myThid)
59        RETURN        RETURN
60        END        END
61    
62  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
63    CBOP
64    C     !ROUTINE: MNC_VAR_INIT_INT
65    
66    C     !INTERFACE:
67        SUBROUTINE MNC_VAR_INIT_INT(        SUBROUTINE MNC_VAR_INIT_INT(
      I     myThid,  
68       I     fname,       I     fname,
69       I     gname,       I     gname,
70       I     vname,       I     vname,
71       I     units )       I     myThid )
72    
73    C     !DESCRIPTION:
74    C     Create an integer variable within a NetCDF file context.
75      
76    C     !USES:
77        implicit none        implicit none
78  #include "netcdf.inc"  #include "netcdf.inc"
79    
80  C     Arguments  C     !INPUT PARAMETERS:
81        integer myThid        integer myThid
82        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
83    CEOP
84    
85        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, myThid)
86        RETURN        RETURN
87        END        END
88    
89  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
90    CBOP
91    C     !ROUTINE: MNC_VAR_INIT_ANY
92    
93    C     !INTERFACE:
94        SUBROUTINE MNC_VAR_INIT_ANY(        SUBROUTINE MNC_VAR_INIT_ANY(
      I     myThid,  
95       I     fname,       I     fname,
96       I     gname,       I     gname,
97       I     vname,       I     vname,
98       I     units,       I     vtype,
99       I     vtype )       I     myThid )
100    
101    C     !DESCRIPTION:
102    C     General function for creating variables within a NetCDF file
103    C     context.
104          
105    C     !USES:
106        implicit none        implicit none
107  #include "netcdf.inc"  #include "netcdf.inc"
108  #include "mnc_common.h"  #include "mnc_common.h"
109  #include "EEPARAMS.h"  #include "EEPARAMS.h"
110    
111  C     Arguments  C     !INPUT PARAMETERS:
112        integer myThid        integer myThid
113        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
114        integer vtype        integer vtype
115    
116  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
117        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
118        integer vid, nv, ind_g_finfo        integer vid, nv, ind_g_finfo, needed, nvar
119        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
120        integer rids(10), ids(10)        integer ids(20)
121        integer lenf,leng,lenv,lenu        integer lenf,leng,lenv
122    CEOP
123    C     Functions
124          integer ILNBLNK
125    
126  C     Strip trailing spaces  C     Strip trailing spaces
127        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
128        leng = ILNBLNK(gname)        leng = ILNBLNK(gname)
129        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
       lenu = ILNBLNK(units)  
130    
131  C     Check that the file is open  C     Check that the file is open
132        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
133        IF (indf .LT. 1) THEN        IF (indf .LT. 1) THEN
134          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,
135       &       ''' must be opened first'       &       ''' must be opened first'
136          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
137          stop 'ABNORMAL END: S/R MNC_VAR_INIT_DBL'          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
138        ENDIF        ENDIF
139        fid = mnc_f_info(indf,2)        fid = mnc_f_info(indf,2)
140    
141    C     Check for sufficient storage space in mnc_fv_ids
142          needed = 1 + 3*(mnc_fv_ids(indf,1) + 1)
143          IF (needed .GE. MNC_MAX_INFO) THEN
144            write(msgbuf,'(2a,i7,a)') 'MNC ERROR: MNC_MAX_INFO exceeded',
145         &       ': please increase it to ', 2*MNC_MAX_INFO,
146         &       ' in the file ''pkg/mnc/mnc_common.h'''
147            CALL print_error(msgbuf, mythid)
148            stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
149          ENDIF
150    
151  C     Get the grid information  C     Get the grid information
152        ngrid = mnc_f_info(indf,3)        ngrid = mnc_f_info(indf,3)
153        IF (ngrid .LT. 1) THEN        IF (ngrid .LT. 1) THEN
154          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),
155       &       ''' contains NO grids'       &       ''' contains NO grids'
156          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
157          stop 'ABNORMAL END: S/R MNC_VAR_INIT_DBL'          stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
158        ENDIF        ENDIF
159        DO i = 1,ngrid        DO i = 1,ngrid
160          j = 4 + (i-1)*3          j = 4 + (i-1)*3
# Line 129  C     Get the grid information Line 168  C     Get the grid information
168            nd = 0            nd = 0
169            DO k = is,ie            DO k = is,ie
170              nd = nd + 1              nd = nd + 1
171              ids(nd) = mnc_fg_ids(indf,k)              ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
172            ENDDO            ENDDO
173            GOTO 10            GOTO 10
174          ENDIF          ENDIF
# Line 137  C     Get the grid information Line 176  C     Get the grid information
176        write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),        write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
177       &     ''' does not contain grid ''', gname(1:leng), ''''       &     ''' does not contain grid ''', gname(1:leng), ''''
178        CALL print_error(msgbuf, mythid)        CALL print_error(msgbuf, mythid)
179        stop 'ABNORMAL END: S/R MNC_VAR_INIT_DBL'        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
180   10   CONTINUE   10   CONTINUE
181    
182    C     Check if the variable is already defined
183          nvar = mnc_fv_ids(indf,1)
184          DO i = 1,nvar
185            j = 2 + 3*(i-1)
186            IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vname) THEN
187              k = mnc_f_info(indf,mnc_fv_ids(indf,j+2))
188              IF (mnc_g_names(k) .NE. gname) THEN
189                write(msgbuf,'(5a)') 'MNC ERROR: variable ''',
190         &           vname(1:lenv), ''' is already defined in file ''',
191         &           fname(1:lenf), ''' but using a different grid shape'
192                CALL print_error(msgbuf, mythid)
193                stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
194              ELSE
195    C           Its OK, the variable and grid names are the same
196                RETURN
197              ENDIF
198            ENDIF
199          ENDDO
200    
201  C     Add the variable definition  C     Add the variable definition
202        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
203        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
204        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
205       &     ''' in file ''', fname(1:lenf), ''''       &     ''' in file ''', fname(1:lenf), ''''
206        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
207    
208  C     Success, so save the variable info  C     Success, so save the variable info
209        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_v_names, indv)        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,indv, myThid)
210        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
211        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
212        i = 2 + nv*3        i = 2 + nv*3
213        j = i + 1        mnc_fv_ids(indf,i)   = indv
214        k = i + 2        mnc_fv_ids(indf,i+1) = vid
215        mnc_fv_ids(indf,i) = indv        mnc_fv_ids(indf,i+2) = ind_g_finfo
       mnc_fv_ids(indf,j) = vid  
       mnc_fv_ids(indf,k) = ind_g_finfo  
216        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
217    
 C     Add the units  
       CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)  
   
218        RETURN        RETURN
219        END        END
220    
221  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
222    CBOP
223    C     !ROUTINE: MNC_VAR_ADD_ATTR_STR
224    
225    C     !INTERFACE:
226        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
      I     myThid,  
227       I     fname,       I     fname,
228       I     vname,       I     vname,
229       I     atname,       I     atname,
230       I     sval )       I     sval,
231         I     myThid )
232    
233    C     !DESCRIPTION:
234    C     Subroutine for adding a character string attribute to a NetCDF
235    C     file.
236          
237    C     !USES:
238        implicit none        implicit none
239  C     Arguments  
240    C     !INPUT PARAMETERS:
241        integer myThid        integer myThid
242        character*(*) fname,vname,atname,sval        character*(*) fname,vname,atname,sval
243    CEOP
244    
245        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
246       &     1, sval, 0, 0.0D0, 0.0, 0)       &     1, sval, 0, 0.0D0, 0.0, 0, myThid)
247        RETURN        RETURN
248        END        END
249  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
250    CBOP
251    C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL
252    
253    C     !INTERFACE:
254        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
      I     myThid,  
255       I     fname,       I     fname,
256       I     vname,       I     vname,
257       I     atname,       I     atname,
258       I     nv,       I     nv,
259       I     dval )       I     dval,
260         I     myThid )
261    
262    C     !DESCRIPTION:
263    C     Subroutine for adding a double-precision real attribute to a
264    C     NetCDF file.
265      
266    C     !USES:
267        implicit none        implicit none
268  C     Arguments  
269    C     !INPUT PARAMETERS:
270        integer myThid,nv        integer myThid,nv
271        character*(*) fname,vname,atname        character*(*) fname,vname,atname
272        _RL dval(*)        REAL*8 dval(*)
273    CEOP
274    
275        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
276       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, 0.0, 0, myThid)
277        RETURN        RETURN
278        END        END
279    
280  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
281    CBOP
282    C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL
283    
284    C     !INTERFACE:
285        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
      I     myThid,  
286       I     fname,       I     fname,
287       I     vname,       I     vname,
288       I     atname,       I     atname,
289       I     nv,       I     nv,
290       I     rval )       I     rval,
291         I     myThid )
292    
293    C     !DESCRIPTION:
294    C     Subroutine for adding a single-precision real attribute to a
295    C     NetCDF file.
296      
297    C     !USES:
298        implicit none        implicit none
299  C     Arguments  
300    C     !INPUT PARAMETERS:
301        integer myThid,nv        integer myThid,nv
302        character*(*) fname,vname,atname        character*(*) fname,vname,atname
303        _RS rval(*)        REAL*4 rval(*)
304    CEOP
305    
306        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
307       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, 0.0D0, rval, 0, myThid)
308        RETURN        RETURN
309        END        END
310    
311  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
312    CBOP
313    C     !ROUTINE: MNC_VAR_ADD_ATTR_INT
314    
315    C     !INTERFACE:
316        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
      I     myThid,  
317       I     fname,       I     fname,
318       I     vname,       I     vname,
319       I     atname,       I     atname,
320       I     nv,       I     nv,
321       I     ival )       I     ival,
322         I     myThid )
323    
324    C     !DESCRIPTION:
325    C     Subroutine for adding an integer attribute to a
326    C     NetCDF file.
327          
328    C     !USES:
329        implicit none        implicit none
330  C     Arguments  
331    C     !INPUT PARAMETERS:
332        integer myThid,nv        integer myThid,nv
333        character*(*) fname,vname,atname        character*(*) fname,vname,atname
334        integer ival(*)        integer ival(*)
335    CEOP
336    
337        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
338       &     4, ' ', nv, 0.0D0, 0.0, ival)       &     4, ' ', nv, 0.0D0, 0.0, ival, myThid)
339        RETURN        RETURN
340        END        END
341    
342  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
343    CBOP
344    C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY
345    
346    C     !INTERFACE:
347        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
      I     myThid,  
348       I     fname,       I     fname,
349       I     vname,       I     vname,
350       I     atname,       I     atname,
351       I     atype, cs,len,dv,rv,iv )       I     atype, cs,len,dv,rv,iv,
352         I     myThid )
353    
354    C     !DESCRIPTION:
355    C     General subroutine for adding attributes to a NetCDF file.
356          
357    C     !USES:
358        implicit none        implicit none
359  #include "netcdf.inc"  #include "netcdf.inc"
360  #include "mnc_common.h"  #include "mnc_common.h"
361  #include "EEPARAMS.h"  #include "EEPARAMS.h"
362    
363  C     Arguments  C     !INPUT PARAMETERS:
364        integer myThid,atype,len        integer myThid,atype,len
365        character*(*) fname,vname,atname        character*(*) fname,vname,atname
366        character*(*) cs        character*(*) cs
367        _RL dv(*)        REAL*8 dv(*)
368        _RS rv(*)        REAL*4 rv(*)
369        integer iv(*)        integer iv(*)
370    
371  C     Functions  C     !LOCAL VARIABLES:
372        integer ILNBLNK        integer n, indf,ind_fv_ids, fid,vid, err
   
 C     Local Variables  
       integer i,j,k, n, nv, indf,ind_fv_ids, fid,vid, err  
373        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
374        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
375    CEOP
376    C     Functions
377          integer ILNBLNK
378    
379  C     Strip trailing spaces  C     Strip trailing spaces
380        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
# Line 282  C     Strip trailing spaces Line 382  C     Strip trailing spaces
382        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
383        lens = ILNBLNK(cs)        lens = ILNBLNK(cs)
384    
385        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
386        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
387          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
388       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 294  C     Strip trailing spaces Line 394  C     Strip trailing spaces
394        vid = mnc_fv_ids(indf,(ind_fv_ids+1))        vid = mnc_fv_ids(indf,(ind_fv_ids+1))
395    
396  C     Set the attribute  C     Set the attribute
397        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
398        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
399          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
400        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
# Line 312  C     Set the attribute Line 412  C     Set the attribute
412        ENDIF        ENDIF
413        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
414       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
415        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
416    
417        RETURN        RETURN
418        END        END
419    
420  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
421    
422        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
      I     myThid,  
423       I     fname,       I     fname,
424       I     vname,       I     vname,
425       I     var )       I     var,
426         I     myThid )
427    
428        implicit none        implicit none
429  C     Arguments  C     Arguments
430        integer myThid        integer myThid
431        character*(*) fname,vname        character*(*) fname,vname
432        _RL var(*)        REAL*8 var(*)
433    
434        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 1, var, 0.0, 0 )        CALL MNC_VAR_WRITE_ANY(fname,vname,1,0,var,0.0,0, myThid)
435        RETURN        RETURN
436        END        END
437    
438  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
439    
440        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
      I     myThid,  
441       I     fname,       I     fname,
442       I     vname,       I     vname,
443       I     var )       I     var,
444         I     myThid )
445    
446        implicit none        implicit none
447  C     Arguments  C     Arguments
448        integer myThid        integer myThid
449        character*(*) fname,vname        character*(*) fname,vname
450        _RS var(*)        REAL*4 var(*)
451    
452        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 2, 0.0D0, var, 0 )        CALL MNC_VAR_WRITE_ANY(fname,vname,2,0,0.0D0,var,0, myThid)
453        RETURN        RETURN
454        END        END
455    
456  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
457    
458        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
      I     myThid,  
459       I     fname,       I     fname,
460       I     vname,       I     vname,
461       I     var )       I     var,
462         I     myThid )
463    
464        implicit none        implicit none
465  C     Arguments  C     Arguments
# Line 367  C     Arguments Line 467  C     Arguments
467        character*(*) fname,vname        character*(*) fname,vname
468        integer var(*)        integer var(*)
469    
470        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 3, 0.0D0, 0.0, var )        CALL MNC_VAR_WRITE_ANY(fname,vname,3,0,0.0D0,0.0,var, myThid)
471          RETURN
472          END
473    
474    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
475    
476          SUBROUTINE MNC_VAR_APPEND_DBL(
477         I     fname,
478         I     vname,
479         I     var,
480         I     append,
481         I     myThid )
482    
483          implicit none
484    C     Arguments
485          integer myThid, append
486          character*(*) fname,vname
487          REAL*8 var(*)
488    
489          CALL MNC_VAR_WRITE_ANY(fname,vname,1,append,var,0.0,0, myThid)
490          RETURN
491          END
492    
493    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
494    
495          SUBROUTINE MNC_VAR_APPEND_REAL(
496         I     fname,
497         I     vname,
498         I     var,
499         I     append,
500         I     myThid )
501    
502          implicit none
503    C     Arguments
504          integer myThid, append
505          character*(*) fname,vname
506          REAL*4 var(*)
507    
508          CALL MNC_VAR_WRITE_ANY(fname,vname,2,append,0.0D0,var,0,myThid)
509          RETURN
510          END
511    
512    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
513    
514          SUBROUTINE MNC_VAR_APPEND_INT(
515         I     fname,
516         I     vname,
517         I     var,
518         I     append,
519         I     myThid )
520    
521          implicit none
522    C     Arguments
523          integer myThid, append
524          character*(*) fname,vname
525          integer var(*)
526    
527          CALL MNC_VAR_WRITE_ANY(fname,vname,3,append,0.0D0,0.0,var,myThid)
528        RETURN        RETURN
529        END        END
530    
531  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
532    
533        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
      I     myThid,  
534       I     fname,       I     fname,
535       I     vname,       I     vname,
536       I     vtype,       I     vtype,
537         I     append,
538       I     dv,       I     dv,
539       I     rv,       I     rv,
540       I     iv )       I     iv,
541         I     myThid )
542    
543        implicit none        implicit none
544  #include "netcdf.inc"  #include "netcdf.inc"
# Line 390  C======================================= Line 548  C=======================================
548  C     Arguments  C     Arguments
549        integer myThid, vtype        integer myThid, vtype
550        character*(*) fname,vname        character*(*) fname,vname
551        _RL dv(*)        REAL*8 dv(*)
552        _RS rv(*)        REAL*4 rv(*)
553        integer iv(*)        integer iv(*)
554          integer append
555    
556  C     Functions  C     Functions
557        integer ILNBLNK        integer ILNBLNK
# Line 402  C     Local Variables Line 561  C     Local Variables
561        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
562        integer lenf,lenv, lend        integer lenf,lenv, lend
563        integer vstart(100), vcount(100)        integer vstart(100), vcount(100)
       integer rvstart(100), rvcount(100)  
564    
565  C     Strip trailing spaces  C     Strip trailing spaces
566        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
567        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
568    
569        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
570        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
571          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
572       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 433  C     Get the lengths from the dim IDs Line 591  C     Get the lengths from the dim IDs
591  C     Check for the unlimited dimension  C     Check for the unlimited dimension
592        j = mnc_d_size( mnc_fd_ind(indf,de) )        j = mnc_d_size( mnc_fd_ind(indf,de) )
593        IF (j .LT. 1) THEN        IF (j .LT. 1) THEN
594          did = mnc_fg_ids(indf,de)          did = mnc_d_ids( mnc_fd_ind(indf,de) )
595          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
596          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
597          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
598          IF (lend .LT. 1)  lend = lend + 1          IF (append .GT. 0) THEN
599              lend = lend + append
600            ENDIF
601            IF (lend .LT. 1) lend = 1
602          vstart(k) = lend          vstart(k) = lend
603          vcount(k) = 1          vcount(k) = 1
604        ENDIF        ENDIF
605    
606        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(fname, myThid)
607        IF (vtype .EQ. 1) THEN        IF (vtype .EQ. 1) THEN
608          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
609        ELSEIF (vtype .EQ. 2) THEN        ELSEIF (vtype .EQ. 2) THEN
# Line 458  C     Check for the unlimited dimension Line 619  C     Check for the unlimited dimension
619        ENDIF          ENDIF  
620        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
621       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
622        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
623    
624        RETURN        RETURN
625        END        END
626    
627    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
628    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22