pkg/mnc/mnc_var.F

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