pkg/mnc/mnc_file.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_file.F,v 1.16 2004/04/02 16:12:48 edhill Exp $
C $Name:  $

#include "MNC_OPTIONS.h"

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_CREATE( 
     I     fname, 
     I     myThid )

C     !DESCRIPTION:
C     Create a NetCDF file.
      
C     !USES:
      implicit none

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

C     !LOCAL VARIABLES:
      integer indf

      CALL MNC_FILE_OPEN(fname, 0, indf, myThid)

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_OPEN( 
     I     fname, 
     I     itype, 
     O     indf, 
     I     myThid )

C     !DESCRIPTION:
C     Open or create a NetCDF file.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid,indf
      character*(*) fname
      integer itype
C     itype => [ 0=new | 1=append | 2=read-only ]
CEOP

C     !LOCAL VARIABLES:
      integer n, err, fid, nf
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer ILNBLNK

C     Is the file already open?
      nf = ILNBLNK(fname)
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
      IF (indf .GT. 0) THEN
        write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname(1:nf), 
     &       ''' is already open -- cannot open twice'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: package MNC'
      ENDIF

      write(msgbuf,'(3a)') 'opening ''', fname, ''''
      IF (itype .EQ. 0) THEN

C       Create new file
        err = NF_CREATE(fname, NF_CLOBBER, fid)
        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)

      ELSEIF (itype .EQ. 1) THEN

C       Append to existing file
        CALL MNC_FILE_READALL(fname, myThid)

      ELSE
C       Error
        write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype, 
     &       ''' is not defined--should be: [0|1]'
        CALL print_error( msgbuf, mythid )
        stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'
      ENDIF

      CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_f_names,indf, myThid)
      n = ILNBLNK(fname)
      mnc_f_names(indf)(1:n) = fname(1:n)
      mnc_f_info(indf,1) = 1
      mnc_f_info(indf,2) = fid
      mnc_f_info(indf,3) = 0
      mnc_fv_ids(indf,1) = 0
      mnc_f_alld(indf,1) = 0

      RETURN
      END

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

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

C     !DESCRIPTION:
C     Add a character string attribute to a NetCDF file.

C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid
      character*(*) fname, atname, sval
CEOP
      real*4 sZero
      sZero = 0.

      CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 1, 
     &     sval, 0, 0.0D0, sZero, 0, myThid )
      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_ADD_ATTR_DBL( 
     I     fname, 
     I     atname, 
     I     len, 
     I     dval, 
     I     myThid )

C     !DESCRIPTION:
C     Add a double-precision real attribute to a NetCDF file.

C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid, len
      character*(*) fname, atname
      REAL*8 dval
CEOP
      real*4 sZero
      sZero = 0.

      CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 2, 
     &     ' ', len, dval, sZero, 0, myThid )
      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_ADD_ATTR_REAL( 
     I     fname, 
     I     atname, 
     I     len, 
     I     rval, 
     I     myThid )

C     !DESCRIPTION:
C     Add a single-precision real attribute to a NetCDF file.

C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid, len
      character*(*) fname, atname
      REAL*4 rval
CEOP

      CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 3, 
     &     ' ', len, 0.0D0, rval, 0, myThid )
      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_ADD_ATTR_INT( 
     I     fname, 
     I     atname, 
     I     len, 
     I     ival, 
     I     myThid )

C     !DESCRIPTION:
C     Add an integer attribute to a NetCDF file.

C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid, len, ival
      character*(*) fname, atname
CEOP
      real*4 sZero
      sZero = 0.

      CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 4, 
     &     ' ', len, 0.0D0, sZero, ival, myThid )
      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_ADD_ATTR_ANY( 
     I     fname, 
     I     atname, 
     I     atype, sv, len,dv,rv,iv, 
     I     myThid )

C     !DESCRIPTION:
C     Add all 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, iv
      character*(*) fname, atname, sv
      REAL*8 dv
      REAL*4 rv
CEOP

C     !LOCAL VARIABLES:
      integer n, err, fid, ind, n1, lens
      character*(MNC_MAX_CHAR) s1
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer ILNBLNK

