1 |
jmc |
1.7 |
C $Header: /u/gcmpack/MITgcm/pkg/exch2/exch2_check_depths.F,v 1.6 2009/06/28 01:00:23 jmc Exp $ |
2 |
jmc |
1.1 |
C $Name: $ |
3 |
|
|
|
4 |
jmc |
1.3 |
#include "PACKAGES_CONFIG.h" |
5 |
jmc |
1.1 |
#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 |
jmc |
1.4 |
#include "W2_EXCH2_SIZE.h" |
30 |
jmc |
1.1 |
#include "W2_EXCH2_TOPOLOGY.h" |
31 |
jmc |
1.3 |
#ifdef ALLOW_OBCS |
32 |
|
|
# include "PARAMS.h" |
33 |
|
|
#endif |
34 |
jmc |
1.1 |
|
35 |
|
|
C !INPUT/OUTPUT PARAMETERS: |
36 |
|
|
C === Routine arguments === |
37 |
|
|
C rLow :: Lower "r" boundary |
38 |
|
|
C rHigh :: Higher "r" boundary |
39 |
jmc |
1.7 |
C myThid :: my Thread Id number |
40 |
jmc |
1.1 |
_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 |
jmc |
1.3 |
#ifdef ALLOW_OBCS |
54 |
jmc |
1.1 |
C- For now, do nothing if OBCs is used |
55 |
|
|
IF ( useOBCs ) RETURN |
56 |
jmc |
1.3 |
#endif |
57 |
jmc |
1.1 |
|
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 |
jmc |
1.6 |
tId = W2_myTileList(bi,bj) |
76 |
jmc |
1.1 |
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 |
jmc |
1.5 |
WRITE(msgBuf,'(2A,I6,A,2(I4,A))') |
111 |
jmc |
1.7 |
& '** WARNING ** EXCH2_CHECK_DEPTHS: ', |
112 |
jmc |
1.5 |
& 'tile #', tId, ' (bi,bj=', bi, ',', bj, ' ):' |
113 |
|
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
114 |
|
|
& SQUEEZE_RIGHT, myThid ) |
115 |
jmc |
1.1 |
IF ( errN.GE.1 ) THEN |
116 |
|
|
WRITE(msgBuf,'(A,I5,A)') ' N.Edge has', errN, |
117 |
|
|
& ' unconnected points with non-zero depth.' |
118 |
jmc |
1.5 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
119 |
|
|
& SQUEEZE_RIGHT, myThid ) |
120 |
jmc |
1.1 |
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 |
jmc |
1.5 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
125 |
|
|
& SQUEEZE_RIGHT, myThid ) |
126 |
jmc |
1.1 |
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 |
jmc |
1.5 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
131 |
|
|
& SQUEEZE_RIGHT, myThid ) |
132 |
jmc |
1.1 |
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 |
jmc |
1.5 |
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
137 |
|
|
& SQUEEZE_RIGHT, myThid ) |
138 |
jmc |
1.1 |
ENDIF |
139 |
jmc |
1.5 |
WRITE( msgBuf,'(A)') 'S/R EXCH2_CHECK_DEPTHS: Fatal Error' |
140 |
jmc |
1.1 |
errFlag = .TRUE. |
141 |
|
|
ENDIF |
142 |
|
|
|
143 |
|
|
ENDDO |
144 |
|
|
ENDDO |
145 |
|
|
|
146 |
jmc |
1.2 |
#ifdef USE_ERROR_STOP |
147 |
jmc |
1.5 |
c CALL STOP_IF_ERROR( errFlag, msgBuf, myThid ) |
148 |
jmc |
1.2 |
#else /* USE_ERROR_STOP */ |
149 |
jmc |
1.5 |
c IF ( errFlag ) STOP 'ABNORMAL END: S/R EXCH2_CHECK_DEPTHS' |
150 |
jmc |
1.2 |
#endif /* USE_ERROR_STOP */ |
151 |
jmc |
1.5 |
IF ( errFlag ) THEN |
152 |
jmc |
1.7 |
WRITE( msgBuf,'(2A)') '** WARNING ** EXCH2_CHECK_DEPTHS:', |
153 |
jmc |
1.5 |
& ' some algorithm implementation might not be' |
154 |
|
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
155 |
|
|
& SQUEEZE_RIGHT, myThid ) |
156 |
jmc |
1.7 |
WRITE( msgBuf,'(2A)') '** WARNING ** EXCH2_CHECK_DEPTHS:', |
157 |
jmc |
1.5 |
& ' safe with non-zero depth next to blank-tile' |
158 |
|
|
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit, |
159 |
|
|
& SQUEEZE_RIGHT, myThid ) |
160 |
|
|
ENDIF |
161 |
jmc |
1.1 |
|
162 |
|
|
RETURN |
163 |
|
|
END |