pkg/mnc/mnc_var.F

C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_var.F,v 1.10 2004/01/25 00:22:57 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_INIT_DBL( 
     I     myThid, 
     I     fname, 
     I     gname, 
     I     vname,
     I     units )

      implicit none
#include "netcdf.inc"

C     Arguments
      integer myThid
      character*(*) fname,gname,vname,units

      CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_INIT_REAL( 
     I     myThid, 
     I     fname, 
     I     gname, 
     I     vname,
     I     units )

      implicit none
#include "netcdf.inc"

C     Arguments
      integer myThid
      character*(*) fname,gname,vname,units

      CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_INIT_INT( 
     I     myThid, 
     I     fname, 
     I     gname, 
     I     vname,
     I     units )

      implicit none
#include "netcdf.inc"

C     Arguments
      integer myThid
      character*(*) fname,gname,vname,units

      CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_INIT_ANY( 
     I     myThid, 
     I     fname, 
     I     gname, 
     I     vname, 
     I     units, 
     I     vtype )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid
      character*(*) fname,gname,vname,units
      integer vtype

C     Functions
      integer ILNBLNK

C     Local Variables
      integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err
      integer vid, nv, ind_g_finfo, needed
      character*(MAX_LEN_MBUF) msgbuf
      integer ids(20)
      integer lenf,leng,lenv,lenu

C     Strip trailing spaces
      lenf = ILNBLNK(fname)
      leng = ILNBLNK(gname)
      lenv = ILNBLNK(vname)
      lenu = ILNBLNK(units)

C     Check that the file is open
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
      IF (indf .LT. 1) THEN
        write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname, 
     &       ''' must be opened first'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
      ENDIF
      fid = mnc_f_info(indf,2)

C     Check for sufficient storage space in mnc_fv_ids
      needed = 1 + 3*(mnc_fv_ids(indf,1) + 1)
      IF (needed .GE. MNC_MAX_INFO) THEN
        write(msgbuf,'(2a,i7,a)') 'MNC ERROR: MNC_MAX_INFO exceeded', 
     &       ': please increase it to ', 2*MNC_MAX_INFO, 
     &       ' in the file ''pkg/mnc/mnc_common.h'''
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
      ENDIF

C     Get the grid information
      ngrid = mnc_f_info(indf,3)
      IF (ngrid .LT. 1) THEN
        write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf), 
     &       ''' contains NO grids'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
      ENDIF
      DO i = 1,ngrid
        j = 4 + (i-1)*3
        k = mnc_f_info(indf,j)
        n = ILNBLNK(mnc_g_names(k))
        IF ((leng .EQ. n) 
     &       .AND. (mnc_g_names(k)(1:n) .EQ. gname(1:n))) THEN
          ind_g_finfo = j
          is = mnc_f_info(indf,(j+1))
          ie = mnc_f_info(indf,(j+2))
          nd = 0
          DO k = is,ie
            nd = nd + 1
            ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
          ENDDO
          GOTO 10
        ENDIF
      ENDDO
      write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf), 
     &     ''' does not contain grid ''', gname(1:leng), ''''
      CALL print_error(msgbuf, mythid)
      stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
 10   CONTINUE

