pkg/mnc/mnc_cwrapper.F

C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cwrapper.F,v 1.9 2004/03/19 03:28:36 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_CW_ADD_GNAME( 
     I     name, 
     I     ndim, 
     I     dlens, 
     I     dnames, 
     I     inds_beg, inds_end, 
     I     myThid )

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

C     Arguments
      integer myThid, ndim
      character*(*) name
      integer dlens(*), inds_beg(*), inds_end(*)
      character*(*) dnames(*)

C     Functions
      integer IFNBLNK, ILNBLNK

C     Local Variables
      integer i, nnf,nnl, indg
      character*(MAX_LEN_MBUF) msgbuf

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

      SUBROUTINE MNC_CW_DUMP( myThid )

      implicit none
#include "mnc_common.h"
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

C     Arguments
      integer myThid

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

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

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

C     Arguments
      integer myThid
      integer sNx,sNy, OLx,OLy, nSx,nSy, nPx,nPy, Nr

C     Functions
      integer IFNBLNK, ILNBLNK

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

      SUBROUTINE MNC_CW_ADD_VNAME( 
     I     vname, 
     I     gname, 
     I     bi_dim, bj_dim, 
     I     myThid )

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

C     Arguments
      integer myThid, bi_dim, bj_dim
      character*(*) vname, gname

C     Functions
      integer IFNBLNK, ILNBLNK

C     Local Variables
      integer i, nvf,nvl, ngf,ngl, indv,indg
      character*(MAX_LEN_MBUF) msgbuf

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

      SUBROUTINE MNC_CW_ADD_VATTR_TEXT( 
     I     vname, 
     I     ntat, 
     I     tnames, 
     I     tvals, 
     I     myThid )

      implicit none

C     Arguments
      integer myThid, ntat
      character*(*) vname, tnames(*), tvals(*)

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

      SUBROUTINE MNC_CW_ADD_VATTR_INT( 
     I     vname, 
     I     niat, 
     I     inames, 
     I     ivals, 
     I     myThid )

      implicit none

C     Arguments
      integer myThid, niat
      character*(*) vname, inames(*)
      integer ivals(*)

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

      SUBROUTINE MNC_CW_ADD_VATTR_DBL( 
     I     vname, 
     I     ndat, 
     I     dnames, 
     I     dvals, 
     I     myThid )

      implicit none

C     Arguments
      integer myThid, ndat
      character*(*) vname, dnames(*)
      REAL*8 dvals(*)

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

      RETURN
      END

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

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

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

C     Arguments
      integer myThid, ntat, niat, ndat
      character*(*) vname
      character*(*) tnames(*), inames(*), dnames(*)
      character*(*) tvals(*)
      integer ivals(*)
      REAL*8 dvals(*)

C     Functions
      integer IFNBLNK, ILNBLNK

C     Local Variables
      integer i, n, nvf,nvl, n1,n2, indv
      character*(MAX_LEN_MBUF) msgbuf

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

      SUBROUTINE MNC_CW_GET_TILE_NUM( 
     I     bi, bj, 
     O     uniq_tnum, 
     I     myThid )

      implicit none
#include "EEPARAMS.h"
#include "SIZE.h"
#ifdef ALLOW_EXCH2
#include "W2_EXCH2_TOPOLOGY.h"
#include "W2_EXCH2_PARAMS.h"
#endif

C     Arguments
      integer myThid, bi,bj, uniq_tnum

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

      SUBROUTINE MNC_CW_FILE_AORC( 
     I     fname, 
     O     indf, 
     I     myThid )

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

C     Arguments
      integer myThid, indf
      character*(*) fname

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