/[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.20 by edhill, Fri Mar 10 05:50:23 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-|--+----|
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     irv,
16         I     myThid )
17    
18    C     !DESCRIPTION:
19    C     Create a double-precision real variable within a NetCDF file
20    C     context.
21          
22    C     !USES:
23        implicit none        implicit none
24  #include "netcdf.inc"  #include "netcdf.inc"
25    
26  C     Arguments  C     !INPUT PARAMETERS:
27        integer myThid        integer irv,myThid
28        character*(*) fname,gname,vname        character*(*) fname,gname,vname
29    CEOP
30    
31        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_DOUBLE)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, irv,myThid)
32        RETURN        RETURN
33        END        END
34    
35  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
36    CBOP 1
37    C     !ROUTINE: MNC_VAR_INIT_REAL
38    
39    C     !INTERFACE:
40        SUBROUTINE MNC_VAR_INIT_REAL(        SUBROUTINE MNC_VAR_INIT_REAL(
      I     myThid,  
41       I     fname,       I     fname,
42       I     gname,       I     gname,
43       I     vname )       I     vname,
44         I     irv,
45         I     myThid )
46    
47    C     !DESCRIPTION:
48    C     Create a single-precision real variable within a NetCDF file
49    C     context.
50          
51    C     !USES:
52        implicit none        implicit none
53  #include "netcdf.inc"  #include "netcdf.inc"
54    
55  C     Arguments  C     !INPUT PARAMETERS:
56        integer myThid        integer irv,myThid
57        character*(*) fname,gname,vname        character*(*) fname,gname,vname
58    CEOP
59    
60        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_FLOAT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, irv,myThid)
61        RETURN        RETURN
62        END        END
63    
64  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
65    CBOP 1
66    C     !ROUTINE: MNC_VAR_INIT_INT
67    
68    C     !INTERFACE:
69        SUBROUTINE MNC_VAR_INIT_INT(        SUBROUTINE MNC_VAR_INIT_INT(
      I     myThid,  
70       I     fname,       I     fname,
71       I     gname,       I     gname,
72       I     vname )       I     vname,
73         I     irv,
74         I     myThid )
75    
76    C     !DESCRIPTION:
77    C     Create an integer variable within a NetCDF file context.
78      
79    C     !USES:
80        implicit none        implicit none
81  #include "netcdf.inc"  #include "netcdf.inc"
82    
83  C     Arguments  C     !INPUT PARAMETERS:
84        integer myThid        integer irv,myThid
85        character*(*) fname,gname,vname        character*(*) fname,gname,vname
86    CEOP
87    
88        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_INT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, irv,myThid)
89        RETURN        RETURN
90        END        END
91    
92  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
93    CBOP 1
94    C     !ROUTINE: MNC_VAR_INIT_ANY
95    
96    C     !INTERFACE:
97        SUBROUTINE MNC_VAR_INIT_ANY(        SUBROUTINE MNC_VAR_INIT_ANY(
      I     myThid,  
98       I     fname,       I     fname,
99       I     gname,       I     gname,
100       I     vname,       I     vname,
101       I     vtype )       I     vtype,
102         I     irv,
103         I     myThid )
104    
105    C     !DESCRIPTION:
106    C     General function for creating variables within a NetCDF file
107    C     context.
108          
109    C     !USES:
110        implicit none        implicit none
111  #include "netcdf.inc"  #include "netcdf.inc"
112  #include "mnc_common.h"  #include "mnc_common.h"
113  #include "EEPARAMS.h"  #include "EEPARAMS.h"
114    
115  C     Arguments  C     !INPUT PARAMETERS:
116        integer myThid        integer irv,myThid
117        character*(*) fname,gname,vname        character*(*) fname,gname,vname
118        integer vtype        integer vtype
119    CEOP
120    
121  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
122        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
123        integer vid, nv, ind_g_finfo, needed, nvar        integer vid, nv, ind_g_finfo, needed, nvar
124        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
125        integer ids(20)        integer ids(20)
126        integer lenf,leng,lenv        integer lenf,leng,lenv
127    
128    C     Functions
129          integer ILNBLNK
130    
131  C     Strip trailing spaces  C     Strip trailing spaces
132        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
133        leng = ILNBLNK(gname)        leng = ILNBLNK(gname)
134        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
135    
136  C     Check that the file is open  C     Check that the file is open
137        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)
138        IF (indf .LT. 1) THEN        IF (indf .LT. 1) THEN
139          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,
140       &       ''' must be opened first'       &       ''' must be opened first'
# Line 159  C     Check if the variable is already d Line 198  C     Check if the variable is already d
198              stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'              stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
199            ELSE            ELSE
200  C           Its OK, the variable and grid names are the same  C           Its OK, the variable and grid names are the same
201                irv = 0
202              RETURN              RETURN
203            ENDIF            ENDIF
204          ENDIF          ENDIF
205        ENDDO        ENDDO
206    
207          irv = 1
208    
209  C     Add the variable definition  C     Add the variable definition
210        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
211        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
212        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),        IF ( err .NE. NF_NOERR ) THEN
213            write(msgbuf,'(2a)') 'ERROR:  MNC will not ',
214         &       'overwrite variables in existing NetCDF'
215            CALL PRINT_ERROR( msgBuf, myThid )
216            write(msgbuf,'(2a)') '        files.  Please',
217         &       ' make sure that you are not trying to'
218            CALL PRINT_ERROR( msgBuf, myThid )
219            write(msgbuf,'(2a)') '        overwrite output',
220         &       'files from a previous model run!'
221            CALL PRINT_ERROR( msgBuf, myThid )
222            write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
223       &     ''' in file ''', fname(1:lenf), ''''       &     ''' in file ''', fname(1:lenf), ''''
224        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
225          ENDIF
226    
227  C     Success, so save the variable info  C     Success, so save the variable info
228        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,'mnc_v_names',
229         &     indv, myThid)
230        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
231        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
232        i = 2 + nv*3        i = 2 + nv*3
# Line 185  C     Success, so save the variable info Line 239  C     Success, so save the variable info
239        END        END
240    
241  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
242    CBOP 1
243    C     !ROUTINE: MNC_VAR_ADD_ATTR_STR
244    
245    C     !INTERFACE:
246        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
      I     myThid,  
