pkg/mnc/mnc_var.F

C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_var.F,v 1.12 2004/02/04 05:45:09 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

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

      implicit none
#include "netcdf.inc"

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

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

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

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

      implicit none
#include "netcdf.inc"

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

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

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

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

      implicit none
#include "netcdf.inc"

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

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

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

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

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

C     Arguments
      integer myThid
      character*(*) fname,gname,vname
      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, nvar
      character*(MAX_LEN_MBUF) msgbuf
      integer ids(20)
      integer lenf,leng,lenv

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

C     Check that the file is open
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
      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     Check if the variable is already defined
      nvar = mnc_fv_ids(indf,1)
      DO i = 1,nvar
        j = 2 + 3*(i-1)
        IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vname) THEN
          k = mnc_f_info(indf,mnc_fv_ids(indf,j+2))
          IF (mnc_g_names(k) .NE. gname) THEN
            write(msgbuf,'(5a)') 'MNC ERROR: variable ''', 
     &           vname(1:lenv), ''' is already defined in file ''', 
     &           fname(1:lenf), ''' but using a different grid shape'
            CALL print_error(msgbuf, mythid)
            stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY'
          ELSE
C           Its OK, the variable and grid names are the same
            RETURN
          ENDIF
        ENDIF
      ENDDO

C     Add the variable definition
      CALL MNC_FILE_REDEF(fname, myThid)
      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(err, msgbuf, myThid)

C     Success, so save the variable info
      CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,indv, myThid)
      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

      RETURN
      END

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      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(fname, vname, indf, ind_fv_ids, myThid)
      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(fname, myThid)
      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(err, msgbuf, myThid)

      RETURN
      END

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      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(fname, vname, indf, ind_fv_ids, myThid)
      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(err, msgbuf, myThid)
        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(fname, myThid)
      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(err, msgbuf, myThid)

      RETURN
      END

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

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