C     Add the variable definition
      CALL MNC_FILE_REDEF(myThid, fname)
      err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
      write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
     &     ''' in file ''', fname(1:lenf), ''''
      CALL MNC_HANDLE_ERR(myThid, err, msgbuf)

C     Success, so save the variable info
      CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_v_names, indv)
      mnc_v_names(indv)(1:lenv) = vname(1:lenv)
      nv = mnc_fv_ids(indf,1)
      i = 2 + nv*3
      mnc_fv_ids(indf,i)   = indv
      mnc_fv_ids(indf,i+1) = vid
      mnc_fv_ids(indf,i+2) = ind_g_finfo
      mnc_fv_ids(indf,1) = nv + 1

C     Add the units
      CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_ADD_ATTR_STR( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     atname, 
     I     sval )

      implicit none
C     Arguments
      integer myThid
      character*(*) fname,vname,atname,sval

      CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname, 
     &     1, sval, 0, 0.0D0, 0.0, 0)
      RETURN
      END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_ADD_ATTR_DBL( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     atname, 
     I     nv, 
     I     dval )

      implicit none
C     Arguments
      integer myThid,nv
      character*(*) fname,vname,atname
      REAL*8 dval(*)

      CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname, 
     &     2, ' ', nv, dval, 0.0, 0)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_ADD_ATTR_REAL( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     atname, 
     I     nv, 
     I     rval )

      implicit none
C     Arguments
      integer myThid,nv
      character*(*) fname,vname,atname
      REAL*4 rval(*)

      CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname, 
     &     3, ' ', nv, 0.0D0, rval, 0)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_ADD_ATTR_INT( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     atname, 
     I     nv, 
     I     ival )

      implicit none
C     Arguments
      integer myThid,nv
      character*(*) fname,vname,atname
      integer ival(*)

      CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname, 
     &     4, ' ', nv, 0.0D0, 0.0, ival)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_ADD_ATTR_ANY( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     atname, 
     I     atype, cs,len,dv,rv,iv )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid,atype,len
      character*(*) fname,vname,atname
      character*(*) cs
      REAL*8 dv(*)
      REAL*4 rv(*)
      integer iv(*)

C     Functions
      integer ILNBLNK

C     Local Variables
      integer n, indf,ind_fv_ids, fid,vid, err
      character*(MAX_LEN_MBUF) msgbuf
      integer lenf,lenv,lenat,lens

C     Strip trailing spaces
      lenf = ILNBLNK(fname)
      lenv = ILNBLNK(vname)
      lenat = ILNBLNK(atname)
      lens = ILNBLNK(cs)

      CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
      IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
        write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf), 
     &       ''' is not open or does not contain variable ''', 
     &       vname(1:lenv), ''''
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
      ENDIF
      fid = mnc_f_info(indf,2)
      vid = mnc_fv_ids(indf,(ind_fv_ids+1))

C     Set the attribute
      CALL MNC_FILE_REDEF(myThid, fname)
      IF (atype .EQ. 1) THEN
        err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
      ELSEIF (atype .EQ. 2) THEN
        err = NF_PUT_ATT_DOUBLE(fid, vid, atname, NF_DOUBLE, len, dv)
      ELSEIF (atype .EQ. 3) THEN
        err = NF_PUT_ATT_REAL(fid, vid, atname, NF_FLOAT, len, rv)
      ELSEIF (atype .EQ. 4) THEN
        err = NF_PUT_ATT_INT(fid, vid, atname, NF_INT, len, iv)
      ELSE
        write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype, 
     &       ''' is invalid--must be: [1-4]'
        n = ILNBLNK(msgbuf)
        CALL print_error(msgbuf(1:n), mythid)
        stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
      ENDIF
      write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
     &     ''' to file ''', fname(1:lenf), ''''
      CALL MNC_HANDLE_ERR(myThid, err, msgbuf)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_WRITE_DBL( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     var )

      implicit none
C     Arguments
      integer myThid
      character*(*) fname,vname
      REAL*8 var(*)

      CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,0,var,0.0,0)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_WRITE_REAL( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     var )

      implicit none
C     Arguments
      integer myThid
      character*(*) fname,vname
      REAL*4 var(*)

      CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,0,0.0D0,var,0)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_WRITE_INT( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     var )

      implicit none
C     Arguments
      integer myThid
      character*(*) fname,vname
      integer var(*)

      CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,0,0.0D0,0.0,var)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_APPEND_DBL( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     var, 
     I     append )

      implicit none
C     Arguments
      integer myThid, append
      character*(*) fname,vname
      REAL*8 var(*)

      CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,append,var,0.0,0)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_APPEND_REAL( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     var, 
     I     append )

      implicit none
C     Arguments
      integer myThid, append
      character*(*) fname,vname
      REAL*4 var(*)

      CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,append,0.0D0,var,0)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_APPEND_INT( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     var, 
     I     append )

      implicit none
C     Arguments
      integer myThid, append
      character*(*) fname,vname
      integer var(*)

      CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,append,0.0D0,0.0,var)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_VAR_WRITE_ANY( 
     I     myThid, 
     I     fname, 
     I     vname, 
     I     vtype,
     I     append,
     I     dv,
     I     rv,
     I     iv )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid, vtype
      character*(*) fname,vname
      REAL*8 dv(*)
      REAL*4 rv(*)
      integer iv(*)
      integer append

C     Functions
      integer ILNBLNK

C     Local Variables
      integer i,j,k, n, indf,ind_fv_ids, fid,vid,did, ig, err, ds,de
      character*(MAX_LEN_MBUF) msgbuf
      integer lenf,lenv, lend
      integer vstart(100), vcount(100)

