pkg/mnc/mnc_cwrapper.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cwrapper.F,v 1.10 2004/03/20 23:51:23 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
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(*)

C     !LOCAL VARIABLES:
      integer i, nnf,nnl, indg
      character*(MAX_LEN_MBUF) msgbuf
CEOP
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
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

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

      _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
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     !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

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)
CEOP
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
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:
C     Add a variable type.
      
C     !USES:
      implicit none
#include "mnc_common.h"
#include "EEPARAMS.h"

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

C     !LOCAL VARIABLES:
      integer i, nvf,nvl, ngf,ngl, indv,indg
      character*(MAX_LEN_MBUF) msgbuf
CEOP
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
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
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
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(*)

C     !LOCAL VARIABLES:
      integer i, n, nvf,nvl, n1,n2, indv
      character*(MAX_LEN_MBUF) msgbuf
CEOP
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
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

C     !LOCAL VARIABLES:
      integer iG,jG
CEOP

      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
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

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

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