/[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.12 by edhill, Wed Feb 4 05:45:09 2004 UTC revision 1.17 by jmc, Thu Sep 23 16:17:57 2004 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-|--+----|
7    CBOP 1
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     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        character*(*) fname,gname,vname
28    CEOP
29    
30        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_DOUBLE)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, myThid)
31        RETURN        RETURN
32        END        END
33    
34  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
35    CBOP 1
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     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        character*(*) fname,gname,vname
56    CEOP
57    
58        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_FLOAT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, myThid)
59        RETURN        RETURN
60        END        END
61    
62  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
63    CBOP 1
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     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        character*(*) fname,gname,vname
83    CEOP
84    
85        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_INT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, myThid)
86        RETURN        RETURN
87        END        END
88    
89  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
90    CBOP 1
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     vtype )       I     vtype,
99         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        character*(*) fname,gname,vname
114        integer vtype        integer vtype
115    CEOP
116    
117  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
118        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
119        integer vid, nv, ind_g_finfo, needed, nvar        integer vid, nv, ind_g_finfo, needed, nvar
120        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
121        integer ids(20)        integer ids(20)
122        integer lenf,leng,lenv        integer lenf,leng,lenv
123    
124    C     Functions
125          integer ILNBLNK
126    
127  C     Strip trailing spaces  C     Strip trailing spaces
128        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
129        leng = ILNBLNK(gname)        leng = ILNBLNK(gname)
130        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
131    
132  C     Check that the file is open  C     Check that the file is open
133        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)
134        IF (indf .LT. 1) THEN        IF (indf .LT. 1) THEN
135          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,
136       &       ''' must be opened first'       &       ''' must be opened first'
# Line 165  C           Its OK, the variable and gri Line 200  C           Its OK, the variable and gri
200        ENDDO        ENDDO
201    
202  C     Add the variable definition  C     Add the variable definition
203        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
204        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
205        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
206       &     ''' in file ''', fname(1:lenf), ''''       &     ''' in file ''', fname(1:lenf), ''''
207        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
208    
209  C     Success, so save the variable info  C     Success, so save the variable info
210        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)
211        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
212        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
213        i = 2 + nv*3        i = 2 + nv*3
# Line 185  C     Success, so save the variable info Line 220  C     Success, so save the variable info
220        END        END
221    
222  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
223    CBOP 1
224    C     !ROUTINE: MNC_VAR_ADD_ATTR_STR
225    
226    C     !INTERFACE:
227        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
      I     myThid,  
228       I     fname,       I     fname,
229       I     vname,       I     vname,
230       I     atname,       I     atname,
231       I     sval )       I     sval,
232         I     myThid )
233    
234    C     !DESCRIPTION:
235    C     Subroutine for adding a character string attribute to a NetCDF
236    C     file.
237          
238    C     !USES:
239        implicit none        implicit none
240  C     Arguments  
241    C     !INPUT PARAMETERS:
242        integer myThid        integer myThid
243        character*(*) fname,vname,atname,sval        character*(*) fname,vname,atname,sval
244    CEOP
245          real*8 dZero(1)
246          real*4 sZero(1)
247          integer iZero(1)
248          dZero(1) = 0.0D0
249          sZero(1) = 0.0
250          iZero(1) = 0
251    
252        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
253       &     1, sval, 0, 0.0D0, 0.0, 0)       &     1, sval, 0, dZero, sZero, iZero, myThid)
254        RETURN        RETURN
255        END        END
256  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
257    CBOP 1
258    C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL
259    
260    C     !INTERFACE:
261        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
      I     myThid,  
262       I     fname,       I     fname,
263       I     vname,       I     vname,
264       I     atname,       I     atname,
265       I     nv,       I     nv,
266       I     dval )       I     dval,
267         I     myThid )
268    
269    C     !DESCRIPTION:
270    C     Subroutine for adding a double-precision real attribute to a
271    C     NetCDF file.
272      
273    C     !USES:
274        implicit none        implicit none
275  C     Arguments  
276    C     !INPUT PARAMETERS:
277        integer myThid,nv        integer myThid,nv
278        character*(*) fname,vname,atname        character*(*) fname,vname,atname
279        REAL*8 dval(*)        REAL*8 dval(*)
280    CEOP
281          real*4 sZero(1)
282          integer iZero(1)
283          sZero(1) = 0.0
284          iZero(1) = 0
285    
286        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
287       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, sZero, iZero, myThid)
288        RETURN        RETURN
289        END        END
290    
291  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
292    CBOP 1
293    C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL
294    
295    C     !INTERFACE:
296        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
      I     myThid,  
