/[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.18 by edhill, Sun Dec 26 15:24:50 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),        IF ( err .NE. NF_NOERR ) THEN
206            write(msgbuf,'(2a)') 'ERROR:  MNC will not ',
207         &       'overwrite variables in existing NetCDF'
208            CALL PRINT_ERROR( msgBuf, myThid )
209            write(msgbuf,'(2a)') '        files.  Please',
210         &       ' make sure that you are not trying to'
211            CALL PRINT_ERROR( msgBuf, myThid )
212            write(msgbuf,'(2a)') '        overwrite output',
213         &       'files from a previous model run!'
214            CALL PRINT_ERROR( msgBuf, myThid )
215            write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
216       &     ''' in file ''', fname(1:lenf), ''''       &     ''' in file ''', fname(1:lenf), ''''
217        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
218          ENDIF
219    
220  C     Success, so save the variable info  C     Success, so save the variable info
221        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)
222        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
223        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
224        i = 2 + nv*3        i = 2 + nv*3
# Line 185  C     Success, so save the variable info Line 231  C     Success, so save the variable info
231        END        END
232    
233  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
234    CBOP 1
235    C     !ROUTINE: MNC_VAR_ADD_ATTR_STR
236    
237    C     !INTERFACE:
238        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
      I     myThid,  
239       I     fname,       I     fname,
240       I     vname,       I     vname,
241       I     atname,       I     atname,
242       I     sval )       I     sval,
243         I     myThid )
244    
245    C     !DESCRIPTION:
246    C     Subroutine for adding a character string attribute to a NetCDF
247    C     file.
248          
249    C     !USES:
250        implicit none        implicit none
251  C     Arguments  
252    C     !INPUT PARAMETERS:
253        integer myThid        integer myThid
254        character*(*) fname,vname,atname,sval        character*(*) fname,vname,atname,sval
255    CEOP
256          real*8 dZero(1)
257          real*4 sZero(1)
258          integer iZero(1)
259          dZero(1) = 0.0D0
260          sZero(1) = 0.0
261          iZero(1) = 0
262    
263        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
264       &     1, sval, 0, 0.0D0, 0.0, 0)       &     1, sval, 0, dZero, sZero, iZero, myThid)
265        RETURN        RETURN
266        END        END
267  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
268    CBOP 1
269    C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL
270    
271    C     !INTERFACE:
272        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
      I     myThid,  
273       I     fname,       I     fname,
274       I     vname,       I     vname,
275       I     atname,       I     atname,
276       I     nv,       I     nv,
277       I     dval )       I     dval,
278         I     myThid )
279    
280    C     !DESCRIPTION:
281    C     Subroutine for adding a double-precision real attribute to a
282    C     NetCDF file.
283      
284    C     !USES:
285        implicit none        implicit none
286  C     Arguments  
287    C     !INPUT PARAMETERS:
288        integer myThid,nv        integer myThid,nv
289        character*(*) fname,vname,atname        character*(*) fname,vname,atname
290        REAL*8 dval(*)        REAL*8 dval(*)
291    CEOP
292          real*4 sZero(1)
293          integer iZero(1)
294          sZero(1) = 0.0
295          iZero(1) = 0
296    
297        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
298       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, sZero, iZero, myThid)
299        RETURN        RETURN
300        END        END
301    
302  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
303    CBOP 1
304    C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL
305    
306    C     !INTERFACE:
307        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
      I     myThid,  
308       I     fname,       I     fname,
309       I     vname,       I     vname,
310       I     atname,       I     atname,
311       I     nv,       I     nv,
312       I     rval )       I     rval,
313         I     myThid )
314    
315    C     !DESCRIPTION:
316    C     Subroutine for adding a single-precision real attribute to a
317    C     NetCDF file.
318      
319    C     !USES:
320        implicit none        implicit none
321  C     Arguments  
322    C     !INPUT PARAMETERS:
323        integer myThid,nv        integer myThid,nv
324        character*(*) fname,vname,atname        character*(*) fname,vname,atname
325        REAL*4 rval(*)        REAL*4 rval(*)
326    CEOP
327          real*8 dZero(1)
328          integer iZero(1)
329          dZero(1) = 0.0D0
330          iZero(1) = 0
331    
332        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
333       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, dZero, rval, iZero, myThid)
334        RETURN        RETURN
335        END        END
336    
337  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
338    CBOP 1
339    C     !ROUTINE: MNC_VAR_ADD_ATTR_INT
340    
341    C     !INTERFACE:
342        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
      I     myThid,  
