/[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.10 by edhill, Sun Jan 25 00:22:57 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 129  C     Get the grid information Line 139  C     Get the grid information
139            nd = 0            nd = 0
140            DO k = is,ie            DO k = is,ie
141              nd = nd + 1              nd = nd + 1
142              ids(nd) = mnc_fg_ids(indf,k)              ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
143            ENDDO            ENDDO
144            GOTO 10            GOTO 10
145          ENDIF          ENDIF
# Line 152  C     Success, so save the variable info Line 162  C     Success, so save the variable info
162        mnc_v_names(indv)(1:lenv) = vname(1:lenv)        mnc_v_names(indv)(1:lenv) = vname(1:lenv)
163        nv = mnc_fv_ids(indf,1)        nv = mnc_fv_ids(indf,1)
164        i = 2 + nv*3        i = 2 + nv*3
165        j = i + 1        mnc_fv_ids(indf,i)   = indv
166        k = i + 2        mnc_fv_ids(indf,i+1) = vid
167        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  
168        mnc_fv_ids(indf,1) = nv + 1        mnc_fv_ids(indf,1) = nv + 1
169    
170  C     Add the units  C     Add the units
# Line 197  C======================================= Line 205  C=======================================
205  C     Arguments  C     Arguments
206        integer myThid,nv        integer myThid,nv
207        character*(*) fname,vname,atname        character*(*) fname,vname,atname
208        _RL dval(*)        REAL*8 dval(*)
209    
210        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
211       &     2, ' ', nv, dval, 0.0, 0)       &     2, ' ', nv, dval, 0.0, 0)
# Line 218  C======================================= Line 226  C=======================================
226  C     Arguments  C     Arguments
227        integer myThid,nv        integer myThid,nv
228        character*(*) fname,vname,atname        character*(*) fname,vname,atname
229        _RS rval(*)        REAL*4 rval(*)
230    
231        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,        CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
232       &     3, ' ', nv, 0.0D0, rval, 0)       &     3, ' ', nv, 0.0D0, rval, 0)
# Line 264  C     Arguments Line 272  C     Arguments
272        integer myThid,atype,len        integer myThid,atype,len
273        character*(*) fname,vname,atname        character*(*) fname,vname,atname
274        character*(*) cs        character*(*) cs
275        _RL dv(*)        REAL*8 dv(*)
276        _RS rv(*)        REAL*4 rv(*)
277        integer iv(*)        integer iv(*)
278    
279  C     Functions  C     Functions
280        integer ILNBLNK        integer ILNBLNK
281    
282  C     Local Variables  C     Local Variables
283        integer i,j,k, n, nv, indf,ind_fv_ids, fid,vid, err        integer n, indf,ind_fv_ids, fid,vid, err
284        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
285        integer lenf,lenv,lenat,lens        integer lenf,lenv,lenat,lens
286    
# Line 329  C======================================= Line 337  C=======================================
337  C     Arguments  C     Arguments
338        integer myThid        integer myThid
339        character*(*) fname,vname        character*(*) fname,vname
340        _RL var(*)        REAL*8 var(*)
341    
342        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)
343        RETURN        RETURN
344        END        END
345    
# Line 347  C======================================= Line 355  C=======================================
355  C     Arguments  C     Arguments
356        integer myThid        integer myThid
357        character*(*) fname,vname        character*(*) fname,vname
358        _RS var(*)        REAL*4 var(*)
359    
360        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)
361        RETURN        RETURN
362        END        END
363    
# Line 367  C     Arguments Line 375  C     Arguments
375        character*(*) fname,vname        character*(*) fname,vname
376        integer var(*)        integer var(*)
377    
378        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)
379          RETURN
380          END
381    
382    C==================================================================
383    
384          SUBROUTINE MNC_VAR_APPEND_DBL(
385         I     myThid,
386         I     fname,
387         I     vname,
388         I     var,
389         I     append )
390    
391          implicit none
392    C     Arguments
393          integer myThid, append
394          character*(*) fname,vname
395          REAL*8 var(*)
396    
397          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,append,var,0.0,0)
398          RETURN
399          END
400    
401    C==================================================================
402    
403          SUBROUTINE MNC_VAR_APPEND_REAL(
404         I     myThid,
405         I     fname,
406         I     vname,
407         I     var,
408         I     append )
409    
410          implicit none
411    C     Arguments
412          integer myThid, append
413          character*(*) fname,vname
414          REAL*4 var(*)
415    
416          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,append,0.0D0,var,0)
417          RETURN
418          END
419    
420    C==================================================================
421    
422          SUBROUTINE MNC_VAR_APPEND_INT(
423         I     myThid,
424         I     fname,
425         I     vname,
426         I     var,
427         I     append )
428    
429          implicit none
430    C     Arguments
431          integer myThid, append
432          character*(*) fname,vname
433          integer var(*)
434    
435          CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,append,0.0D0,0.0,var)
436        RETURN        RETURN
437        END        END
438    
# Line 378  C======================================= Line 443  C=======================================
443       I     fname,       I     fname,
444       I     vname,       I     vname,
445       I     vtype,       I     vtype,
446         I     append,
447       I     dv,       I     dv,
448       I     rv,       I     rv,
449       I     iv )       I     iv )
# Line 390  C======================================= Line 456  C=======================================
456  C     Arguments  C     Arguments
457        integer myThid, vtype        integer myThid, vtype
458        character*(*) fname,vname        character*(*) fname,vname
459        _RL dv(*)        REAL*8 dv(*)
460        _RS rv(*)        REAL*4 rv(*)
461        integer iv(*)        integer iv(*)
462          integer append
463    
464  C     Functions  C     Functions
465        integer ILNBLNK        integer ILNBLNK
# Line 402  C     Local Variables Line 469  C     Local Variables
469        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
470        integer lenf,lenv, lend        integer lenf,lenv, lend
471        integer vstart(100), vcount(100)        integer vstart(100), vcount(100)
       integer rvstart(100), rvcount(100)  
472    
473  C     Strip trailing spaces  C     Strip trailing spaces
474        lenf = ILNBLNK(fname)        lenf = ILNBLNK(fname)
# Line 433  C     Get the lengths from the dim IDs Line 499  C     Get the lengths from the dim IDs
499  C     Check for the unlimited dimension  C     Check for the unlimited dimension
500        j = mnc_d_size( mnc_fd_ind(indf,de) )        j = mnc_d_size( mnc_fd_ind(indf,de) )
501        IF (j .LT. 1) THEN        IF (j .LT. 1) THEN
502          did = mnc_fg_ids(indf,de)          did = mnc_d_ids( mnc_fd_ind(indf,de) )
503          err = NF_INQ_DIMLEN(fid, did, lend)          err = NF_INQ_DIMLEN(fid, did, lend)
504          write(msgbuf,'(a)') 'reading current length of unlimited dim'          write(msgbuf,'(a)') 'reading current length of unlimited dim'
505          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
506          IF (lend .LT. 1)  lend = lend + 1          IF (append .GT. 0) THEN
507              lend = lend + append
508            ENDIF
509            IF (lend .LT. 1) lend = 1
510          vstart(k) = lend          vstart(k) = lend
511          vcount(k) = 1          vcount(k) = 1
512        ENDIF        ENDIF
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22