297       I     fname,       I     fname,
298       I     vname,       I     vname,
299       I     atname,       I     atname,
300       I     nv,       I     nv,
301       I     rval )       I     rval,
302         I     myThid )
303    
304    C     !DESCRIPTION:
305    C     Subroutine for adding a single-precision real attribute to a
306    C     NetCDF file.
307      
308    C     !USES:
309        implicit none        implicit none
310  C     Arguments  
311    C     !INPUT PARAMETERS:
312        integer myThid,nv        integer myThid,nv
313        character*(*) fname,vname,atname        character*(*) fname,vname,atname
314        REAL*4 rval(*)        REAL*4 rval(*)
315    CEOP
316          real*8 dZero(1)
317          integer iZero(1)
318          dZero(1) = 0.0D0
319          iZero(1) = 0
320    
321        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
322       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, dZero, rval, iZero, myThid)
323        RETURN        RETURN
324        END        END
325    
326  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
327    CBOP 1
328    C     !ROUTINE: MNC_VAR_ADD_ATTR_INT
329    
330    C     !INTERFACE:
331        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
      I     myThid,  
332       I     fname,       I     fname,
333       I     vname,       I     vname,
334       I     atname,       I     atname,
335       I     nv,       I     nv,
336       I     ival )       I     ival,
337         I     myThid )
338    
339    C     !DESCRIPTION:
340    C     Subroutine for adding an integer attribute to a
341    C     NetCDF file.
342          
343    C     !USES:
344        implicit none        implicit none
345  C     Arguments  
346    C     !INPUT PARAMETERS:
347        integer myThid,nv        integer myThid,nv
348        character*(*) fname,vname,atname        character*(*) fname,vname,atname
349        integer ival(*)        integer ival(*)
350    CEOP
351          real*8 dZero(1)
352          real*4 sZero(1)
353          dZero(1) = 0.0D0
354          sZero(1) = 0.0
355    
356        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
357       &     4, ' ', nv, 0.0D0, 0.0, ival)       &     4, ' ', nv, dZero, sZero, ival, myThid)
358        RETURN        RETURN
359        END        END
360    
361  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
362    CBOP 1
363    C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY
364    
365    C     !INTERFACE:
366        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
      I     myThid,  
367       I     fname,       I     fname,
368       I     vname,       I     vname,
369       I     atname,       I     atname,
370       I     atype, cs,len,dv,rv,iv )       I     atype, cs,len,dv,rv,iv,
371         I     myThid )
372    
373    C     !DESCRIPTION:
374    C     General subroutine for adding attributes to a NetCDF file.
375          
376    C     !USES:
377        implicit none        implicit none
378  #include "netcdf.inc"  #include "netcdf.inc"
379  #include "mnc_common.h"  #include "mnc_common.h"
380  #include "EEPARAMS.h"  #include "EEPARAMS.h"
381    
382  C     Arguments  C     !INPUT PARAMETERS:
383        integer myThid,atype,len        integer myThid,atype,len
384        character*(*) fname,vname,atname        character*(*) fname,vname,atname
385        character*(*) cs        character*(*) cs
386        REAL*8 dv(*)        REAL*8 dv(*)
387        REAL*4 rv(*)        REAL*4 rv(*)
388        integer iv(*)        integer iv(*)
389    CEOP
390    
391  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
392        integer n, indf,ind_fv_ids, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
393        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
394        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
395    
396    C     Functions
397          integer ILNBLNK
398    
399  C     Strip trailing spaces  C     Strip trailing spaces
400        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
401        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
402        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
403        lens = ILNBLNK(cs)        lens = ILNBLNK(cs)
404    
405        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
406        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
407          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
408       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 313  C     Strip trailing spaces Line 414  C     Strip trailing spaces
414        vid = mnc_fv_ids(indf,(ind_fv_ids+1))        vid = mnc_fv_ids(indf,(ind_fv_ids+1))
415    
416  C     Set the attribute  C     Set the attribute
417        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
418        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
419          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
420        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
# Line 331  C     Set the attribute Line 432  C     Set the attribute
432        ENDIF        ENDIF
433        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
434       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
435        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
436    
437        RETURN        RETURN
438        END        END
# Line 339  C     Set the attribute Line 440  C     Set the attribute
440  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
441    
442        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
      I     myThid,  
443       I     fname,       I     fname,
444       I     vname,       I     vname,
445       I     var )       I     var,
446         I     myThid )
447    
448        implicit none        implicit none
449  C     Arguments  C     Arguments
# Line 350  C     Arguments Line 451  C     Arguments
451        character*(*) fname,vname        character*(*) fname,vname
452        REAL*8 var(*)        REAL*8 var(*)
453    
454        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)
455        RETURN        RETURN
456        END        END
457    
458  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
459    
460        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
      I     myThid,  
