C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_get_position.F,v 1.11 2014/10/09 00:50:54 gforget Exp $
C $Name:  $

#include "GRDCHK_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif

      subroutine GRDCHK_GET_POSITION( mythid )

c     ==================================================================
c     SUBROUTINE grdchk_loc
c     ==================================================================
c
c     o Get the location of a given component of the control vector for
c       the current process.
c
c     started: Christian Eckert eckert@mit.edu 04-Apr-2000
c     continued: heimbach@mit.edu: 13-Jun-2001
c
c     ==================================================================
c     SUBROUTINE grdchk_loc
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#ifdef ALLOW_SHELFICE
# include "SHELFICE.h"
#endif
#ifdef ALLOW_OBCS
# include "OBCS_GRID.h"
#endif
#include "ctrl.h"
#include "CTRL_OBCS.h"
#include "grdchk.h"

c     == routine arguments ==

      integer       icvrec
      integer       jtile
      integer       itile
      integer       layer
      integer       obcspos
      integer       itilepos
      integer       jtilepos
      integer       itest
      integer       ierr
      integer       mythid

#ifdef ALLOW_GRDCHK
c     == local variables ==

      integer iG,jG
      integer bi,bj
      integer i,j,k
      integer iobcs
c     integer biwrk,bjwrk
      integer iproc, jproc
      integer iwrk, jwrk, kwrk
      integer iobcswrk
      integer irec, irecwrk
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer icomptest
      integer nobcsmax
      integer pastit

      _RL wetlocal

      logical ltmp
c     == end of interface ==

      jtlo = 1
      jthi = nsy
      itlo = 1
      ithi = nsx
      jmin = 1
      jmax = sny
      imin = 1
      imax = snx

      itile = iLocTile
      jtile = jLocTile
      itilepos = iGloPos
      jtilepos = jGloPos
      layer    = kGloPos
      obcspos  = obcsglo
      icvrec   = recglo

      _BEGIN_MASTER( mythid )

c--   determine proc. number from following assumptions <= done in grdchk_readparms

      if ( myProcId .EQ. grdchkwhichproc ) then

c     initialise parameters
      ierr      = -5
      pastit    = -1
      wetlocal  = 0

      itest     = 0
      icomptest = 0
      irecwrk   = 1
c     bjwrk     = 1
c     biwrk     = 1
      kwrk      = 1
      iobcswrk  = 1
      jwrk      = 1
      iwrk      = 1

c--   set max loop index for obcs multiplicities
      if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
         nobcsmax = nobcs
      else
         nobcsmax = 1
      endif

c--   Start to loop over records.
        do irec = irecwrk, ncvarrecs(grdchkvarindex)
         iobcs = MOD((irec-1),nobcsmax) + 1
c         do bj = bjwrk, jthi
c          do bi = biwrk, ithi
            bi = itile
            bj = jtile
            do k = kwrk, ncvarnrmax(grdchkvarindex)

cph(
cph-print               print *, 'ph-grd get_pos irec, bj, bi, k ',
cph-print     &              irec, bj, bi, k
cph)
             if ( ierr .ne. 0 ) then
               icvrec = irec

               do j = jwrk, ncvarymax(grdchkvarindex)
                do i = iwrk, ncvarxmax(grdchkvarindex)
                 if (ierr .ne. 0) then
                  if ( ncvargrd(grdchkvarindex) .eq. 'c' ) then
                     if ( maskC(i,j,k,bi,bj) .gt. 0.) then
                        icomptest = icomptest + 1
                     endif
                     wetlocal = maskC(i,j,k,bi,bj)
                  else if ( ncvargrd(grdchkvarindex) .eq. 's' ) then
                     if ( _maskS(i,j,k,bi,bj) .gt. 0.) then
                        icomptest = icomptest + 1
                     endif
                     wetlocal = _maskS(i,j,k,bi,bj)
                  else if ( ncvargrd(grdchkvarindex) .eq. 'w' ) then
                     if ( _maskW(i,j,k,bi,bj) .gt. 0.) then
                        icomptest = icomptest + 1
                     endif
                     wetlocal = _maskW(i,j,k,bi,bj)