343       I     fname,       I     fname,
344       I     vname,       I     vname,
345       I     atname,       I     atname,
346       I     nv,       I     nv,
347       I     ival )       I     ival,
348         I     myThid )
349    
350    C     !DESCRIPTION:
351    C     Subroutine for adding an integer attribute to a
352    C     NetCDF file.
353          
354    C     !USES:
355        implicit none        implicit none
356  C     Arguments  
357    C     !INPUT PARAMETERS:
358        integer myThid,nv        integer myThid,nv
359        character*(*) fname,vname,atname        character*(*) fname,vname,atname
360        integer ival(*)        integer ival(*)
361    CEOP
362          real*8 dZero(1)
363          real*4 sZero(1)
364          dZero(1) = 0.0D0
365          sZero(1) = 0.0
366    
367        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
368       &     4, ' ', nv, 0.0D0, 0.0, ival)       &     4, ' ', nv, dZero, sZero, ival, myThid)
369        RETURN        RETURN
370        END        END
371    
372  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
373    CBOP 1
374    C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY
375    
376    C     !INTERFACE:
377        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
      I     myThid,  
378       I     fname,       I     fname,
379       I     vname,       I     vname,
380       I     atname,       I     atname,
381       I     atype, cs,len,dv,rv,iv )       I     atype, cs,len,dv,rv,iv,
382         I     myThid )
383    
384    C     !DESCRIPTION:
385    C     General subroutine for adding attributes to a NetCDF file.
386          
387    C     !USES:
388        implicit none        implicit none
389  #include "netcdf.inc"  #include "netcdf.inc"
390  #include "mnc_common.h"  #include "mnc_common.h"
391  #include "EEPARAMS.h"  #include "EEPARAMS.h"
392    
393  C     Arguments  C     !INPUT PARAMETERS:
394        integer myThid,atype,len        integer myThid,atype,len
395        character*(*) fname,vname,atname        character*(*) fname,vname,atname
396        character*(*) cs        character*(*) cs
397        REAL*8 dv(*)        REAL*8 dv(*)
398        REAL*4 rv(*)        REAL*4 rv(*)
399        integer iv(*)        integer iv(*)
400    CEOP
401    
402  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
403        integer n, indf,ind_fv_ids, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
404        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
405        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
406    
407    C     Functions
408          integer ILNBLNK
409    
410  C     Strip trailing spaces  C     Strip trailing spaces
411        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
412        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
413        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
414        lens = ILNBLNK(cs)        lens = ILNBLNK(cs)
415    
416        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
417        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
418          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
419       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 313  C     Strip trailing spaces Line 425  C     Strip trailing spaces
425        vid = mnc_fv_ids(indf,(ind_fv_ids+1))        vid = mnc_fv_ids(indf,(ind_fv_ids+1))
426    
427  C     Set the attribute  C     Set the attribute
428        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
429        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
430          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
431        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
# Line 331  C     Set the attribute Line 443  C     Set the attribute
443        ENDIF        ENDIF
444        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
445       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
446        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
447    
448        RETURN        RETURN
449        END        END
# Line 339  C     Set the attribute Line 451  C     Set the attribute
451  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
452    
453        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
      I     myThid,  
454       I     fname,       I     fname,
455       I     vname,       I     vname,
456       I     var )       I     var,
457         I     myThid )
458    
459        implicit none        implicit none
460  C     Arguments  C     Arguments
# Line 350  C     Arguments Line 462  C     Arguments
462        character*(*) fname,vname        character*(*) fname,vname
463        REAL*8 var(*)        REAL*8 var(*)
464    
465        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)
466        RETURN        RETURN
467        END        END
468    
469  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
470    
471        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
      I     myThid,  
