/[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.9 by edhill, Sun Jan 18 23:23:15 2004 UTC revision 1.16 by edhill, Fri Apr 2 16:12:48 2004 UTC
# Line 3  C $Name$ Line 3  C $Name$
3                
4  #include "MNC_OPTIONS.h"  #include "MNC_OPTIONS.h"
5                
6  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    CBOP 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     myThid )
16    
17    C     !DESCRIPTION:
18    C     Create a double-precision real variable within a NetCDF file
19    C     context.
20          
21    C     !USES:
22        implicit none        implicit none
23  #include "netcdf.inc"  #include "netcdf.inc"
24    
25  C     Arguments  C     !INPUT PARAMETERS:
26        integer myThid        integer myThid
27        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
28    CEOP
29    
30        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, myThid)
31        RETURN        RETURN
32        END        END
33    
34  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
35    CBOP 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     units )       I     myThid )
44    
45    C     !DESCRIPTION:
46    C     Create a single-precision real variable within a NetCDF file
47    C     context.
48          
49    C     !USES:
50        implicit none        implicit none
51  #include "netcdf.inc"  #include "netcdf.inc"
52    
53  C     Arguments  C     !INPUT PARAMETERS:
54        integer myThid        integer myThid
55        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
56    CEOP
57    
58        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, myThid)
59        RETURN        RETURN
60        END        END
61    
62  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
63    CBOP 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     units )       I     myThid )
72    
73    C     !DESCRIPTION:
74    C     Create an integer variable within a NetCDF file context.
75      
76    C     !USES:
77        implicit none        implicit none
78  #include "netcdf.inc"  #include "netcdf.inc"
79    
80  C     Arguments  C     !INPUT PARAMETERS:
81        integer myThid        integer myThid
82        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
83    CEOP
84    
85        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, myThid)
86        RETURN        RETURN
87        END        END
88    
89  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
90    CBOP 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     units,       I     vtype,
99       I     vtype )       I     myThid )
100    
101    C     !DESCRIPTION:
102    C     General function for creating variables within a NetCDF file
103    C     context.
104          
105    C     !USES:
106        implicit none        implicit none
107  #include "netcdf.inc"  #include "netcdf.inc"
108  #include "mnc_common.h"  #include "mnc_common.h"
109  #include "EEPARAMS.h"  #include "EEPARAMS.h"
110    
111  C     Arguments  C     !INPUT PARAMETERS:
112        integer myThid        integer myThid
113        character*(*) fname,gname,vname,units        character*(*) fname,gname,vname
114        integer vtype        integer vtype
115    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        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,lenu        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)
       lenu = ILNBLNK(units)  
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 139  C     Get the grid information Line 169  C     Get the grid information
169            nd = 0            nd = 0
170            DO k = is,ie            DO k = is,ie
171              nd = nd + 1              nd = nd + 1
172              ids(nd) = mnc_fg_ids(indf,k)              ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
173            ENDDO            ENDDO
174            GOTO 10            GOTO 10
175          ENDIF          ENDIF
# Line 150  C     Get the grid information Line 180  C     Get the grid information
180        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
181   10   CONTINUE   10   CONTINUE
182    
183    C     Check if the variable is already defined
184          nvar = mnc_fv_ids(indf,1)
185          DO i = 1,nvar
186            j = 2 + 3*(i-1)
187            IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vname) THEN
188              k = mnc_f_info(indf,mnc_fv_ids(indf,j+2))
189              IF (mnc_g_names(k) .NE. gname) THEN
190                write(msgbuf,'(5a)') 'MNC ERROR: variable ''',
191         &           vname(1:lenv), ''' is already defined in file ''',
192         &           fname(1:lenf), ''' but using a different grid shape'
193                CALL print_error(msgbuf, mythid)
194                stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
195              ELSE
196    C           Its OK, the variable and grid names are the same
197                RETURN
198              ENDIF
199            ENDIF
200          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
214        j = i + 1        mnc_fv_ids(indf,i)   = indv
215        k = i + 2        mnc_fv_ids(indf,i+1) = vid
216        mnc_fv_ids(indf,i) = indv        mnc_fv_ids(indf,i+2) = ind_g_finfo
       mnc_fv_ids(indf,j) = vid  
       mnc_fv_ids(indf,k) = ind_g_finfo  
217        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
218    
 C     Add the units  
       CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)  
   
219        RETURN        RETURN
220        END        END
221    
222  C==================================================================  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    
246        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
247       &     1, sval, 0, 0.0D0, 0.0, 0)       &     1, sval, 0, 0.0D0, 0.0, 0, myThid)
248        RETURN        RETURN
249        END        END
250  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
251    CBOP 1
252    C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL
253    
254    C     !INTERFACE:
255        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
      I     myThid,  
256       I     fname,       I     fname,
257       I     vname,       I     vname,
258       I     atname,       I     atname,
259       I     nv,       I     nv,
260       I     dval )       I     dval,
261         I     myThid )
262    
263    C     !DESCRIPTION:
264    C     Subroutine for adding a double-precision real attribute to a
265    C     NetCDF file.
266      
267    C     !USES:
268        implicit none        implicit none
269  C     Arguments  
270    C     !INPUT PARAMETERS:
271        integer myThid,nv        integer myThid,nv
272        character*(*) fname,vname,atname        character*(*) fname,vname,atname
273        REAL*8 dval(*)        REAL*8 dval(*)
274    CEOP
275    
276        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
277       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, 0.0, 0, myThid)
278        RETURN        RETURN
279        END        END
280    
281  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
282    CBOP 1
283    C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL
284    
285    C     !INTERFACE:
286        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
      I     myThid,  
287       I     fname,       I     fname,
288       I     vname,       I     vname,
289       I     atname,       I     atname,
290       I     nv,       I     nv,
291       I     rval )       I     rval,
292         I     myThid )
293    
294    C     !DESCRIPTION:
295    C     Subroutine for adding a single-precision real attribute to a
296    C     NetCDF file.
297      
298    C     !USES:
299        implicit none        implicit none
300  C     Arguments  
301    C     !INPUT PARAMETERS:
302        integer myThid,nv        integer myThid,nv
303        character*(*) fname,vname,atname        character*(*) fname,vname,atname
304        REAL*4 rval(*)        REAL*4 rval(*)
305    CEOP
306    
307        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
308       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, 0.0D0, rval, 0, myThid)
309        RETURN        RETURN
310        END        END
311    
312  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
313    CBOP 1
314    C     !ROUTINE: MNC_VAR_ADD_ATTR_INT
315    
316    C     !INTERFACE:
317        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
      I     myThid,  
318       I     fname,       I     fname,
319       I     vname,       I     vname,
320       I     atname,       I     atname,
321       I     nv,       I     nv,
322       I     ival )       I     ival,
323         I     myThid )
324    
325    C     !DESCRIPTION:
326    C     Subroutine for adding an integer attribute to a
327    C     NetCDF file.
328          
329    C     !USES:
330        implicit none        implicit none
331  C     Arguments  
332    C     !INPUT PARAMETERS:
333        integer myThid,nv        integer myThid,nv
334        character*(*) fname,vname,atname        character*(*) fname,vname,atname
335        integer ival(*)        integer ival(*)
336    CEOP
337    
338        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
339       &     4, ' ', nv, 0.0D0, 0.0, ival)       &     4, ' ', nv, 0.0D0, 0.0, ival, myThid)
340        RETURN        RETURN
341        END        END
342    
343  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
344    CBOP 1
345    C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY
346    
347    C     !INTERFACE:
348        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
      I     myThid,  
349       I     fname,       I     fname,
350       I     vname,       I     vname,
351       I     atname,       I     atname,
352       I     atype, cs,len,dv,rv,iv )       I     atype, cs,len,dv,rv,iv,
353         I     myThid )
354    
355    C     !DESCRIPTION:
356    C     General subroutine for adding attributes to a NetCDF file.
357          
358    C     !USES:
359        implicit none        implicit none
360  #include "netcdf.inc"  #include "netcdf.inc"
361  #include "mnc_common.h"  #include "mnc_common.h"
362  #include "EEPARAMS.h"  #include "EEPARAMS.h"
363    
364  C     Arguments  C     !INPUT PARAMETERS:
365        integer myThid,atype,len        integer myThid,atype,len
366        character*(*) fname,vname,atname        character*(*) fname,vname,atname
367        character*(*) cs        character*(*) cs
368        REAL*8 dv(*)        REAL*8 dv(*)
369        REAL*4 rv(*)        REAL*4 rv(*)
370        integer iv(*)        integer iv(*)
371    CEOP
372    
373  C     Functions  C     !LOCAL VARIABLES:
       integer ILNBLNK  
   
 C     Local Variables  
374        integer n, indf,ind_fv_ids, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
375        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
376        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
377    
378    C     Functions
379          integer ILNBLNK
380    
381  C     Strip trailing spaces  C     Strip trailing spaces
382        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
383        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
384        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
385        lens = ILNBLNK(cs)        lens = ILNBLNK(cs)
386    
387        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
388        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
389          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
390       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 304  C     Strip trailing spaces Line 396  C     Strip trailing spaces
396        vid = mnc_fv_ids(indf,(ind_fv_ids+1))        vid = mnc_fv_ids(indf,(ind_fv_ids+1))
397    
398  C     Set the attribute  C     Set the attribute
399        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
400        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
401          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
402        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
# Line 322  C     Set the attribute Line 414  C     Set the attribute
414        ENDIF        ENDIF
415        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
416       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
417        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
418    
419        RETURN        RETURN
420        END        END
421    
422  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
423    
424        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
      I     myThid,  
425       I     fname,       I     fname,
426       I     vname,       I     vname,
427       I     var )       I     var,
428         I     myThid )
429    
430        implicit none        implicit none
431  C     Arguments  C     Arguments
# Line 341  C     Arguments Line 433  C     Arguments
433        character*(*) fname,vname        character*(*) fname,vname
434        REAL*8 var(*)        REAL*8 var(*)
435    
436        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)
437        RETURN        RETURN
438        END        END
439    
440  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
441    
442        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
      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 359  C     Arguments Line 451  C     Arguments
451        character*(*) fname,vname        character*(*) fname,vname
452        REAL*4 var(*)        REAL*4 var(*)
453    
454        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)
455        RETURN        RETURN
456        END        END
457    
458  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
459    
460        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
      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 377  C     Arguments Line 469  C     Arguments
469        character*(*) fname,vname        character*(*) fname,vname
470        integer var(*)        integer var(*)
471    
472        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)
473        RETURN        RETURN
474        END        END
475    
476  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
477    
478        SUBROUTINE MNC_VAR_APPEND_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
      I     myThid,  
479       I     fname,       I     fname,
480       I     vname,       I     vname,
481       I     var,       I     var,
482       I     append )       I     append,
483         I     myThid )
484    
485        implicit none        implicit none
486  C     Arguments  C     Arguments
# Line 396  C     Arguments Line 488  C     Arguments
488        character*(*) fname,vname        character*(*) fname,vname
489        REAL*8 var(*)        REAL*8 var(*)
490    
491        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)
492        RETURN        RETURN
493        END        END
494    
495  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
496    
497        SUBROUTINE MNC_VAR_APPEND_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
      I     myThid,  
498       I     fname,       I     fname,
499       I     vname,       I     vname,
500       I     var,       I     var,
501       I     append )       I     append,
502         I     myThid )
503    
504        implicit none        implicit none
505  C     Arguments  C     Arguments
# Line 415  C     Arguments Line 507  C     Arguments
507        character*(*) fname,vname        character*(*) fname,vname
508        REAL*4 var(*)        REAL*4 var(*)
509    
510        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)
511        RETURN        RETURN
512        END        END
513    
514  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
515    
516        SUBROUTINE MNC_VAR_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
      I     myThid,  
517       I     fname,       I     fname,
518       I     vname,       I     vname,
519       I     var,       I     var,
520       I     append )       I     append,
521         I     myThid )
522    
523        implicit none        implicit none
524  C     Arguments  C     Arguments
# Line 434  C     Arguments Line 526  C     Arguments
526        character*(*) fname,vname        character*(*) fname,vname
527        integer var(*)        integer var(*)
528    
529        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)
530        RETURN        RETURN
531        END        END
532    
533  C==================================================================  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
534    
535        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
      I     myThid,  
536       I     fname,       I     fname,
537       I     vname,       I     vname,
538       I     vtype,       I     vtype,
539       I     append,       I     append,
540       I     dv,       I     dv,
541       I     rv,       I     rv,
542       I     iv )       I     iv,
543         I     myThid )
544    
545        implicit none        implicit none
546  #include "netcdf.inc"  #include "netcdf.inc"
# Line 476  C     Strip trailing spaces Line 568  C     Strip trailing spaces
568        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
569        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
570    
571        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
572        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
573          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
574       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 501  C     Get the lengths from the dim IDs Line 593  C     Get the lengths from the dim IDs
593  C     Check for the unlimited dimension  C     Check for the unlimited dimension
594        j = mnc_d_size( mnc_fd_ind(indf,de) )        j = mnc_d_size( mnc_fd_ind(indf,de) )
595        IF (j .LT. 1) THEN        IF (j .LT. 1) THEN
596          did = mnc_fg_ids(indf,de)          did = mnc_d_ids( mnc_fd_ind(indf,de) )
597          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
598          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
599          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
600          IF (append .GT. 0) THEN          IF (append .GT. 0) THEN
601            lend = lend + append            lend = lend + append
602          ENDIF          ENDIF
# Line 513  C     Check for the unlimited dimension Line 605  C     Check for the unlimited dimension
605          vcount(k) = 1          vcount(k) = 1
606        ENDIF        ENDIF
607    
608        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(fname, myThid)
609        IF (vtype .EQ. 1) THEN        IF (vtype .EQ. 1) THEN
610          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
611        ELSEIF (vtype .EQ. 2) THEN        ELSEIF (vtype .EQ. 2) THEN
# Line 529  C     Check for the unlimited dimension Line 621  C     Check for the unlimited dimension
621        ENDIF          ENDIF  
622        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
623       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
624        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
625    
626        RETURN        RETURN
627        END        END
628    
629    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
630    
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22