C     Strip trailing spaces
      lenf = ILNBLNK(fname)
      lenv = ILNBLNK(vname)

      CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
      IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
        write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf), 
     &       ''' is not open or does not contain variable ''', 
     &       vname(1:lenv), ''''
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
      ENDIF
      fid = mnc_f_info(indf,2)
      vid = mnc_fv_ids(indf,(ind_fv_ids+1))

C     Get the lengths from the dim IDs
      ig = mnc_fv_ids(indf,(ind_fv_ids+2))
      ds = mnc_f_info(indf,ig+1)
      de = mnc_f_info(indf,ig+2)
      k = 0
      DO i = ds,de
        k = k + 1
        vstart(k) = 1
        vcount(k) = mnc_d_size( mnc_fd_ind(indf,i) )
      ENDDO

C     Check for the unlimited dimension
      j = mnc_d_size( mnc_fd_ind(indf,de) )
      IF (j .LT. 1) THEN
        did = mnc_d_ids( mnc_fd_ind(indf,de) )
        err = NF_INQ_DIMLEN(fid, did, lend)
        write(msgbuf,'(a)') 'reading current length of unlimited dim'
        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
        IF (append .GT. 0) THEN
          lend = lend + append
        ENDIF
        IF (lend .LT. 1) lend = 1
        vstart(k) = lend
        vcount(k) = 1
      ENDIF

      CALL MNC_FILE_ENDDEF(myThid, fname)
      IF (vtype .EQ. 1) THEN
        err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
      ELSEIF (vtype .EQ. 2) THEN
        err = NF_PUT_VARA_REAL(fid, vid, vstart, vcount, rv)
      ELSEIF (vtype .EQ. 3) THEN
        err = NF_PUT_VARA_INT(fid, vid, vstart, vcount, iv)
      ELSE
        write(msgbuf,'(a,i10,a)') 'MNC ERROR: vtype = ''', vtype, 
     &       ''' is invalid--must be: [1|2|3]'
        n = ILNBLNK(msgbuf)
        CALL print_error(msgbuf(1:n), mythid)
        stop 'ABNORMAL END: S/R MNC_VAR_WRITE_ALL'
      ENDIF  
      write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
     &     ''' to file ''', fname(1:lenf), ''''
      CALL MNC_HANDLE_ERR(myThid, err, msgbuf)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

