pkg/mnc/mnc_cwrapper.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cwrapper.F,v 1.11 2004/03/29 03:33:51 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C     !ROUTINE: MNC_CW_ADD_GNAME

C     !INTERFACE:
      SUBROUTINE MNC_CW_ADD_GNAME( 
     I     name, 
     I     ndim, 
     I     dlens, 
     I     dnames, 
     I     inds_beg, inds_end, 
     I     myThid )

C     !DESCRIPTION:
C     Add a grid name to the MNC convenience wrapper layer.
      
C     !USES:
      implicit none
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid, ndim
      character*(*) name
      integer dlens(*), inds_beg(*), inds_end(*)
      character*(*) dnames(*)
CEOP

C     !LOCAL VARIABLES:
      integer i, nnf,nnl, indg
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer IFNBLNK, ILNBLNK

      nnf = IFNBLNK(name)
      nnl = ILNBLNK(name)

C     Check that this name is not already defined
      CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
      IF (indg .GT. 0) THEN
        write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name, 
     &       ''' is already defined'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
      ENDIF
      CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname, 
     &     indg, myThid)

      mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
      mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
      mnc_cw_ndim(indg) = ndim

      DO i = 1,ndim
        mnc_cw_dn(i,indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
        nnf = IFNBLNK(dnames(i))
        nnl = ILNBLNK(dnames(i))
        mnc_cw_dn(i,indg)(1:(nnl-nnf+1)) = dnames(i)(nnf:nnl)
        mnc_cw_dims(i,indg) = dlens(i)
        mnc_cw_is(i,indg)   = inds_beg(i)
        mnc_cw_ie(i,indg)   = inds_end(i)
      ENDDO

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_CW_DUMP( myThid )

C     !DESCRIPTION:
C     Write a condensed view of the current state of the MNC look-up
C     tables for the convenience wrapper section.
      
C     !USES:
      implicit none
#include "mnc_common.h"
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid
CEOP

C     !LOCAL VARIABLES:
      integer i,j, ntot
      integer NBLNK
      parameter ( NBLNK = 150 )
      character s1*(NBLNK), blnk*(NBLNK)

      _BEGIN_MASTER(myThid)
      
      DO i = 1,NBLNK
        blnk(i:i) = ' '
      ENDDO
      
      s1(1:NBLNK) = blnk(1:NBLNK)
      write(s1,'(a5,a)') 'MNC: ',
     &     'The currently defined Grid Types are:'
      CALL PRINT_MESSAGE(
     &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
      ntot = 0
      DO j = 1,MNC_MAX_ID
        IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR) 
     &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
          
          ntot = ntot + 1
          s1(1:NBLNK) = blnk(1:NBLNK)
          write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
     &         'MNC: ',
     &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j), 
     &         ' : ', (mnc_cw_dims(i,j), i=1,5), 
     &         '  | ', (mnc_cw_is(i,j), i=1,5),
     &         '  | ', (mnc_cw_ie(i,j), i=1,5),
     &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)
          CALL PRINT_MESSAGE(
     &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
          
        ENDIF
      ENDDO
      
      s1(1:NBLNK) = blnk(1:NBLNK)
      write(s1,'(a5,a)') 'MNC: ',
     &     'The currently defined Variable Types are:'
      CALL PRINT_MESSAGE(
     &     s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
      ntot = 0
      DO j = 1,MNC_MAX_ID
        IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR) 
     &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
          
          ntot = ntot + 1
          s1(1:NBLNK) = blnk(1:NBLNK)
          write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
     &         j, ntot, ' | ', 
     &         mnc_cw_vname(j)(1:20), ' | ', mnc_cw_vgind(j)
          CALL PRINT_MESSAGE(
     &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
          
          DO i = 1,mnc_cw_vnat(1,j)
            s1(1:NBLNK) = blnk(1:NBLNK)
            write(s1,'(a5,a14,i4,a3,a25,a3,a55)') 
     &           'MNC: ','      text_at:',i, 
     &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
     &           mnc_cw_vtat(i,j)(1:55)
            CALL PRINT_MESSAGE(
     &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
          ENDDO
          DO i = 1,mnc_cw_vnat(2,j)
            s1(1:NBLNK) = blnk(1:NBLNK)
            write(s1,'(a5,a14,i4,a3,a25,a3,i20)') 
     &           'MNC: ','      int__at:',i, 
     &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
     &           mnc_cw_viat(i,j)
            CALL PRINT_MESSAGE(
     &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
          ENDDO
          DO i = 1,mnc_cw_vnat(3,j)
            s1(1:NBLNK) = blnk(1:NBLNK)
            write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)') 
     &           'MNC: ','      dbl__at:',i, 
     &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
     &           mnc_cw_vdat(i,j)
            CALL PRINT_MESSAGE(
     &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
        ENDDO
        
        ENDIF
      ENDDO
      IF (ntot .EQ. 0) THEN
        s1(1:NBLNK) = blnk(1:NBLNK)
        write(s1,'(a)') 'MNC:    None defined!'
        CALL PRINT_MESSAGE(
     &       s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
      ENDIF
      
      _END_MASTER(myThid)

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_CW_INIT( 
     I     sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr, 
     I     myThid )

C     !DESCRIPTION:
C     Create the pre-defined grid types and variable types.

C     The grid type is a character string that encodes the presence and
C     types associated with the four possible dimensions.  The character
C     string follows the format
C     \begin{center}
C       \texttt{H0\_H1\_H2\_\_V\_\_T}
C     \end{center}
C     where the terms \textit{H0}, \textit{H1}, \textit{H2}, \textit{V},
C     \textit{T} can be almost any combination of the following:
C     \begin{center}
C       \begin{tabular}[h]{|ccc|c|c|}\hline
C         \multicolumn{3}{|c|}{Horizontal} & Vertical & Time \\
C         \textit{H0}: location & \textit{H1}: dimensions & \textit{H2}: halo 
C               & \textit{V}: location & \textit{T}: level  \\\hline
C         \texttt{-} & xy & Hn & \texttt{-} & \texttt{-} \\
C         U  &  x  &  Hy  &  i  &  t  \\
C         V  &  y  &      &  c  &     \\
C         Cen  &   &      &     &     \\
C         Cor  &   &      &     &     \\\hline
C       \end{tabular}
C     \end{center}


C     !USES:
      implicit none
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid
      integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr
CEOP

C     !LOCAL VARIABLES:
      integer CW_MAX_LOC
      parameter ( CW_MAX_LOC = 5 )
      integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
      integer ndim, ncomb
      character*(MAX_LEN_MBUF) msgbuf
      character*(MNC_MAX_CHAR) name
      character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
      character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),
     &     vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC), 
     &     halo_dat(CW_MAX_LOC)
      integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)

C     Functions
      integer IFNBLNK, ILNBLNK

C     ......12345....12345....12345....12345....12345...
      data horz_dat /
     &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /
      data hsub_dat /
     &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /
      data halo_dat /
     &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /
      data vert_dat /
     &     '-    ', 'C    ', 'I    ', '     ', '     '  /
      data time_dat /
     &     '-    ', 't    ', '     ', '     ', '     '  /

      ncomb = 0
      DO ihorz = 1,5
        DO is = 1,3
          DO ih = 1,2
            
C           Loop just ONCE if the Horiz component is "-"
            ihsub = is
            ihalo = ih
            IF (ihorz .EQ. 1) THEN
              IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
                ihsub = 4
                ihalo = 3
              ELSE
                GOTO 10
              ENDIF
            ENDIF
            
            DO ivert = 1,3
              DO itime = 1,2
                
C               horiz and hsub
                name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
                n = ILNBLNK(horz_dat(ihorz))
                name(1:n) = horz_dat(ihorz)(1:n)
                ntot = n + 1              
                name(ntot:ntot) = '_'
                n = ILNBLNK(hsub_dat(ihsub))
                name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
                ntot = ntot + n

C               vert, time, and halo
                write(name((ntot+1):(ntot+9)), '(a1,2a2,a1,a2,a1)') 
     &               '_', halo_dat(ihalo)(1:2), '__',
     &               vert_dat(ivert)(1:1), '__', 
     &               time_dat(itime)(1:1)

                ndim = 0
                DO i = 1,CW_MAX_LOC
                  dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
                  dim(i) = 0
                  ib(i) = 0
                  ie(i) = 0
                ENDDO

C               Horizontal dimensions
                IF (halo_dat(ihalo)(1:5) .EQ. 'Hn   ') THEN

                  IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
                    ndim = ndim + 1
                    IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
     &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
                      dn(ndim)(1:1) = 'X'
                      dim(ndim) = sNx + 2*OLx
                      ib(ndim)  = OLx + 1
                      ie(ndim)  = OLx + sNx
                    ENDIF
                    IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
     &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
                      dn(ndim)(1:3) = 'Xp1'
                      dim(ndim) = sNx + 2*OLx
                      ib(ndim)  = OLx + 1
                      ie(ndim)  = OLx + sNx + 1
                    ENDIF
                  ENDIF
                  IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
     &                 .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
                    ndim = ndim + 1
                    IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
     &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
                      dn(ndim)(1:1) = 'Y'
                      dim(ndim) = sNy + 2*OLy
                      ib(ndim)  = OLy + 1
                      ie(ndim)  = OLy + sNy
                    ENDIF
                    IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
     &                   .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
                      dn(ndim)(1:3) = 'Yp1'
                      dim(ndim) = sNy + 2*OLy
                      ib(ndim)  = OLy + 1
                      ie(ndim)  = OLy + sNy + 1
                    ENDIF
                  ENDIF

                ELSEIF (halo_dat(ihalo)(1:5) .EQ. 'Hy   ') THEN

                  IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
                    ndim = ndim + 1
                    dn(ndim)(1:3) = 'Xwh'
                    dim(ndim) = sNx + 2*OLx
                    ib(ndim)  = 1
                    ie(ndim)  = sNx + 2*OLx
                  ENDIF
                  IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
     &                 .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
                    ndim = ndim + 1
                    dn(ndim)(1:3) = 'Ywh'
                    dim(ndim) = sNy + 2*OLy
                    ib(ndim)  = 1
                    ie(ndim)  = sNy + 2*OLy
                  ENDIF

                ENDIF

C               Vertical dimension
                IF (vert_dat(ivert)(1:1) .EQ. 'C') THEN
                  ndim = ndim + 1
                  dn(ndim)(1:1) = 'Z'
                  dim(ndim) = Nr
                  ib(ndim)  = 1
                  ie(ndim)  = Nr
                ENDIF
                IF (vert_dat(ivert)(1:1) .EQ. 'I') THEN
                  ndim = ndim + 1
                  dn(ndim)(1:3) = 'Zp1'
                  dim(ndim) = Nr + 1
                  ib(ndim)  = 1
                  ie(ndim)  = Nr + 1
                ENDIF

C               Time dimension
                IF (time_dat(itime)(1:1) .EQ. 't') THEN
                  ndim = ndim + 1
                  dn(ndim)(1:1) = 'T'
                  dim(ndim) = -1
                  ib(ndim)  = 1
                  ie(ndim)  = 1
                ENDIF

                IF (ndim .GT. 0) THEN
#ifdef MNC_DEBUG
                  ncomb = ncomb + 1
                  write(*,'(i4,a3,a15,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
     &                 ncomb, ' : ', name(1:15), ndim, 
     &                 ' : ', (dim(i), i=1,5), 
     &                 '  | ', (ib(i), i=1,5),
     &                 '  | ', (ie(i), i=1,5),
     &                 '  | ', (dn(i)(1:4), i=1,5)
#endif

                  CALL MNC_CW_ADD_GNAME(name, ndim, 
     &                 dim, dn, ib, ie, myThid)
                ENDIF

              ENDDO
            ENDDO

 10         CONTINUE
          ENDDO
        ENDDO
      ENDDO
      
      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_CW_ADD_VNAME( 
     I     vname, 
     I     gname, 
     I     bi_dim, bj_dim, 
     I     myThid )

C     !DESCRIPTION: Add a variable type to the MNC CW layer.  The
C     variable type is an association between a variable type name and
C     the following items:
C     \begin{center}
C       \begin{tabular}[h]{|ll|}\hline
C         \textbf{Item}  & \textbf{Purpose}  \\\hline
C         grid type  &  defines the in-memory arrangement  \\
C         \texttt{bi,bj} dimensions  &  tiling indices, if present  \\\hline
C       \end{tabular}
C     \end{center}
  
C     !USES:
      implicit none
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer i, nvf,nvl, ngf,ngl, indv,indg
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer IFNBLNK, ILNBLNK

      nvf = IFNBLNK(vname)
      nvl = ILNBLNK(vname)
      ngf = IFNBLNK(gname)
      ngl = ILNBLNK(gname)

C     Check that this vname is not already defined
      CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
      IF (indv .GT. 0) THEN
        write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''', 
     &       vname(nvf:nvl), ''' is already defined'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
      ENDIF
      CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname, 
     &     indv, myThid)

C     Check that gname exists
      CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
      IF (indg .LT. 1) THEN
        write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''', 
     &       gname(ngf:ngl), ''' is not defined'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
      ENDIF

      mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
      mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)
      mnc_cw_vgind(indv) = indg
      DO i = 1,3
        mnc_cw_vnat(i,indv) = 0
      ENDDO
      mnc_cw_vbij(1,indv) = bi_dim
      mnc_cw_vbij(2,indv) = bj_dim

      CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_CW_ADD_VATTR_TEXT( 
     I     vname, 
     I     ntat, 
     I     tnames, 
     I     tvals, 
     I     myThid )

C     !DESCRIPTION:
C     Add a text attribute
      
C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid, ntat
      character*(*) vname, tnames(*), tvals(*)
CEOP

      CALL MNC_CW_ADD_VATTR_ANY(vname, 
     &     ntat, 0, 0, 
     &     tnames, ' ', ' ', 
     &     tvals, 0, 0.0D0, myThid )

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_CW_ADD_VATTR_INT( 
     I     vname, 
     I     niat, 
     I     inames, 
     I     ivals, 
     I     myThid )

C     !DESCRIPTION:

C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid, niat
      character*(*) vname, inames(*)
      integer ivals(*)
CEOP

      CALL MNC_CW_ADD_VATTR_ANY(vname, 
     &     0, niat, 0, 
     &     ' ', inames, ' ', 
     &     ' ', ivals, 0.0D0, myThid )

      RETURN
      END

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

C !INTERFACE:
      SUBROUTINE MNC_CW_ADD_VATTR_DBL( 
     I     vname, 
     I     ndat, 
     I     dnames, 
     I     dvals, 
     I     myThid )

C     !DESCRIPTION:

C     !USES:
      implicit none

C     !INPUT PARAMETERS:
      integer myThid, ndat
      character*(*) vname, dnames(*)
      REAL*8 dvals(*)
CEOP

      CALL MNC_CW_ADD_VATTR_ANY(vname, 
     &     0, 0, ndat, 
     &     ' ', ' ', dnames, 
     &     ' ', 0, dvals, myThid )

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_CW_ADD_VATTR_ANY( 
     I     vname, 
     I     ntat,   niat,   ndat,
     I     tnames, inames, dnames,
     I     tvals,  ivals,  dvals, 
     I     myThid )

C     !DESCRIPTION:

C     !USES:
      implicit none
#include "mnc_common.h"
#include "EEPARAMS.h"

C     !INPUT PARAMETERS:
      integer myThid, ntat, niat, ndat
      character*(*) vname
      character*(*) tnames(*), inames(*), dnames(*)
      character*(*) tvals(*)
      integer ivals(*)
      REAL*8 dvals(*)
CEOP

C     !LOCAL VARIABLES:
      integer i, n, nvf,nvl, n1,n2, indv
      character*(MAX_LEN_MBUF) msgbuf

C     Functions
      integer IFNBLNK, ILNBLNK

      nvf = IFNBLNK(vname)
      nvl = ILNBLNK(vname)

C     Check that vname is defined
      CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
      IF (indv .LT. 1) THEN
        write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''', 
     &       vname(nvf:nvl), ''' is not defined'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
      ENDIF

C     Text Attributes
      n = mnc_cw_vnat(1,indv)
      DO i = 1,ntat
        n1 = IFNBLNK(tnames(i))
        n2 = ILNBLNK(tnames(i))
        mnc_cw_vtnm(n+i,indv)(1:(n2-n1+1)) = tnames(i)(n1:n2)
        n1 = IFNBLNK(tvals(i))
        n2 = ILNBLNK(tvals(i))
        mnc_cw_vtat(n+i,indv)(1:(n2-n1+1)) = tvals(i)(n1:n2)
      ENDDO
      mnc_cw_vnat(1,indv) = n + ntat

C     Integer Attributes
      n = mnc_cw_vnat(2,indv)
      DO i = 1,niat
        n1 = IFNBLNK(inames(i))
        n2 = ILNBLNK(inames(i))
        mnc_cw_vinm(n+i,indv)(1:(n2-n1+1)) = inames(i)(n1:n2)
        mnc_cw_viat(n+i,indv) = ivals(i)
      ENDDO
      mnc_cw_vnat(2,indv) = n + niat

C     Double Attributes
      n = mnc_cw_vnat(3,indv)
      DO i = 1,ndat
        n1 = IFNBLNK(dnames(i))
        n2 = ILNBLNK(dnames(i))
        mnc_cw_vdnm(n+i,indv)(1:(n2-n1+1)) = dnames(i)(n1:n2)
        mnc_cw_vdat(n+i,indv) = dvals(i)
      ENDDO
      mnc_cw_vnat(3,indv) = n + ndat

      RETURN
      END

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

C     !INTERFACE:
      SUBROUTINE MNC_CW_GET_TILE_NUM( 
     I     bi, bj, 
     O     uniq_tnum, 
     I     myThid )

C     !DESCRIPTION:

C     !USES:
      implicit none
#include "EEPARAMS.h"
#include "SIZE.h"
#ifdef ALLOW_EXCH2
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"
#endif

C     !INPUT PARAMETERS:
      integer myThid, bi,bj, uniq_tnum
CEOP

C     !LOCAL VARIABLES:
      integer iG,jG

      iG = 0
      jG = 0

#ifdef ALLOW_EXCH2

      uniq_tnum = W2_myTileList(bi)

#else

C     Global tile number for simple (non-cube) domains
      iG = bi+(myXGlobalLo-1)/sNx
      jG = bj+(myYGlobalLo-1)/sNy

      uniq_tnum = (jG - 1)*(nPx*nSx) + iG

#endif

CEH3      write(*,*) 'iG,jG,uniq_tnum :', iG,jG,uniq_tnum

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: MNC_CW_FILE_AORC
      
C     !INTERFACE:
      SUBROUTINE MNC_CW_FILE_AORC( 
     I     fname, 
     O     indf, 
     I     myThid )

C     !DESCRIPTION:

C     !USES:
      implicit none
#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer i, ierr
      character*(MAX_LEN_MBUF) msgbuf

C     Check if the file is already open
      CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
      IF (indf .GT. 0) THEN
        RETURN
      ENDIF

C     Try to open an existing file
      CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
      IF (ierr .EQ. NF_NOERR) THEN
        RETURN
      ENDIF

C     Try to create a new one
      CALL MNC_FILE_OPEN(fname, 0, indf, myThid)

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

1	edhill	1.12	C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cwrapper.F,v 1.11 2004/03/29 03:33:51 edhill Exp $
2	edhill	1.1	C $Name: $
3
4			#include "MNC_OPTIONS.h"
5
6			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7	edhill	1.12	CBOP 0
8	edhill	1.11	C !ROUTINE: MNC_CW_ADD_GNAME
9	edhill	1.1
10	edhill	1.11	C !INTERFACE:
11	edhill	1.2	SUBROUTINE MNC_CW_ADD_GNAME(
12	edhill	1.1	I name,
13			I ndim,
14			I dlens,
15			I dnames,
16	edhill	1.9	I inds_beg, inds_end,
17			I myThid )
18	edhill	1.1
19	edhill	1.11	C !DESCRIPTION:
20			C Add a grid name to the MNC convenience wrapper layer.
21
22			C !USES:
23	edhill	1.1	implicit none
24			#include "mnc_common.h"
25			#include "EEPARAMS.h"
26
27	edhill	1.11	C !INPUT PARAMETERS:
28	edhill	1.1	integer myThid, ndim
29			character() name
30			integer dlens(), inds_beg(), inds_end(*)
31			character() dnames(*)
32	edhill	1.12	CEOP
33	edhill	1.1
34	edhill	1.11	C !LOCAL VARIABLES:
35			integer i, nnf,nnl, indg
36			character*(MAX_LEN_MBUF) msgbuf
37	edhill	1.12
38	edhill	1.2	C Functions
39			integer IFNBLNK, ILNBLNK
40
41	edhill	1.1	nnf = IFNBLNK(name)
42			nnl = ILNBLNK(name)
43
44			C Check that this name is not already defined
45	edhill	1.9	CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
46	edhill	1.1	IF (indg .GT. 0) THEN
47	edhill	1.2	write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
48	edhill	1.1	& ''' is already defined'
49			CALL print_error(msgbuf, mythid)
50	edhill	1.2	stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
51	edhill	1.1	ENDIF
52	edhill	1.9	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
53			& indg, myThid)
54	edhill	1.1
55	edhill	1.2	mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
56			mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
57	edhill	1.1	mnc_cw_ndim(indg) = ndim
58
59			DO i = 1,ndim
60			mnc_cw_dn(i,indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
61			nnf = IFNBLNK(dnames(i))
62			nnl = ILNBLNK(dnames(i))
63			mnc_cw_dn(i,indg)(1:(nnl-nnf+1)) = dnames(i)(nnf:nnl)
64			mnc_cw_dims(i,indg) = dlens(i)
65			mnc_cw_is(i,indg) = inds_beg(i)
66			mnc_cw_ie(i,indg) = inds_end(i)
67			ENDDO
68
69			RETURN
70			END
71
72	edhill	1.2	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
73	edhill	1.12	CBOP 1
74	edhill	1.11	C !ROUTINE: MNC_CW_DUMP
75	edhill	1.2
76	edhill	1.11	C !INTERFACE:
77	edhill	1.10	SUBROUTINE MNC_CW_DUMP( myThid )
78	edhill	1.2
79	edhill	1.11	C !DESCRIPTION:
80			C Write a condensed view of the current state of the MNC look-up
81			C tables for the convenience wrapper section.
82
83			C !USES:
84	edhill	1.2	implicit none
85			#include "mnc_common.h"
86	edhill	1.10	#include "SIZE.h"
87			#include "EEPARAMS.h"
88			#include "PARAMS.h"
89
90	edhill	1.11	C !INPUT PARAMETERS:
91	edhill	1.10	integer myThid
92	edhill	1.12	CEOP
93	edhill	1.2
94	edhill	1.11	C !LOCAL VARIABLES:
95	edhill	1.2	integer i,j, ntot
96	edhill	1.10	integer NBLNK
97			parameter ( NBLNK = 150 )
98			character s1(NBLNK), blnk(NBLNK)
99
100			_BEGIN_MASTER(myThid)
101
102			DO i = 1,NBLNK
103			blnk(i:i) = ' '
104			ENDDO
105
106			s1(1:NBLNK) = blnk(1:NBLNK)
107			write(s1,'(a5,a)') 'MNC: ',
108			& 'The currently defined Grid Types are:'
109			CALL PRINT_MESSAGE(
110			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
111	edhill	1.2	ntot = 0
112			DO j = 1,MNC_MAX_ID
113			IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
114			& .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
115
116			ntot = ntot + 1
117	edhill	1.10	s1(1:NBLNK) = blnk(1:NBLNK)
118			write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
119			& 'MNC: ',
120	edhill	1.2	& j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
121			& ' : ', (mnc_cw_dims(i,j), i=1,5),
122			& ' \| ', (mnc_cw_is(i,j), i=1,5),
123			& ' \| ', (mnc_cw_ie(i,j), i=1,5),
124			& ' \| ', (mnc_cw_dn(i,j)(1:4), i=1,5)
125	edhill	1.10	CALL PRINT_MESSAGE(
126			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
127
128	edhill	1.2	ENDIF
129			ENDDO
130	edhill	1.10
131			s1(1:NBLNK) = blnk(1:NBLNK)
132			write(s1,'(a5,a)') 'MNC: ',
133			& 'The currently defined Variable Types are:'
134			CALL PRINT_MESSAGE(
135			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
136	edhill	1.3	ntot = 0
137			DO j = 1,MNC_MAX_ID
138			IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
139			& .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
140	edhill	1.10
141	edhill	1.3	ntot = ntot + 1
142	edhill	1.10	s1(1:NBLNK) = blnk(1:NBLNK)
143			write(s1,'(a5,2i5,a3,a25,a3,i4)') 'MNC: ',
144			& j, ntot, ' \| ',
145			& mnc_cw_vname(j)(1:20), ' \| ', mnc_cw_vgind(j)
146			CALL PRINT_MESSAGE(
147			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
148
149	edhill	1.3	DO i = 1,mnc_cw_vnat(1,j)
150	edhill	1.10	s1(1:NBLNK) = blnk(1:NBLNK)
151			write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
152			& 'MNC: ',' text_at:',i,
153	edhill	1.3	& ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
154	edhill	1.8	& mnc_cw_vtat(i,j)(1:55)
155	edhill	1.10	CALL PRINT_MESSAGE(
156			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
157	edhill	1.3	ENDDO
158			DO i = 1,mnc_cw_vnat(2,j)
159	edhill	1.10	s1(1:NBLNK) = blnk(1:NBLNK)
160			write(s1,'(a5,a14,i4,a3,a25,a3,i20)')
161			& 'MNC: ',' int__at:',i,
162	edhill	1.3	& ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
163			& mnc_cw_viat(i,j)
164	edhill	1.10	CALL PRINT_MESSAGE(
165			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
166	edhill	1.3	ENDDO
167			DO i = 1,mnc_cw_vnat(3,j)
168	edhill	1.10	s1(1:NBLNK) = blnk(1:NBLNK)
169			write(s1,'(a5,a14,i4,a3,a25,a3,f25.10)')
170			& 'MNC: ',' dbl__at:',i,
171	edhill	1.3	& ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
172			& mnc_cw_vdat(i,j)
173	edhill	1.10	CALL PRINT_MESSAGE(
174			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
175			ENDDO
176
177	edhill	1.3	ENDIF
178			ENDDO
179			IF (ntot .EQ. 0) THEN
180	edhill	1.10	s1(1:NBLNK) = blnk(1:NBLNK)
181			write(s1,'(a)') 'MNC: None defined!'
182			CALL PRINT_MESSAGE(
183			& s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
184	edhill	1.3	ENDIF
185	edhill	1.10
186			_END_MASTER(myThid)
187	edhill	1.3
188	edhill	1.2	RETURN
189			END
190	edhill	1.1
191			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
192	edhill	1.12	CBOP 0
193	edhill	1.11	C !ROUTINE: MNC_CW_INIT
194	edhill	1.1
195	edhill	1.11	C !INTERFACE:
196	edhill	1.1	SUBROUTINE MNC_CW_INIT(
197	edhill	1.9	I sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr,
198			I myThid )
199	edhill	1.1
200	edhill	1.11	C !DESCRIPTION:
201	edhill	1.12	C Create the pre-defined grid types and variable types.
202
203			C The grid type is a character string that encodes the presence and
204			C types associated with the four possible dimensions. The character
205			C string follows the format
206			C \begin{center}
207			C \texttt{H0\_H1\_H2\_\_V\_\_T}
208			C \end{center}
209			C where the terms \textit{H0}, \textit{H1}, \textit{H2}, \textit{V},
210			C \textit{T} can be almost any combination of the following:
211			C \begin{center}
212			C \begin{tabular}[h]{\|ccc\|c\|c\|}\hline
213			C \multicolumn{3}{\|c\|}{Horizontal} & Vertical & Time \\
214			C \textit{H0}: location & \textit{H1}: dimensions & \textit{H2}: halo
215			C & \textit{V}: location & \textit{T}: level \\\hline
216			C \texttt{-} & xy & Hn & \texttt{-} & \texttt{-} \\
217			C U & x & Hy & i & t \\
218			C V & y & & c & \\
219			C Cen & & & & \\
220			C Cor & & & & \\\hline
221			C \end{tabular}
222			C \end{center}
223
224
225	edhill	1.11	C !USES:
226	edhill	1.1	implicit none
227			#include "mnc_common.h"
228			#include "EEPARAMS.h"
229
230	edhill	1.11	C !INPUT PARAMETERS:
231	edhill	1.1	integer myThid
232			integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr
233	edhill	1.12	CEOP
234	edhill	1.1
235	edhill	1.11	C !LOCAL VARIABLES:
236	edhill	1.1	integer CW_MAX_LOC
237			parameter ( CW_MAX_LOC = 5 )
238	edhill	1.2	integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
239			integer ndim, ncomb
240	edhill	1.1	character*(MAX_LEN_MBUF) msgbuf
241			character*(MNC_MAX_CHAR) name
242			character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
243			character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),
244			& vert_dat(CW_MAX_LOC), time_dat(CW_MAX_LOC),
245			& halo_dat(CW_MAX_LOC)
246			integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)
247	edhill	1.12
248	edhill	1.11	C Functions
249			integer IFNBLNK, ILNBLNK
250	edhill	1.1
251			C ......12345....12345....12345....12345....12345...
252			data horz_dat /
253			& '- ', 'U ', 'V ', 'Cen ', 'Cor ' /
254			data hsub_dat /
255			& 'xy ', 'x ', 'y ', '- ', ' ' /
256	edhill	1.2	data halo_dat /
257			& 'Hn ', 'Hy ', '-- ', ' ', ' ' /
258	edhill	1.1	data vert_dat /
259			& '- ', 'C ', 'I ', ' ', ' ' /
260			data time_dat /
261			& '- ', 't ', ' ', ' ', ' ' /
262
263	edhill	1.2	ncomb = 0
264	edhill	1.1	DO ihorz = 1,5
265			DO is = 1,3
266	edhill	1.2	DO ih = 1,2
267
268			C Loop just ONCE if the Horiz component is "-"
269			ihsub = is
270			ihalo = ih
271			IF (ihorz .EQ. 1) THEN
272			IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
273			ihsub = 4
274			ihalo = 3
275			ELSE
276			GOTO 10
277			ENDIF
278	edhill	1.1	ENDIF
279	edhill	1.2
280			DO ivert = 1,3
281			DO itime = 1,2
282
283	edhill	1.1	C horiz and hsub
284			name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
285			n = ILNBLNK(horz_dat(ihorz))
286			name(1:n) = horz_dat(ihorz)(1:n)
287			ntot = n + 1
288			name(ntot:ntot) = '_'
289			n = ILNBLNK(hsub_dat(ihsub))
290			name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
291			ntot = ntot + n
292
293			C vert, time, and halo
294	edhill	1.2	write(name((ntot+1):(ntot+9)), '(a1,2a2,a1,a2,a1)')
295			& '_', halo_dat(ihalo)(1:2), '__',
296			& vert_dat(ivert)(1:1), '__',
297			& time_dat(itime)(1:1)
298	edhill	1.1
299			ndim = 0
300			DO i = 1,CW_MAX_LOC
301			dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
302			dim(i) = 0
303	edhill	1.2	ib(i) = 0
304			ie(i) = 0
305	edhill	1.1	ENDDO
306
307			C Horizontal dimensions
308			IF (halo_dat(ihalo)(1:5) .EQ. 'Hn ') THEN
309
310			IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
311			ndim = ndim + 1
312			IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
313			& .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
314			dn(ndim)(1:1) = 'X'
315			dim(ndim) = sNx + 2*OLx
316			ib(ndim) = OLx + 1
317			ie(ndim) = OLx + sNx
318			ENDIF
319			IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
320			& .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
321			dn(ndim)(1:3) = 'Xp1'
322			dim(ndim) = sNx + 2*OLx
323			ib(ndim) = OLx + 1
324			ie(ndim) = OLx + sNx + 1
325			ENDIF
326			ENDIF
327			IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
328			& .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
329			ndim = ndim + 1
330			IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cen')
331			& .OR. (horz_dat(ihorz)(1:1) .EQ. 'U') ) THEN
332			dn(ndim)(1:1) = 'Y'
333			dim(ndim) = sNy + 2*OLy
334			ib(ndim) = OLy + 1
335			ie(ndim) = OLy + sNy
336			ENDIF
337			IF ( (horz_dat(ihorz)(1:3) .EQ. 'Cor')
338			& .OR. (horz_dat(ihorz)(1:1) .EQ. 'V') ) THEN
339			dn(ndim)(1:3) = 'Yp1'
340			dim(ndim) = sNy + 2*OLy
341			ib(ndim) = OLy + 1
342			ie(ndim) = OLy + sNy + 1
343			ENDIF
344			ENDIF
345
346			ELSEIF (halo_dat(ihalo)(1:5) .EQ. 'Hy ') THEN
347
348			IF (hsub_dat(ihsub)(1:1) .EQ. 'x') THEN
349			ndim = ndim + 1
350			dn(ndim)(1:3) = 'Xwh'
351			dim(ndim) = sNx + 2*OLx
352			ib(ndim) = 1
353			ie(ndim) = sNx + 2*OLx
354			ENDIF
355			IF ((hsub_dat(ihsub)(1:1) .EQ. 'y')
356			& .OR. (hsub_dat(ihsub)(2:2) .EQ. 'y')) THEN
357			ndim = ndim + 1
358			dn(ndim)(1:3) = 'Ywh'
359			dim(ndim) = sNy + 2*OLy
360			ib(ndim) = 1
361	edhill	1.2	ie(ndim) = sNy + 2*OLy
362	edhill	1.1	ENDIF
363
364			ENDIF
365
366			C Vertical dimension
367			IF (vert_dat(ivert)(1:1) .EQ. 'C') THEN
368			ndim = ndim + 1
369			dn(ndim)(1:1) = 'Z'
370			dim(ndim) = Nr
371			ib(ndim) = 1
372			ie(ndim) = Nr
373			ENDIF
374			IF (vert_dat(ivert)(1:1) .EQ. 'I') THEN
375			ndim = ndim + 1
376			dn(ndim)(1:3) = 'Zp1'
377			dim(ndim) = Nr + 1
378			ib(ndim) = 1
379			ie(ndim) = Nr + 1
380			ENDIF
381
382			C Time dimension
383			IF (time_dat(itime)(1:1) .EQ. 't') THEN
384			ndim = ndim + 1
385			dn(ndim)(1:1) = 'T'
386			dim(ndim) = -1
387			ib(ndim) = 1
388			ie(ndim) = 1
389			ENDIF
390
391	edhill	1.2	IF (ndim .GT. 0) THEN
392			#ifdef MNC_DEBUG
393			ncomb = ncomb + 1
394			write(*,'(i4,a3,a15,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
395			& ncomb, ' : ', name(1:15), ndim,
396			& ' : ', (dim(i), i=1,5),
397			& ' \| ', (ib(i), i=1,5),
398			& ' \| ', (ie(i), i=1,5),
399			& ' \| ', (dn(i)(1:4), i=1,5)
400			#endif
401	edhill	1.1
402	edhill	1.9	CALL MNC_CW_ADD_GNAME(name, ndim,
403			& dim, dn, ib, ie, myThid)
404	edhill	1.1	ENDIF
405
406			ENDDO
407			ENDDO
408	edhill	1.2
409			10 CONTINUE
410	edhill	1.1	ENDDO
411			ENDDO
412			ENDDO
413
414	edhill	1.2	RETURN
415			END
416
417			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
418	edhill	1.12	CBOP 0
419	edhill	1.11	C !ROUTINE: MNC_CW_ADD_VNAME
420	edhill	1.2
421	edhill	1.11	C !INTERFACE:
422	edhill	1.2	SUBROUTINE MNC_CW_ADD_VNAME(
423			I vname,
424	edhill	1.5	I gname,
425	edhill	1.9	I bi_dim, bj_dim,
426			I myThid )
427	edhill	1.2
428	edhill	1.12	C !DESCRIPTION: Add a variable type to the MNC CW layer. The
429			C variable type is an association between a variable type name and
430			C the following items:
431			C \begin{center}
432			C \begin{tabular}[h]{\|ll\|}\hline
433			C \textbf{Item} & \textbf{Purpose} \\\hline
434			C grid type & defines the in-memory arrangement \\
435			C \texttt{bi,bj} dimensions & tiling indices, if present \\\hline
436			C \end{tabular}
437			C \end{center}
438
439	edhill	1.11	C !USES:
440	edhill	1.2	implicit none
441			#include "mnc_common.h"
442			#include "EEPARAMS.h"
443
444	edhill	1.11	C !INPUT PARAMETERS:
445	edhill	1.5	integer myThid, bi_dim, bj_dim
446	edhill	1.2	character() vname, gname
447	edhill	1.12	CEOP
448	edhill	1.2
449	edhill	1.11	C !LOCAL VARIABLES:
450			integer i, nvf,nvl, ngf,ngl, indv,indg
451			character*(MAX_LEN_MBUF) msgbuf
452	edhill	1.12
453	edhill	1.2	C Functions
454			integer IFNBLNK, ILNBLNK
455
456			nvf = IFNBLNK(vname)
457			nvl = ILNBLNK(vname)
458			ngf = IFNBLNK(gname)
459			ngl = ILNBLNK(gname)
460
461			C Check that this vname is not already defined
462	edhill	1.9	CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
463	edhill	1.2	IF (indv .GT. 0) THEN
464			write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
465			& vname(nvf:nvl), ''' is already defined'
466			CALL print_error(msgbuf, mythid)
467			stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
468			ENDIF
469	edhill	1.9	CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
470			& indv, myThid)
471	edhill	1.2
472			C Check that gname exists
473	edhill	1.9	CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
474	edhill	1.2	IF (indg .LT. 1) THEN
475			write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
476			& gname(ngf:ngl), ''' is not defined'
477			CALL print_error(msgbuf, mythid)
478			stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
479			ENDIF
480
481			mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
482			mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)
483			mnc_cw_vgind(indv) = indg
484			DO i = 1,3
485			mnc_cw_vnat(i,indv) = 0
486			ENDDO
487	edhill	1.5	mnc_cw_vbij(1,indv) = bi_dim
488			mnc_cw_vbij(2,indv) = bj_dim
489	edhill	1.6
490	edhill	1.9	CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
491	edhill	1.2
492			RETURN
493			END
494
495			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
496	edhill	1.12	CBOP 0
497	edhill	1.11	C !ROUTINE: MNC_CW_ADD_VATTR_TEXT
498	edhill	1.2
499	edhill	1.11	C !INTERFACE:
500	edhill	1.3	SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
501			I vname,
502			I ntat,
503			I tnames,
504	edhill	1.9	I tvals,
505			I myThid )
506	edhill	1.3
507	edhill	1.11	C !DESCRIPTION:
508			C Add a text attribute
509
510			C !USES:
511	edhill	1.3	implicit none
512
513	edhill	1.11	C !INPUT PARAMETERS:
514	edhill	1.3	integer myThid, ntat
515			character() vname, tnames(), tvals()
516	edhill	1.11	CEOP
517	edhill	1.3
518	edhill	1.9	CALL MNC_CW_ADD_VATTR_ANY(vname,
519	edhill	1.3	& ntat, 0, 0,
520			& tnames, ' ', ' ',
521	edhill	1.9	& tvals, 0, 0.0D0, myThid )
522	edhill	1.3
523			RETURN
524			END
525
526			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
527	edhill	1.11	CBOP
528			C !ROUTINE: MNC_CW_ADD_VATTR_INT
529	edhill	1.3
530	edhill	1.11	C !INTERFACE:
531	edhill	1.3	SUBROUTINE MNC_CW_ADD_VATTR_INT(
532			I vname,
533			I niat,
534			I inames,
535	edhill	1.9	I ivals,
536			I myThid )
537	edhill	1.3
538	edhill	1.11	C !DESCRIPTION:
539
540			C !USES:
541	edhill	1.3	implicit none
542
543	edhill	1.11	C !INPUT PARAMETERS:
544	edhill	1.3	integer myThid, niat
545			character() vname, inames(*)
546			integer ivals(*)
547	edhill	1.11	CEOP
548	edhill	1.3
549	edhill	1.9	CALL MNC_CW_ADD_VATTR_ANY(vname,
550	edhill	1.3	& 0, niat, 0,
551			& ' ', inames, ' ',
552	edhill	1.9	& ' ', ivals, 0.0D0, myThid )
553	edhill	1.3
554			RETURN
555			END
556
557			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
558	edhill	1.12	CBOP 0
559	edhill	1.11	C !ROUTINE: MNC_CW_ADD_VATTR_DBL
560	edhill	1.3
561	edhill	1.11	C !INTERFACE:
562	edhill	1.3	SUBROUTINE MNC_CW_ADD_VATTR_DBL(
563			I vname,
564			I ndat,
565			I dnames,
566	edhill	1.9	I dvals,
567			I myThid )
568	edhill	1.3
569	edhill	1.11	C !DESCRIPTION:
570
571			C !USES:
572	edhill	1.3	implicit none
573
574	edhill	1.11	C !INPUT PARAMETERS:
575	edhill	1.3	integer myThid, ndat
576			character() vname, dnames(*)
577			REAL8 dvals()
578	edhill	1.11	CEOP
579	edhill	1.3
580	edhill	1.9	CALL MNC_CW_ADD_VATTR_ANY(vname,
581	edhill	1.3	& 0, 0, ndat,
582			& ' ', ' ', dnames,
583	edhill	1.9	& ' ', 0, dvals, myThid )
584	edhill	1.3
585			RETURN
586			END
587
588			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
589	edhill	1.12	CBOP 1
590	edhill	1.11	C !ROUTINE: MNC_CW_ADD_VATTR_ANY
591	edhill	1.3
592	edhill	1.11	C !INTERFACE:
593	edhill	1.2	SUBROUTINE MNC_CW_ADD_VATTR_ANY(
594			I vname,
595			I ntat, niat, ndat,
596			I tnames, inames, dnames,
597	edhill	1.9	I tvals, ivals, dvals,
598			I myThid )
599	edhill	1.2
600	edhill	1.11	C !DESCRIPTION:
601
602			C !USES:
603	edhill	1.2	implicit none
604			#include "mnc_common.h"
605			#include "EEPARAMS.h"
606
607	edhill	1.11	C !INPUT PARAMETERS:
608	edhill	1.2	integer myThid, ntat, niat, ndat
609			character() vname
610			character() tnames(), inames(), dnames(*)
611			character() tvals(*)
612			integer ivals(*)
613			REAL8 dvals()
614	edhill	1.12	CEOP
615	edhill	1.2
616	edhill	1.11	C !LOCAL VARIABLES:
617			integer i, n, nvf,nvl, n1,n2, indv
618			character*(MAX_LEN_MBUF) msgbuf
619	edhill	1.12
620	edhill	1.2	C Functions
621			integer IFNBLNK, ILNBLNK
622
623			nvf = IFNBLNK(vname)
624			nvl = ILNBLNK(vname)
625
626			C Check that vname is defined
627	edhill	1.9	CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
628	edhill	1.2	IF (indv .LT. 1) THEN
629			write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
630			& vname(nvf:nvl), ''' is not defined'
631			CALL print_error(msgbuf, mythid)
632			stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
633			ENDIF
634
635			C Text Attributes
636			n = mnc_cw_vnat(1,indv)
637			DO i = 1,ntat
638			n1 = IFNBLNK(tnames(i))
639			n2 = ILNBLNK(tnames(i))
640			mnc_cw_vtnm(n+i,indv)(1:(n2-n1+1)) = tnames(i)(n1:n2)
641			n1 = IFNBLNK(tvals(i))
642			n2 = ILNBLNK(tvals(i))
643			mnc_cw_vtat(n+i,indv)(1:(n2-n1+1)) = tvals(i)(n1:n2)
644			ENDDO
645			mnc_cw_vnat(1,indv) = n + ntat
646
647			C Integer Attributes
648			n = mnc_cw_vnat(2,indv)
649			DO i = 1,niat
650			n1 = IFNBLNK(inames(i))
651			n2 = ILNBLNK(inames(i))
652			mnc_cw_vinm(n+i,indv)(1:(n2-n1+1)) = inames(i)(n1:n2)
653			mnc_cw_viat(n+i,indv) = ivals(i)
654			ENDDO
655			mnc_cw_vnat(2,indv) = n + niat
656
657			C Double Attributes
658			n = mnc_cw_vnat(3,indv)
659			DO i = 1,ndat
660			n1 = IFNBLNK(dnames(i))
661			n2 = ILNBLNK(dnames(i))
662			mnc_cw_vdnm(n+i,indv)(1:(n2-n1+1)) = dnames(i)(n1:n2)
663			mnc_cw_vdat(n+i,indv) = dvals(i)
664			ENDDO
665			mnc_cw_vnat(3,indv) = n + ndat
666	edhill	1.3
667			RETURN
668			END
669
670			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
671	edhill	1.12	CBOP 1
672	edhill	1.11	C !ROUTINE: MNC_CW_GET_TILE_NUM
673	edhill	1.3
674	edhill	1.11	C !INTERFACE:
675	edhill	1.3	SUBROUTINE MNC_CW_GET_TILE_NUM(
676			I bi, bj,
677	edhill	1.9	O uniq_tnum,
678			I myThid )
679	edhill	1.3
680	edhill	1.11	C !DESCRIPTION:
681
682			C !USES:
683	edhill	1.3	implicit none
684			#include "EEPARAMS.h"
685			#include "SIZE.h"
686	edhill	1.7	#ifdef ALLOW_EXCH2
687			#include "W2_EXCH2_TOPOLOGY.h"
688			#include "W2_EXCH2_PARAMS.h"
689			#endif
690	edhill	1.3
691	edhill	1.11	C !INPUT PARAMETERS:
692	edhill	1.3	integer myThid, bi,bj, uniq_tnum
693	edhill	1.12	CEOP
694	edhill	1.3
695	edhill	1.11	C !LOCAL VARIABLES:
696	edhill	1.3	integer iG,jG
697
698	edhill	1.4	iG = 0
699			jG = 0
700
701	edhill	1.3	#ifdef ALLOW_EXCH2
702
703			uniq_tnum = W2_myTileList(bi)
704
705			#else
706
707			C Global tile number for simple (non-cube) domains
708			iG = bi+(myXGlobalLo-1)/sNx
709			jG = bj+(myYGlobalLo-1)/sNy
710	edhill	1.4
711			uniq_tnum = (jG - 1)(nPxnSx) + iG
712	edhill	1.3
713			#endif
714
715	edhill	1.4	CEH3 write(,) 'iG,jG,uniq_tnum :', iG,jG,uniq_tnum
716
717	edhill	1.3	RETURN
718			END
719
720			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
721	edhill	1.12	CBOP 1
722	edhill	1.11	C !ROUTINE: MNC_CW_FILE_AORC
723
724			C !INTERFACE:
725	edhill	1.3	SUBROUTINE MNC_CW_FILE_AORC(
726	edhill	1.4	I fname,
727	edhill	1.9	O indf,
728			I myThid )
729	edhill	1.3
730	edhill	1.11	C !DESCRIPTION:
731
732			C !USES:
733	edhill	1.3	implicit none
734			#include "netcdf.inc"
735			#include "mnc_common.h"
736			#include "EEPARAMS.h"
737
738	edhill	1.11	C !INPUT PARAMETERS:
739	edhill	1.4	integer myThid, indf
740	edhill	1.3	character() fname
741	edhill	1.12	CEOP
742	edhill	1.3
743	edhill	1.11	C !LOCAL VARIABLES:
744	edhill	1.4	integer i, ierr
745	edhill	1.3	character*(MAX_LEN_MBUF) msgbuf
746
747			C Check if the file is already open
748	edhill	1.9	CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
749	edhill	1.3	IF (indf .GT. 0) THEN
750			RETURN
751			ENDIF
752
753			C Try to open an existing file
754	edhill	1.9	CALL MNC_FILE_TRY_READ(fname, ierr, indf, myThid)
755	edhill	1.3	IF (ierr .EQ. NF_NOERR) THEN
756			RETURN
757			ENDIF
758
759			C Try to create a new one
760	edhill	1.9	CALL MNC_FILE_OPEN(fname, 0, indf, myThid)
761	edhill	1.2
762	edhill	1.1	RETURN
763			END
764
765			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
766