C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_check_depths.F,v 1.7 2011/10/28 21:21:00 jmc Exp $
C $Name: $
#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"
#include "W2_OPTIONS.h"
CBOP
C !ROUTINE: EXCH2_CHECK_DEPTHS
C !INTERFACE:
SUBROUTINE EXCH2_CHECK_DEPTHS( rLow, rHigh, myThid )
C !DESCRIPTION: \bc
C *==========================================================*
C | SUBROUTINE EXCH2_CHECK_DEPTHS
C | o Check that disconnected tile edges (when using blank
C | tiles) correspond to a closed (= zero depth) boundary.
C | Note: no check if using OBCs
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
c#include "EESUPPORT.h"
#include "W2_EXCH2_SIZE.h"
#include "W2_EXCH2_TOPOLOGY.h"
#ifdef ALLOW_OBCS
# include "PARAMS.h"
#endif
C !INPUT/OUTPUT PARAMETERS:
C === Routine arguments ===
C rLow :: Lower "r" boundary
C rHigh :: Higher "r" boundary
C myThid :: my Thread Id number
_RS rLow (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RS rHigh(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
INTEGER myThid
CEOP
C == Local variables ==
_RS tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER bi, bj, tId
INTEGER i, j, n
INTEGER errN, errS, errE, errW
LOGICAL errFlag
#ifdef ALLOW_OBCS
C- For now, do nothing if OBCs is used
IF ( useOBCs ) RETURN
#endif
errFlag = .FALSE.
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
C- Fill E,W & N,S edges with total depth from the interior
i = sNx+1
DO j=1,sNy
tmpFld(0,j) = rHigh( 1 ,j,bi,bj) - rLow( 1 ,j,bi,bj)
tmpFld(i,j) = rHigh(sNx,j,bi,bj) - rLow(sNx,j,bi,bj)
ENDDO
j = sNy+1
DO i=1,sNx
tmpFld(i,0) = rHigh(i, 1 ,bi,bj) - rLow(i, 1 ,bi,bj)
tmpFld(i,j) = rHigh(i,sNy,bi,bj) - rLow(i,sNy,bi,bj)
ENDDO
C- Reset to zero if connected
tId = W2_myTileList(bi,bj)
DO n= 1,exch2_nNeighbours(tId)
DO j=exch2_jLo(n,tId),exch2_jHi(n,tId)
DO i=exch2_iLo(n,tId),exch2_iHi(n,tId)
tmpFld(i,j) = 0.
ENDDO
ENDDO
ENDDO
C- North:
errN = 0
j = sNy+1
DO i=1,sNx
IF ( tmpFld(i,j).GT.0. ) errN = errN + 1
ENDDO
C- South:
errS = 0
j = 0
DO i=1,sNx
IF ( tmpFld(i,j).GT.0. ) errS = errS + 1
ENDDO
C- East :
errE = 0
i = sNx+1
DO j=1,sNy
IF ( tmpFld(i,j).GT.0. ) errE = errE + 1
ENDDO
C- West :
errW = 0
i = 0
DO j=1,sNy
IF ( tmpFld(i,j).GT.0. ) errW = errW + 1
ENDDO
IF ( errN+errS+errW+errE .GE. 1 ) THEN
WRITE(msgBuf,'(2A,I6,A,2(I4,A))')
& '** WARNING ** EXCH2_CHECK_DEPTHS: ',
& 'tile #', tId, ' (bi,bj=', bi, ',', bj, ' ):'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
IF ( errN.GE.1 ) THEN
WRITE(msgBuf,'(A,I5,A)') ' N.Edge has', errN,
& ' unconnected points with non-zero depth.'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
IF ( errS.GE.1 ) THEN
WRITE(msgBuf,'(A,I5,A)') ' S.Edge has', errS,
& ' unconnected points with non-zero depth.'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
IF ( errE.GE.1 ) THEN
WRITE(msgBuf,'(A,I5,A)') ' E.Edge has', errE,
& ' unconnected points with non-zero depth.'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
IF ( errW.GE.1 ) THEN
WRITE(msgBuf,'(A,I5,A)') ' W.Edge has', errW,
& ' unconnected points with non-zero depth.'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
WRITE( msgBuf,'(A)') 'S/R EXCH2_CHECK_DEPTHS: Fatal Error'
errFlag = .TRUE.
ENDIF
ENDDO
ENDDO
#ifdef USE_ERROR_STOP
c CALL STOP_IF_ERROR( errFlag, msgBuf, myThid )
#else /* USE_ERROR_STOP */
c IF ( errFlag ) STOP 'ABNORMAL END: S/R EXCH2_CHECK_DEPTHS'
#endif /* USE_ERROR_STOP */
IF ( errFlag ) THEN
WRITE( msgBuf,'(2A)') '** WARNING ** EXCH2_CHECK_DEPTHS:',
& ' some algorithm implementation might not be'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
WRITE( msgBuf,'(2A)') '** WARNING ** EXCH2_CHECK_DEPTHS:',
& ' safe with non-zero depth next to blank-tile'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT, myThid )
ENDIF
RETURN
END