/[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.19 by edhill, Fri Feb 24 20:39:10 2006 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 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     units )       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,units        character*(*) fname,gname,vname
29    CEOP
30    
31        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, irv,myThid)
32        RETURN        RETURN
33        END        END
34    
35  C==================================================================  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     units )       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,units        character*(*) fname,gname,vname
58    CEOP
59    
60        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, irv,myThid)
61        RETURN        RETURN
62        END        END
63    
64  C==================================================================  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     units )       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,units        character*(*) fname,gname,vname
86    CEOP
87    
88        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, irv,myThid)
89        RETURN        RETURN
90        END        END
91    
92  C==================================================================  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     units,       I     vtype,
102       I     vtype )       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,units        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        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,lenu        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)
       lenu = ILNBLNK(units)  
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 150  C     Get the grid information Line 184  C     Get the grid information
184        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
185   10   CONTINUE   10   CONTINUE
186    
187    C     Check if the variable is already defined
188          nvar = mnc_fv_ids(indf,1)
189          DO i = 1,nvar
190            j = 2 + 3*(i-1)
191            IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vname) THEN
192              k = mnc_f_info(indf,mnc_fv_ids(indf,j+2))
193              IF (mnc_g_names(k) .NE. gname) THEN
194                write(msgbuf,'(5a)') 'MNC ERROR: variable ''',
195         &           vname(1:lenv), ''' is already defined in file ''',
196         &           fname(1:lenf), ''' but using a different grid shape'
197                CALL print_error(msgbuf, mythid)
198                stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
199              ELSE
200    C           Its OK, the variable and grid names are the same
201                irv = 0
202                RETURN
203              ENDIF
204            ENDIF
205          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,indv, myThid)
229        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
230        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
231        i = 2 + nv*3        i = 2 + nv*3
# Line 167  C     Success, so save the variable info Line 234  C     Success, so save the variable info
234        mnc_fv_ids(indf,i+2) = ind_g_finfo        mnc_fv_ids(indf,i+2) = ind_g_finfo
235        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
236    
 C     Add the units  
       CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)  
   
237        RETURN        RETURN
238        END        END
239    
240  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
241    CBOP 1
242    C     !ROUTINE: MNC_VAR_ADD_ATTR_STR
243    
244    C     !INTERFACE:
245        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
      I     myThid,  
246       I     fname,       I     fname,
247       I     vname,       I     vname,
248       I     atname,       I     atname,
249       I     sval )       I     sval,
250         I     myThid )
251    
252    C     !DESCRIPTION:
253    C     Subroutine for adding a character string attribute to a NetCDF
254    C     file.
255          
256    C     !USES:
257        implicit none        implicit none
258  C     Arguments  
259    C     !INPUT PARAMETERS:
260        integer myThid        integer myThid
261        character*(*) fname,vname,atname,sval        character*(*) fname,vname,atname,sval
262    CEOP
263          real*8 dZero(1)
264          real*4 sZero(1)
265          integer iZero(1)
266          dZero(1) = 0.0D0
267          sZero(1) = 0.0
268          iZero(1) = 0
269    
270          CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
271         &     1, sval, 0, dZero, sZero, iZero, myThid)
272          RETURN
273          END
274    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
275    CBOP 1
276    C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL
277    
278        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,  C     !INTERFACE:
      &     1, sval, 0, 0.0D0, 0.0, 0)  
       RETURN  
       END  
 C==================================================================  
   
279        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
      I     myThid,  
280       I     fname,       I     fname,
281       I     vname,       I     vname,
282       I     atname,       I     atname,
283       I     nv,       I     nv,
284       I     dval )       I     dval,
285         I     myThid )
286    
287    C     !DESCRIPTION:
288    C     Subroutine for adding a double-precision real attribute to a
289    C     NetCDF file.
290      
291    C     !USES:
292        implicit none        implicit none
293  C     Arguments  
294    C     !INPUT PARAMETERS:
295        integer myThid,nv        integer myThid,nv
296        character*(*) fname,vname,atname        character*(*) fname,vname,atname
297        REAL*8 dval(*)        REAL*8 dval(*)
298    CEOP
299          real*4 sZero(1)
300          integer iZero(1)
301          sZero(1) = 0.0
302          iZero(1) = 0
303    
304        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
305       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, sZero, iZero, myThid)
306        RETURN        RETURN
307        END        END
308    
309  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
310    CBOP 1
311    C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL
312    
313    C     !INTERFACE:
314        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
      I     myThid,  
315       I     fname,       I     fname,
316       I     vname,       I     vname,
317       I     atname,       I     atname,
318       I     nv,       I     nv,
319       I     rval )       I     rval,
320         I     myThid )
321    
322    C     !DESCRIPTION:
323    C     Subroutine for adding a single-precision real attribute to a
324    C     NetCDF file.
325      
326    C     !USES:
327        implicit none        implicit none
328  C     Arguments  
329    C     !INPUT PARAMETERS:
330        integer myThid,nv        integer myThid,nv
331        character*(*) fname,vname,atname        character*(*) fname,vname,atname
332        REAL*4 rval(*)        REAL*4 rval(*)
333    CEOP
334          real*8 dZero(1)
335          integer iZero(1)
336          dZero(1) = 0.0D0
337          iZero(1) = 0
338    
339        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
340       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, dZero, rval, iZero, myThid)
341        RETURN        RETURN
342        END        END
343    
344  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
345    CBOP 1
346    C     !ROUTINE: MNC_VAR_ADD_ATTR_INT
347    
348    C     !INTERFACE:
349        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
      I     myThid,  
350       I     fname,       I     fname,
351       I     vname,       I     vname,
352       I     atname,       I     atname,
353       I     nv,       I     nv,
354       I     ival )       I     ival,
355         I     myThid )
356    
357    C     !DESCRIPTION:
358    C     Subroutine for adding an integer attribute to a
359    C     NetCDF file.
360          
361    C     !USES:
362        implicit none        implicit none
363  C     Arguments  
364    C     !INPUT PARAMETERS:
365        integer myThid,nv        integer myThid,nv
366        character*(*) fname,vname,atname        character*(*) fname,vname,atname
367        integer ival(*)        integer ival(*)
368    CEOP
369          real*8 dZero(1)
370          real*4 sZero(1)
371          dZero(1) = 0.0D0
372          sZero(1) = 0.0
373    
374        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
375       &     4, ' ', nv, 0.0D0, 0.0, ival)       &     4, ' ', nv, dZero, sZero, ival, myThid)
376        RETURN        RETURN
377        END        END
378    
379  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
380    CBOP 1
381    C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY
382    
383    C     !INTERFACE:
384        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
      I     myThid,  
385       I     fname,       I     fname,
386       I     vname,       I     vname,
387       I     atname,       I     atname,
388       I     atype, cs,len,dv,rv,iv )       I     atype, cs,len,dv,rv,iv,
389         I     myThid )
390    
391    C     !DESCRIPTION:
392    C     General subroutine for adding attributes to a NetCDF file.
393          
394    C     !USES:
395        implicit none        implicit none
396  #include "netcdf.inc"  #include "netcdf.inc"
397  #include "mnc_common.h"  #include "mnc_common.h"
398  #include "EEPARAMS.h"  #include "EEPARAMS.h"
399    
400  C     Arguments  C     !INPUT PARAMETERS:
401        integer myThid,atype,len        integer myThid,atype,len
402        character*(*) fname,vname,atname        character*(*) fname,vname,atname
403        character*(*) cs        character*(*) cs
404        REAL*8 dv(*)        REAL*8 dv(*)
405        REAL*4 rv(*)        REAL*4 rv(*)
406        integer iv(*)        integer iv(*)
407    CEOP
408    
409  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
410        integer n, indf,ind_fv_ids, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
411        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
412        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
413    
414    C     Functions
415          integer ILNBLNK
416    
417  C     Strip trailing spaces  C     Strip trailing spaces
418        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
419        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
420        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
421        lens = ILNBLNK(cs)        lens = ILNBLNK(cs)
422    
423        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
424        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
425          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
426       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 302  C     Strip trailing spaces Line 432  C     Strip trailing spaces
432        vid = mnc_fv_ids(indf,(ind_fv_ids+1))        vid = mnc_fv_ids(indf,(ind_fv_ids+1))
433    
434  C     Set the attribute  C     Set the attribute
435        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
436        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
437          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
438        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
# Line 320  C     Set the attribute Line 450  C     Set the attribute
450        ENDIF        ENDIF
451        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
452       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
453        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
454    
455        RETURN        RETURN
456        END        END
457    
458  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
459    
460        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
      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 339  C     Arguments Line 469  C     Arguments
469        character*(*) fname,vname        character*(*) fname,vname
470        REAL*8 var(*)        REAL*8 var(*)
471    
472        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)
473        RETURN        RETURN
474        END        END
475    
476  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
477    
478        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
      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 357  C     Arguments Line 487  C     Arguments
487        character*(*) fname,vname        character*(*) fname,vname
488        REAL*4 var(*)        REAL*4 var(*)
489    
490        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)
491        RETURN        RETURN
492        END        END
493    
494  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
495    
496        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
      I     myThid,  
497       I     fname,       I     fname,
498       I     vname,       I     vname,
499       I     var )       I     var,
500         I     myThid )
501    
502        implicit none        implicit none
503  C     Arguments  C     Arguments
# Line 375  C     Arguments Line 505  C     Arguments
505        character*(*) fname,vname        character*(*) fname,vname
506        integer var(*)        integer var(*)
507    
508        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)
509        RETURN        RETURN
510        END        END
511    
512  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
513    
514        SUBROUTINE MNC_VAR_APPEND_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
      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 394  C     Arguments Line 524  C     Arguments
524        character*(*) fname,vname        character*(*) fname,vname
525        REAL*8 var(*)        REAL*8 var(*)
526    
527        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)
528        RETURN        RETURN
529        END        END
530    
531  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
532    
533        SUBROUTINE MNC_VAR_APPEND_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
      I     myThid,  
534       I     fname,       I     fname,
535       I     vname,       I     vname,
536       I     var,       I     var,
537       I     append )       I     append,
538         I     myThid )
539    
540        implicit none        implicit none
541  C     Arguments  C     Arguments
# Line 413  C     Arguments Line 543  C     Arguments
543        character*(*) fname,vname        character*(*) fname,vname
544        REAL*4 var(*)        REAL*4 var(*)
545    
546        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)
547        RETURN        RETURN
548        END        END
549    
550  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
551    
552        SUBROUTINE MNC_VAR_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
      I     myThid,  
553       I     fname,       I     fname,
554       I     vname,       I     vname,
555       I     var,       I     var,
556       I     append )       I     append,
557         I     myThid )
558    
559        implicit none        implicit none
560  C     Arguments  C     Arguments
# Line 432  C     Arguments Line 562  C     Arguments
562        character*(*) fname,vname        character*(*) fname,vname
563        integer var(*)        integer var(*)
564    
565        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)
566        RETURN        RETURN
567        END        END
568    
569  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
570    
571        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
      I     myThid,  
572       I     fname,       I     fname,
573       I     vname,       I     vname,
574       I     vtype,       I     vtype,
575       I     append,       I     append,
576       I     dv,       I     dv,
577       I     rv,       I     rv,
578       I     iv )       I     iv,
579         I     myThid )
580    
581        implicit none        implicit none
582  #include "netcdf.inc"  #include "netcdf.inc"
# Line 474  C     Strip trailing spaces Line 604  C     Strip trailing spaces
604        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
605        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
606    
607        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
608        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
609          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
610       &       ''' 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 632  C     Check for the unlimited dimension
632          did = mnc_d_ids( mnc_fd_ind(indf,de) )          did = mnc_d_ids( mnc_fd_ind(indf,de) )
633          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
634          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
635          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
636          IF (append .GT. 0) THEN          IF (append .GT. 0) THEN
637            lend = lend + append            lend = lend + append
638          ENDIF          ENDIF
# Line 511  C     Check for the unlimited dimension Line 641  C     Check for the unlimited dimension
641          vcount(k) = 1          vcount(k) = 1
642        ENDIF        ENDIF
643    
644        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(fname, myThid)
645        IF (vtype .EQ. 1) THEN        IF (vtype .EQ. 1) THEN
646          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
647        ELSEIF (vtype .EQ. 2) THEN        ELSEIF (vtype .EQ. 2) THEN
# Line 527  C     Check for the unlimited dimension Line 657  C     Check for the unlimited dimension
657        ENDIF          ENDIF  
658        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
659       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
660        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
661    
662        RETURN        RETURN
663        END        END
664    
665    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
666    
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22