247       I     fname,       I     fname,
248       I     vname,       I     vname,
249       I     atname,       I     atname,
250       I     sval )       I     sval,
251         I     myThid )
252    
253    C     !DESCRIPTION:
254    C     Subroutine for adding a character string attribute to a NetCDF
255    C     file.
256          
257    C     !USES:
258        implicit none        implicit none
259  C     Arguments  
260    C     !INPUT PARAMETERS:
261        integer myThid        integer myThid
262        character*(*) fname,vname,atname,sval        character*(*) fname,vname,atname,sval
263    CEOP
264          real*8 dZero(1)
265          real*4 sZero(1)
266          integer iZero(1)
267          dZero(1) = 0.0D0
268          sZero(1) = 0.0
269          iZero(1) = 0
270    
271        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
272       &     1, sval, 0, 0.0D0, 0.0, 0)       &     1, sval, 0, dZero, sZero, iZero, myThid)
273        RETURN        RETURN
274        END        END
275  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
276    CBOP 1
277    C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL
278    
279    C     !INTERFACE:
280        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
      I     myThid,  
281       I     fname,       I     fname,
282       I     vname,       I     vname,
283       I     atname,       I     atname,
284       I     nv,       I     nv,
285       I     dval )       I     dval,
286         I     myThid )
287    
288    C     !DESCRIPTION:
289    C     Subroutine for adding a double-precision real attribute to a
290    C     NetCDF file.
291      
292    C     !USES:
293        implicit none        implicit none
294  C     Arguments  
295    C     !INPUT PARAMETERS:
296        integer myThid,nv        integer myThid,nv
297        character*(*) fname,vname,atname        character*(*) fname,vname,atname
298        REAL*8 dval(*)        REAL*8 dval(*)
299    CEOP
300          real*4 sZero(1)
301          integer iZero(1)
302          sZero(1) = 0.0
303          iZero(1) = 0
304    
305        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
306       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, sZero, iZero, myThid)
307        RETURN        RETURN
308        END        END
309    
310  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
311    CBOP 1
312    C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL
313    
314    C     !INTERFACE:
315        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
      I     myThid,  
