C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/mnc/mnc_file.F,v 1.7 2004/01/17 13:55:49 edhill Exp $
C $Name:  $

#include "MNC_OPTIONS.h"

C==================================================================

      SUBROUTINE MNC_FILE_CREATE( 
     I     myThid,
     I     fname )

      implicit none

C     Arguments
      integer myThid
      character*(*) fname

      CALL MNC_FILE_OPEN(myThid, fname, 0)

      RETURN
      END

C==================================================================

      SUBROUTINE MNC_FILE_OPEN( 
     I     myThid,
     I     fname, 
     I     itype )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid
      character*(*) fname
      integer itype
C     itype => [ 0=new | 1=append ]

C     Functions
      integer ILNBLNK

C     Local Variables
      integer n, err, fid, ind
      character*(MAX_LEN_MBUF) msgbuf

C     Is the file already open?
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
      IF ( ind .GT. 0 ) THEN
        write(msgbuf,'(3a)') 'MNC_FILE_OPEN ERROR: ''', fname, 
     &       ''' 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(myThid, err, msgbuf)
      ELSEIF ( itype .EQ. 1 ) THEN
C       Append to existing file
        err = NF_OPEN( fname, NF_WRITE, fid )
        CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
      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(myThid, MNC_MAX_ID, mnc_f_names, ind)
      n = ILNBLNK(fname)
      mnc_f_names(ind)(1:n) = fname(1:n)
      mnc_f_info(ind,1) = 1
      mnc_f_info(ind,2) = fid
      mnc_f_info(ind,3) = 0
      mnc_fv_ids(ind,1) = 0
      mnc_f_alld(ind,1) = 0

      RETURN
      END

C==================================================================

      SUBROUTINE MNC_FILE_ADD_ATTR_STR( 
     I     myThid, 
     I     fname, 
     I     atname, 
     I     sval )

      implicit none
C     Arguments
      integer myThid
      character*(*) fname, atname, sval

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

C==================================================================

      SUBROUTINE MNC_FILE_ADD_ATTR_DBL( 
     I     myThid, 
     I     fname, 
     I     atname, 
     I     len, 
     I     dval )

      implicit none
C     Arguments
      integer myThid, len
      character*(*) fname, atname
      REAL*8 dval

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

C==================================================================

      SUBROUTINE MNC_FILE_ADD_ATTR_REAL( 
     I     myThid, 
     I     fname, 
     I     atname, 
     I     len, 
     I     rval )

      implicit none
C     Arguments
      integer myThid, len
      character*(*) fname, atname
      REAL*4 rval

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

C==================================================================

      SUBROUTINE MNC_FILE_ADD_ATTR_INT( 
     I     myThid, 
     I     fname, 
     I     atname, 
     I     len, 
     I     ival )

      implicit none
C     Arguments
      integer myThid, len, ival
      character*(*) fname, atname

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

C==================================================================

      SUBROUTINE MNC_FILE_ADD_ATTR_ANY( 
     I     myThid, 
     I     fname, 
     I     atname, 
     I     atype, sv, len,dv,rv,iv )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid, atype, len, iv
      character*(*) fname, atname, sv
      REAL*8 dv
      REAL*4 rv
      
C     Functions
      integer ILNBLNK

C     Local Variables
      integer n, err, fid, ind, n1, lens
      character*(MNC_MAX_CHAR) s1
      character*(MAX_LEN_MBUF) msgbuf
      
C     Verify that the file is open
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
      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(myThid, fname)

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

      SUBROUTINE MNC_FILE_CLOSE( 
     I     myThid,
     I     fname )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid
      character*(*) fname

C     Local Variables
      integer i,j,k,n, err, fid, ind
      character*(MAX_LEN_MBUF) msgbuf

C     Check that the file is open
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
      IF (ind .LT. 1) THEN
        write(msgbuf,'(3a)') 'MNC Warning: file ''', fname, 
     &       ''' is already closed'
        CALL print_error( msgbuf, mythid )
        RETURN
      ENDIF
      fid = mnc_f_info(ind,2)
      err = NF_CLOSE(fid)
      write(msgbuf,'(3a)') ' cannot close file ''', fname, ''''
      CALL MNC_HANDLE_ERR(myThid, err, msgbuf)

C     Clear all the file, grid, variable, and dim names and refs
      n = mnc_fv_ids(ind,1)
      IF (n .GE. 1) THEN
        DO i = 1,n
          j = 2*i
          k = mnc_fv_ids(ind,j)
          mnc_v_names(k)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
        ENDDO
      ENDIF
      n = mnc_f_alld(ind,1)
      DO i = 1,n
        j = mnc_f_alld(ind,i+1)
        mnc_d_names(j)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
      ENDDO
      mnc_f_alld(ind,1) = 0
      DO i = 1,3
        mnc_f_info(ind,i) = 0
      ENDDO
      mnc_f_names(ind)(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)

      RETURN
      END

C==================================================================

      SUBROUTINE MNC_FILE_REDEF( 
     I     myThid,
     I     fname )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid
      character*(*) fname

C     Functions
      integer ILNBLNK

C     Local Variables
      integer ind, fid, def, err, n
      character*(MAX_LEN_MBUF) msgbuf

C     Verify that the file is open
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
      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(myThid, err, 
     &       'entering define mode in S/R MNC_FILE_REDEF')
        mnc_f_info(ind,1) = 1
      ENDIF

      RETURN
      END

C==================================================================

      SUBROUTINE MNC_FILE_ENDDEF( 
     I     myThid,
     I     fname )

      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

C     Arguments
      integer myThid
      character*(*) fname

C     Functions
      integer ILNBLNK

C     Local Variables
      integer ind, fid, def, err, n
      character*(MAX_LEN_MBUF) msgbuf

C     Verify that the file is open
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, ind)
      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(myThid, err, 
     &       'ending define mode in S/R MNC_FILE_ENDDEF')
        mnc_f_info(ind,1) = 2
      ENDIF

      RETURN
      END