pkg/mnc/mnc_var.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_var.F,v 1.18 2004/12/26 15:24:50 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,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.19	C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_var.F,v 1.18 2004/12/26 15:24:50 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.13	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,indv, myThid)
229	edhill	1.3	mnc_v_names(indv)(1:lenv) = vname(1:lenv)
230			nv = mnc_fv_ids(indf,1)
231	edhill	1.5	i = 2 + nv*3
232	edhill	1.10	mnc_fv_ids(indf,i) = indv
233			mnc_fv_ids(indf,i+1) = vid
234			mnc_fv_ids(indf,i+2) = ind_g_finfo
235	edhill	1.3	mnc_fv_ids(indf,1) = nv + 1
236	edhill	1.5
237	edhill	1.3	RETURN
238			END
239
240	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
241	edhill	1.16	CBOP 1
242	edhill	1.14	C !ROUTINE: MNC_VAR_ADD_ATTR_STR
243	edhill	1.3
244	edhill	1.14	C !INTERFACE:
245	edhill	1.3	SUBROUTINE MNC_VAR_ADD_ATTR_STR(
246			I fname,
247			I vname,
248			I atname,
249	edhill	1.13	I sval,
250			I myThid )
251	edhill	1.3
252	edhill	1.14	C !DESCRIPTION:
253			C Subroutine for adding a character string attribute to a NetCDF
254			C file.
255
256			C !USES:
257	edhill	1.3	implicit none
258	edhill	1.14
259			C !INPUT PARAMETERS:
260	edhill	1.5	integer myThid
261			character() fname,vname,atname,sval
262	edhill	1.14	CEOP
263	jmc	1.17	real*8 dZero(1)
264			real*4 sZero(1)
265			integer iZero(1)
266			dZero(1) = 0.0D0
267			sZero(1) = 0.0
268			iZero(1) = 0
269	edhill	1.5
270	edhill	1.13	CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
271	jmc	1.17	& 1, sval, 0, dZero, sZero, iZero, myThid)
272	edhill	1.5	RETURN
273			END
274	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
275	edhill	1.16	CBOP 1
276	edhill	1.14	C !ROUTINE: MNC_VAR_ADD_ATTR_DBL
277	edhill	1.5
278	edhill	1.14	C !INTERFACE:
279	edhill	1.5	SUBROUTINE MNC_VAR_ADD_ATTR_DBL(
280			I fname,
281			I vname,
282			I atname,
283			I nv,
284	edhill	1.13	I dval,
285			I myThid )
286	edhill	1.5
287	edhill	1.14	C !DESCRIPTION:
288			C Subroutine for adding a double-precision real attribute to a
289			C NetCDF file.
290
291			C !USES:
292	edhill	1.5	implicit none
293	edhill	1.14
294			C !INPUT PARAMETERS:
295	edhill	1.5	integer myThid,nv
296			character() fname,vname,atname
297	edhill	1.8	REAL8 dval()
298	edhill	1.14	CEOP
299	jmc	1.17	real*4 sZero(1)
300			integer iZero(1)
301			sZero(1) = 0.0
302			iZero(1) = 0
303	edhill	1.5
304	edhill	1.13	CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
305	jmc	1.17	& 2, ' ', nv, dval, sZero, iZero, myThid)
306	edhill	1.5	RETURN
307			END
308
309	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
310	edhill	1.16	CBOP 1
311	edhill	1.15	C !ROUTINE: MNC_VAR_ADD_ATTR_REAL
312	edhill	1.5
313	edhill	1.14	C !INTERFACE:
314	edhill	1.5	SUBROUTINE MNC_VAR_ADD_ATTR_REAL(
315			I fname,
316			I vname,
317			I atname,
318			I nv,
319	edhill	1.13	I rval,
320			I myThid )
321	edhill	1.5
322	edhill	1.14	C !DESCRIPTION:
323			C Subroutine for adding a single-precision real attribute to a
324			C NetCDF file.
325
326			C !USES:
327	edhill	1.5	implicit none
328	edhill	1.14
329			C !INPUT PARAMETERS:
330	edhill	1.5	integer myThid,nv
331			character() fname,vname,atname
332	edhill	1.8	REAL4 rval()
333	edhill	1.14	CEOP
334	jmc	1.17	real*8 dZero(1)
335			integer iZero(1)
336			dZero(1) = 0.0D0
337			iZero(1) = 0
338	edhill	1.5
339	edhill	1.13	CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
340	jmc	1.17	& 3, ' ', nv, dZero, rval, iZero, myThid)
341	edhill	1.5	RETURN
342			END
343
344	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
345	edhill	1.16	CBOP 1
346	edhill	1.14	C !ROUTINE: MNC_VAR_ADD_ATTR_INT
347	edhill	1.5
348	edhill	1.14	C !INTERFACE:
349	edhill	1.5	SUBROUTINE MNC_VAR_ADD_ATTR_INT(
350			I fname,
351			I vname,
352			I atname,
353			I nv,
354	edhill	1.13	I ival,
355			I myThid )
356	edhill	1.5
357	edhill	1.14	C !DESCRIPTION:
358			C Subroutine for adding an integer attribute to a
359			C NetCDF file.
360
361			C !USES:
362	edhill	1.5	implicit none
363	edhill	1.14
364			C !INPUT PARAMETERS:
365	edhill	1.5	integer myThid,nv
366			character() fname,vname,atname
367			integer ival(*)
368	edhill	1.14	CEOP
369	jmc	1.17	real*8 dZero(1)
370			real*4 sZero(1)
371			dZero(1) = 0.0D0
372			sZero(1) = 0.0
373	edhill	1.5
374	edhill	1.13	CALL MNC_VAR_ADD_ATTR_ANY(fname,vname,atname,
375	jmc	1.17	& 4, ' ', nv, dZero, sZero, ival, myThid)
376	edhill	1.5	RETURN
377			END
378
379	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
380	edhill	1.16	CBOP 1
381	edhill	1.14	C !ROUTINE: MNC_VAR_ADD_ATTR_ANY
382	edhill	1.5
383	edhill	1.14	C !INTERFACE:
384	edhill	1.5	SUBROUTINE MNC_VAR_ADD_ATTR_ANY(
385			I fname,
386			I vname,
387			I atname,
388	edhill	1.13	I atype, cs,len,dv,rv,iv,
389			I myThid )
390	edhill	1.5
391	edhill	1.14	C !DESCRIPTION:
392			C General subroutine for adding attributes to a NetCDF file.
393
394			C !USES:
395	edhill	1.5	implicit none
396	edhill	1.3	#include "netcdf.inc"
397			#include "mnc_common.h"
398			#include "EEPARAMS.h"
399
400	edhill	1.14	C !INPUT PARAMETERS:
401	edhill	1.5	integer myThid,atype,len
402			character() fname,vname,atname
403			character() cs
404	edhill	1.8	REAL8 dv()
405			REAL4 rv()
406	edhill	1.5	integer iv(*)
407	edhill	1.16	CEOP
408	edhill	1.3
409	edhill	1.14	C !LOCAL VARIABLES:
410	edhill	1.8	integer n, indf,ind_fv_ids, fid,vid, err
411	edhill	1.3	character*(MAX_LEN_MBUF) msgbuf
412			integer lenf,lenv,lenat,lens
413	edhill	1.16
414	edhill	1.14	C Functions
415			integer ILNBLNK
416	edhill	1.3
417			C Strip trailing spaces
418			lenf = ILNBLNK(fname)
419			lenv = ILNBLNK(vname)
420			lenat = ILNBLNK(atname)
421	edhill	1.5	lens = ILNBLNK(cs)
422	edhill	1.3
423	edhill	1.13	CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
424	edhill	1.4	IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
425			write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
426			& ''' is not open or does not contain variable ''',
427			& vname(1:lenv), ''''
428	edhill	1.3	CALL print_error(msgbuf, mythid)
429			stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
430			ENDIF
431			fid = mnc_f_info(indf,2)
432	edhill	1.4	vid = mnc_fv_ids(indf,(ind_fv_ids+1))
433	edhill	1.3
434			C Set the attribute
435	edhill	1.13	CALL MNC_FILE_REDEF(fname, myThid)
436	edhill	1.5	IF (atype .EQ. 1) THEN
437			err = NF_PUT_ATT_TEXT(fid, vid, atname, lens, cs)
438			ELSEIF (atype .EQ. 2) THEN
439			err = NF_PUT_ATT_DOUBLE(fid, vid, atname, NF_DOUBLE, len, dv)
440			ELSEIF (atype .EQ. 3) THEN
441			err = NF_PUT_ATT_REAL(fid, vid, atname, NF_FLOAT, len, rv)
442			ELSEIF (atype .EQ. 4) THEN
443			err = NF_PUT_ATT_INT(fid, vid, atname, NF_INT, len, iv)
444			ELSE
445			write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
446			& ''' is invalid--must be: [1-4]'
447			n = ILNBLNK(msgbuf)
448			CALL print_error(msgbuf(1:n), mythid)
449			stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
450			ENDIF
451	edhill	1.3	write(msgbuf,'(5a)') 'adding attribute ''', atname(1:lenat),
452	edhill	1.4	& ''' to file ''', fname(1:lenf), ''''
453	edhill	1.13	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
454	edhill	1.4
455			RETURN
456			END
457
458	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
459	edhill	1.4
460			SUBROUTINE MNC_VAR_WRITE_DBL(
461			I fname,
462			I vname,
463	edhill	1.13	I var,
464			I myThid )
465	edhill	1.4
466			implicit none
467	edhill	1.5	C Arguments
468			integer myThid
469			character() fname,vname
470	edhill	1.8	REAL8 var()
471	edhill	1.5
472	edhill	1.13	CALL MNC_VAR_WRITE_ANY(fname,vname,1,0,var,0.0,0, myThid)
473	edhill	1.5	RETURN
474			END
475
476	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
477	edhill	1.5
478			SUBROUTINE MNC_VAR_WRITE_REAL(
479			I fname,
480			I vname,
481	edhill	1.13	I var,
482			I myThid )
483	edhill	1.5
484			implicit none
485			C Arguments
486			integer myThid
487			character() fname,vname
488	edhill	1.8	REAL4 var()
489	edhill	1.5
490	edhill	1.13	CALL MNC_VAR_WRITE_ANY(fname,vname,2,0,0.0D0,var,0, myThid)
491	edhill	1.5	RETURN
492			END
493
494	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
495	edhill	1.5
496			SUBROUTINE MNC_VAR_WRITE_INT(
497			I fname,
498			I vname,
499	edhill	1.13	I var,
500			I myThid )
501	edhill	1.5
502			implicit none
503			C Arguments
504			integer myThid
505			character() fname,vname
506			integer var(*)
507
508	edhill	1.13	CALL MNC_VAR_WRITE_ANY(fname,vname,3,0,0.0D0,0.0,var, myThid)
509	edhill	1.9	RETURN
510			END
511
512	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
513	edhill	1.9
514			SUBROUTINE MNC_VAR_APPEND_DBL(
515			I fname,
516			I vname,
517			I var,
518	edhill	1.13	I append,
519			I myThid )
520	edhill	1.9
521			implicit none
522			C Arguments
523			integer myThid, append
524			character() fname,vname
525			REAL8 var()
526
527	edhill	1.13	CALL MNC_VAR_WRITE_ANY(fname,vname,1,append,var,0.0,0, myThid)
528	edhill	1.9	RETURN
529			END
530
531	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
532	edhill	1.9
533			SUBROUTINE MNC_VAR_APPEND_REAL(
534			I fname,
535			I vname,
536			I var,
537	edhill	1.13	I append,
538			I myThid )
539	edhill	1.9
540			implicit none
541			C Arguments
542			integer myThid, append
543			character() fname,vname
544			REAL4 var()
545
546	edhill	1.13	CALL MNC_VAR_WRITE_ANY(fname,vname,2,append,0.0D0,var,0,myThid)
547	edhill	1.9	RETURN
548			END
549
550	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
551	edhill	1.9
552			SUBROUTINE MNC_VAR_APPEND_INT(
553			I fname,
554			I vname,
555			I var,
556	edhill	1.13	I append,
557			I myThid )
558	edhill	1.9
559			implicit none
560			C Arguments
561			integer myThid, append
562			character() fname,vname
563			integer var(*)
564
565	edhill	1.13	CALL MNC_VAR_WRITE_ANY(fname,vname,3,append,0.0D0,0.0,var,myThid)
566	edhill	1.5	RETURN
567			END
568
569	edhill	1.11	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
570	edhill	1.5
571			SUBROUTINE MNC_VAR_WRITE_ANY(
572			I fname,
573			I vname,
574			I vtype,
575	edhill	1.9	I append,
576	edhill	1.5	I dv,
577			I rv,
578	edhill	1.13	I iv,
579			I myThid )
580	edhill	1.5
581			implicit none
582	edhill	1.4	#include "netcdf.inc"
583			#include "mnc_common.h"
584			#include "EEPARAMS.h"
585
586			C Arguments
587	edhill	1.5	integer myThid, vtype
588			character() fname,vname
589	edhill	1.8	REAL8 dv()
590			REAL4 rv()
591	edhill	1.5	integer iv(*)
592	edhill	1.9	integer append
593	edhill	1.4
594			C Functions
595			integer ILNBLNK
596
597			C Local Variables
598			integer i,j,k, n, indf,ind_fv_ids, fid,vid,did, ig, err, ds,de
599			character*(MAX_LEN_MBUF) msgbuf
600			integer lenf,lenv, lend
601			integer vstart(100), vcount(100)
602
603			C Strip trailing spaces
604			lenf = ILNBLNK(fname)
605			lenv = ILNBLNK(vname)
606
607	edhill	1.13	CALL MNC_GET_FVINDS(fname, vname, indf, ind_fv_ids, myThid)
608	edhill	1.4	IF ((indf .LT. 1).OR.(ind_fv_ids .LT. 1)) THEN
609			write(msgbuf,'(5a)') 'MNC ERROR: file ''', fname(1:lenf),
610			& ''' is not open or does not contain variable ''',
611			& vname(1:lenv), ''''
612			CALL print_error(msgbuf, mythid)
613			stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_STR'
614			ENDIF
615			fid = mnc_f_info(indf,2)
616			vid = mnc_fv_ids(indf,(ind_fv_ids+1))
617
618			C Get the lengths from the dim IDs
619			ig = mnc_fv_ids(indf,(ind_fv_ids+2))
620			ds = mnc_f_info(indf,ig+1)
621			de = mnc_f_info(indf,ig+2)
622			k = 0
623			DO i = ds,de
624			k = k + 1
625			vstart(k) = 1
626			vcount(k) = mnc_d_size( mnc_fd_ind(indf,i) )
627			ENDDO
628
629			C Check for the unlimited dimension
630			j = mnc_d_size( mnc_fd_ind(indf,de) )
631			IF (j .LT. 1) THEN
632	edhill	1.10	did = mnc_d_ids( mnc_fd_ind(indf,de) )
633	edhill	1.4	err = NF_INQ_DIMLEN(fid, did, lend)
634			write(msgbuf,'(a)') 'reading current length of unlimited dim'
635	edhill	1.13	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
636	edhill	1.9	IF (append .GT. 0) THEN
637			lend = lend + append
638			ENDIF
639			IF (lend .LT. 1) lend = 1
640	edhill	1.4	vstart(k) = lend
641			vcount(k) = 1
642			ENDIF
643
644	edhill	1.13	CALL MNC_FILE_ENDDEF(fname, myThid)
645	edhill	1.5	IF (vtype .EQ. 1) THEN
646			err = NF_PUT_VARA_DOUBLE(fid, vid, vstart, vcount, dv)
647			ELSEIF (vtype .EQ. 2) THEN
648			err = NF_PUT_VARA_REAL(fid, vid, vstart, vcount, rv)
649			ELSEIF (vtype .EQ. 3) THEN
650			err = NF_PUT_VARA_INT(fid, vid, vstart, vcount, iv)
651			ELSE
652			write(msgbuf,'(a,i10,a)') 'MNC ERROR: vtype = ''', vtype,
653			& ''' is invalid--must be: [1\|2\|3]'
654			n = ILNBLNK(msgbuf)
655			CALL print_error(msgbuf(1:n), mythid)
656			stop 'ABNORMAL END: S/R MNC_VAR_WRITE_ALL'
657			ENDIF
658	edhill	1.4	write(msgbuf,'(5a)') 'writing variable ''', vname(1:lenv),
659	edhill	1.3	& ''' to file ''', fname(1:lenf), ''''
660	edhill	1.13	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
661	edhill	1.1
662	edhill	1.2	RETURN
663	edhill	1.1	END
664	edhill	1.11
665			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
666	edhill	1.1