316       I     fname,       I     fname,
317       I     vname,       I     vname,
318       I     atname,       I     atname,
319       I     nv,       I     nv,
320       I     rval )       I     rval,
321         I     myThid )
322    
323    C     !DESCRIPTION:
324    C     Subroutine for adding a single-precision real attribute to a
325    C     NetCDF file.
326      
327    C     !USES:
328        implicit none        implicit none
329  C     Arguments  
330    C     !INPUT PARAMETERS:
331        integer myThid,nv        integer myThid,nv
332        character*(*) fname,vname,atname        character*(*) fname,vname,atname
333        REAL*4 rval(*)        REAL*4 rval(*)
334    CEOP
335          real*8 dZero(1)
336          integer iZero(1)
337          dZero(1) = 0.0D0
338          iZero(1) = 0
339    
340        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
341       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, dZero, rval, iZero, myThid)
342        RETURN        RETURN
343        END        END
344    
345  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
346    CBOP 1
347    C     !ROUTINE: MNC_VAR_ADD_ATTR_INT
348    
349    C     !INTERFACE:
350        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
      I     myThid,  
351       I     fname,       I     fname,
352       I     vname,       I     vname,
353       I     atname,       I     atname,
354       I     nv,       I     nv,
355       I     ival )       I     ival,
356         I     myThid )
357    
358    C     !DESCRIPTION:
359    C     Subroutine for adding an integer attribute to a
360    C     NetCDF file.
361          
362    C     !USES:
363        implicit none        implicit none
364  C     Arguments  
365    C     !INPUT PARAMETERS:
366        integer myThid,nv        integer myThid,nv
367        character*(*) fname,vname,atname        character*(*) fname,vname,atname
368        integer ival(*)        integer ival(*)
369    CEOP
370          real*8 dZero(1)
371          real*4 sZero(1)
372          dZero(1) = 0.0D0
373          sZero(1) = 0.0
374    
375        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
376       &     4, ' ', nv, 0.0D0, 0.0, ival)       &     4, ' ', nv, dZero, sZero, ival, myThid)
377        RETURN        RETURN
378        END        END
379    
380  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
381    CBOP 1
382    C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY
383    
384    C     !INTERFACE:
385        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
      I     myThid,  
386       I     fname,       I     fname,
387       I     vname,       I     vname,
388       I     atname,       I     atname,
389       I     atype, cs,len,dv,rv,iv )       I     atype, cs,len,dv,rv,iv,
390         I     myThid )
391    
392    C     !DESCRIPTION:
393    C     General subroutine for adding attributes to a NetCDF file.
394          
395    C     !USES:
396        implicit none        implicit none
397  #include "netcdf.inc"  #include "netcdf.inc"
398  #include "mnc_common.h"  #include "mnc_common.h"
399  #include "EEPARAMS.h"  #include "EEPARAMS.h"
400    
401  C     Arguments  C     !INPUT PARAMETERS:
402        integer myThid,atype,len        integer myThid,atype,len
403        character*(*) fname,vname,atname        character*(*) fname,vname,atname
404        character*(*) cs        character*(*) cs
405        REAL*8 dv(*)        REAL*8 dv(*)
406        REAL*4 rv(*)        REAL*4 rv(*)
407        integer iv(*)        integer iv(*)
408    CEOP
409    
410  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
411        integer n, indf,ind_fv_ids, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
412        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
413        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
414    
415    C     Functions
416          integer ILNBLNK
417    
418  C     Strip trailing spaces  C     Strip trailing spaces
419        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
420        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
421        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
422        lens = ILNBLNK(cs)        lens = ILNBLNK(cs)
423    
424        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
425        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
426          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
427       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 313  C     Strip trailing spaces Line 433  C     Strip trailing spaces
433        vid = mnc_fv_ids(indf,(ind_fv_ids+1))        vid = mnc_fv_ids(indf,(ind_fv_ids+1))
434    
435  C     Set the attribute  C     Set the attribute
436        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
437        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
438          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
439        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
# Line 331  C     Set the attribute Line 451  C     Set the attribute
451        ENDIF        ENDIF
452        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
453       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
454        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
455    
456        RETURN        RETURN
457        END        END
# Line 339  C     Set the attribute Line 459  C     Set the attribute
459  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
460    
461        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
      I     myThid,  