472       I     fname,       I     fname,
473       I     vname,       I     vname,
474       I     var )       I     var,
475         I     myThid )
476    
477        implicit none        implicit none
478  C     Arguments  C     Arguments
# Line 368  C     Arguments Line 480  C     Arguments
480        character*(*) fname,vname        character*(*) fname,vname
481        REAL*4 var(*)        REAL*4 var(*)
482    
483        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)
484        RETURN        RETURN
485        END        END
486    
487  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
488    
489        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
      I     myThid,  
490       I     fname,       I     fname,
491       I     vname,       I     vname,
492       I     var )       I     var,
493         I     myThid )
494    
495        implicit none        implicit none
496  C     Arguments  C     Arguments
# Line 386  C     Arguments Line 498  C     Arguments
498        character*(*) fname,vname        character*(*) fname,vname
499        integer var(*)        integer var(*)
500    
501        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)
502        RETURN        RETURN
503        END        END
504    
505  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
506    
507        SUBROUTINE MNC_VAR_APPEND_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
      I     myThid,  
508       I     fname,       I     fname,
509       I     vname,       I     vname,
510       I     var,       I     var,
511       I     append )       I     append,
512         I     myThid )
513    
514        implicit none        implicit none
515  C     Arguments  C     Arguments
# Line 405  C     Arguments Line 517  C     Arguments
517        character*(*) fname,vname        character*(*) fname,vname
518        REAL*8 var(*)        REAL*8 var(*)
519    
520        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)
521        RETURN        RETURN
522        END        END
523    
524  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
525    
526        SUBROUTINE MNC_VAR_APPEND_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
      I     myThid,  
527       I     fname,       I     fname,
528       I     vname,       I     vname,
529       I     var,       I     var,
530       I     append )       I     append,
531         I     myThid )
532    
533        implicit none        implicit none
534  C     Arguments  C     Arguments
# Line 424  C     Arguments Line 536  C     Arguments
536        character*(*) fname,vname        character*(*) fname,vname
537        REAL*4 var(*)        REAL*4 var(*)
538    
539        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)
540        RETURN        RETURN
541        END        END
542    
543  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
544    
545        SUBROUTINE MNC_VAR_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
      I     myThid,  
546       I     fname,       I     fname,
547       I     vname,       I     vname,
548       I     var,       I     var,
549       I     append )       I     append,
550         I     myThid )
551    
552        implicit none        implicit none
553  C     Arguments  C     Arguments
# Line 443  C     Arguments Line 555  C     Arguments
555        character*(*) fname,vname        character*(*) fname,vname
556        integer var(*)        integer var(*)
557    
558        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)
559        RETURN        RETURN
560        END        END
561    
562  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
563    
564        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
      I     myThid,  
565       I     fname,       I     fname,
566       I     vname,       I     vname,
567       I     vtype,       I     vtype,
568       I     append,       I     append,
569       I     dv,       I     dv,
570       I     rv,       I     rv,
571       I     iv )       I     iv,
572         I     myThid )
573    
574        implicit none        implicit none
575  #include "netcdf.inc"  #include "netcdf.inc"
# Line 485  C     Strip trailing spaces Line 597  C     Strip trailing spaces
597        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
598        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
599    
600        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
601        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
602          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
603       &       ''' 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 625  C     Check for the unlimited dimension
625          did = mnc_d_ids( mnc_fd_ind(indf,de) )          did = mnc_d_ids( mnc_fd_ind(indf,de) )
626          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
627          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
628          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
629          IF (append .GT. 0) THEN          IF (append .GT. 0) THEN
630            lend = lend + append            lend = lend + append
631          ENDIF          ENDIF
# Line 522  C     Check for the unlimited dimension Line 634  C     Check for the unlimited dimension
634          vcount(k) = 1          vcount(k) = 1
635        ENDIF        ENDIF
636    
637        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(fname, myThid)
638        IF (vtype .EQ. 1) THEN        IF (vtype .EQ. 1) THEN
639          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
640        ELSEIF (vtype .EQ. 2) THEN        ELSEIF (vtype .EQ. 2) THEN
# Line 538  C     Check for the unlimited dimension Line 650  C     Check for the unlimited dimension
650        ENDIF          ENDIF  
651        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
652       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
653        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
654    
655        RETURN        RETURN
656        END        END
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22