pkg/mnc/mnc_var.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_var.F,v 1.19 2006/02/24 20:39:10 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_INIT_DBL

C     !INTERFACE:
      SUBROUTINE MNC_VAR_INIT_DBL( 
     I     fname, 
     I     gname, 
     I     vname, 
     I     irv,
     I     myThid )

C     !DESCRIPTION:
C     Create a double-precision real variable within a NetCDF file
C     context.
      
C     !USES:
      implicit none
#include "netcdf.inc"

C     !INPUT PARAMETERS:
      integer irv,myThid
      character*(*) fname,gname,vname
CEOP

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

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_INIT_REAL

C     !INTERFACE:
      SUBROUTINE MNC_VAR_INIT_REAL( 
     I     fname, 
     I     gname, 
     I     vname, 
     I     irv,
     I     myThid )

C     !DESCRIPTION:
C     Create a single-precision real variable within a NetCDF file
C     context.
      
C     !USES:
      implicit none
#include "netcdf.inc"

C     !INPUT PARAMETERS:
      integer irv,myThid
      character*(*) fname,gname,vname
CEOP

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

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_INIT_INT

C     !INTERFACE:
      SUBROUTINE MNC_VAR_INIT_INT( 
     I     fname, 
     I     gname, 
     I     vname, 
     I     irv,
     I     myThid )

C     !DESCRIPTION:
C     Create an integer variable within a NetCDF file context.
  
C     !USES:
      implicit none
#include "netcdf.inc"

C     !INPUT PARAMETERS:
      integer irv,myThid
      character*(*) fname,gname,vname
CEOP

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

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_INIT_ANY

C     !INTERFACE:
      SUBROUTINE MNC_VAR_INIT_ANY( 
     I     fname, 
     I     gname, 
     I     vname, 
     I     vtype, 
     I     irv,
     I     myThid )

C     !DESCRIPTION:
C     General function for creating variables within a NetCDF file
C     context.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer irv,myThid
      character*(*) fname,gname,vname
      integer vtype
CEOP

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     Functions
      integer ILNBLNK

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
            irv = 0
            RETURN
          ENDIF
        ENDIF
      ENDDO

      irv = 1

C     Add the variable definition
      CALL MNC_FILE_REDEF(fname, myThid)
      err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid)
      IF ( err .NE. NF_NOERR ) THEN
        write(msgbuf,'(2a)') 'ERROR:  MNC will not ',
     &       'overwrite variables in existing NetCDF'
        CALL PRINT_ERROR( msgBuf, myThid )
        write(msgbuf,'(2a)') '        files.  Please',
     &       ' make sure that you are not trying to'
        CALL PRINT_ERROR( msgBuf, myThid )
        write(msgbuf,'(2a)') '        overwrite output',
     &       'files from a previous model run!'
        CALL PRINT_ERROR( msgBuf, myThid )
        write(msgbuf,'(5a)') 'defining variable ''', vname(1:lenv),
     &     ''' in file ''', fname(1:lenf), ''''
        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
      ENDIF

C     Success, so save the variable info
      CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,'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-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_ADD_ATTR_STR

C     !INTERFACE:
      SUBROUTINE MNC_VAR_ADD_ATTR_STR( 
     I     fname, 
     I     vname, 
     I     atname, 
     I     sval, 
     I     myThid )

C     !DESCRIPTION:
C     Subroutine for adding a character string attribute to a NetCDF
C     file.
      
C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid
      character*(*) fname,vname,atname,sval
CEOP
      real*8 dZero(1)
      real*4 sZero(1)
      integer iZero(1)
      dZero(1) = 0.0D0
      sZero(1) = 0.0
      iZero(1) = 0

      CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname, 
     &     1, sval, 0, dZero, sZero, iZero, myThid)
      RETURN
      END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_ADD_ATTR_DBL

C     !INTERFACE:
      SUBROUTINE MNC_VAR_ADD_ATTR_DBL( 
     I     fname, 
     I     vname, 
     I     atname, 
     I     nv, 
     I     dval, 
     I     myThid )

C     !DESCRIPTION:
C     Subroutine for adding a double-precision real attribute to a
C     NetCDF file.
   
C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid,nv
      character*(*) fname,vname,atname
      REAL*8 dval(*)
CEOP
      real*4 sZero(1)
      integer iZero(1)
      sZero(1) = 0.0
      iZero(1) = 0

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

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_ADD_ATTR_REAL

C     !INTERFACE:
      SUBROUTINE MNC_VAR_ADD_ATTR_REAL( 
     I     fname, 
     I     vname, 
     I     atname, 
     I     nv, 
     I     rval, 
     I     myThid )

C     !DESCRIPTION:
C     Subroutine for adding a single-precision real attribute to a
C     NetCDF file.
   
C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid,nv
      character*(*) fname,vname,atname
      REAL*4 rval(*)
CEOP
      real*8 dZero(1)
      integer iZero(1)
      dZero(1) = 0.0D0
      iZero(1) = 0

      CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname, 
     &     3, ' ', nv, dZero, rval, iZero, myThid)
      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_ADD_ATTR_INT

C     !INTERFACE:
      SUBROUTINE MNC_VAR_ADD_ATTR_INT( 
     I     fname, 
     I     vname, 
     I     atname, 
     I     nv, 
     I     ival, 
     I     myThid )

C     !DESCRIPTION:
C     Subroutine for adding an integer attribute to a
C     NetCDF file.
      
C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid,nv
      character*(*) fname,vname,atname
      integer ival(*)
CEOP
      real*8 dZero(1)
      real*4 sZero(1)
      dZero(1) = 0.0D0
      sZero(1) = 0.0

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

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_VAR_ADD_ATTR_ANY

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

C     !DESCRIPTION:
C     General subroutine for adding attributes to a NetCDF file.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid,atype,len
      character*(*) fname,vname,atname
      character*(*) cs
      REAL*8 dv(*)
      REAL*4 rv(*)
      integer iv(*)
CEOP

C     !LOCAL VARIABLES:
      integer n, indf,ind_fv_ids, fid,vid, err
      character*(MAX_LEN_MBUF) msgbuf
      integer lenf,lenv,lenat,lens

C     Functions
      integer ILNBLNK

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