461       I     fname,       I     fname,
462       I     vname,       I     vname,
463       I     var )       I     var,
464         I     myThid )
465    
466        implicit none        implicit none
467  C     Arguments  C     Arguments
# Line 368  C     Arguments Line 469  C     Arguments
469        character*(*) fname,vname        character*(*) fname,vname
470        REAL*4 var(*)        REAL*4 var(*)
471    
472        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)
473        RETURN        RETURN
474        END        END
475    
476  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
477    
478        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
      I     myThid,  
479       I     fname,       I     fname,
480       I     vname,       I     vname,
481       I     var )       I     var,
482         I     myThid )
483    
484        implicit none        implicit none
485  C     Arguments  C     Arguments
# Line 386  C     Arguments Line 487  C     Arguments
487        character*(*) fname,vname        character*(*) fname,vname
488        integer var(*)        integer var(*)
489    
490        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)
491        RETURN        RETURN
492        END        END
493    
494  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
495    
496        SUBROUTINE MNC_VAR_APPEND_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
      I     myThid,  
497       I     fname,       I     fname,
498       I     vname,       I     vname,
499       I     var,       I     var,
500       I     append )       I     append,
501         I     myThid )
502    
503        implicit none        implicit none
504  C     Arguments  C     Arguments
# Line 405  C     Arguments Line 506  C     Arguments
506        character*(*) fname,vname        character*(*) fname,vname
507        REAL*8 var(*)        REAL*8 var(*)
508    
509        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)
510        RETURN        RETURN
511        END        END
512    
513  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
514    
515        SUBROUTINE MNC_VAR_APPEND_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
      I     myThid,  
516       I     fname,       I     fname,
517       I     vname,       I     vname,
518       I     var,       I     var,
519       I     append )       I     append,
520         I     myThid )
521    
522        implicit none        implicit none
523  C     Arguments  C     Arguments
# Line 424  C     Arguments Line 525  C     Arguments
525        character*(*) fname,vname        character*(*) fname,vname
526        REAL*4 var(*)        REAL*4 var(*)
527    
528        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)
529        RETURN        RETURN
530        END        END
531    
532  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
533    
534        SUBROUTINE MNC_VAR_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
      I     myThid,  
535       I     fname,       I     fname,
536       I     vname,       I     vname,
537       I     var,       I     var,
538       I     append )       I     append,
539         I     myThid )
540    
541        implicit none        implicit none
542  C     Arguments  C     Arguments
# Line 443  C     Arguments Line 544  C     Arguments
544        character*(*) fname,vname        character*(*) fname,vname
545        integer var(*)        integer var(*)
546    
547        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)
548        RETURN        RETURN
549        END        END
550    
551  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
552    
553        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
      I     myThid,  
554       I     fname,       I     fname,
555       I     vname,       I     vname,
556       I     vtype,       I     vtype,
557       I     append,       I     append,
558       I     dv,       I     dv,
559       I     rv,       I     rv,
560       I     iv )       I     iv,
561         I     myThid )
562    
563        implicit none        implicit none
564  #include "netcdf.inc"  #include "netcdf.inc"
# Line 485  C     Strip trailing spaces Line 586  C     Strip trailing spaces
586        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
587        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
588    
589        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
590        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
591          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
592       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 513  C     Check for the unlimited dimension Line 614  C     Check for the unlimited dimension
614          did = mnc_d_ids( mnc_fd_ind(indf,de) )          did = mnc_d_ids( mnc_fd_ind(indf,de) )
615          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
616          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
617          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
618          IF (append .GT. 0) THEN          IF (append .GT. 0) THEN
619            lend = lend + append            lend = lend + append
620          ENDIF          ENDIF
# Line 522  C     Check for the unlimited dimension Line 623  C     Check for the unlimited dimension
623          vcount(k) = 1          vcount(k) = 1
624        ENDIF        ENDIF
625    
626        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(fname, myThid)
627        IF (vtype .EQ. 1) THEN        IF (vtype .EQ. 1) THEN
628          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
629        ELSEIF (vtype .EQ. 2) THEN        ELSEIF (vtype .EQ. 2) THEN
# Line 538  C     Check for the unlimited dimension Line 639  C     Check for the unlimited dimension
639        ENDIF          ENDIF  
640        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
641       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
642        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
643    
644        RETURN        RETURN
645        END        END
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22