462       I     fname,       I     fname,
463       I     vname,       I     vname,
464       I     var )       I     var,
465         I     myThid )
466    
467        implicit none        implicit none
468  C     Arguments  C     Arguments
# Line 350  C     Arguments Line 470  C     Arguments
470        character*(*) fname,vname        character*(*) fname,vname
471        REAL*8 var(*)        REAL*8 var(*)
472    
473        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)
474        RETURN        RETURN
475        END        END
476    
477  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
478    
479        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
      I     myThid,  
480       I     fname,       I     fname,
481       I     vname,       I     vname,
482       I     var )       I     var,
483         I     myThid )
484    
485        implicit none        implicit none
486  C     Arguments  C     Arguments
# Line 368  C     Arguments Line 488  C     Arguments
488        character*(*) fname,vname        character*(*) fname,vname
489        REAL*4 var(*)        REAL*4 var(*)
490    
491        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)
492        RETURN        RETURN
493        END        END
494    
495  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
496    
497        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
      I     myThid,  
498       I     fname,       I     fname,
499       I     vname,       I     vname,
500       I     var )       I     var,
501         I     myThid )
502    
503        implicit none        implicit none
504  C     Arguments  C     Arguments
# Line 386  C     Arguments Line 506  C     Arguments
506        character*(*) fname,vname        character*(*) fname,vname
507        integer var(*)        integer var(*)
508    
509        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)
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_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
      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 405  C     Arguments Line 525  C     Arguments
525        character*(*) fname,vname        character*(*) fname,vname
526        REAL*8 var(*)        REAL*8 var(*)
527    
528        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)
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_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
      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 424  C     Arguments Line 544  C     Arguments
544        character*(*) fname,vname        character*(*) fname,vname
545        REAL*4 var(*)        REAL*4 var(*)
546    
547        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)
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_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
      I     myThid,  
554       I     fname,       I     fname,
555       I     vname,       I     vname,
556       I     var,       I     var,
557       I     append )       I     append,
558         I     myThid )
559    
560        implicit none        implicit none
561  C     Arguments  C     Arguments
# Line 443  C     Arguments Line 563  C     Arguments
563        character*(*) fname,vname        character*(*) fname,vname
564        integer var(*)        integer var(*)
565    
566        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)
567        RETURN        RETURN
568        END        END
569    
570  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
571    
572        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
      I     myThid,  
573       I     fname,       I     fname,
574       I     vname,       I     vname,
575       I     vtype,       I     vtype,
576       I     append,       I     append,
577       I     dv,       I     dv,
578       I     rv,       I     rv,
579       I     iv )       I     iv,
580         I     myThid )
581    
582        implicit none        implicit none
583  #include "netcdf.inc"  #include "netcdf.inc"
# Line 485  C     Strip trailing spaces Line 605  C     Strip trailing spaces
605        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
606        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
607    
608        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
609        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
610          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
611       &       ''' 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 633  C     Check for the unlimited dimension
633          did = mnc_d_ids( mnc_fd_ind(indf,de) )          did = mnc_d_ids( mnc_fd_ind(indf,de) )
634          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
635          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
636          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
637          IF (append .GT. 0) THEN          IF (append .GT. 0) THEN
638            lend = lend + append            lend = lend + append
639          ENDIF          ENDIF
# Line 522  C     Check for the unlimited dimension Line 642  C     Check for the unlimited dimension
642          vcount(k) = 1          vcount(k) = 1
643        ENDIF        ENDIF
644    
645        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(fname, myThid)
646        IF (vtype .EQ. 1) THEN        IF (vtype .EQ. 1) THEN
647          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
648        ELSEIF (vtype .EQ. 2) THEN        ELSEIF (vtype .EQ. 2) THEN
# Line 538  C     Check for the unlimited dimension Line 658  C     Check for the unlimited dimension
658        ENDIF          ENDIF  
659        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
660       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
661        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
662    
663        RETURN        RETURN
664        END        END
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22