/[MITgcm]/MITgcm/pkg/debug/debug_cs_corner_uv.F
ViewVC logotype

Contents of /MITgcm/pkg/debug/debug_cs_corner_uv.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.8 - (show annotations) (download)
Wed Nov 27 00:40:31 2013 UTC (10 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.7: +69 -57 lines
- fix for the case nSy > 1 (left from Jun 2009 modif of pkg/exch2, allowing
  bj <> 1 )

1 C $Header: /u/gcmpack/MITgcm/pkg/debug/debug_cs_corner_uv.F,v 1.7 2009/06/28 01:05:41 jmc Exp $
2 C $Name: $
3
4 #include "DEBUG_OPTIONS.h"
5
6 SUBROUTINE DEBUG_CS_CORNER_UV(
7 I word2print,
8 I uFld, vFld,
9 I k, ioUnit, bi,bj, myThid )
10 C *==========================================================*
11 C | S/R DEBUG_CS_CORNER_UV |
12 C | o check UV fields at Egdes of CS grid, near corners. |
13 C *==========================================================*
14 C | Values of U,V fields at the Edges of the CS grid |
15 C | are common to 2 faces, and are stored + used in 2 |
16 C | places (2 tiles): one in the interior of the 1rst tile, |
17 C | the other in the halo of the 2nd one. |
18 C | This S/R print the 2 values and check that they are |
19 C | identical (print the difference). |
20 C | This is specially usefull for checking that gU,gV are |
21 C | correct before entering solve_for_pressure. |
22 C *==========================================================*
23 C | Note: only works on a 1.cpu set up with square tiles |
24 C *==========================================================*
25 IMPLICIT NONE
26
27 C == Global variables ==
28 #include "SIZE.h"
29 #include "EEPARAMS.h"
30 #ifdef ALLOW_EXCH2
31 #include "W2_EXCH2_SIZE.h"
32 #include "W2_EXCH2_TOPOLOGY.h"
33 #endif
34 c #include "PARAMS.h"
35 c #include "GRID.h"
36
37 C == Routine arguments ==
38 C word2print :: a string to print
39 C uFld :: u component of 2D vector
40 C vFld :: v component of 2D vector
41 C k :: current level
42 C ioUnit :: I/O unit number
43 C bi,bj :: tile indices
44 C myThid :: Instance number for this invocation of
45 CHARACTER*(*) word2print
46 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
47 _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
48 INTEGER k, ioUnit
49 INTEGER bi, bj
50 INTEGER myThid
51
52 #ifdef ALLOW_DEBUG
53
54 C == Local variables in common block :
55 COMMON / DEBUG_CS_CORNER_UV_LOCAL / tmpU, tmpV
56 _RL tmpU(4,Nr,nSx*nSy)
57 _RL tmpV(4,Nr,nSx*nSy)
58
59 C == Local variables ==
60 C edgeIndex :: index (in X or Y) from the W. or S. edge of the tile
61 C :: of the U,V field to write
62 C n1 :: combined bi,bj index for current tile
63 C n2, n3 :: combined bi,bj index for W. and S. neigbour tile
64 C t1 :: current tile id
65 C t2, t3 :: tile id of W. and S. neigbour tile
66 #ifdef ALLOW_EXCH2
67 INTEGER t1, t2, t3
68 #endif
69 INTEGER n1, n2, n3
70 INTEGER edgeIndex
71 INTEGER ic, i, j
72
73 EXTERNAL ILNBLNK
74 INTEGER ILNBLNK
75
76 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
77
78 edgeIndex = 1
79
80 j = MIN(MAX(1-Olx,edgeIndex),Olx)
81 n1 = bi + (bj-1)*nSx
82 1010 FORMAT(2A,I2,1PE12.4,I3,1P2E12.4)
83 c IF (k.EQ.4 .AND. myIter.EQ.nIter0 ) THEN
84 tmpU(1,k,n1)= uFld(1,j)
85 tmpU(2,k,n1)= uFld(1,sNy+1-j)
86 tmpU(3,k,n1)= uFld(sNx+1,j)
87 tmpU(4,k,n1)= uFld(sNx+1,sNy+1-j)
88 tmpV(1,k,n1)= vFld(j,1)
89 tmpV(2,k,n1)= vFld(sNx+1-j,1)
90 tmpV(3,k,n1)= vFld(j,sNy+1)
91 tmpV(4,k,n1)= vFld(sNx+1-j,sNy+1)
92 _BARRIER
93 #ifdef ALLOW_EXCH2
94 IF (bi.EQ.nSx .AND. bj.EQ.nSy .AND. sNx.EQ.sNy) THEN
95 #else /* ALLOW_EXCH2 */
96 IF (bi.EQ.nSx .AND. nSy.EQ.1 .AND. nSx.EQ.6) THEN
97 #endif /* ALLOW_EXCH2 */
98 WRITE(ioUnit,'(2A)') 'DEBUG_CS_CORNER_UV: ',
99 & '------------------------------------------------------------'
100 ic = MAX(1,ILNBLNK(word2print))
101 WRITE(ioUnit,'(3A,I3)') 'DEBUG_CS_CORNER_UV: ',
102 & word2print(1:ic), ' , index=', j
103 WRITE(ioUnit,'(2A,I4)') 'DEBUG_CS_CORNER_UV: ',
104 & ' Edges values near a corner, lev=',k
105 WRITE(ioUnit,'(2A)') 'DEBUG_CS_CORNER_UV: ',
106 & ' tile_1, value_1, tile_2, value_2, difference v1-v2:'
107 DO j=1,nSy
108 DO i=1,nSx
109 #ifdef ALLOW_EXCH2
110 n1 = i + (j-1)*nSx
111 n2 = 0
112 n3 = 0
113 t1 = W2_myTileList(i,j)
114 t2 = exch2_neighbourId(4,t1)
115 t3 = exch2_neighbourId(2,t1)
116 IF ( W2_tileProc(t2).EQ.myProcId+1 ) n2 = W2_tileIndex(t2)
117 IF ( W2_tileProc(t3).EQ.myProcId+1 ) n3 = W2_tileIndex(t3)
118
119 IF ( n2.GE.1 .AND. exch2_pij(3,4,t1).EQ.-1 ) THEN
120 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
121 & t1,tmpU(1,k,n1), t2,tmpV(4,k,n2),
122 & tmpU(1,k,n1) - tmpV(4,k,n2)
123 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
124 & t1,tmpU(2,k,n1), t2,tmpV(3,k,n2),
125 & tmpU(2,k,n1) - tmpV(3,k,n2)
126 ENDIF
127 IF ( n2.GE.1 .AND. exch2_pij(4,4,t1).EQ.1 ) THEN
128 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
129 & t1,tmpU(1,k,n1), t2,tmpU(3,k,n2),
130 & tmpU(1,k,n1) - tmpU(3,k,n2)
131 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
132 & t1,tmpU(2,k,n1), t2,tmpU(4,k,n2),
133 & tmpU(2,k,n1) - tmpU(4,k,n2)
134 ENDIF
135 IF ( n3.GE.1 .AND. exch2_pij(1,2,t1).EQ.1 ) THEN
136 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
137 & t1,tmpV(1,k,n1), t3,tmpV(3,k,n3),
138 & tmpV(1,k,n1) - tmpV(3,k,n3)
139 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
140 & t1,tmpV(2,k,n1), t3,tmpV(4,k,n3),
141 & tmpV(2,k,n1) - tmpV(4,k,n3)
142 ENDIF
143 IF ( n3.GE.1 .AND. exch2_pij(2,2,t1).EQ.-1 ) THEN
144 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
145 & t1,tmpV(1,k,n1), t3,tmpU(4,k,n3),
146 & tmpV(1,k,n1) - tmpU(4,k,n3)
147 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
148 & t1,tmpV(2,k,n1), t3,tmpU(3,k,n3),
149 & tmpV(2,k,n1) - tmpU(3,k,n3)
150 ENDIF
151 #else /* ALLOW_EXCH2 */
152 n1 = i
153 IF (MOD(n1,2).EQ.1 ) THEN
154 c n1=1 n2=5,+v,-
155 c n1=1 n3=6,+v,+
156 c n1=3 n2=1,+v,-
157 c n1=3 n3=2,+v,+
158 c n1=5 n2=3,+v,-
159 c n1=5 n3=4,+v,+
160 n2 = 1+MOD(n1-2+5,6)
161 n3 = 1+MOD(n1-1+5,6)
162 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
163 & n1,tmpU(1,k,n1), n2,tmpV(4,k,n2),
164 & tmpU(1,k,n1) - tmpV(4,k,n2)
165 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
166 & n1,tmpU(2,k,n1), n2,tmpV(3,k,n2),
167 & tmpU(2,k,n1) - tmpV(3,k,n2)
168 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
169 & n1,tmpV(1,k,n1), n3,tmpV(3,k,n3),
170 & tmpV(1,k,n1) - tmpV(3,k,n3)
171 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
172 & n1,tmpV(2,k,n1), n3,tmpV(4,k,n3),
173 & tmpV(2,k,n1) - tmpV(4,k,n3)
174 ELSE
175 c n1=2 n2=1,+u,+
176 c n1=2 n3=6,+u,-
177 c n1=4 n2=3,+u,+
178 c n1=4 n3=2,+u,-
179 c n1=6 n2=5,+u,+
180 c n1=6 n3=4,+u,-
181 n2 = 1+MOD(n1-1+5,6)
182 n3 = 1+MOD(n1-2+5,6)
183 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, S:',
184 & n1,tmpU(1,k,n1), n2,tmpU(3,k,n2),
185 & tmpU(1,k,n1) - tmpU(3,k,n2)
186 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'W edge, N:',
187 & n1,tmpU(2,k,n1), n2,tmpU(4,k,n2),
188 & tmpU(2,k,n1) - tmpU(4,k,n2)
189 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, W:',
190 & n1,tmpV(1,k,n1), n3,tmpU(4,k,n3),
191 & tmpV(1,k,n1) - tmpU(4,k,n3)
192 WRITE(ioUnit,1010) 'DEBUG_CS_CORNER_UV: ', 'S edge, E:',
193 & n1,tmpV(2,k,n1), n3,tmpU(3,k,n3),
194 & tmpV(2,k,n1) - tmpU(3,k,n3)
195 ENDIF
196 #endif /* ALLOW_EXCH2 */
197 ENDDO
198 ENDDO
199 WRITE(ioUnit,'(2A)') 'DEBUG_CS_CORNER_UV: ',
200 & '------------------------------------------------------------'
201 ENDIF
202 c ENDIF
203
204 #endif /* ALLOW_DEBUG */
205
206 RETURN
207 END

  ViewVC Help
Powered by ViewVC 1.1.22