1	edhill	1.11	C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_var.F,v 1.10 2004/01/25 00:22:57 edhill Exp $
2	edhill	1.1	C $Name: $
3
4			#include "MNC_OPTIONS.h"
5
6	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7	edhill	1.1
8			SUBROUTINE MNC_VAR_INIT_DBL(
9			I myThid,
10			I fname,
11			I gname,
12	edhill	1.5	I vname,
13			I units )
14
15			implicit none
16			#include "netcdf.inc"
17
18			C Arguments
19			integer myThid
20			character() fname,gname,vname,units
21
22			CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE)
23			RETURN
24			END
25
26	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
27	edhill	1.5
28			SUBROUTINE MNC_VAR_INIT_REAL(
29			I myThid,
30			I fname,
31			I gname,
32			I vname,
33			I units )
34
35			implicit none
36			#include "netcdf.inc"
37
38			C Arguments
39			integer myThid
40			character() fname,gname,vname,units
41
42			CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT)
43			RETURN
44			END
45
46	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
47	edhill	1.5
48			SUBROUTINE MNC_VAR_INIT_INT(
49			I myThid,
50			I fname,
51			I gname,
52			I vname,
53			I units )
54
55			implicit none
56			#include "netcdf.inc"
57
58			C Arguments
59			integer myThid
60			character() fname,gname,vname,units
61
62			CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT)
63			RETURN
64			END
65
66	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
67	edhill	1.5
68			SUBROUTINE MNC_VAR_INIT_ANY(
69			I myThid,
70			I fname,
71			I gname,
72	edhill	1.1	I vname,
73	edhill	1.5	I units,
74			I vtype )
75	edhill	1.1
76			implicit none
77	edhill	1.3	#include "netcdf.inc"
78	edhill	1.1	#include "mnc_common.h"
79			#include "EEPARAMS.h"
80
81			C Arguments
82			integer myThid
83	edhill	1.5	character() fname,gname,vname,units
84			integer vtype
85	edhill	1.1
86			C Functions
87			integer ILNBLNK
88
89			C Local Variables
90	edhill	1.3	integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err
91	edhill	1.8	integer vid, nv, ind_g_finfo, needed
92	edhill	1.1	character*(MAX_LEN_MBUF) msgbuf
93	edhill	1.8	integer ids(20)
94	edhill	1.5	integer lenf,leng,lenv,lenu
95	edhill	1.1
96	edhill	1.3	C Strip trailing spaces
97			lenf = ILNBLNK(fname)
98			leng = ILNBLNK(gname)
99			lenv = ILNBLNK(vname)
100	edhill	1.5	lenu = ILNBLNK(units)
101	edhill	1.3
102			C Check that the file is open
103			CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
104			IF (indf .LT. 1) THEN
105			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname,
106			& ''' must be opened first'
107			CALL print_error(msgbuf, mythid)
108	edhill	1.7	stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
109	edhill	1.1	ENDIF
110	edhill	1.3	fid = mnc_f_info(indf,2)
111
112	edhill	1.8	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	edhill	1.3	C Get the grid information
123			ngrid = mnc_f_info(indf,3)
124			IF (ngrid .LT. 1) THEN
125			write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:lenf),
126			& ''' contains NO grids'
127			CALL print_error(msgbuf, mythid)
128	edhill	1.7	stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
129	edhill	1.3	ENDIF
130			DO i = 1,ngrid
131			j = 4 + (i-1)*3
132			k = mnc_f_info(indf,j)
133			n = ILNBLNK(mnc_g_names(k))
134			IF ((leng .EQ. n)
135			& .AND. (mnc_g_names(k)(1:n) .EQ. gname(1:n))) THEN
136	edhill	1.4	ind_g_finfo = j
137	edhill	1.3	is = mnc_f_info(indf,(j+1))
138			ie = mnc_f_info(indf,(j+2))
139			nd = 0
140			DO k = is,ie
141			nd = nd + 1
142	edhill	1.10	ids(nd) = mnc_d_ids(mnc_fd_ind(indf,k))
143	edhill	1.3	ENDDO
144			GOTO 10
145			ENDIF
146			ENDDO
147			write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
148			& ''' does not contain grid ''', gname(1:leng), ''''
149			CALL print_error(msgbuf, mythid)
150	edhill	1.7	stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
151	edhill	1.3	10 CONTINUE
152
153			C Add the variable definition
154			CALL MNC_FILE_REDEF(myThid, fname)
155	edhill	1.5	err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
156	edhill	1.3	write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
157			& ''' in file ''', fname(1:lenf), ''''
158			CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
159
160			C Success, so save the variable info
161			CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_v_names, indv)
162			mnc_v_names(indv)(1:lenv) = vname(1:lenv)
163			nv = mnc_fv_ids(indf,1)
164	edhill	1.5	i = 2 + nv*3
165	edhill	1.10	mnc_fv_ids(indf,i) = indv
166			mnc_fv_ids(indf,i+1) = vid
167			mnc_fv_ids(indf,i+2) = ind_g_finfo
168	edhill	1.3	mnc_fv_ids(indf,1) = nv + 1
169
170	edhill	1.5	C Add the units
171			CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units)
172
173	edhill	1.3	RETURN
174			END
175
176	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
177	edhill	1.3
178			SUBROUTINE MNC_VAR_ADD_ATTR_STR(
179			I myThid,
180			I fname,
181			I vname,
182			I atname,
183			I sval )
184
185			implicit none
186	edhill	1.5	C Arguments
187			integer myThid
188			character() fname,vname,atname,sval
189
190			CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
191			& 1, sval, 0, 0.0D0, 0.0, 0)
192			RETURN
193			END
194	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
195	edhill	1.5
196			SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
197			I myThid,
198			I fname,
199			I vname,
200			I atname,
201			I nv,
202			I dval )
203
204			implicit none
205			C Arguments
206			integer myThid,nv
207			character() fname,vname,atname
208	edhill	1.8	REAL8 dval()
209	edhill	1.5
210			CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
211			& 2, ' ', nv, dval, 0.0, 0)
212			RETURN
213			END
214
215	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
216	edhill	1.5
217			SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
218			I myThid,
219			I fname,
220			I vname,
221			I atname,
222			I nv,
223			I rval )
224
225			implicit none
226			C Arguments
227			integer myThid,nv
228			character() fname,vname,atname
229	edhill	1.8	REAL4 rval()
230	edhill	1.5
231			CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
232			& 3, ' ', nv, 0.0D0, rval, 0)
233			RETURN
234			END
235
236	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
237	edhill	1.5
238			SUBROUTINE MNC_VAR_ADD_ATTR_INT(
239			I myThid,
240			I fname,
241			I vname,
242			I atname,
243			I nv,
244			I ival )
245
246			implicit none
247			C Arguments
248			integer myThid,nv
249			character() fname,vname,atname
250			integer ival(*)
251
252			CALL MNC_VAR_ADD_ATTR_ANY(myThid,fname,vname,atname,
253			& 4, ' ', nv, 0.0D0, 0.0, ival)
254			RETURN
255			END
256
257	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
258	edhill	1.5
259			SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
260			I myThid,
261			I fname,
262			I vname,
263			I atname,
264			I atype, cs,len,dv,rv,iv )
265
266			implicit none
267	edhill	1.3	#include "netcdf.inc"
268			#include "mnc_common.h"
269			#include "EEPARAMS.h"
270
271			C Arguments
272	edhill	1.5	integer myThid,atype,len
273			character() fname,vname,atname
274			character() cs
275	edhill	1.8	REAL8 dv()
276			REAL4 rv()
277	edhill	1.5	integer iv(*)
278	edhill	1.3
279			C Functions
280			integer ILNBLNK
281
282			C Local Variables
283	edhill	1.8	integer n, indf,ind_fv_ids, fid,vid, err
284	edhill	1.3	character*(MAX_LEN_MBUF) msgbuf
285			integer lenf,lenv,lenat,lens
286
287			C Strip trailing spaces
288			lenf = ILNBLNK(fname)
289			lenv = ILNBLNK(vname)
290			lenat = ILNBLNK(atname)
291	edhill	1.5	lens = ILNBLNK(cs)
292	edhill	1.3
293	edhill	1.4	CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
294			IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
295			write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
296			& ''' is not open or does not contain variable ''',
297			& vname(1:lenv), ''''
298	edhill	1.3	CALL print_error(msgbuf, mythid)
299			stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
300			ENDIF
301			fid = mnc_f_info(indf,2)
302	edhill	1.4	vid = mnc_fv_ids(indf,(ind_fv_ids+1))
303	edhill	1.3
304			C Set the attribute
305			CALL MNC_FILE_REDEF(myThid, fname)
306	edhill	1.5	IF (atype .EQ. 1) THEN
307			err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
308			ELSEIF (atype .EQ. 2) THEN
309			err = NF_PUT_ATT_DOUBLE(fid, vid, atname, NF_DOUBLE, len, dv)
310			ELSEIF (atype .EQ. 3) THEN
311			err = NF_PUT_ATT_REAL(fid, vid, atname, NF_FLOAT, len, rv)
312			ELSEIF (atype .EQ. 4) THEN
313			err = NF_PUT_ATT_INT(fid, vid, atname, NF_INT, len, iv)
314			ELSE
315			write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
316			& ''' is invalid--must be: [1-4]'
317			n = ILNBLNK(msgbuf)
318			CALL print_error(msgbuf(1:n), mythid)
319			stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
320			ENDIF
321	edhill	1.3	write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
322	edhill	1.4	& ''' to file ''', fname(1:lenf), ''''
323			CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
324
325			RETURN
326			END
327
328	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
329	edhill	1.4
330			SUBROUTINE MNC_VAR_WRITE_DBL(
331			I myThid,
332			I fname,
333			I vname,
334			I var )
335
336			implicit none
337	edhill	1.5	C Arguments
338			integer myThid
339			character() fname,vname
340	edhill	1.8	REAL8 var()
341	edhill	1.5
342	edhill	1.9	CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,0,var,0.0,0)
343	edhill	1.5	RETURN
344			END
345
346	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
347	edhill	1.5
348			SUBROUTINE MNC_VAR_WRITE_REAL(
349			I myThid,
350			I fname,
351			I vname,
352			I var )
353
354			implicit none
355			C Arguments
356			integer myThid
357			character() fname,vname
358	edhill	1.8	REAL4 var()
359	edhill	1.5
360	edhill	1.9	CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,0,0.0D0,var,0)
361	edhill	1.5	RETURN
362			END
363
364	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
365	edhill	1.5
366			SUBROUTINE MNC_VAR_WRITE_INT(
367			I myThid,
368			I fname,
369			I vname,
370			I var )
371
372			implicit none
373			C Arguments
374			integer myThid
375			character() fname,vname
376			integer var(*)
377
378	edhill	1.9	CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,3,0,0.0D0,0.0,var)
379			RETURN
380			END
381
382	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
383	edhill	1.9
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			REAL8 var()
396
397			CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,1,append,var,0.0,0)
398			RETURN
399			END
400
401	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
402	edhill	1.9
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			REAL4 var()
415
416			CALL MNC_VAR_WRITE_ANY(myThid,fname,vname,2,append,0.0D0,var,0)
417			RETURN
418			END
419
420	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
421	edhill	1.9
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	edhill	1.5	RETURN
437			END
438
439	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
440	edhill	1.5
441			SUBROUTINE MNC_VAR_WRITE_ANY(
442			I myThid,
443			I fname,
444			I vname,
445			I vtype,
446	edhill	1.9	I append,
447	edhill	1.5	I dv,
448			I rv,
449			I iv )
450
451			implicit none
452	edhill	1.4	#include "netcdf.inc"
453			#include "mnc_common.h"
454			#include "EEPARAMS.h"
455
456			C Arguments
457	edhill	1.5	integer myThid, vtype
458			character() fname,vname
459	edhill	1.8	REAL8 dv()
460			REAL4 rv()
461	edhill	1.5	integer iv(*)
462	edhill	1.9	integer append
463	edhill	1.4
464			C Functions
465			integer ILNBLNK
466
467			C Local Variables
468			integer i,j,k, n, indf,ind_fv_ids, fid,vid,did, ig, err, ds,de
469			character*(MAX_LEN_MBUF) msgbuf
470			integer lenf,lenv, lend
471			integer vstart(100), vcount(100)
472
473			C Strip trailing spaces
474			lenf = ILNBLNK(fname)
475			lenv = ILNBLNK(vname)
476
477			CALL MNC_GET_FVINDS(myThid, fname, vname, indf, ind_fv_ids)
478			IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
479			write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
480			& ''' is not open or does not contain variable ''',
481			& vname(1:lenv), ''''
482			CALL print_error(msgbuf, mythid)
483			stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
484			ENDIF
485			fid = mnc_f_info(indf,2)
486			vid = mnc_fv_ids(indf,(ind_fv_ids+1))
487
488			C Get the lengths from the dim IDs
489			ig = mnc_fv_ids(indf,(ind_fv_ids+2))
490			ds = mnc_f_info(indf,ig+1)
491			de = mnc_f_info(indf,ig+2)
492			k = 0
493			DO i = ds,de
494			k = k + 1
495			vstart(k) = 1
496			vcount(k) = mnc_d_size( mnc_fd_ind(indf,i) )
497			ENDDO
498
499			C Check for the unlimited dimension
500			j = mnc_d_size( mnc_fd_ind(indf,de) )
501			IF (j .LT. 1) THEN
502	edhill	1.10	did = mnc_d_ids( mnc_fd_ind(indf,de) )
503	edhill	1.4	err = NF_INQ_DIMLEN(fid, did, lend)
504			write(msgbuf,'(a)') 'reading current length of unlimited dim'
505			CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
506	edhill	1.9	IF (append .GT. 0) THEN
507			lend = lend + append
508			ENDIF
509			IF (lend .LT. 1) lend = 1
510	edhill	1.4	vstart(k) = lend
511			vcount(k) = 1
512			ENDIF
513
514			CALL MNC_FILE_ENDDEF(myThid, fname)
515	edhill	1.5	IF (vtype .EQ. 1) THEN
516			err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
517			ELSEIF (vtype .EQ. 2) THEN
518			err = NF_PUT_VARA_REAL(fid, vid, vstart, vcount, rv)
519			ELSEIF (vtype .EQ. 3) THEN
520			err = NF_PUT_VARA_INT(fid, vid, vstart, vcount, iv)
521			ELSE
522			write(msgbuf,'(a,i10,a)') 'MNC ERROR: vtype = ''', vtype,
523			& ''' is invalid--must be: [1\|2\|3]'
524			n = ILNBLNK(msgbuf)
525			CALL print_error(msgbuf(1:n), mythid)
526			stop 'ABNORMAL END: S/R MNC_VAR_WRITE_ALL'
527			ENDIF
528	edhill	1.4	write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
529	edhill	1.3	& ''' to file ''', fname(1:lenf), ''''
530			CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
531	edhill	1.1
532	edhill	1.2	RETURN
533	edhill	1.1	END
534	edhill	1.11
535			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
536	edhill	1.1