pkg/mnc/mnc_var.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_var.F,v 1.17 2004/09/23 16:17:57 jmc 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     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 myThid
      character*(*) fname,gname,vname
CEOP

      CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_DOUBLE, 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     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 myThid
      character*(*) fname,gname,vname
CEOP

      CALL MNC_VAR_INIT_ANY(fname,gname,vname, NF_FLOAT, 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     myThid )

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

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

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