/[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.7 by edhill, Thu Jan 15 04:31:24 2004 UTC revision 1.9 by edhill, Sun Jan 18 23:23:15 2004 UTC
# Line 88  C     Functions Line 88  C     Functions
88    
89  C     Local Variables  C     Local Variables
90        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
91        integer vid, nv, ind_g_finfo        integer vid, nv, ind_g_finfo, needed
92        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
93        integer rids(10), ids(10)        integer ids(20)
94        integer lenf,leng,lenv,lenu        integer lenf,leng,lenv,lenu
95    
96  C     Strip trailing spaces  C     Strip trailing spaces
# Line 109  C     Check that the file is open Line 109  C     Check that the file is open
109        ENDIF        ENDIF
110        fid = mnc_f_info(indf,2)        fid = mnc_f_info(indf,2)
111    
112    C     Check for sufficient storage space in mnc_fv_ids
113          needed = 1 + 3*(mnc_fv_ids(indf,1) + 1)
114          IF (needed .GE. MNC_MAX_INFO) THEN
115            write(msgbuf,'(2a,i7,a)') 'MNC ERROR: MNC_MAX_INFO exceeded',
116         &       ': please increase it to ', 2*MNC_MAX_INFO,
117         &       ' in the file ''pkg/mnc/mnc_common.h'''
118            CALL print_error(msgbuf, mythid)
119            stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
120          ENDIF
121    
122  C     Get the grid information  C     Get the grid information
123        ngrid = mnc_f_info(indf,3)        ngrid = mnc_f_info(indf,3)
124        IF (ngrid .LT. 1) THEN        IF (ngrid .LT. 1) THEN
# Line 197  C======================================= Line 207  C=======================================
207  C     Arguments  C     Arguments
208        integer myThid,nv        integer myThid,nv
209        character*(*) fname,vname,atname        character*(*) fname,vname,atname
210        _RL dval(*)        REAL*8 dval(*)
211    
212        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
213       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, 0.0, 0)
# Line 218  C======================================= Line 228  C=======================================
228  C     Arguments  C     Arguments
229        integer myThid,nv        integer myThid,nv
230        character*(*) fname,vname,atname        character*(*) fname,vname,atname
231        _RS rval(*)        REAL*4 rval(*)
232    
233        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
234       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, 0.0D0, rval, 0)
# Line 264  C     Arguments Line 274  C     Arguments
274        integer myThid,atype,len        integer myThid,atype,len
275        character*(*) fname,vname,atname        character*(*) fname,vname,atname
276        character*(*) cs        character*(*) cs
277        _RL dv(*)        REAL*8 dv(*)
278        _RS rv(*)        REAL*4 rv(*)
279        integer iv(*)        integer iv(*)
280    
281  C     Functions  C     Functions
282        integer ILNBLNK        integer ILNBLNK
283    
284  C     Local Variables  C     Local Variables
285        integer i,j,k, n, nv, indf,ind_fv_ids, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
286        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
287        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
288    
# Line 329  C======================================= Line 339  C=======================================
339  C     Arguments  C     Arguments
340        integer myThid        integer myThid
341        character*(*) fname,vname        character*(*) fname,vname
342        _RL var(*)        REAL*8 var(*)
343    
344        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 1, var, 0.0, 0 )        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,0,var,0.0,0)
345        RETURN        RETURN
346        END        END
347    
# Line 347  C======================================= Line 357  C=======================================
357  C     Arguments  C     Arguments
358        integer myThid        integer myThid
359        character*(*) fname,vname        character*(*) fname,vname
360        _RS var(*)        REAL*4 var(*)
361    
362        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 2, 0.0D0, var, 0 )        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,0,0.0D0,var,0)
363        RETURN        RETURN
364        END        END
365    
# Line 367  C     Arguments Line 377  C     Arguments
377        character*(*) fname,vname        character*(*) fname,vname
378        integer var(*)        integer var(*)
379    
380        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname, 3, 0.0D0, 0.0, var )        CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,0,0.0D0,0.0,var)
381          RETURN
382          END
383    
384    C==================================================================
385    
386          SUBROUTINE MNC_VAR_APPEND_DBL(
387         I     myThid,
388         I     fname,
389         I     vname,
390         I     var,
391         I     append )
392    
393          implicit none
394    C     Arguments
395          integer myThid, append
396          character*(*) fname,vname
397          REAL*8 var(*)
398    
399          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,append,var,0.0,0)
400          RETURN
401          END
402    
403    C==================================================================
404    
405          SUBROUTINE MNC_VAR_APPEND_REAL(
406         I     myThid,
407         I     fname,
408         I     vname,
409         I     var,
410         I     append )
411    
412          implicit none
413    C     Arguments
414          integer myThid, append
415          character*(*) fname,vname
416          REAL*4 var(*)
417    
418          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,append,0.0D0,var,0)
419          RETURN
420          END
421    
422    C==================================================================
423    
424          SUBROUTINE MNC_VAR_APPEND_INT(
425         I     myThid,
426         I     fname,
427         I     vname,
428         I     var,
429         I     append )
430    
431          implicit none
432    C     Arguments
433          integer myThid, append
434          character*(*) fname,vname
435          integer var(*)
436    
437          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,append,0.0D0,0.0,var)
438        RETURN        RETURN
439        END        END
440    
# Line 378  C======================================= Line 445  C=======================================
445       I     fname,       I     fname,
446       I     vname,       I     vname,
447       I     vtype,       I     vtype,
448         I     append,
449       I     dv,       I     dv,
450       I     rv,       I     rv,
451       I     iv )       I     iv )
# Line 390  C======================================= Line 458  C=======================================
458  C     Arguments  C     Arguments
459        integer myThid, vtype        integer myThid, vtype
460        character*(*) fname,vname        character*(*) fname,vname
461        _RL dv(*)        REAL*8 dv(*)
462        _RS rv(*)        REAL*4 rv(*)
463        integer iv(*)        integer iv(*)
464          integer append
465    
466  C     Functions  C     Functions
467        integer ILNBLNK        integer ILNBLNK
# Line 402  C     Local Variables Line 471  C     Local Variables
471        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
472        integer lenf,lenv, lend        integer lenf,lenv, lend
473        integer vstart(100), vcount(100)        integer vstart(100), vcount(100)
       integer rvstart(100), rvcount(100)  
474    
475  C     Strip trailing spaces  C     Strip trailing spaces
476        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
# Line 437  C     Check for the unlimited dimension Line 505  C     Check for the unlimited dimension
505          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
506          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
507          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
508          IF (lend .LT. 1)  lend = lend + 1          IF (append .GT. 0) THEN
509              lend = lend + append
510            ENDIF
511            IF (lend .LT. 1) lend = 1
512          vstart(k) = lend          vstart(k) = lend
513          vcount(k) = 1          vcount(k) = 1
514        ENDIF        ENDIF
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22