1 |
C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_check_depths.F,v 1.5 2009/05/26 19:00:09 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "PACKAGES_CONFIG.h" |
5 |
#include "CPP_OPTIONS.h" |
6 |
#include "W2_OPTIONS.h" |
7 |
|
8 |
CBOP |
9 |
C !ROUTINE: EXCH2_CHECK_DEPTHS |
10 |
|
11 |
C !INTERFACE: |
12 |
SUBROUTINE EXCH2_CHECK_DEPTHS( rLow, rHigh, myThid ) |
13 |
|
14 |
C !DESCRIPTION: \bc |
15 |
C *==========================================================* |
16 |
C | SUBROUTINE EXCH2_CHECK_DEPTHS |
17 |
C | o Check that disconnected tile edges (when using blank |
18 |
C | tiles) correspond to a closed (= zero depth) boundary. |
19 |
C | Note: no check if using OBCs |
20 |
C *==========================================================* |
21 |
C \ev |
22 |
|
23 |
C !USES: |
24 |
IMPLICIT NONE |
25 |
C === Global variables === |
26 |
#include "SIZE.h" |
27 |
#include "EEPARAMS.h" |
28 |
c#include "EESUPPORT.h" |
29 |
#include "W2_EXCH2_SIZE.h" |
30 |
#include "W2_EXCH2_TOPOLOGY.h" |
31 |
#ifdef ALLOW_OBCS |
32 |
# include "PARAMS.h" |
33 |
#endif |
34 |
|
35 |
C !INPUT/OUTPUT PARAMETERS: |
36 |
C === Routine arguments === |
37 |
C rLow :: Lower "r" boundary |
38 |
C rHigh :: Higher "r" boundary |
39 |
C myThid :: my Thread Id number |
40 |
_RS rLow (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
41 |
_RS rHigh(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
42 |
INTEGER myThid |
43 |
CEOP |
44 |
|
45 |
C == Local variables == |
46 |
_RS tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
47 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
48 |
INTEGER bi, bj, tId |
49 |
INTEGER i, j, n |
50 |
INTEGER errN, errS, errE, errW |
51 |
LOGICAL errFlag |
52 |
|
53 |
#ifdef ALLOW_OBCS |
54 |
C- For now, do nothing if OBCs is used |
55 |
IF ( useOBCs ) RETURN |
56 |
#endif |
57 |
|
58 |
errFlag = .FALSE. |
59 |
DO bj = myByLo(myThid), myByHi(myThid) |
60 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
61 |
|
62 |
C- Fill E,W & N,S edges with total depth from the interior |
63 |
i = sNx+1 |
64 |
DO j=1,sNy |
65 |
tmpFld(0,j) = rHigh( 1 ,j,bi,bj) - rLow( 1 ,j,bi,bj) |
66 |
tmpFld(i,j) = rHigh(sNx,j,bi,bj) - rLow(sNx,j,bi,bj) |
67 |
ENDDO |
68 |
j = sNy+1 |
69 |
DO i=1,sNx |
70 |
tmpFld(i,0) = rHigh(i, 1 ,bi,bj) - rLow(i, 1 ,bi,bj) |
71 |
tmpFld(i,j) = rHigh(i,sNy,bi,bj) - rLow(i,sNy,bi,bj) |
72 |
ENDDO |
73 |
|
74 |
C- Reset to zero if connected |
75 |
tId = W2_myTileList(bi,bj) |
76 |
DO n= 1,exch2_nNeighbours(tId) |
77 |
DO j=exch2_jLo(n,tId),exch2_jHi(n,tId) |
78 |
DO i=exch2_iLo(n,tId),exch2_iHi(n,tId) |
79 |
tmpFld(i,j) = 0. |
80 |
ENDDO |
81 |
ENDDO |
82 |
ENDDO |
83 |
|
84 |
C- North: |
85 |
errN = 0 |
86 |
j = sNy+1 |
87 |
DO i=1,sNx |
88 |
IF ( tmpFld(i,j).GT.0. ) errN = errN + 1 |
89 |
ENDDO |
90 |
C- South: |
91 |
errS = 0 |
92 |
j = 0 |
93 |
DO i=1,sNx |
94 |
IF ( tmpFld(i,j).GT.0. ) errS = errS + 1 |
95 |
ENDDO |
96 |
C- East : |
97 |
errE = 0 |
98 |
i = sNx+1 |
99 |
DO j=1,sNy |
100 |
IF ( tmpFld(i,j).GT.0. ) errE = errE + 1 |
101 |
ENDDO |
102 |
C- West : |
103 |
errW = 0 |
104 |
i = 0 |
105 |
DO j=1,sNy |
106 |
IF ( tmpFld(i,j).GT.0. ) errW = errW + 1 |
107 |
ENDDO |
108 |
|
109 |
IF ( errN+errS+errW+errE .GE. 1 ) THEN |
110 |
WRITE(msgBuf,'(2A,I6,A,2(I4,A))') |
111 |
& '** WARNINGS ** EXCH2_CHECK_DEPTHS: ', |
112 |
& 'tile #', tId, ' (bi,bj=', bi, ',', bj, ' ):' |
113 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
114 |
& SQUEEZE_RIGHT, myThid ) |
115 |
IF ( errN.GE.1 ) THEN |
116 |
WRITE(msgBuf,'(A,I5,A)') ' N.Edge has', errN, |
117 |
& ' unconnected points with non-zero depth.' |
118 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
119 |
& SQUEEZE_RIGHT, myThid ) |
120 |
ENDIF |
121 |
IF ( errS.GE.1 ) THEN |
122 |
WRITE(msgBuf,'(A,I5,A)') ' S.Edge has', errS, |
123 |
& ' unconnected points with non-zero depth.' |
124 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
125 |
& SQUEEZE_RIGHT, myThid ) |
126 |
ENDIF |
127 |
IF ( errE.GE.1 ) THEN |
128 |
WRITE(msgBuf,'(A,I5,A)') ' E.Edge has', errE, |
129 |
& ' unconnected points with non-zero depth.' |
130 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
131 |
& SQUEEZE_RIGHT, myThid ) |
132 |
ENDIF |
133 |
IF ( errW.GE.1 ) THEN |
134 |
WRITE(msgBuf,'(A,I5,A)') ' W.Edge has', errW, |
135 |
& ' unconnected points with non-zero depth.' |
136 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
137 |
& SQUEEZE_RIGHT, myThid ) |
138 |
ENDIF |
139 |
WRITE( msgBuf,'(A)') 'S/R EXCH2_CHECK_DEPTHS: Fatal Error' |
140 |
errFlag = .TRUE. |
141 |
ENDIF |
142 |
|
143 |
ENDDO |
144 |
ENDDO |
145 |
|
146 |
#ifdef USE_ERROR_STOP |
147 |
c CALL STOP_IF_ERROR( errFlag, msgBuf, myThid ) |
148 |
#else /* USE_ERROR_STOP */ |
149 |
c IF ( errFlag ) STOP 'ABNORMAL END: S/R EXCH2_CHECK_DEPTHS' |
150 |
#endif /* USE_ERROR_STOP */ |
151 |
IF ( errFlag ) THEN |
152 |
WRITE( msgBuf,'(2A)') '** WARNINGS ** EXCH2_CHECK_DEPTHS:', |
153 |
& ' some algorithm implementation might not be' |
154 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
155 |
& SQUEEZE_RIGHT, myThid ) |
156 |
WRITE( msgBuf,'(2A)') '** WARNINGS ** EXCH2_CHECK_DEPTHS:', |
157 |
& ' safe with non-zero depth next to blank-tile' |
158 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
159 |
& SQUEEZE_RIGHT, myThid ) |
160 |
ENDIF |
161 |
|
162 |
RETURN |
163 |
END |