/[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.13 by edhill, Fri Mar 19 03:28:37 2004 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE MNC_VAR_INIT_DBL(        SUBROUTINE MNC_VAR_INIT_DBL(
      I     myThid,  
9       I     fname,       I     fname,
10       I     gname,       I     gname,
11       I     vname )       I     vname,
12         I     myThid )
13    
14        implicit none        implicit none
15  #include "netcdf.inc"  #include "netcdf.inc"
# Line 18  C     Arguments Line 18  C     Arguments
18        integer myThid        integer myThid
19        character*(*) fname,gname,vname        character*(*) fname,gname,vname
20    
21        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_DOUBLE)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, myThid)
22        RETURN        RETURN
23        END        END
24    
25  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
26    
27        SUBROUTINE MNC_VAR_INIT_REAL(        SUBROUTINE MNC_VAR_INIT_REAL(
      I     myThid,  
28       I     fname,       I     fname,
29       I     gname,       I     gname,
30       I     vname )       I     vname,
31         I     myThid )
32    
33        implicit none        implicit none
34  #include "netcdf.inc"  #include "netcdf.inc"
# Line 37  C     Arguments Line 37  C     Arguments
37        integer myThid        integer myThid
38        character*(*) fname,gname,vname        character*(*) fname,gname,vname
39    
40        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_FLOAT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, myThid)
41        RETURN        RETURN
42        END        END
43    
44  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
45    
46        SUBROUTINE MNC_VAR_INIT_INT(        SUBROUTINE MNC_VAR_INIT_INT(
      I     myThid,  
47       I     fname,       I     fname,
48       I     gname,       I     gname,
49       I     vname )       I     vname,
50         I     myThid )
51    
52        implicit none        implicit none
53  #include "netcdf.inc"  #include "netcdf.inc"
# Line 56  C     Arguments Line 56  C     Arguments
56        integer myThid        integer myThid
57        character*(*) fname,gname,vname        character*(*) fname,gname,vname
58    
59        CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_INT)        CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_INT, myThid)
60        RETURN        RETURN
61        END        END
62    
63  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
64    
65        SUBROUTINE MNC_VAR_INIT_ANY(        SUBROUTINE MNC_VAR_INIT_ANY(
      I     myThid,  
66       I     fname,       I     fname,
67       I     gname,       I     gname,
68       I     vname,       I     vname,
69       I     vtype )       I     vtype,
70         I     myThid )
71    
72        implicit none        implicit none
73  #include "netcdf.inc"  #include "netcdf.inc"
# Line 95  C     Strip trailing spaces Line 95  C     Strip trailing spaces
95        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
96    
97  C     Check that the file is open  C     Check that the file is open
98        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)
99        IF (indf .LT. 1) THEN        IF (indf .LT. 1) THEN
100          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,          write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,
101       &       ''' must be opened first'       &       ''' must be opened first'
# Line 165  C           Its OK, the variable and gri Line 165  C           Its OK, the variable and gri
165        ENDDO        ENDDO
166    
167  C     Add the variable definition  C     Add the variable definition
168        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
169        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)        err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
170        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
171       &     ''' in file ''', fname(1:lenf), ''''       &     ''' in file ''', fname(1:lenf), ''''
172        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
173    
174  C     Success, so save the variable info  C     Success, so save the variable info
175        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)
176        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
177        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
178        i = 2 + nv*3        i = 2 + nv*3
# Line 187  C     Success, so save the variable info Line 187  C     Success, so save the variable info
187  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
188    
189        SUBROUTINE MNC_VAR_ADD_ATTR_STR(        SUBROUTINE MNC_VAR_ADD_ATTR_STR(
      I     myThid,  
190       I     fname,       I     fname,
191       I     vname,       I     vname,
192       I     atname,       I     atname,
193       I     sval )       I     sval,
194         I     myThid )
195    
196        implicit none        implicit none
197  C     Arguments  C     Arguments
198        integer myThid        integer myThid
199        character*(*) fname,vname,atname,sval        character*(*) fname,vname,atname,sval
200    
201        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
202       &     1, sval, 0, 0.0D0, 0.0, 0)       &     1, sval, 0, 0.0D0, 0.0, 0, myThid)
203        RETURN        RETURN
204        END        END
205  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
206    
207        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(        SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
      I     myThid,  
208       I     fname,       I     fname,
209       I     vname,       I     vname,
210       I     atname,       I     atname,
211       I     nv,       I     nv,
212       I     dval )       I     dval,
213         I     myThid )
214    
215        implicit none        implicit none
216  C     Arguments  C     Arguments
# Line 218  C     Arguments Line 218  C     Arguments
218        character*(*) fname,vname,atname        character*(*) fname,vname,atname
219        REAL*8 dval(*)        REAL*8 dval(*)
220    
221        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
222       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, 0.0, 0, myThid)
223        RETURN        RETURN
224        END        END
225    
226  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
227    
228        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(        SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
      I     myThid,  
229       I     fname,       I     fname,
230       I     vname,       I     vname,
231       I     atname,       I     atname,
232       I     nv,       I     nv,
233       I     rval )       I     rval,
234         I     myThid )
235    
236        implicit none        implicit none
237  C     Arguments  C     Arguments
# Line 239  C     Arguments Line 239  C     Arguments
239        character*(*) fname,vname,atname        character*(*) fname,vname,atname
240        REAL*4 rval(*)        REAL*4 rval(*)
241    
242        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
243       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, 0.0D0, rval, 0, myThid)
244        RETURN        RETURN
245        END        END
246    
247  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
248    
249        SUBROUTINE MNC_VAR_ADD_ATTR_INT(        SUBROUTINE MNC_VAR_ADD_ATTR_INT(
      I     myThid,  
250       I     fname,       I     fname,
251       I     vname,       I     vname,
252       I     atname,       I     atname,
253       I     nv,       I     nv,
254       I     ival )       I     ival,
255         I     myThid )
256    
257        implicit none        implicit none
258  C     Arguments  C     Arguments
# Line 260  C     Arguments Line 260  C     Arguments
260        character*(*) fname,vname,atname        character*(*) fname,vname,atname
261        integer ival(*)        integer ival(*)
262    
263        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
264       &     4, ' ', nv, 0.0D0, 0.0, ival)       &     4, ' ', nv, 0.0D0, 0.0, ival, myThid)
265        RETURN        RETURN
266        END        END
267    
268  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
269    
270        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(        SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
      I     myThid,  
271       I     fname,       I     fname,
272       I     vname,       I     vname,
273       I     atname,       I     atname,
274       I     atype, cs,len,dv,rv,iv )       I     atype, cs,len,dv,rv,iv,
275         I     myThid )
276    
277        implicit none        implicit none
278  #include "netcdf.inc"  #include "netcdf.inc"
# Line 301  C     Strip trailing spaces Line 301  C     Strip trailing spaces
301        lenat = ILNBLNK(atname)        lenat = ILNBLNK(atname)
302        lens = ILNBLNK(cs)        lens = ILNBLNK(cs)
303    
304        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
305        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
306          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
307       &       ''' is not open or does not contain variable ''',       &       ''' is not open or does not contain variable ''',
# Line 313  C     Strip trailing spaces Line 313  C     Strip trailing spaces
313        vid = mnc_fv_ids(indf,(ind_fv_ids+1))        vid = mnc_fv_ids(indf,(ind_fv_ids+1))
314    
315  C     Set the attribute  C     Set the attribute
316        CALL MNC_FILE_REDEF(myThid, fname)        CALL MNC_FILE_REDEF(fname, myThid)
317        IF (atype .EQ. 1) THEN        IF (atype .EQ. 1) THEN
318          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)          err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
319        ELSEIF (atype .EQ. 2) THEN        ELSEIF (atype .EQ. 2) THEN
# Line 331  C     Set the attribute Line 331  C     Set the attribute
331        ENDIF        ENDIF
332        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),        write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
333       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
334        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
335    
336        RETURN        RETURN
337        END        END
# Line 339  C     Set the attribute Line 339  C     Set the attribute
339  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
340    
341        SUBROUTINE MNC_VAR_WRITE_DBL(        SUBROUTINE MNC_VAR_WRITE_DBL(
      I     myThid,  
342       I     fname,       I     fname,
343       I     vname,       I     vname,
344       I     var )       I     var,
345         I     myThid )
346    
347        implicit none        implicit none
348  C     Arguments  C     Arguments
# Line 350  C     Arguments Line 350  C     Arguments
350        character*(*) fname,vname        character*(*) fname,vname
351        REAL*8 var(*)        REAL*8 var(*)
352    
353        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)
354        RETURN        RETURN
355        END        END
356    
357  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
358    
359        SUBROUTINE MNC_VAR_WRITE_REAL(        SUBROUTINE MNC_VAR_WRITE_REAL(
      I     myThid,  
360       I     fname,       I     fname,
361       I     vname,       I     vname,
362       I     var )       I     var,
363         I     myThid )
364    
365        implicit none        implicit none
366  C     Arguments  C     Arguments
# Line 368  C     Arguments Line 368  C     Arguments
368        character*(*) fname,vname        character*(*) fname,vname
369        REAL*4 var(*)        REAL*4 var(*)
370    
371        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)
372        RETURN        RETURN
373        END        END
374    
375  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
376    
377        SUBROUTINE MNC_VAR_WRITE_INT(        SUBROUTINE MNC_VAR_WRITE_INT(
      I     myThid,  
378       I     fname,       I     fname,
379       I     vname,       I     vname,
380       I     var )       I     var,
381         I     myThid )
382    
383        implicit none        implicit none
384  C     Arguments  C     Arguments
# Line 386  C     Arguments Line 386  C     Arguments
386        character*(*) fname,vname        character*(*) fname,vname
387        integer var(*)        integer var(*)
388    
389        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)
390        RETURN        RETURN
391        END        END
392    
393  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
394    
395        SUBROUTINE MNC_VAR_APPEND_DBL(        SUBROUTINE MNC_VAR_APPEND_DBL(
      I     myThid,  
396       I     fname,       I     fname,
397       I     vname,       I     vname,
398       I     var,       I     var,
399       I     append )       I     append,
400         I     myThid )
401    
402        implicit none        implicit none
403  C     Arguments  C     Arguments
# Line 405  C     Arguments Line 405  C     Arguments
405        character*(*) fname,vname        character*(*) fname,vname
406        REAL*8 var(*)        REAL*8 var(*)
407    
408        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)
409        RETURN        RETURN
410        END        END
411    
412  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
413    
414        SUBROUTINE MNC_VAR_APPEND_REAL(        SUBROUTINE MNC_VAR_APPEND_REAL(
      I     myThid,  
415       I     fname,       I     fname,
416       I     vname,       I     vname,
417       I     var,       I     var,
418       I     append )       I     append,
419         I     myThid )
420    
421        implicit none        implicit none
422  C     Arguments  C     Arguments
# Line 424  C     Arguments Line 424  C     Arguments
424        character*(*) fname,vname        character*(*) fname,vname
425        REAL*4 var(*)        REAL*4 var(*)
426    
427        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)
428        RETURN        RETURN
429        END        END
430    
431  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
432    
433        SUBROUTINE MNC_VAR_APPEND_INT(        SUBROUTINE MNC_VAR_APPEND_INT(
      I     myThid,  
434       I     fname,       I     fname,
435       I     vname,       I     vname,
436       I     var,       I     var,
437       I     append )       I     append,
438         I     myThid )
439    
440        implicit none        implicit none
441  C     Arguments  C     Arguments
# Line 443  C     Arguments Line 443  C     Arguments
443        character*(*) fname,vname        character*(*) fname,vname
444        integer var(*)        integer var(*)
445    
446        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)
447        RETURN        RETURN
448        END        END
449    
450  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
451    
452        SUBROUTINE MNC_VAR_WRITE_ANY(        SUBROUTINE MNC_VAR_WRITE_ANY(
      I     myThid,  
453       I     fname,       I     fname,
454       I     vname,       I     vname,
455       I     vtype,       I     vtype,
456       I     append,       I     append,
457       I     dv,       I     dv,
458       I     rv,       I     rv,
459       I     iv )       I     iv,
460         I     myThid )
461    
462        implicit none        implicit none
463  #include "netcdf.inc"  #include "netcdf.inc"
# Line 485  C     Strip trailing spaces Line 485  C     Strip trailing spaces
485        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
486        lenv = ILNBLNK(vname)        lenv = ILNBLNK(vname)
487    
488        CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)        CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
489        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN        IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
490          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),          write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
491       &       ''' 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 513  C     Check for the unlimited dimension
513          did = mnc_d_ids( mnc_fd_ind(indf,de) )          did = mnc_d_ids( mnc_fd_ind(indf,de) )
514          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
515          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
516          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
517          IF (append .GT. 0) THEN          IF (append .GT. 0) THEN
518            lend = lend + append            lend = lend + append
519          ENDIF          ENDIF
# Line 522  C     Check for the unlimited dimension Line 522  C     Check for the unlimited dimension
522          vcount(k) = 1          vcount(k) = 1
523        ENDIF        ENDIF
524    
525        CALL MNC_FILE_ENDDEF(myThid, fname)        CALL MNC_FILE_ENDDEF(fname, myThid)
526        IF (vtype .EQ. 1) THEN        IF (vtype .EQ. 1) THEN
527          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)          err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
528        ELSEIF (vtype .EQ. 2) THEN        ELSEIF (vtype .EQ. 2) THEN
# Line 538  C     Check for the unlimited dimension Line 538  C     Check for the unlimited dimension
538        ENDIF          ENDIF  
539        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),        write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
540       &     ''' to file ''', fname(1:lenf), ''''       &     ''' to file ''', fname(1:lenf), ''''
541        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
542    
543        RETURN        RETURN
544        END        END
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22