#ifdef ALLOW_SHIFWFLX_CONTROL
c--             Ice shelf mask.
                  else if ( ncvargrd(grdchkvarindex) .eq. 'i' ) then
                     if ( maskSHI(i,j,k,bi,bj) .gt. 0.) then
                        icomptest = icomptest + 1
                     endif
                     wetlocal = maskSHI(i,j,k,bi,bj)
#endif /* ALLOW_SHIFWFLX_CONTROL */
                  else if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
                     if ( grdchkvarindex .EQ. 11 ) then
#ifdef ALLOW_OBCSN_CONTROL
                        if (grdchk_maskxz(i,k,bi,bj,iobcs) .gt. 0.
     &                       .and. j.eq. OB_Jn(I,bi,bj) ) then
                           icomptest = icomptest + 1
                        endif
                        wetlocal = grdchk_maskxz(i,k,bi,bj,iobcs)
#endif
                     else if ( grdchkvarindex .EQ. 12 ) then
#ifdef ALLOW_OBCSS_CONTROL
                        if (grdchk_maskxz(i,k,bi,bj,iobcs) .gt. 0.
     &                       .and. j.eq. OB_Js(I,bi,bj) ) then
                           icomptest = icomptest + 1
                        endif
                        wetlocal = grdchk_maskxz(i,k,bi,bj,iobcs)
#endif
                     else if ( grdchkvarindex .EQ. 13 ) then
#ifdef ALLOW_OBCSW_CONTROL
                        if ( grdchk_maskyz(j,k,bi,bj,iobcs) .gt. 0.
     &                      .and. i.eq. OB_Iw(J,bi,bj) ) then
                           icomptest = icomptest + 1
                        endif
                        wetlocal = grdchk_maskyz(j,k,bi,bj,iobcs)
#endif
                     else if ( grdchkvarindex .EQ. 14 ) then
#ifdef ALLOW_OBCSE_CONTROL
                        if (grdchk_maskyz(j,k,bi,bj,iobcs) .gt. 0.
     &                       .and. i.eq. OB_Ie(J,bi,bj) ) then
                           icomptest = icomptest + 1
                        endif
                        wetlocal = grdchk_maskyz(j,k,bi,bj,iobcs)
#endif
                     endif
                  endif
c
                  if ( i     .EQ. itilepos .AND.
     &                 j     .EQ. jtilepos .AND.
     &                 k     .EQ. layer .AND.
     &                 bi    .EQ. itile .AND.
     &                 bj    .EQ. jtile .AND.
     &                 iobcs .EQ. obcspos .AND.
     &                 irec  .EQ. icvrec ) then
                     pastit = 0
                     if ( wetlocal .NE.0 ) then
                        nbeg = icomptest
                        nend = nbeg + nend
                        ierr     = 0
                        print '(a,6I5)',
     &                       ' grad-res exact position met: '
                        print '(a,7I5)',
     &                       ' grad-res ', grdchkwhichproc,
     &                       nbeg, itilepos, jtilepos, layer,
     &                       itile, jtile
                        goto 1234
                     endif
                  else if ( pastit .EQ. 0 .AND.
     &                    wetlocal .NE.0 ) then
                     nbeg = icomptest
                     nend = nbeg + nend
                     ierr     = 0
                        print '(a,6I5)',
     &                       ' grad-res closest next position: '
                        print '(a,7I5)',
     &                       ' grad-res ', grdchkwhichproc,
     &                       nbeg, itilepos, jtilepos, layer,
     &                       itile, jtile
                        goto 1234
                  endif
c
                 endif
                enddo
                iwrk = 1
               enddo
               jwrk = 1
             else if (ierr .NE. 0) then
                itest     = itest + nwettile(bi,bj,k,iobcs)
                iwrk      = 1
                jwrk      = 1
             endif
c--   End of loop over k
            enddo
            kwrk = 1
c--   End of loop over bi
c          enddo
c          biwrk = 1
c--   End of loop over bj
c         enddo
c         bjwrk = 1
c--   End of loop over iobcs
cph         enddo
cph         iobcswrk = 1
c--   End of loop over irec records.
         enddo

c--   End of if myProcId statement
      endif

 1234 continue

      _END_MASTER( mythid )

      _BARRIER

#endif /* ALLOW_GRDCHK */

      return
      end