/[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.10 by edhill, Sun Jan 25 00:22:57 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, needed        integer vid, nv, ind_g_finfo, needed, nvar
119        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
120        integer ids(20)        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'
# Line 150  C     Get the grid information Line 179  C     Get the grid information
179        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'        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
# Line 167  C     Success, so save the variable info Line 215  C     Success, so save the variable info
215        mnc_fv_ids(indf,i+2) = ind_g_finfo        mnc_fv_ids(indf,i+2) = 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        REAL*8 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        REAL*4 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
# Line 276  C     Arguments Line 368  C     Arguments
368        REAL*4 rv(*)        REAL*4 rv(*)
369        integer iv(*)        integer iv(*)
370    
371  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
372        integer n, indf,ind_fv_ids, fid,vid, err        integer n, 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 290  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 302  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 320  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
# Line 339  C     Arguments Line 431  C     Arguments
431        character*(*) fname,vname        character*(*) fname,vname
432        REAL*8 var(*)        REAL*8 var(*)
433    
434        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,0,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
# Line 357  C     Arguments Line 449  C     Arguments
449        character*(*) fname,vname        character*(*) fname,vname
450        REAL*4 var(*)        REAL*4 var(*)
451    
452        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,0,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 375  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,0.0D0,0.0,var)        CALL MNC_VAR_WRITE_ANY(fname,vname,3,0,0.0D0,0.0,var, myThid)
471        RETURN        RETURN
472        END        END
473    
474  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
475    
476        SUBROUTINE MNC_VAR_APPEND_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
      I     myThid,  
477       I     fname,       I     fname,
478       I     vname,       I     vname,
479       I     var,       I     var,
480       I     append )       I     append,
481         I     myThid )
482    
483        implicit none        implicit none
484  C     Arguments  C     Arguments
# Line 394  C     Arguments Line 486  C     Arguments
486        character*(*) fname,vname        character*(*) fname,vname
487        REAL*8 var(*)        REAL*8 var(*)
488    
489        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,append,var,0.0,0)        CALL MNC_VAR_WRITE_ANY(fname,vname,1,append,var,0.0,0, myThid)
490        RETURN        RETURN
491        END        END
492    
493  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
494    
495        SUBROUTINE MNC_VAR_APPEND_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
      I     myThid,  
496       I     fname,       I     fname,
497       I     vname,       I     vname,
498       I     var,       I     var,
499       I     append )       I     append,
500         I     myThid )
501    
502        implicit none        implicit none
503  C     Arguments  C     Arguments
# Line 413  C     Arguments Line 505  C     Arguments
505        character*(*) fname,vname        character*(*) fname,vname
506        REAL*4 var(*)        REAL*4 var(*)
507    
508        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,append,0.0D0,var,0)        CALL MNC_VAR_WRITE_ANY(fname,vname,2,append,0.0D0,var,0,myThid)
509        RETURN        RETURN
510        END        END
511    
512  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
513    
514        SUBROUTINE MNC_VAR_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
      I     myThid,  
515       I     fname,       I     fname,
516       I     vname,       I     vname,
517       I     var,       I     var,
518       I     append )       I     append,
519         I     myThid )
520    
521        implicit none        implicit none
522  C     Arguments  C     Arguments
# Line 432  C     Arguments Line 524  C     Arguments
524        character*(*) fname,vname        character*(*) fname,vname
525        integer var(*)        integer var(*)
526    
527        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,append,0.0D0,0.0,var)        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,       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 474  C     Strip trailing spaces Line 566  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 502  C     Check for the unlimited dimension Line 594  C     Check for the unlimited dimension
594          did = mnc_d_ids( mnc_fd_ind(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 (append .GT. 0) THEN          IF (append .GT. 0) THEN
599            lend = lend + append            lend = lend + append
600          ENDIF          ENDIF
# Line 511  C     Check for the unlimited dimension Line 603  C     Check for the unlimited dimension
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 527  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.10  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22