C     Verify that the file is open
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, ind, myThid)
      IF (ind .LT. 0) THEN
        write(msgbuf,'(3a)') 'MNC ERROR: file ''',
     &       fname, ''' must be opened first'
        CALL print_error( msgbuf, mythid )
        stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_INT'
      ENDIF
      fid = mnc_f_info(ind,2)

C     Enter define mode
      CALL MNC_FILE_REDEF(fname, myThid)

      s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
      n1 = ILNBLNK(atname)
      s1(1:n1) = atname(1:n1)

      IF (atype .EQ. 1) THEN
        lens = ILNBLNK(sv)
        err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, lens, sv)
        CALL MNC_HANDLE_ERR(err,
     &       'adding TEXT attribute in S/R MNC_FILE_ADD_ATTR_ANY', 
     &       myThid)
      ELSEIF (atype .EQ. 2) THEN
        err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, len, dv)
        CALL MNC_HANDLE_ERR(err,
     &       'adding DOUBLE attribute in S/R MNC_FILE_ADD_ATTR_ANY',
     &       myThid)
      ELSEIF (atype .EQ. 3) THEN
        err = NF_PUT_ATT_REAL(fid, NF_GLOBAL, s1, NF_FLOAT, len, rv)
        CALL MNC_HANDLE_ERR(err,
     &       'adding REAL attribute in S/R MNC_FILE_ADD_ATTR_ANY',
     &       myThid)
      ELSEIF (atype .EQ. 4) THEN
        err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, len, iv)
        CALL MNC_HANDLE_ERR(err,
     &       'adding INT attribute in S/R MNC_FILE_ADD_ATTR_ANY',
     &       myThid)
      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

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_CLOSE( 
     I     fname, 
     I     myThid )

C     !DESCRIPTION:
C     Close a NetCDF file.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer i,j,k,n, err, fid, indf, nf
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer ILNBLNK

      nf = ILNBLNK(fname)

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 Warning: file ''', fname(1:nf), 
     &       ''' is already closed'
        CALL print_error( msgbuf, mythid )
        RETURN
      ENDIF
      fid = mnc_f_info(indf,2)
      err = NF_CLOSE(fid)
      write(msgbuf,'(3a)') ' cannot close file ''', fname(1:nf), ''''
      CALL MNC_HANDLE_ERR(err, msgbuf, myThid)

C     Clear all the info associated with this file
C     variables
      n = mnc_fv_ids(indf,1)
      IF (n .GE. 1) THEN
        DO i = 1,n
          j = 2 + 3*(i - 1)
          k = mnc_fv_ids(indf,j)
          mnc_v_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
        ENDDO
        DO i = 1,MNC_MAX_INFO
          mnc_fv_ids(indf,i) = 0
        ENDDO
      ENDIF
C     dims
      n = mnc_f_alld(indf,1)
      mnc_f_alld(indf,1) = 0
      DO i = 1,n
        j = mnc_f_alld(indf,i+1)
        mnc_d_ids(j)  = 0
        mnc_d_size(j) = 0
        mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
        mnc_f_alld(indf,i+1) = 0
      ENDDO
C     grids
      n = mnc_f_info(indf,3)
      IF (n .GT. 0) THEN
        DO i = 1,n
          j = 4 + 3*(i - 1)
          k = mnc_f_info(indf,j)
          mnc_g_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
        ENDDO
        DO i = 1,MNC_MAX_INFO
          mnc_fd_ind(indf,i) = 0
          mnc_f_info(indf,i) = 0
        ENDDO
      ENDIF
C     file name
      mnc_f_names(indf)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_CLOSE_ALL_MATCHING( 
     I     fname, 
     I     myThid ) 

C     !DESCRIPTION:
C     Close all files matching a character string.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer i,n

C     Functions
      integer ILNBLNK

      n = ILNBLNK(fname)
      DO i = 1,MNC_MAX_ID

C       Check that the file is open
        IF (fname(1:n) .EQ. mnc_f_names(i)(1:n)) THEN
          CALL MNC_FILE_CLOSE(mnc_f_names(i), myThid)
        ENDIF

      ENDDO

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_CLOSE_ALL( 
     I     myThid ) 

C     !DESCRIPTION:
C     Close all NetCDF files matching a string.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid
CEOP

C     !LOCAL VARIABLES:
      integer i

      DO i = 1,MNC_MAX_ID

C       Check that the file is open
        IF (mnc_f_names(i)(1:MNC_MAX_CHAR) 
     &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
          CALL MNC_FILE_CLOSE(mnc_f_names(i), myThid)
        ENDIF

      ENDDO

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_REDEF( 
     I     fname, 
     I     myThid )

C     !DESCRIPTION:
C     Set the NetCDF file to DEFINE mode.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer ind, fid, def, err, n
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer ILNBLNK

C     Verify that the file is open
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, ind, myThid)
      IF (ind .LT. 0) THEN
        n = ILNBLNK(fname)
        write(msgbuf,'(3a)') 'MNC ERROR: file ''',
     &       fname(1:n), ''' must be opened first'
        CALL print_error( msgbuf, mythid )
        stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
      ENDIF
      def = mnc_f_info(ind,1)
      fid = mnc_f_info(ind,2)

      IF (def .NE. 1) THEN
C       Enter define mode
        err = NF_REDEF(fid)
        CALL MNC_HANDLE_ERR(err, 
     &       'entering define mode in S/R MNC_FILE_REDEF', myThid)
        mnc_f_info(ind,1) = 1
      ENDIF

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_ENDDEF( 
     I     fname, 
     I     myThid )

C     !DESCRIPTION:
C     End DEFINE mode for a NetCDF file.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer ind, fid, def, err, n
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer ILNBLNK

C     Verify that the file is open
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, ind, myThid)
      IF (ind .LT. 0) THEN
        n = ILNBLNK(fname)
        write(msgbuf,'(3a)') 'MNC ERROR: file ''',
     &       fname(1:n), ''' must be opened first'
        CALL print_error( msgbuf, mythid )
        stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
      ENDIF
      def = mnc_f_info(ind,1)
      fid = mnc_f_info(ind,2)

      IF (def .NE. 2) THEN
C       Enter define mode
        err = NF_ENDDEF(fid)
        CALL MNC_HANDLE_ERR(err, 
     &       'ending define mode in S/R MNC_FILE_ENDDEF', myThid)
        mnc_f_info(ind,1) = 2
      ENDIF

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_READALL( 
     I     fname, 
     I     myThid ) 

C     !DESCRIPTION:
C     Try to open and read a NetCDF file.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "EEPARAMS.h"

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

C     Functions
      integer IFNBLNK, ILNBLNK

C     Local Variables
      integer ierr, nff,nlf, indf
      character*(MAX_LEN_MBUF) msgbuf

      nff = IFNBLNK(fname)
      nlf = ILNBLNK(fname)
      CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
      write(msgbuf,'(3a)') 'MNC ERROR: cannot open file ''', 
     &     fname(nff:nlf), ''' for read/write access'
      CALL MNC_HANDLE_ERR(ierr, msgbuf, myThid)

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_FILE_TRY_READ( 
     I     fname, 
     O     ierr, 
     O     indf, 
     I     myThid ) 

C     !DESCRIPTION:
C     Try to open and read a NetCDF file.
      
C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid, ierr, indf
      character*(*) fname

C     !LOCAL VARIABLES:
      integer i,j,k, fid, err, ndim,nvar,ngat,unlimid
      integer dlen, id, xtype, nat, nff,nlf, iv
      integer ndv, did, ns,ne, n1,n2, indg, indv
      character*(MAX_LEN_MBUF) msgbuf
      character*(NF_MAX_NAME) name
      integer idlist(NF_MAX_VAR_DIMS)
      character*(MNC_MAX_CHAR) dnames(20)
CEOP
C     Functions
      integer IFNBLNK, ILNBLNK

C     Open and save the filename and fID
      nff = IFNBLNK(fname)
      nlf = ILNBLNK(fname)
      err = NF_OPEN(fname, NF_WRITE, fid)
      ierr = NF_NOERR
      IF (err .NE. NF_NOERR) THEN
        ierr = err
        RETURN
      ENDIF
      CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_f_names,indf, myThid)
      mnc_f_names(indf)(1:(nlf-nff+1)) = fname(nff:nlf)
      mnc_f_info(indf,2) = fid

C     Get the overall number of entities
      err = NF_INQ(fid, ndim, nvar, ngat, unlimid)
      write(msgbuf,'(4a)') 'MNC ERROR: cannot read number of dims',
     &     ' in file ''', fname(nff:nlf), ''''
      CALL MNC_HANDLE_ERR(err, msgbuf, myThid)

C     Read each dimension and save the information
      DO id = 1,ndim
        err = NF_INQ_DIM(fid, id, name, dlen)
        write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read dimension',
     &       ' info for dim ''', id, ''' in file ''', 
     &       fname(nff:nlf), ''''
        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
        IF (id .EQ. unlimid) THEN
          dlen = -1
        ENDIF
        ns = IFNBLNK(name)
        ne = ILNBLNK(name)
        CALL MNC_DIM_INIT_ALL(fname,name(ns:ne),dlen,'N', myThid)
        DO i = 1,mnc_f_alld(indf,1)
          j = mnc_f_alld(indf,i+1)
          n1 = IFNBLNK(mnc_d_names(j))
          n2 = ILNBLNK(mnc_d_names(j))
          IF (((ne-ns) .EQ. (n2-n1)) 
     &         .AND. (mnc_d_names(j)(ns:ne) .EQ. name(ns:ne))) THEN
            mnc_d_ids(j) = id
            goto 10
          ENDIF
        ENDDO
 10     CONTINUE
      ENDDO

C     Read and save each variable
      DO id = 1,nvar
        err = NF_INQ_VAR(fid, id, name, xtype, ndv, idlist, nat)
        write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read variable',
     &       ' info for variable ''', id, ''' in file ''', 
     &       fname(nff:nlf), ''''
        CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
        n1 = IFNBLNK(name)
        n2 = ILNBLNK(name)
        
C       Create a grid for this variable
        DO i = 1,ndv
          did = idlist(i)
          dnames(i)(1:MNC_MAX_CHAR) = mnc_d_names(did)(1:MNC_MAX_CHAR)
        ENDDO
        CALL MNC_GRID_INIT_ALL(fname, name, ndv, dnames, indg, myThid)

C       Update the tables
        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,indv,myThid)
        mnc_v_names(indv)(1:(n2-n1+1)) = name(n1:n2)
        iv = 2 + 3*mnc_fv_ids(indf,1)
        mnc_fv_ids(indf,iv)   = indv
        mnc_fv_ids(indf,iv+1) = id
        DO i = 1,mnc_f_info(indf,3)
          j = 4 + 3*(i-1)
          k = mnc_f_info(indf,j)
          IF (k .EQ. indg) THEN
            mnc_fv_ids(indf,iv+2) = j
            GOTO 20
          ENDIF
        ENDDO
 20     CONTINUE
        mnc_fv_ids(indf,1) = mnc_fv_ids(indf,1) + 1
        
      ENDDO

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	jmc	1.17	C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_file.F,v 1.16 2004/04/02 16:12:48 edhill Exp $
2	edhill	1.1	C $Name: $
3
4			#include "MNC_OPTIONS.h"
5
6	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7	edhill	1.16	CBOP 0
8	edhill	1.15	C !ROUTINE: MNC_FILE_CREATE
9	edhill	1.1
10	edhill	1.15	C !INTERFACE:
11	edhill	1.3	SUBROUTINE MNC_FILE_CREATE(
12	edhill	1.14	I fname,
13			I myThid )
14	edhill	1.3
15	edhill	1.15	C !DESCRIPTION:
16			C Create a NetCDF file.
17
18			C !USES:
19	edhill	1.3	implicit none
20
21	edhill	1.15	C !INPUT PARAMETERS:
22	edhill	1.3	integer myThid
23			character() fname
24	edhill	1.16	CEOP
25	edhill	1.3
26	edhill	1.15	C !LOCAL VARIABLES:
27	edhill	1.12	integer indf
28
29	edhill	1.14	CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
30	edhill	1.3
31			RETURN
32			END
33
34	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
35	edhill	1.16	CBOP 0
36	edhill	1.15	C !ROUTINE: MNC_FILE_OPEN
37	edhill	1.3
38	edhill	1.15	C !INTERFACE:
39	edhill	1.1	SUBROUTINE MNC_FILE_OPEN(
40			I fname,
41	edhill	1.12	I itype,
42	edhill	1.14	O indf,
43			I myThid )
44	edhill	1.1
45	edhill	1.15	C !DESCRIPTION:
46			C Open or create a NetCDF file.
47
48			C !USES:
49	edhill	1.1	implicit none
50			#include "netcdf.inc"
51			#include "mnc_common.h"
52			#include "EEPARAMS.h"
53
54	edhill	1.15	C !INPUT PARAMETERS:
55	edhill	1.12	integer myThid,indf
56	edhill	1.1	character() fname
57			integer itype
58	edhill	1.13	C itype => [ 0=new \| 1=append \| 2=read-only ]
59	edhill	1.16	CEOP
60	edhill	1.1
61	edhill	1.15	C !LOCAL VARIABLES:
62			integer n, err, fid, nf
63			character*(MAX_LEN_MBUF) msgbuf
64	edhill	1.16
65	edhill	1.3	C Functions
66			integer ILNBLNK
67
68	edhill	1.1	C Is the file already open?
69	edhill	1.13	nf = ILNBLNK(fname)
70	edhill	1.14	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
71	edhill	1.12	IF (indf .GT. 0) THEN
72	edhill	1.13	write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname(1:nf),
73	edhill	1.1	& ''' is already open -- cannot open twice'
74	edhill	1.12	CALL print_error(msgbuf, mythid)
75	edhill	1.1	stop 'ABNORMAL END: package MNC'
76			ENDIF
77
78	edhill	1.3	write(msgbuf,'(3a)') 'opening ''', fname, ''''
79	edhill	1.12	IF (itype .EQ. 0) THEN
80	edhill	1.9
81	edhill	1.1	C Create new file
82	edhill	1.9	err = NF_CREATE(fname, NF_CLOBBER, fid)
83	edhill	1.14	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
84	edhill	1.9
85	edhill	1.12	ELSEIF (itype .EQ. 1) THEN
86	edhill	1.9
87	edhill	1.1	C Append to existing file
88	edhill	1.14	CALL MNC_FILE_READALL(fname, myThid)
89	edhill	1.9
90	edhill	1.1	ELSE
91			C Error
92			write(msgbuf,'(a,i5,a)') 'MNC_FILE_OPEN ERROR: ''', itype,
93			& ''' is not defined--should be: [0\|1]'
94	edhill	1.3	CALL print_error( msgbuf, mythid )
95			stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_STR'
96	edhill	1.1	ENDIF
97
98	edhill	1.14	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_f_names,indf, myThid)
99	edhill	1.3	n = ILNBLNK(fname)
100	edhill	1.12	mnc_f_names(indf)(1:n) = fname(1:n)
101			mnc_f_info(indf,1) = 1
102			mnc_f_info(indf,2) = fid
103			mnc_f_info(indf,3) = 0
104			mnc_fv_ids(indf,1) = 0
105			mnc_f_alld(indf,1) = 0
106	edhill	1.1
107	edhill	1.3	RETURN
108	edhill	1.1	END
109
110	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
111	edhill	1.16	CBOP 0
112	edhill	1.15	C !ROUTINE: MNC_FILE_ADD_ATTR_STR
113	edhill	1.1
114	edhill	1.15	C !INTERFACE:
115	edhill	1.1	SUBROUTINE MNC_FILE_ADD_ATTR_STR(
116			I fname,
117			I atname,
118	edhill	1.14	I sval,
119			I myThid )
120	edhill	1.1
121	edhill	1.15	C !DESCRIPTION:
122			C Add a character string attribute to a NetCDF file.
123
124			C !USES:
125	edhill	1.1	implicit none
126	edhill	1.15
127			C !INPUT PARAMETERS:
128	edhill	1.7	integer myThid
129	edhill	1.5	character() fname, atname, sval
130	edhill	1.15	CEOP
131	jmc	1.17	real*4 sZero
132			sZero = 0.
133	edhill	1.5
134	edhill	1.14	CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 1,
135	jmc	1.17	& sval, 0, 0.0D0, sZero, 0, myThid )
136	edhill	1.5	RETURN
137			END
138	edhill	1.1
139	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
140	edhill	1.16	CBOP 0
141	edhill	1.15	C !ROUTINE: MNC_FILE_ADD_ATTR_DBL
142	edhill	1.1
143	edhill	1.15	C !INTERFACE:
144	edhill	1.5	SUBROUTINE MNC_FILE_ADD_ATTR_DBL(
145			I fname,
146			I atname,
147			I len,
148	edhill	1.14	I dval,
149			I myThid )
150	edhill	1.1
151	edhill	1.15	C !DESCRIPTION:
152			C Add a double-precision real attribute to a NetCDF file.
153
154			C !USES:
155	edhill	1.5	implicit none
156	edhill	1.15
157			C !INPUT PARAMETERS:
158	edhill	1.5	integer myThid, len
159			character() fname, atname
160	edhill	1.7	REAL*8 dval
161	edhill	1.15	CEOP
162	jmc	1.17	real*4 sZero
163			sZero = 0.
164	edhill	1.1
165	edhill	1.14	CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 2,
166	jmc	1.17	& ' ', len, dval, sZero, 0, myThid )
167	edhill	1.5	RETURN
168			END
169	edhill	1.1
170	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
171	edhill	1.16	CBOP 0
172	edhill	1.15	C !ROUTINE: MNC_FILE_ADD_ATTR_REAL
173	edhill	1.1
174	edhill	1.15	C !INTERFACE:
175	edhill	1.5	SUBROUTINE MNC_FILE_ADD_ATTR_REAL(
176			I fname,
177			I atname,
178			I len,
179	edhill	1.14	I rval,
180			I myThid )
181	edhill	1.1
182	edhill	1.15	C !DESCRIPTION:
183			C Add a single-precision real attribute to a NetCDF file.
184
185			C !USES:
186	edhill	1.5	implicit none
187	edhill	1.15
188			C !INPUT PARAMETERS:
189	edhill	1.5	integer myThid, len
190			character() fname, atname
191	edhill	1.7	REAL*4 rval
192	edhill	1.15	CEOP
193	edhill	1.1
194	edhill	1.14	CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 3,
195			& ' ', len, 0.0D0, rval, 0, myThid )
196	edhill	1.3	RETURN
197	edhill	1.1	END
198
199	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
200	edhill	1.16	CBOP 0
201	edhill	1.15	C !ROUTINE: MNC_FILE_ADD_ATTR_INT
202	edhill	1.1
203	edhill	1.15	C !INTERFACE:
204	edhill	1.1	SUBROUTINE MNC_FILE_ADD_ATTR_INT(
205			I fname,
206			I atname,
207	edhill	1.5	I len,
208	edhill	1.14	I ival,
209			I myThid )
210	edhill	1.1
211	edhill	1.15	C !DESCRIPTION:
212			C Add an integer attribute to a NetCDF file.
213
214			C !USES:
215	edhill	1.1	implicit none
216	edhill	1.15
217			C !INPUT PARAMETERS:
218	edhill	1.5	integer myThid, len, ival
219	edhill	1.1	character() fname, atname
220	edhill	1.15	CEOP
221	jmc	1.17	real*4 sZero
222			sZero = 0.
223	edhill	1.1
224	edhill	1.14	CALL MNC_FILE_ADD_ATTR_ANY(fname,atname, 4,
225	jmc	1.17	& ' ', len, 0.0D0, sZero, ival, myThid )
226	edhill	1.3	RETURN
227	edhill	1.1	END
228
229	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
230	edhill	1.16	CBOP 1
231	edhill	1.15	C !ROUTINE: MNC_FILE_ADD_ATTR_ANY
232	edhill	1.1
233	edhill	1.15	C !INTERFACE:
234	edhill	1.5	SUBROUTINE MNC_FILE_ADD_ATTR_ANY(
235	edhill	1.1	I fname,
236			I atname,
237	edhill	1.14	I atype, sv, len,dv,rv,iv,
238			I myThid )
239	edhill	1.1
240	edhill	1.15	C !DESCRIPTION:
241			C Add all attributes to a NetCDF file.
242
243			C !USES:
244	edhill	1.5	implicit none
245	edhill	1.1	#include "netcdf.inc"
246			#include "mnc_common.h"
247			#include "EEPARAMS.h"
248
249	edhill	1.15	C !INPUT PARAMETERS:
250	edhill	1.5	integer myThid, atype, len, iv
251			character() fname, atname, sv
252	edhill	1.7	REAL*8 dv
253			REAL*4 rv
254	edhill	1.16	CEOP
255
256	edhill	1.15	C !LOCAL VARIABLES:
257			integer n, err, fid, ind, n1, lens
258			character*(MNC_MAX_CHAR) s1
259			character*(MAX_LEN_MBUF) msgbuf
260	edhill	1.16
261	edhill	1.1	C Functions
262			integer ILNBLNK
263
264	edhill	1.4	C Verify that the file is open
265	edhill	1.14	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, ind, myThid)
266	edhill	1.4	IF (ind .LT. 0) THEN
267	edhill	1.1	write(msgbuf,'(3a)') 'MNC ERROR: file ''',
268			& fname, ''' must be opened first'
269			CALL print_error( msgbuf, mythid )
270			stop 'ABNORMAL END: S/R MNC_FILE_ADD_ATTR_INT'
271			ENDIF
272	edhill	1.2	fid = mnc_f_info(ind,2)
273	edhill	1.1
274			C Enter define mode
275	edhill	1.14	CALL MNC_FILE_REDEF(fname, myThid)
276	edhill	1.1
277			s1(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
278			n1 = ILNBLNK(atname)
279			s1(1:n1) = atname(1:n1)
280
281	edhill	1.5	IF (atype .EQ. 1) THEN
282			lens = ILNBLNK(sv)
283			err = NF_PUT_ATT_TEXT(fid, NF_GLOBAL, s1, lens, sv)
284	edhill	1.14	CALL MNC_HANDLE_ERR(err,
285			& 'adding TEXT attribute in S/R MNC_FILE_ADD_ATTR_ANY',
286			& myThid)
287	edhill	1.5	ELSEIF (atype .EQ. 2) THEN
288			err = NF_PUT_ATT_DOUBLE(fid, NF_GLOBAL, s1, NF_DOUBLE, len, dv)
289	edhill	1.14	CALL MNC_HANDLE_ERR(err,
290			& 'adding DOUBLE attribute in S/R MNC_FILE_ADD_ATTR_ANY',
291			& myThid)
292	edhill	1.5	ELSEIF (atype .EQ. 3) THEN
293			err = NF_PUT_ATT_REAL(fid, NF_GLOBAL, s1, NF_FLOAT, len, rv)
294	edhill	1.14	CALL MNC_HANDLE_ERR(err,
295			& 'adding REAL attribute in S/R MNC_FILE_ADD_ATTR_ANY',
296			& myThid)
297	edhill	1.5	ELSEIF (atype .EQ. 4) THEN
298			err = NF_PUT_ATT_INT(fid, NF_GLOBAL, s1, NF_INT, len, iv)
299	edhill	1.14	CALL MNC_HANDLE_ERR(err,
300			& 'adding INT attribute in S/R MNC_FILE_ADD_ATTR_ANY',
301			& myThid)
302	edhill	1.5	ELSE
303			write(msgbuf,'(a,i10,a)') 'MNC ERROR: atype = ''', atype,
304			& ''' is invalid--must be: [1-4]'
305			n = ILNBLNK(msgbuf)
306			CALL print_error(msgbuf(1:n), mythid)
307			stop 'ABNORMAL END: S/R MNC_VAR_ADD_ATTR_ANY'
308			ENDIF
309	edhill	1.3
310			RETURN
311			END
312
313	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
314	edhill	1.16	CBOP 1
315	edhill	1.15	C !ROUTINE: MNC_FILE_CLOSE
316	edhill	1.3
317	edhill	1.15	C !INTERFACE:
318	edhill	1.3	SUBROUTINE MNC_FILE_CLOSE(
319	edhill	1.14	I fname,
320			I myThid )
321	edhill	1.3
322	edhill	1.15	C !DESCRIPTION:
323			C Close a NetCDF file.
324
325			C !USES:
326	edhill	1.3	implicit none
327			#include "netcdf.inc"
328			#include "mnc_common.h"
329			#include "EEPARAMS.h"
330
331	edhill	1.15	C !INPUT PARAMETERS:
332	edhill	1.3	integer myThid
333			character() fname
334	edhill	1.16	CEOP
335	edhill	1.3
336	edhill	1.15	C !LOCAL VARIABLES:
337			integer i,j,k,n, err, fid, indf, nf
338			character*(MAX_LEN_MBUF) msgbuf
339	edhill	1.16
340	edhill	1.13	C Functions
341			integer ILNBLNK
342
343			nf = ILNBLNK(fname)
344
345	edhill	1.3	C Check that the file is open
346	edhill	1.14	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
347	edhill	1.13	IF (indf .LT. 1) THEN
348			write(msgbuf,'(3a)') 'MNC Warning: file ''', fname(1:nf),
349	edhill	1.3	& ''' is already closed'
350			CALL print_error( msgbuf, mythid )
351			RETURN
352			ENDIF
353	edhill	1.13	fid = mnc_f_info(indf,2)
354	edhill	1.3	err = NF_CLOSE(fid)
355	edhill	1.13	write(msgbuf,'(3a)') ' cannot close file ''', fname(1:nf), ''''
356	edhill	1.14	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
357	edhill	1.3
358	edhill	1.9	C Clear all the info associated with this file
359			C variables
360	edhill	1.13	n = mnc_fv_ids(indf,1)
361	edhill	1.3	IF (n .GE. 1) THEN
362			DO i = 1,n
363	edhill	1.9	j = 2 + 3*(i - 1)
364	edhill	1.13	k = mnc_fv_ids(indf,j)
365	edhill	1.3	mnc_v_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
366			ENDDO
367	edhill	1.13	DO i = 1,MNC_MAX_INFO
368			mnc_fv_ids(indf,i) = 0
369	edhill	1.9	ENDDO
370	edhill	1.3	ENDIF
371	edhill	1.9	C dims
372	edhill	1.13	n = mnc_f_alld(indf,1)
373			mnc_f_alld(indf,1) = 0
374	edhill	1.7	DO i = 1,n
375	edhill	1.13	j = mnc_f_alld(indf,i+1)
376	edhill	1.9	mnc_d_ids(j) = 0
377			mnc_d_size(j) = 0
378	edhill	1.7	mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
379	edhill	1.13	mnc_f_alld(indf,i+1) = 0
380	edhill	1.7	ENDDO
381	edhill	1.9	C grids
382	edhill	1.13	n = mnc_f_info(indf,3)
383	edhill	1.9	IF (n .GT. 0) THEN
384			DO i = 1,n
385			j = 4 + 3*(i - 1)
386	edhill	1.13	k = mnc_f_info(indf,j)
387	edhill	1.9	mnc_g_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
388			ENDDO
389			DO i = 1,MNC_MAX_INFO
390	edhill	1.13	mnc_fd_ind(indf,i) = 0
391			mnc_f_info(indf,i) = 0
392	edhill	1.9	ENDDO
393			ENDIF
394			C file name
395	edhill	1.13	mnc_f_names(indf)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
396	edhill	1.8
397			RETURN
398			END
399
400	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
401	edhill	1.16	CBOP 0
402	edhill	1.15	C !ROUTINE: MNC_FILE_CLOSE_ALL_MATCHING
403	edhill	1.8
404	edhill	1.15	C !INTERFACE:
405	edhill	1.8	SUBROUTINE MNC_FILE_CLOSE_ALL_MATCHING(
406	edhill	1.14	I fname,
407			I myThid )
408	edhill	1.8
409	edhill	1.15	C !DESCRIPTION:
410			C Close all files matching a character string.
411
412			C !USES:
413	edhill	1.8	implicit none
414			#include "netcdf.inc"
415			#include "mnc_common.h"
416			#include "EEPARAMS.h"
417
418	edhill	1.15	C !INPUT PARAMETERS:
419	edhill	1.8	integer myThid
420			character() fname
421	edhill	1.16	CEOP
422	edhill	1.8
423	edhill	1.15	C !LOCAL VARIABLES:
424			integer i,n
425	edhill	1.16
426	edhill	1.8	C Functions
427			integer ILNBLNK
428
429			n = ILNBLNK(fname)
430			DO i = 1,MNC_MAX_ID
431
432			C Check that the file is open
433			IF (fname(1:n) .EQ. mnc_f_names(i)(1:n)) THEN
434	edhill	1.14	CALL MNC_FILE_CLOSE(mnc_f_names(i), myThid)
435	edhill	1.8	ENDIF
436
437			ENDDO
438
439			RETURN
440			END
441
442	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
443	edhill	1.16	CBOP 0
444	edhill	1.15	C !ROUTINE: MNC_FILE_CLOSE_ALL
445	edhill	1.8
446	edhill	1.15	C !INTERFACE:
447	edhill	1.8	SUBROUTINE MNC_FILE_CLOSE_ALL(
448			I myThid )
449
450	edhill	1.15	C !DESCRIPTION:
451			C Close all NetCDF files matching a string.
452
453			C !USES:
454	edhill	1.8	implicit none
455			#include "netcdf.inc"
456			#include "mnc_common.h"
457			#include "EEPARAMS.h"
458
459	edhill	1.15	C !INPUT PARAMETERS:
460	edhill	1.8	integer myThid
461	edhill	1.16	CEOP
462	edhill	1.8
463	edhill	1.15	C !LOCAL VARIABLES:
464	edhill	1.8	integer i
465
466			DO i = 1,MNC_MAX_ID
467
468			C Check that the file is open
469			IF (mnc_f_names(i)(1:MNC_MAX_CHAR)
470			& .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
471	edhill	1.14	CALL MNC_FILE_CLOSE(mnc_f_names(i), myThid)
472	edhill	1.8	ENDIF
473
474			ENDDO
475	edhill	1.4
476			RETURN
477			END
478
479	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
480	edhill	1.16	CBOP 0
481	edhill	1.15	C !ROUTINE: MNC_FILE_REDEF
482	edhill	1.4
483	edhill	1.15	C !INTERFACE:
484	edhill	1.4	SUBROUTINE MNC_FILE_REDEF(
485	edhill	1.14	I fname,
486			I myThid )
487	edhill	1.4
488	edhill	1.15	C !DESCRIPTION:
489			C Set the NetCDF file to DEFINE mode.
490
491			C !USES:
492	edhill	1.4	implicit none
493			#include "netcdf.inc"
494			#include "mnc_common.h"
495			#include "EEPARAMS.h"
496
497	edhill	1.15	C !INPUT PARAMETERS:
498	edhill	1.4	integer myThid
499			character() fname
500	edhill	1.16	CEOP
501	edhill	1.4
502	edhill	1.15	C !LOCAL VARIABLES:
503			integer ind, fid, def, err, n
504			character*(MAX_LEN_MBUF) msgbuf
505	edhill	1.16
506	edhill	1.4	C Functions
507			integer ILNBLNK
508
509			C Verify that the file is open
510	edhill	1.14	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, ind, myThid)
511	edhill	1.4	IF (ind .LT. 0) THEN
512	edhill	1.7	n = ILNBLNK(fname)
513	edhill	1.4	write(msgbuf,'(3a)') 'MNC ERROR: file ''',
514	edhill	1.7	& fname(1:n), ''' must be opened first'
515	edhill	1.4	CALL print_error( msgbuf, mythid )
516			stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
517			ENDIF
518			def = mnc_f_info(ind,1)
519			fid = mnc_f_info(ind,2)
520
521			IF (def .NE. 1) THEN
522			C Enter define mode
523			err = NF_REDEF(fid)
524	edhill	1.14	CALL MNC_HANDLE_ERR(err,
525			& 'entering define mode in S/R MNC_FILE_REDEF', myThid)
526	edhill	1.4	mnc_f_info(ind,1) = 1
527			ENDIF
528
529			RETURN
530			END
531
532	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
533	edhill	1.16	CBOP 0
534	edhill	1.15	C !ROUTINE: MNC_FILE_ENDDEF
535	edhill	1.4
536	edhill	1.15	C !INTERFACE:
537	edhill	1.4	SUBROUTINE MNC_FILE_ENDDEF(
538	edhill	1.14	I fname,
539			I myThid )
540	edhill	1.4
541	edhill	1.15	C !DESCRIPTION:
542			C End DEFINE mode for a NetCDF file.
543
544			C !USES:
545	edhill	1.4	implicit none
546			#include "netcdf.inc"
547			#include "mnc_common.h"
548			#include "EEPARAMS.h"
549
550	edhill	1.15	C !INPUT PARAMETERS:
551	edhill	1.4	integer myThid
552			character() fname
553	edhill	1.16	CEOP
554	edhill	1.4
555	edhill	1.15	C !LOCAL VARIABLES:
556			integer ind, fid, def, err, n
557			character*(MAX_LEN_MBUF) msgbuf
558	edhill	1.16
559	edhill	1.4	C Functions
560			integer ILNBLNK
561
562			C Verify that the file is open
563	edhill	1.14	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, ind, myThid)
564	edhill	1.4	IF (ind .LT. 0) THEN
565	edhill	1.7	n = ILNBLNK(fname)
566	edhill	1.4	write(msgbuf,'(3a)') 'MNC ERROR: file ''',
567	edhill	1.7	& fname(1:n), ''' must be opened first'
568	edhill	1.4	CALL print_error( msgbuf, mythid )
569			stop 'ABNORMAL END: S/R MNC_FILE_REDEF'
570			ENDIF
571			def = mnc_f_info(ind,1)
572			fid = mnc_f_info(ind,2)
573
574			IF (def .NE. 2) THEN
575			C Enter define mode
576			err = NF_ENDDEF(fid)
577	edhill	1.14	CALL MNC_HANDLE_ERR(err,
578			& 'ending define mode in S/R MNC_FILE_ENDDEF', myThid)
579	edhill	1.4	mnc_f_info(ind,1) = 2
580			ENDIF
581	edhill	1.9
582			RETURN
583			END
584
585	edhill	1.10	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
586	edhill	1.16	CBOP 1
587			C !ROUTINE: MNC_FILE_TRY_READ
588	edhill	1.9
589	edhill	1.16	C !INTERFACE:
590	edhill	1.9	SUBROUTINE MNC_FILE_READALL(
591	edhill	1.14	I fname,
592			I myThid )
593	edhill	1.9
594	edhill	1.16	C !DESCRIPTION:
595			C Try to open and read a NetCDF file.
596
597			C !USES:
598	edhill	1.9	implicit none
599			#include "netcdf.inc"
600	edhill	1.11	#include "EEPARAMS.h"
601
602	edhill	1.15	C !INPUT PARAMETERS:
603	edhill	1.11	integer myThid
604			character() fname
605	edhill	1.16	CEOP
606	edhill	1.11
607			C Functions
608			integer IFNBLNK, ILNBLNK
609
610			C Local Variables
611	edhill	1.12	integer ierr, nff,nlf, indf
612	edhill	1.11	character*(MAX_LEN_MBUF) msgbuf
613
614			nff = IFNBLNK(fname)
615			nlf = ILNBLNK(fname)
616	edhill	1.14	CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
617	edhill	1.11	write(msgbuf,'(3a)') 'MNC ERROR: cannot open file ''',
618			& fname(nff:nlf), ''' for read/write access'
619	edhill	1.14	CALL MNC_HANDLE_ERR(ierr, msgbuf, myThid)
620	edhill	1.11
621			RETURN
622			END
623
624			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
625	edhill	1.16	CBOP 1
626	edhill	1.15	C !ROUTINE: MNC_FILE_TRY_READ
627	edhill	1.11
628	edhill	1.15	C !INTERFACE:
629	edhill	1.11	SUBROUTINE MNC_FILE_TRY_READ(
630			I fname,
631	edhill	1.12	O ierr,
632	edhill	1.14	O indf,
633			I myThid )
634	edhill	1.11
635	edhill	1.15	C !DESCRIPTION:
636			C Try to open and read a NetCDF file.
637
638			C !USES:
639	edhill	1.11	implicit none
640			#include "netcdf.inc"
641	edhill	1.9	#include "mnc_common.h"
642			#include "EEPARAMS.h"
643
644	edhill	1.15	C !INPUT PARAMETERS:
645	edhill	1.12	integer myThid, ierr, indf
646	edhill	1.9	character() fname
647
648	edhill	1.15	C !LOCAL VARIABLES:
649	edhill	1.9	integer i,j,k, fid, err, ndim,nvar,ngat,unlimid
650	edhill	1.12	integer dlen, id, xtype, nat, nff,nlf, iv
651	edhill	1.9	integer ndv, did, ns,ne, n1,n2, indg, indv
652			character*(MAX_LEN_MBUF) msgbuf
653			character*(NF_MAX_NAME) name
654			integer idlist(NF_MAX_VAR_DIMS)
655			character*(MNC_MAX_CHAR) dnames(20)
656	edhill	1.15	CEOP
657			C Functions
658			integer IFNBLNK, ILNBLNK
659	edhill	1.9
660			C Open and save the filename and fID
661			nff = IFNBLNK(fname)
662			nlf = ILNBLNK(fname)
663			err = NF_OPEN(fname, NF_WRITE, fid)
664	edhill	1.11	ierr = NF_NOERR
665			IF (err .NE. NF_NOERR) THEN
666			ierr = err
667			RETURN
668			ENDIF
669	edhill	1.14	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_f_names,indf, myThid)
670	edhill	1.9	mnc_f_names(indf)(1:(nlf-nff+1)) = fname(nff:nlf)
671			mnc_f_info(indf,2) = fid
672
673			C Get the overall number of entities
674			err = NF_INQ(fid, ndim, nvar, ngat, unlimid)
675			write(msgbuf,'(4a)') 'MNC ERROR: cannot read number of dims',
676			& ' in file ''', fname(nff:nlf), ''''
677	edhill	1.14	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
678	edhill	1.9
679			C Read each dimension and save the information
680			DO id = 1,ndim
681			err = NF_INQ_DIM(fid, id, name, dlen)
682			write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read dimension',
683			& ' info for dim ''', id, ''' in file ''',
684			& fname(nff:nlf), ''''
685	edhill	1.14	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
686	edhill	1.9	IF (id .EQ. unlimid) THEN
687			dlen = -1
688			ENDIF
689			ns = IFNBLNK(name)
690			ne = ILNBLNK(name)
691	edhill	1.14	CALL MNC_DIM_INIT_ALL(fname,name(ns:ne),dlen,'N', myThid)
692	edhill	1.9	DO i = 1,mnc_f_alld(indf,1)
693			j = mnc_f_alld(indf,i+1)
694			n1 = IFNBLNK(mnc_d_names(j))
695			n2 = ILNBLNK(mnc_d_names(j))
696			IF (((ne-ns) .EQ. (n2-n1))
697			& .AND. (mnc_d_names(j)(ns:ne) .EQ. name(ns:ne))) THEN
698			mnc_d_ids(j) = id
699			goto 10
700			ENDIF
701			ENDDO
702			10 CONTINUE
703			ENDDO
704
705			C Read and save each variable
706			DO id = 1,nvar
707			err = NF_INQ_VAR(fid, id, name, xtype, ndv, idlist, nat)
708			write(msgbuf,'(2a,i5,3a)') 'MNC ERROR: cannot read variable',
709			& ' info for variable ''', id, ''' in file ''',
710			& fname(nff:nlf), ''''
711	edhill	1.14	CALL MNC_HANDLE_ERR(err, msgbuf, myThid)
712	edhill	1.9	n1 = IFNBLNK(name)
713			n2 = ILNBLNK(name)
714
715			C Create a grid for this variable
716			DO i = 1,ndv
717			did = idlist(i)
718			dnames(i)(1:MNC_MAX_CHAR) = mnc_d_names(did)(1:MNC_MAX_CHAR)
719			ENDDO
720	edhill	1.14	CALL MNC_GRID_INIT_ALL(fname, name, ndv, dnames, indg, myThid)
721	edhill	1.9
722			C Update the tables
723	edhill	1.14	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID,mnc_v_names,indv,myThid)
724	edhill	1.9	mnc_v_names(indv)(1:(n2-n1+1)) = name(n1:n2)
725			iv = 2 + 3*mnc_fv_ids(indf,1)
726			mnc_fv_ids(indf,iv) = indv
727			mnc_fv_ids(indf,iv+1) = id
728			DO i = 1,mnc_f_info(indf,3)
729			j = 4 + 3*(i-1)
730			k = mnc_f_info(indf,j)
731			IF (k .EQ. indg) THEN
732			mnc_fv_ids(indf,iv+2) = j
733			GOTO 20
734			ENDIF
735			ENDDO
736			20 CONTINUE
737			mnc_fv_ids(indf,1) = mnc_fv_ids(indf,1) + 1
738
739			ENDDO
740	edhill	1.1
741	edhill	1.3	RETURN
742	edhill	1.1	END
743
744	edhill	1.16	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|