File: /nfs/home/0/users/jenkins/mfix.git/model/calc_s_ddot_s.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: CALC_S_DDOT_S(IJK1, IJK2, FCELL, COM, M, DEL_DOT_U,    C
4     !                             S_DDOT_S, S_dd)                          C
5     !                                                                      C
6     !  Purpose: Calculate del.u, S:S and S_xx, S_yy or S_zz at the         C
7     !           boundary for use in frictional boundary condition          C
8     !                                                                      C
9     !                                                                      C
10     !  Author: Anuj Srivastava, Princeton University      Date: 4-APR-98   C
11     !  Reviewer:                                          Date:            C
12     !                                                                      C
13     !                                                                      C
14     !  Literature/Document References:                                     C
15     !                                                                      C
16     !  Variables referenced:                                               C
17     !  Variables modified:                                                 C
18     !                                                                      C
19     !  Local variables:                                                    C
20     !                                                                      C
21     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
22     !
23           SUBROUTINE CALC_S_DDOT_S(IJK1,IJK2,FCELL,COM,M,DEL_DOT_U,S_DDOT_S,S_DD)
24     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
25     !...Switches: -xf
26     !
27     !-----------------------------------------------
28     !   M o d u l e s
29     !-----------------------------------------------
30           USE param
31           USE param1
32           USE constant
33           USE fldvar
34           USE geometry
35           USE indices
36           USE compar
37           USE fun_avg
38           USE functions
39           IMPLICIT NONE
40     !-----------------------------------------------
41     !   G l o b a l   P a r a m e t e r s
42     !-----------------------------------------------
43     !-----------------------------------------------
44     !   D u m m y   A r g u m e n t s
45     !-----------------------------------------------
46     !
47     !                      IJK indices for wall cell and fluid cell
48           INTEGER          IJK1, IJK2
49     !
50     !                      Other indices
51           INTEGER          IPJK2, IPJMK2, IPJPK2, IPJKM2, IPJKP2
52           INTEGER          IJPK2, IJPKM2, IJPKP2, IMJPK2
53           INTEGER          IJKP2, IJMKP2, IMJKP2
54     
55     !
56     !                      The location (e,w,n...) of fluid cell
57           CHARACTER        FCELL
58     !
59     !                      Velocity component (U, V, W)
60           CHARACTER        COM
61     !
62     !                      Solids phase index
63           INTEGER          M
64     !
65     !                      del.u
66           DOUBLE PRECISION DEL_DOT_U
67     !
68     !                      S:S
69           DOUBLE PRECISION S_DDOT_S
70     
71     !                      S_dd (dd is the relevant direction x,y or z)
72           DOUBLE PRECISION S_dd
73     !
74     !  The location where D (rate of strain tensor) is calculated in
75     !  located at the center of 4
76     !  cells - 2 fluid cells and 2 wall cells. Coordinates of this are i,j,k
77     
78     !                      U_s at the north (i, j+1/2, k)
79           DOUBLE PRECISION U_s_N
80     !
81     !                      U_s at the south (i, j-1/2, k)
82           DOUBLE PRECISION U_s_S
83     
84     !                      U_s at the east (i+1/2, j, k)
85           DOUBLE PRECISION U_s_E
86     !
87     !                      U_s at the west (i-1/2, j, k)
88           DOUBLE PRECISION U_s_W
89     !
90     !                      U_s at the top (i, j, k+1/2)
91           DOUBLE PRECISION U_s_T
92     !
93     !                      U_s at the bottom (i, j, k-1/2)
94           DOUBLE PRECISION U_s_B
95     !
96     !                      U_s at the center (i, j, k)
97     !                      Calculated for Cylindrical coordinates only.
98           DOUBLE PRECISION U_s_C
99     !
100     !                      V_s at the north (i, j+1/2, k)
101           DOUBLE PRECISION V_s_N
102     !
103     !                      V_s at the south (i, j-1/2, k)
104           DOUBLE PRECISION V_s_S
105     !
106     !                      V_s at the east (i+1/2, j, k)
107           DOUBLE PRECISION V_s_E
108     !
109     !                      V_s at the west (i-1/2, j, k)
110           DOUBLE PRECISION V_s_W
111     
112     !                      V_s at the top (i, j, k+1/2)
113           DOUBLE PRECISION V_s_T
114     !
115     !                      V_s at the bottom (i, j, k-1/2)
116           DOUBLE PRECISION V_s_B
117     
118     !                      W_s at the north (i, j+1/2, k)
119           DOUBLE PRECISION W_s_N
120     !
121     !                      W_s at the south (i, j-1/2, k)
122           DOUBLE PRECISION W_s_S
123     !
124     !                      W_s at the east (i+1/2, j, k)
125           DOUBLE PRECISION W_s_E
126     !
127     !                      W_s at the west (1-1/2, j, k)
128           DOUBLE PRECISION W_s_W
129     !
130     !                      W_s at the top (i, j, k+1/2)
131           DOUBLE PRECISION W_s_T
132     !
133     !                      W_s at the bottom (i, j, k-1/2)
134           DOUBLE PRECISION W_s_B
135     !
136     !                      W_s at the center (i, j, k).
137     !                      Calculated for Cylindrical coordinates only.
138           DOUBLE PRECISION W_s_C
139     !-----------------------------------------------
140     
141           SELECT CASE (TRIM(COM))
142           CASE ('U')
143              SELECT CASE (TRIM(FCELL))
144              CASE ('N')
145                 IPJK2 = IP_OF(IJK2)
146                 IPJMK2 = JM_OF(IPJK2)
147     !
148                 U_S_N = U_S(IJK2,M)
149     !
150                 U_S_S = U_S(IJK1,M)
151     !
152                 U_S_E = AVG_Y(AVG_X_E(U_S(IJK1,M),U_S(IPJMK2,M),I_OF(IPJMK2)),&
153                    AVG_X_E(U_S(IJK2,M),U_S(IPJK2,M),I_OF(IPJK2)),J_OF(IPJMK2))
154     !
155                 U_S_W = AVG_Y(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
156                    AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),J_OF(IJK1))
157     !
158                 U_S_T = AVG_Y(AVG_Z(U_S(IJK1,M),U_S(KP_OF(IJK1),M),K_OF(IJK1)),&
159                    AVG_Z(U_S(IJK2,M),U_S(KP_OF(IJK2),M),K_OF(IJK2)),J_OF(IJK1))
160     !
161                 U_S_B = AVG_Y(AVG_Z(U_S(KM_OF(IJK1),M),U_S(IJK1,M),K_OF(KM_OF(&
162                    IJK1))),AVG_Z(U_S(KM_OF(IJK2),M),U_S(IJK2,M),K_OF(KM_OF(IJK2))&
163                    ),J_OF(IJK1))
164     !
165                 V_S_N = AVG_X(AVG_Y_N(V_S(IJK1,M),V_S(IJK2,M)),AVG_Y_N(V_S(&
166                    IPJMK2,M),V_S(IPJK2,M)),I_OF(IJK2))
167     !
168                 V_S_S = AVG_X(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
169                    V_S(JM_OF(IPJMK2),M),V_S(IPJMK2,M)),I_OF(IJK1))
170     !
171                 V_S_E = ZERO
172     !
173                 V_S_W = ZERO
174     !
175                 V_S_T = ZERO
176     !
177                 V_S_B = ZERO
178     !
179                 W_S_N = AVG_X(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
180                    W_S(KM_OF(IPJK2),M),W_S(IPJK2,M)),I_OF(IJK2))
181     !
182                 W_S_S = AVG_X(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
183                    W_S(KM_OF(IPJMK2),M),W_S(IPJMK2,M)),I_OF(IJK1))
184     !
185                 W_S_E = AVG_Y(AVG_Z_T(W_S(KM_OF(IPJMK2),M),W_S(IPJMK2,M)),AVG_Z_T&
186                    (W_S(KM_OF(IPJK2),M),W_S(IPJK2,M)),J_OF(IPJMK2))
187     !
188                 W_S_W = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
189                    W_S(KM_OF(IJK2),M),W_S(IJK2,M)),J_OF(IJK1))
190     !
191                 W_S_T = AVG_X(AVG_Y(W_S(IJK1,M),W_S(IJK2,M),J_OF(IJK1)),AVG_Y(&
192                    W_S(IPJMK2,M),W_S(IPJK2,M),J_OF(IPJMK2)),I_OF(IJK1))
193     !
194                 W_S_B = AVG_X(AVG_Y(W_S(KM_OF(IJK1),M),W_S(KM_OF(IJK2),M),J_OF(&
195                    KM_OF(IJK1))),AVG_Y(W_S(KM_OF(IPJMK2),M),W_S(KM_OF(IPJK2),M),&
196                    J_OF(KM_OF(IPJMK2))),I_OF(IJK1))
197     !
198                 IF (CYLINDRICAL) THEN
199                    U_S_C = AVG_Y(U_S(IJK1,M),U_S(IJK2,M),J_OF(IJK1))
200                    W_S_C = AVG_X(W_S_W,W_S_E,I_OF(IJK1))
201                 ELSE
202                    U_S_C = ZERO
203                    W_S_C = ZERO
204                 ENDIF
205     !
206                 CALL SDDOTS (IJK1, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
207                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
208                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
209                    S_DD)
210     !
211     !
212     !
213     !
214              CASE ('S')
215                 IPJK2 = IP_OF(IJK2)
216                 IPJPK2 = JP_OF(IPJK2)
217     !
218                 U_S_N = U_S(IJK1,M)
219     !
220                 U_S_S = U_S(IJK2,M)
221     !
222                 U_S_E = AVG_Y(AVG_X_E(U_S(IJK2,M),U_S(IPJK2,M),I_OF(IPJK2)),&
223                    AVG_X_E(U_S(IJK1,M),U_S(IPJPK2,M),I_OF(IPJPK2)),J_OF(IPJK2))
224     !
225                 U_S_W = AVG_Y(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
226                    AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),J_OF(IJK2))
227     !
228                 U_S_T = AVG_Y(AVG_Z(U_S(IJK2,M),U_S(KP_OF(IJK2),M),K_OF(IJK2)),&
229                    AVG_Z(U_S(IJK1,M),U_S(KP_OF(IJK1),M),K_OF(IJK1)),J_OF(IJK2))
230     !
231                 U_S_B = AVG_Y(AVG_Z(U_S(KM_OF(IJK2),M),U_S(IJK2,M),K_OF(KM_OF(&
232                    IJK2))),AVG_Z(U_S(KM_OF(IJK1),M),U_S(IJK1,M),K_OF(KM_OF(IJK1))&
233                    ),J_OF(IJK2))
234     !
235                 V_S_N = AVG_X(AVG_Y_N(V_S(IJK2,M),V_S(IJK1,M)),AVG_Y_N(V_S(IPJK2&
236                    ,M),V_S(IPJPK2,M)),I_OF(IJK1))
237     !
238                 V_S_S = AVG_X(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
239                    V_S(JM_OF(IPJK2),M),V_S(IPJK2,M)),I_OF(IJK2))
240     !
241                 V_S_E = ZERO
242     !
243                 V_S_W = ZERO
244     !
245                 V_S_T = ZERO
246     !
247                 V_S_B = ZERO
248     !
249                 W_S_N = AVG_X(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
250                    W_S(KM_OF(IPJPK2),M),W_S(IPJPK2,M)),I_OF(IJK1))
251     !
252                 W_S_S = AVG_X(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
253                    W_S(KM_OF(IPJK2),M),W_S(IPJK2,M)),I_OF(IJK2))
254     !
255                 W_S_E = AVG_Y(AVG_Z_T(W_S(KM_OF(IPJK2),M),W_S(IPJK2,M)),AVG_Z_T(&
256                    W_S(KM_OF(IPJPK2),M),W_S(IPJPK2,M)),J_OF(IPJK2))
257     !
258                 W_S_W = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
259                    W_S(KM_OF(IJK1),M),W_S(IJK1,M)),J_OF(IJK2))
260     !
261                 W_S_T = AVG_X(AVG_Y(W_S(IJK2,M),W_S(IJK1,M),J_OF(IJK2)),AVG_Y(&
262                    W_S(IPJK2,M),W_S(IPJPK2,M),J_OF(IPJK2)),I_OF(IJK2))
263     !
264                 W_S_B = AVG_X(AVG_Y(W_S(KM_OF(IJK2),M),W_S(KM_OF(IJK1),M),J_OF(&
265                    KM_OF(IJK2))),AVG_Y(W_S(KM_OF(IPJK2),M),W_S(KM_OF(IPJPK2),M),&
266                    J_OF(KM_OF(IPJK2))),I_OF(IJK2))
267     !
268                 IF (CYLINDRICAL) THEN
269                    U_S_C = AVG_Y(U_S(IJK2,M),U_S(IJK1,M),J_OF(IJK2))
270                    W_S_C = AVG_X(W_S_W,W_S_E,I_OF(IJK2))
271                 ELSE
272                    U_S_C = ZERO
273                    W_S_C = ZERO
274                 ENDIF
275     !
276                 CALL SDDOTS (IJK2, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
277                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
278                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
279                    S_DD)
280     !
281     !
282              CASE ('T')
283                 IPJK2 = IP_OF(IJK2)
284                 IPJKM2 = KM_OF(IPJK2)
285     !
286     !
287                 U_S_N = AVG_Z(AVG_Y(U_S(IJK1,M),U_S(JP_OF(IJK1),M),J_OF(IJK1)),&
288                    AVG_Y(U_S(IJK2,M),U_S(JP_OF(IJK2),M),J_OF(IJK2)),K_OF(IJK1))
289     !
290                 U_S_S = AVG_Z(AVG_Y(U_S(JM_OF(IJK1),M),U_S(IJK1,M),J_OF(JM_OF(&
291                    IJK1))),AVG_Y(U_S(JM_OF(IJK2),M),U_S(IJK2,M),J_OF(JM_OF(IJK2))&
292                    ),K_OF(IJK1))
293     !
294                 U_S_E = AVG_Z(AVG_X_E(U_S(IJK1,M),U_S(IPJKM2,M),I_OF(IPJKM2)),&
295                    AVG_X_E(U_S(IJK2,M),U_S(IPJK2,M),I_OF(IPJK2)),K_OF(IPJKM2))
296     !
297                 U_S_W = AVG_Z(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
298                    AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),K_OF(IJK1))
299     !
300                 U_S_T = U_S(IJK2,M)
301     !
302                 U_S_B = U_S(IJK1,M)
303     !
304                 V_S_N = AVG_X(AVG_Z(V_S(IJK1,M),V_S(IJK2,M),K_OF(IJK1)),AVG_Z(&
305                    V_S(IPJKM2,M),V_S(IPJK2,M),K_OF(IPJKM2)),I_OF(IJK1))
306     !
307                 V_S_S = AVG_X(AVG_Z(V_S(JM_OF(IJK1),M),V_S(JM_OF(IJK2),M),K_OF(&
308                    JM_OF(IJK1))),AVG_Z(V_S(JM_OF(IPJKM2),M),V_S(JM_OF(IPJK2),M),&
309                    K_OF(JM_OF(IPJKM2))),I_OF(IJK1))
310     !
311                 V_S_E = AVG_Z(AVG_Y_N(V_S(JM_OF(IPJKM2),M),V_S(IPJKM2,M)),AVG_Y_N&
312                    (V_S(JM_OF(IPJK2),M),V_S(IPJK2,M)),K_OF(IPJKM2))
313     !
314                 V_S_W = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
315                    V_S(JM_OF(IJK2),M),V_S(IJK2,M)),K_OF(IJK1))
316     !
317                 V_S_T = AVG_X(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
318                    V_S(JM_OF(IPJK2),M),V_S(IPJK2,M)),I_OF(IJK2))
319     !
320                 V_S_B = AVG_X(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
321                    V_S(JM_OF(IPJKM2),M),V_S(IPJKM2,M)),I_OF(IJK1))
322     !
323                 W_S_N = ZERO
324     !
325                 W_S_S = ZERO
326     !
327                 W_S_E = ZERO
328     !
329                 W_S_W = ZERO
330     !
331                 W_S_T = AVG_X(AVG_Z_T(W_S(IJK1,M),W_S(IJK2,M)),AVG_Z_T(W_S(&
332                    IPJKM2,M),W_S(IPJK2,M)),I_OF(IJK2))
333     !
334                 W_S_B = AVG_X(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
335                    W_S(KM_OF(IPJKM2),M),W_S(IPJKM2,M)),I_OF(IJK1))
336     !
337                 IF (CYLINDRICAL) THEN
338                    U_S_C = AVG_Z(U_S(IJK1,M),U_S(IJK2,M),K_OF(IJK1))
339                    W_S_C = AVG_X(W_S(IJK1,M),W_S(IPJKM2,M),I_OF(IJK1))
340                 ELSE
341                    U_S_C = ZERO
342                    W_S_C = ZERO
343                 ENDIF
344     !
345                 CALL SDDOTS (IJK1, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
346                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
347                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
348                    S_DD)
349     !
350     !
351              CASE ('B')
352                 IPJK2 = IP_OF(IJK2)
353                 IPJKP2 = KP_OF(IPJK2)
354     !
355                 U_S_N = AVG_Z(AVG_Y(U_S(IJK2,M),U_S(JP_OF(IJK2),M),J_OF(IJK2)),&
356                    AVG_Y(U_S(IJK1,M),U_S(JP_OF(IJK1),M),J_OF(IJK1)),K_OF(IJK2))
357     !
358                 U_S_S = AVG_Z(AVG_Y(U_S(JM_OF(IJK2),M),U_S(IJK2,M),J_OF(JM_OF(&
359                    IJK2))),AVG_Y(U_S(JM_OF(IJK1),M),U_S(IJK1,M),J_OF(JM_OF(IJK1))&
360                    ),K_OF(IJK2))
361     !
362                 U_S_E = AVG_Z(AVG_X_E(U_S(IJK2,M),U_S(IPJK2,M),I_OF(IPJK2)),&
363                    AVG_X_E(U_S(IJK1,M),U_S(IPJKP2,M),I_OF(IPJKP2)),K_OF(IPJK2))
364     !
365                 U_S_W = AVG_Z(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
366                    AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),K_OF(IJK2))
367     !
368                 U_S_T = U_S(IJK1,M)
369     !
370                 U_S_B = U_S(IJK2,M)
371     !
372                 V_S_N = AVG_X(AVG_Z(V_S(IJK2,M),V_S(IJK1,M),K_OF(IJK2)),AVG_Z(&
373                    V_S(IPJK2,M),V_S(IPJKP2,M),K_OF(IPJK2)),I_OF(IJK2))
374     !
375                 V_S_S = AVG_X(AVG_Z(V_S(JM_OF(IJK2),M),V_S(JM_OF(IJK1),M),K_OF(&
376                    JM_OF(IJK2))),AVG_Z(V_S(JM_OF(IPJK2),M),V_S(JM_OF(IPJKP2),M),&
377                    K_OF(JM_OF(IPJK2))),I_OF(IJK2))
378     !
379                 V_S_E = AVG_Z(AVG_Y_N(V_S(JM_OF(IPJK2),M),V_S(IPJK2,M)),AVG_Y_N(&
380                    V_S(JM_OF(IPJKP2),M),V_S(IPJKP2,M)),K_OF(IPJK2))
381     !
382                 V_S_W = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
383                    V_S(JM_OF(IJK1),M),V_S(IJK1,M)),K_OF(IJK2))
384     !
385                 V_S_T = AVG_X(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
386                    V_S(JM_OF(IPJKP2),M),V_S(IPJKP2,M)),I_OF(IJK1))
387     !
388                 V_S_B = AVG_X(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
389                    V_S(JM_OF(IPJK2),M),V_S(IPJK2,M)),I_OF(IJK2))
390     !
391                 W_S_N = ZERO
392     !
393                 W_S_S = ZERO
394     !
395                 W_S_E = ZERO
396     !
397                 W_S_W = ZERO
398     !
399                 W_S_T = AVG_X(AVG_Z_T(W_S(IJK2,M),W_S(IJK1,M)),AVG_Z_T(W_S(IPJK2&
400                    ,M),W_S(IPJKP2,M)),I_OF(IJK1))
401     !
402                 W_S_B = AVG_X(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
403                    W_S(KM_OF(IPJK2),M),W_S(IPJK2,M)),I_OF(IJK2))
404     !
405                 IF (CYLINDRICAL) THEN
406                    U_S_C = AVG_Z(U_S(IJK2,M),U_S(IJK1,M),K_OF(IJK2))
407                    W_S_C = AVG_X(W_S(IJK2,M),W_S(IPJK2,M),I_OF(IJK2))
408                 ELSE
409                    U_S_C = ZERO
410                    W_S_C = ZERO
411                 ENDIF
412     !
413                 CALL SDDOTS (IJK2, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
414                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
415                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
416                    S_DD)
417     !
418              END SELECT
419     !
420           CASE ('V')
421              SELECT CASE (TRIM(FCELL))
422              CASE ('T')
423                 IJPK2 = JP_OF(IJK2)
424                 IJPKM2 = KM_OF(IJPK2)
425     !
426                 U_S_N = AVG_Z(AVG_X_E(U_S(IM_OF(IJPKM2),M),U_S(IJPKM2,M),I_OF(&
427                    IJPKM2)),AVG_X_E(U_S(IM_OF(IJPK2),M),U_S(IJPK2,M),I_OF(IJPK2))&
428                    ,K_OF(IJPKM2))
429     !
430                 U_S_S = AVG_Z(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
431                    AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),K_OF(IJK1))
432     !
433                 U_S_E = AVG_Z(AVG_Y(U_S(IJK1,M),U_S(IJPKM2,M),J_OF(IJK1)),AVG_Y(&
434                    U_S(IJK2,M),U_S(IJPK2,M),J_OF(IJK2)),K_OF(IJK1))
435     !
436                 U_S_W = AVG_Z(AVG_Y(U_S(IM_OF(IJK1),M),U_S(IM_OF(IJPKM2),M),J_OF(&
437                    IM_OF(IJK1))),AVG_Y(U_S(IM_OF(IJK2),M),U_S(IM_OF(IJPK2),M),&
438                    J_OF(IM_OF(IJK2))),K_OF(IJK1))
439     !
440                 U_S_T = AVG_Y(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
441                    AVG_X_E(U_S(IM_OF(IJPK2),M),U_S(IJPK2,M),I_OF(IJPK2)),J_OF(&
442                    IJK2))
443     !
444                 U_S_B = AVG_Y(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
445                    AVG_X_E(U_S(IM_OF(IJPKM2),M),U_S(IJPKM2,M),I_OF(IJPKM2)),J_OF(&
446                    IJK1))
447     !
448                 V_S_N = AVG_Z(AVG_Y_N(V_S(IJK1,M),V_S(IJPKM2,M)),AVG_Y_N(V_S(&
449                    IJK2,M),V_S(IJPK2,M)),K_OF(IJPKM2))
450     !
451                 V_S_S = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
452                    V_S(JM_OF(IJK2),M),V_S(IJK2,M)),K_OF(IJK1))
453     !
454                 V_S_E = AVG_Z(AVG_X(V_S(IJK1,M),V_S(IP_OF(IJK1),M),I_OF(IJK1)),&
455                    AVG_X(V_S(IJK2,M),V_S(IP_OF(IJK2),M),I_OF(IJK2)),K_OF(IJK1))
456     !
457                 V_S_W = AVG_Z(AVG_X(V_S(IM_OF(IJK1),M),V_S(IJK1,M),I_OF(IM_OF(&
458                    IJK1))),AVG_X(V_S(IM_OF(IJK2),M),V_S(IJK2,M),I_OF(IM_OF(IJK2))&
459                    ),K_OF(IJK1))
460     !
461                 V_S_T = V_S(IJK2,M)
462     !
463                 V_S_B = V_S(IJK1,M)
464     !
465                 W_S_N = ZERO
466     !
467                 W_S_S = ZERO
468     !
469                 W_S_E = ZERO
470     !
471                 W_S_W = ZERO
472     !
473                 W_S_T = AVG_Y(AVG_Z_T(W_S(IJK1,M),W_S(IJK2,M)),AVG_Z_T(W_S(&
474                    IJPKM2,M),W_S(IJPK2,M)),J_OF(IJK2))
475     !
476                 W_S_B = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
477                    W_S(KM_OF(IJPKM2),M),W_S(IJPKM2,M)),J_OF(IJK1))
478     !
479                 IF (CYLINDRICAL) THEN
480                    U_S_C = AVG_Z(U_S_B,U_S_T,K_OF(IJK1))
481                    W_S_C = AVG_Y(W_S(IJK1,M),W_S(IJPKM2,M),J_OF(IJK1))
482                 ELSE
483                    U_S_C = ZERO
484                    W_S_C = ZERO
485                 ENDIF
486     !
487                 CALL SDDOTS (IJK1, FCELL, 'N', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
488                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
489                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
490                    S_DD)
491     !
492     !
493              CASE ('B')
494                 IJPK2 = JP_OF(IJK2)
495                 IJPKP2 = KP_OF(IJPK2)
496     !
497                 U_S_N = AVG_Z(AVG_X_E(U_S(IM_OF(IJPK2),M),U_S(IJPK2,M),I_OF(IJPK2&
498                    )),AVG_X_E(U_S(IM_OF(IJPKP2),M),U_S(IJPKP2,M),I_OF(IJPKP2)),&
499                    K_OF(IJPK2))
500     !
501                 U_S_S = AVG_Z(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
502                    AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),K_OF(IJK2))
503     !
504                 U_S_E = AVG_Z(AVG_Y(U_S(IJK2,M),U_S(IJPK2,M),J_OF(IJK2)),AVG_Y(&
505                    U_S(IJK1,M),U_S(IJPKP2,M),J_OF(IJK1)),K_OF(IJK2))
506     !
507                 U_S_W = AVG_Z(AVG_Y(U_S(IM_OF(IJK2),M),U_S(IM_OF(IJPK2),M),J_OF(&
508                    IM_OF(IJK2))),AVG_Y(U_S(IM_OF(IJK1),M),U_S(IM_OF(IJPKP2),M),&
509                    J_OF(IM_OF(IJK1))),K_OF(IJK2))
510     !
511                 U_S_T = AVG_Y(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
512                    AVG_X_E(U_S(IM_OF(IJPKP2),M),U_S(IJPKP2,M),I_OF(IJPKP2)),J_OF(&
513                    IJK1))
514     !
515                 U_S_B = AVG_Y(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
516                    AVG_X_E(U_S(IM_OF(IJPK2),M),U_S(IJPK2,M),I_OF(IJPK2)),J_OF(&
517                    IJK2))
518     !
519                 V_S_N = AVG_Z(AVG_Y_N(V_S(IJK2,M),V_S(IJPK2,M)),AVG_Y_N(V_S(IJK1&
520                    ,M),V_S(IJPKP2,M)),K_OF(IJPK2))
521     !
522                 V_S_S = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
523                    V_S(JM_OF(IJK1),M),V_S(IJK1,M)),K_OF(IJK2))
524     !
525                 V_S_E = AVG_Z(AVG_X(V_S(IJK2,M),V_S(IP_OF(IJK2),M),I_OF(IJK2)),&
526                    AVG_X(V_S(IJK1,M),V_S(IP_OF(IJK1),M),I_OF(IJK1)),K_OF(IJK2))
527     !
528                 V_S_W = AVG_Z(AVG_X(V_S(IM_OF(IJK2),M),V_S(IJK2,M),I_OF(IM_OF(&
529                    IJK2))),AVG_X(V_S(IM_OF(IJK1),M),V_S(IJK1,M),I_OF(IM_OF(IJK1))&
530                    ),K_OF(IJK2))
531     !
532                 V_S_T = V_S(IJK1,M)
533     !
534                 V_S_B = V_S(IJK2,M)
535     !
536                 W_S_N = ZERO
537     !
538                 W_S_S = ZERO
539     !
540                 W_S_E = ZERO
541     !
542                 W_S_W = ZERO
543     !
544                 W_S_T = AVG_Y(AVG_Z_T(W_S(IJK2,M),W_S(IJK1,M)),AVG_Z_T(W_S(IJPK2&
545                    ,M),W_S(IJPKP2,M)),J_OF(IJK1))
546     !
547                 W_S_B = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
548                    W_S(KM_OF(IJPK2),M),W_S(IJPK2,M)),J_OF(IJK2))
549     !
550                 IF (CYLINDRICAL) THEN
551                    U_S_C = AVG_Z(U_S_B,U_S_T,K_OF(IJK2))
552                    W_S_C = AVG_Y(W_S(IJK2,M),W_S(IJPK2,M),J_OF(IJK2))
553                 ELSE
554                    U_S_C = ZERO
555                    W_S_C = ZERO
556                 ENDIF
557     !
558                 CALL SDDOTS (IJK2, FCELL, 'N', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
559                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
560                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
561                    S_DD)
562     !
563     !
564              CASE ('E')
565                 IJPK2 = JP_OF(IJK2)
566                 IMJPK2 = IM_OF(IJPK2)
567     !
568                 U_S_N = ZERO
569     !
570                 U_S_S = ZERO
571     !
572                 U_S_E = AVG_Y(AVG_X_E(U_S(IJK1,M),U_S(IJK2,M),I_OF(IJK2)),AVG_X_E&
573                    (U_S(IMJPK2,M),U_S(IJPK2,M),I_OF(IJPK2)),J_OF(IJK2))
574     !
575                 U_S_W = AVG_Y(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
576                    AVG_X_E(U_S(IM_OF(IMJPK2),M),U_S(IMJPK2,M),I_OF(IMJPK2)),J_OF(&
577                    IJK1))
578     !
579                 U_S_T = ZERO
580     !
581                 U_S_B = ZERO
582     !
583                 V_S_N = AVG_X(AVG_Y_N(V_S(IJK1,M),V_S(IMJPK2,M)),AVG_Y_N(V_S(&
584                    IJK2,M),V_S(IJPK2,M)),I_OF(IMJPK2))
585     !
586                 V_S_S = AVG_X(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
587                    V_S(JM_OF(IJK2),M),V_S(IJK2,M)),I_OF(IJK1))
588     !
589                 V_S_E = V_S(IJK2,M)
590     !
591                 V_S_W = V_S(IJK1,M)
592     !
593                 V_S_T = AVG_X(AVG_Z(V_S(IJK1,M),V_S(KP_OF(IJK1),M),K_OF(IJK1)),&
594                    AVG_Z(V_S(IJK2,M),V_S(KP_OF(IJK2),M),K_OF(IJK2)),I_OF(IJK1))
595     !
596                 V_S_B = AVG_X(AVG_Z(V_S(KM_OF(IJK1),M),V_S(IJK1,M),K_OF(KM_OF(&
597                    IJK1))),AVG_Z(V_S(KM_OF(IJK2),M),V_S(IJK2,M),K_OF(KM_OF(IJK2))&
598                    ),I_OF(IJK1))
599     !
600                 W_S_N = AVG_X(AVG_Z_T(W_S(KM_OF(IMJPK2),M),W_S(IMJPK2,M)),AVG_Z_T&
601                    (W_S(KM_OF(IJPK2),M),W_S(IJPK2,M)),I_OF(IMJPK2))
602     !
603                 W_S_S = AVG_X(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
604                    W_S(KM_OF(IJK2),M),W_S(IJK2,M)),I_OF(IJK1))
605     !
606                 W_S_E = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
607                    W_S(KM_OF(IJPK2),M),W_S(IJPK2,M)),J_OF(IJK2))
608     !
609                 W_S_W = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
610                    W_S(KM_OF(IMJPK2),M),W_S(IMJPK2,M)),J_OF(IJK1))
611     !
612                 W_S_T = AVG_X(AVG_Y(W_S(IJK1,M),W_S(IMJPK2,M),J_OF(IJK1)),AVG_Y(&
613                    W_S(IJK2,M),W_S(IJPK2,M),J_OF(IJK2)),I_OF(IJK1))
614     !
615                 W_S_B = AVG_X(AVG_Y(W_S(KM_OF(IJK1),M),W_S(KM_OF(IMJPK2),M),J_OF(&
616                    KM_OF(IJK1))),AVG_Y(W_S(KM_OF(IJK2),M),W_S(KM_OF(IJPK2),M),&
617                    J_OF(KM_OF(IJK2))),I_OF(IJK1))
618     !
619                 IF (CYLINDRICAL) THEN
620                    U_S_C = AVG_Y(U_S(IJK1,M),U_S(IMJPK2,M),J_OF(IJK1))
621                    W_S_C = AVG_X(W_S_W,W_S_E,I_OF(IJK1))
622                 ELSE
623                    U_S_C = ZERO
624                    W_S_C = ZERO
625                 ENDIF
626     !
627                 CALL SDDOTS (IJK1, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
628                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
629                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
630                    S_DD)
631     !
632     !
633              CASE ('W')
634                 IJPK2 = JP_OF(IJK2)
635                 IPJPK2 = IP_OF(IJPK2)
636     !
637                 U_S_N = ZERO
638     !
639                 U_S_S = ZERO
640     !
641                 U_S_E = AVG_Y(AVG_X_E(U_S(IJK2,M),U_S(IJK1,M),I_OF(IJK1)),AVG_X_E&
642                    (U_S(IJPK2,M),U_S(IPJPK2,M),I_OF(IPJPK2)),J_OF(IJK1))
643     !
644                 U_S_W = AVG_Y(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
645                    AVG_X_E(U_S(IM_OF(IJPK2),M),U_S(IJPK2,M),I_OF(IJPK2)),J_OF(&
646                    IJK2))
647     !
648                 U_S_T = ZERO
649     !
650                 U_S_B = ZERO
651     !
652                 V_S_N = AVG_X(AVG_Y_N(V_S(IJK2,M),V_S(IJPK2,M)),AVG_Y_N(V_S(IJK1&
653                    ,M),V_S(IPJPK2,M)),I_OF(IJPK2))
654     !
655                 V_S_S = AVG_X(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
656                    V_S(JM_OF(IJK1),M),V_S(IJK1,M)),I_OF(IJK2))
657     !
658                 V_S_E = V_S(IJK1,M)
659     !
660                 V_S_W = V_S(IJK2,M)
661     !
662                 V_S_T = AVG_X(AVG_Z(V_S(IJK2,M),V_S(KP_OF(IJK2),M),K_OF(IJK2)),&
663                    AVG_Z(V_S(IJK1,M),V_S(KP_OF(IJK1),M),K_OF(IJK1)),I_OF(IJK2))
664     !
665                 V_S_B = AVG_X(AVG_Z(V_S(KM_OF(IJK2),M),V_S(IJK2,M),K_OF(KM_OF(&
666                    IJK2))),AVG_Z(V_S(KM_OF(IJK1),M),V_S(IJK1,M),K_OF(KM_OF(IJK1))&
667                    ),I_OF(IJK2))
668     !
669                 W_S_N = AVG_X(AVG_Z_T(W_S(KM_OF(IJPK2),M),W_S(IJPK2,M)),AVG_Z_T(&
670                    W_S(KM_OF(IPJPK2),M),W_S(IPJPK2,M)),I_OF(IJPK2))
671     !
672                 W_S_S = AVG_X(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
673                    W_S(KM_OF(IJK1),M),W_S(IJK1,M)),I_OF(IJK2))
674     !
675                 W_S_E = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
676                    W_S(KM_OF(IPJPK2),M),W_S(IPJPK2,M)),J_OF(IJK1))
677     !
678                 W_S_W = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
679                    W_S(KM_OF(IJPK2),M),W_S(IJPK2,M)),J_OF(IJK2))
680     !
681                 W_S_T = AVG_X(AVG_Y(W_S(IJK2,M),W_S(IJPK2,M),J_OF(IJK2)),AVG_Y(&
682                    W_S(IJK1,M),W_S(IPJPK2,M),J_OF(IJK1)),I_OF(IJK2))
683     !
684                 W_S_B = AVG_X(AVG_Y(W_S(KM_OF(IJK2),M),W_S(KM_OF(IJPK2),M),J_OF(&
685                    KM_OF(IJK2))),AVG_Y(W_S(KM_OF(IJK1),M),W_S(KM_OF(IPJPK2),M),&
686                    J_OF(KM_OF(IJK1))),I_OF(IJK2))
687     !
688                 IF (CYLINDRICAL) THEN
689                    U_S_C = AVG_Y(U_S(IJK2,M),U_S(IJPK2,M),J_OF(IJK2))
690                    W_S_C = AVG_X(W_S_W,W_S_E,I_OF(IJK2))
691                 ELSE
692                    U_S_C = ZERO
693                    W_S_C = ZERO
694                 ENDIF
695     !
696                 CALL SDDOTS (IJK2, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
697                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
698                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
699                    S_DD)
700     !
701              END SELECT
702     !
703           CASE ('W')
704              SELECT CASE (TRIM(FCELL))
705              CASE ('N')
706                 IJKP2 = KP_OF(IJK2)
707                 IJMKP2 = JM_OF(IJKP2)
708     !
709                 U_S_N = AVG_Z(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
710                    AVG_X_E(U_S(IM_OF(IJKP2),M),U_S(IJKP2,M),I_OF(IJKP2)),K_OF(&
711                    IJK2))
712     !
713                 U_S_S = AVG_Z(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
714                    AVG_X_E(U_S(IM_OF(IJMKP2),M),U_S(IJMKP2,M),I_OF(IJMKP2)),K_OF(&
715                    IJK1))
716     !
717                 U_S_E = AVG_Z(AVG_Y(U_S(IJK1,M),U_S(IJK2,M),J_OF(IJK1)),AVG_Y(&
718                    U_S(IJMKP2,M),U_S(IJKP2,M),J_OF(IJMKP2)),K_OF(IJK1))
719     !
720                 U_S_W = AVG_Z(AVG_Y(U_S(IM_OF(IJK1),M),U_S(IM_OF(IJK2),M),J_OF(&
721                    IM_OF(IJK1))),AVG_Y(U_S(IM_OF(IJMKP2),M),U_S(IM_OF(IJKP2),M),&
722                    J_OF(IM_OF(IJMKP2))),K_OF(IJK1))
723     !
724                 U_S_T = AVG_Y(AVG_X_E(U_S(IM_OF(IJMKP2),M),U_S(IJMKP2,M),I_OF(&
725                    IJMKP2)),AVG_X_E(U_S(IM_OF(IJKP2),M),U_S(IJKP2,M),I_OF(IJKP2))&
726                    ,J_OF(IJMKP2))
727     !
728                 U_S_B = AVG_Y(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
729                    AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),J_OF(IJK1))
730     !
731                 V_S_N = AVG_Z(AVG_Y_N(V_S(IJK1,M),V_S(IJK2,M)),AVG_Y_N(V_S(&
732                    IJMKP2,M),V_S(IJKP2,M)),K_OF(IJK2))
733     !
734                 V_S_S = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
735                    V_S(JM_OF(IJMKP2),M),V_S(IJMKP2,M)),K_OF(IJK1))
736     !
737                 V_S_E = ZERO
738     !
739                 V_S_W = ZERO
740     !
741                 V_S_T = ZERO
742     !
743                 V_S_B = ZERO
744     !
745                 W_S_N = W_S(IJK2,M)
746     !
747                 W_S_S = W_S(IJK1,M)
748     !
749                 W_S_E = AVG_Y(AVG_X(W_S(IJK1,M),W_S(IP_OF(IJK1),M),I_OF(IJK1)),&
750                    AVG_X(W_S(IJK2,M),W_S(IP_OF(IJK2),M),I_OF(IJK2)),J_OF(IJK1))
751     !
752                 W_S_W = AVG_Y(AVG_X(W_S(IM_OF(IJK1),M),W_S(IJK1,M),I_OF(IM_OF(&
753                    IJK1))),AVG_X(W_S(IM_OF(IJK2),M),W_S(IJK2,M),I_OF(IM_OF(IJK2))&
754                    ),J_OF(IJK1))
755     !
756                 W_S_T = AVG_Y(AVG_Z_T(W_S(IJK1,M),W_S(IJMKP2,M)),AVG_Z_T(W_S(&
757                    IJK2,M),W_S(IJKP2,M)),J_OF(IJMKP2))
758     !
759                 W_S_B = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
760                    W_S(KM_OF(IJK2),M),W_S(IJK2,M)),J_OF(IJK1))
761     !
762                 IF (CYLINDRICAL) THEN
763                    U_S_C = AVG_Z(U_S_B,U_S_T,K_OF(IJK1))
764                    W_S_C = AVG_Y(W_S(IJK1,M),W_S(IJK2,M),J_OF(IJK1))
765                 ELSE
766                    U_S_C = ZERO
767                    W_S_C = ZERO
768                 ENDIF
769     !
770                 CALL SDDOTS (IJK1, FCELL, 'N', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
771                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
772                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
773                    S_DD)
774     !
775     !
776              CASE ('S')
777                 IJKP2 = KP_OF(IJK2)
778                 IJPKP2 = JP_OF(IJKP2)
779     !
780                 U_S_N = AVG_Z(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
781                    AVG_X_E(U_S(IM_OF(IJPKP2),M),U_S(IJPKP2,M),I_OF(IJPKP2)),K_OF(&
782                    IJK1))
783     !
784                 U_S_S = AVG_Z(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
785                    AVG_X_E(U_S(IM_OF(IJKP2),M),U_S(IJKP2,M),I_OF(IJKP2)),K_OF(&
786                    IJK2))
787     !
788                 U_S_E = AVG_Z(AVG_Y(U_S(IJK2,M),U_S(IJK1,M),J_OF(IJK2)),AVG_Y(&
789                    U_S(IJKP2,M),U_S(IJPKP2,M),J_OF(IJKP2)),K_OF(IJK2))
790     !
791                 U_S_W = AVG_Z(AVG_Y(U_S(IM_OF(IJK2),M),U_S(IM_OF(IJK1),M),J_OF(&
792                    IM_OF(IJK2))),AVG_Y(U_S(IM_OF(IJKP2),M),U_S(IM_OF(IJPKP2),M),&
793                    J_OF(IM_OF(IJKP2))),K_OF(IJK2))
794     !
795                 U_S_T = AVG_Y(AVG_X_E(U_S(IM_OF(IJKP2),M),U_S(IJKP2,M),I_OF(IJKP2&
796                    )),AVG_X_E(U_S(IM_OF(IJPKP2),M),U_S(IJPKP2,M),I_OF(IJPKP2)),&
797                    J_OF(IJKP2))
798     !
799                 U_S_B = AVG_Y(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
800                    AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),J_OF(IJK2))
801     !
802                 V_S_N = AVG_Z(AVG_Y_N(V_S(IJK2,M),V_S(IJK1,M)),AVG_Y_N(V_S(IJKP2&
803                    ,M),V_S(IJPKP2,M)),K_OF(IJK1))
804     !
805                 V_S_S = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
806                    V_S(JM_OF(IJKP2),M),V_S(IJKP2,M)),K_OF(IJK2))
807     !
808                 V_S_E = ZERO
809     !
810                 V_S_W = ZERO
811     !
812                 V_S_T = ZERO
813     !
814                 V_S_B = ZERO
815     !
816                 W_S_N = W_S(IJK1,M)
817     !
818                 W_S_S = W_S(IJK2,M)
819     !
820                 W_S_E = AVG_Y(AVG_X(W_S(IJK2,M),W_S(IP_OF(IJK2),M),I_OF(IJK2)),&
821                    AVG_X(W_S(IJK1,M),W_S(IP_OF(IJK1),M),I_OF(IJK1)),J_OF(IJK2))
822     !
823                 W_S_W = AVG_Y(AVG_X(W_S(IM_OF(IJK2),M),W_S(IJK2,M),I_OF(IM_OF(&
824                    IJK2))),AVG_X(W_S(IM_OF(IJK1),M),W_S(IJK1,M),I_OF(IM_OF(IJK1))&
825                    ),J_OF(IJK2))
826     !
827                 W_S_T = AVG_Y(AVG_Z_T(W_S(IJK2,M),W_S(IJKP2,M)),AVG_Z_T(W_S(IJK1&
828                    ,M),W_S(IJPKP2,M)),J_OF(IJKP2))
829     !
830                 W_S_B = AVG_Y(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
831                    W_S(KM_OF(IJK1),M),W_S(IJK1,M)),J_OF(IJK2))
832     !
833                 IF (CYLINDRICAL) THEN
834                    U_S_C = AVG_Z(U_S_B,U_S_T,K_OF(IJK2))
835                    W_S_C = AVG_Y(W_S(IJK2,M),W_S(IJK1,M),J_OF(IJK2))
836                 ELSE
837                    U_S_C = ZERO
838                    W_S_C = ZERO
839                 ENDIF
840     !
841                 CALL SDDOTS (IJK2, FCELL, 'N', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
842                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
843                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
844                    S_DD)
845     !
846     !
847              CASE ('E')
848                 IJKP2 = KP_OF(IJK2)
849                 IMJKP2 = IM_OF(IJKP2)
850     !
851                 U_S_N = ZERO
852     !
853                 U_S_S = ZERO
854     !
855                 U_S_E = AVG_Z(AVG_X_E(U_S(IJK1,M),U_S(IJK2,M),I_OF(IJK2)),AVG_X_E&
856                    (U_S(IMJKP2,M),U_S(IJKP2,M),I_OF(IJKP2)),K_OF(IJK2))
857     !
858                 U_S_W = AVG_Z(AVG_X_E(U_S(IM_OF(IJK1),M),U_S(IJK1,M),I_OF(IJK1)),&
859                    AVG_X_E(U_S(IM_OF(IMJKP2),M),U_S(IMJKP2,M),I_OF(IMJKP2)),K_OF(&
860                    IJK1))
861     !
862                 U_S_T = ZERO
863     !
864                 U_S_B = ZERO
865     !
866                 V_S_N = AVG_X(AVG_Z(V_S(IJK1,M),V_S(IMJKP2,M),K_OF(IJK1)),AVG_Z(&
867                    V_S(IJK2,M),V_S(IJKP2,M),K_OF(IJK2)),I_OF(IJK1))
868     !
869                 V_S_S = AVG_X(AVG_Z(V_S(JM_OF(IJK1),M),V_S(JM_OF(IMJKP2),M),K_OF(&
870                    JM_OF(IJK1))),AVG_Z(V_S(JM_OF(IJK2),M),V_S(JM_OF(IJKP2),M),&
871                    K_OF(JM_OF(IJK2))),I_OF(IJK1))
872     !
873                 V_S_E = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
874                    V_S(JM_OF(IJKP2),M),V_S(IJKP2,M)),K_OF(IJK2))
875     !
876                 V_S_W = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
877                    V_S(JM_OF(IMJKP2),M),V_S(IMJKP2,M)),K_OF(IJK1))
878     !
879                 V_S_T = AVG_X(AVG_Y_N(V_S(JM_OF(IMJKP2),M),V_S(IMJKP2,M)),AVG_Y_N&
880                    (V_S(JM_OF(IJKP2),M),V_S(IJKP2,M)),I_OF(IMJKP2))
881     !
882                 V_S_B = AVG_X(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
883                    V_S(JM_OF(IJK2),M),V_S(IJK2,M)),I_OF(IJK1))
884     !
885                 W_S_N = AVG_X(AVG_Y(W_S(IJK1,M),W_S(JP_OF(IJK1),M),J_OF(IJK1)),&
886                    AVG_Y(W_S(IJK2,M),W_S(JP_OF(IJK2),M),J_OF(IJK2)),I_OF(IJK1))
887     !
888                 W_S_S = AVG_X(AVG_Y(W_S(JM_OF(IJK1),M),W_S(IJK1,M),J_OF(JM_OF(&
889                    IJK1))),AVG_Y(W_S(JM_OF(IJK2),M),W_S(IJK2,M),J_OF(JM_OF(IJK2))&
890                    ),I_OF(IJK1))
891     !
892                 W_S_E = W_S(IJK2,M)
893     !
894                 W_S_W = W_S(IJK1,M)
895     !
896                 W_S_T = AVG_X(AVG_Z_T(W_S(IJK1,M),W_S(IMJKP2,M)),AVG_Z_T(W_S(&
897                    IJK2,M),W_S(IJKP2,M)),I_OF(IMJKP2))
898     !
899                 W_S_B = AVG_X(AVG_Z_T(W_S(KM_OF(IJK1),M),W_S(IJK1,M)),AVG_Z_T(&
900                    W_S(KM_OF(IJK2),M),W_S(IJK2,M)),I_OF(IJK1))
901     !
902                 IF (CYLINDRICAL) THEN
903                    U_S_C = AVG_Z(U_S(IJK1,M),U_S(IMJKP2,M),K_OF(IJK1))
904                    W_S_C = AVG_X(W_S(IJK1,M),W_S(IJK2,M),I_OF(IJK1))
905                 ELSE
906                    U_S_C = ZERO
907                    W_S_C = ZERO
908                 ENDIF
909     !
910                 CALL SDDOTS (IJK1, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
911                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
912                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
913                    S_DD)
914     !
915     !
916              CASE ('W')
917                 IJKP2 = KP_OF(IJK2)
918                 IPJKP2 = IP_OF(IJKP2)
919     !
920                 U_S_N = ZERO
921     !
922                 U_S_S = ZERO
923     !
924                 U_S_E = AVG_Z(AVG_X_E(U_S(IJK2,M),U_S(IJK1,M),I_OF(IJK1)),AVG_X_E&
925                    (U_S(IJKP2,M),U_S(IPJKP2,M),I_OF(IPJKP2)),K_OF(IJK1))
926     !
927                 U_S_W = AVG_Z(AVG_X_E(U_S(IM_OF(IJK2),M),U_S(IJK2,M),I_OF(IJK2)),&
928                    AVG_X_E(U_S(IM_OF(IJKP2),M),U_S(IJKP2,M),I_OF(IJKP2)),K_OF(&
929                    IJK2))
930     !
931                 U_S_T = ZERO
932     !
933                 U_S_B = ZERO
934     !
935                 V_S_N = AVG_X(AVG_Z(V_S(IJK2,M),V_S(IJKP2,M),K_OF(IJK2)),AVG_Z(&
936                    V_S(IJK1,M),V_S(IPJKP2,M),K_OF(IJK1)),I_OF(IJK2))
937     !
938                 V_S_S = AVG_X(AVG_Z(V_S(JM_OF(IJK2),M),V_S(JM_OF(IJKP2),M),K_OF(&
939                    JM_OF(IJK2))),AVG_Z(V_S(JM_OF(IJK1),M),V_S(JM_OF(IPJKP2),M),&
940                    K_OF(JM_OF(IJK1))),I_OF(IJK2))
941     !
942                 V_S_E = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK1),M),V_S(IJK1,M)),AVG_Y_N(&
943                    V_S(JM_OF(IPJKP2),M),V_S(IPJKP2,M)),K_OF(IJK1))
944     !
945                 V_S_W = AVG_Z(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
946                    V_S(JM_OF(IJKP2),M),V_S(IJKP2,M)),K_OF(IJK2))
947     !
948                 V_S_T = AVG_X(AVG_Y_N(V_S(JM_OF(IJKP2),M),V_S(IJKP2,M)),AVG_Y_N(&
949                    V_S(JM_OF(IPJKP2),M),V_S(IPJKP2,M)),I_OF(IJKP2))
950     !
951                 V_S_B = AVG_X(AVG_Y_N(V_S(JM_OF(IJK2),M),V_S(IJK2,M)),AVG_Y_N(&
952                    V_S(JM_OF(IJK1),M),V_S(IJK1,M)),I_OF(IJK2))
953     !
954                 W_S_N = AVG_X(AVG_Y(W_S(IJK2,M),W_S(JP_OF(IJK2),M),J_OF(IJK2)),&
955                    AVG_Y(W_S(IJK1,M),W_S(JP_OF(IJK1),M),J_OF(IJK1)),I_OF(IJK2))
956     !
957                 W_S_S = AVG_X(AVG_Y(W_S(JM_OF(IJK2),M),W_S(IJK2,M),J_OF(JM_OF(&
958                    IJK2))),AVG_Y(W_S(JM_OF(IJK1),M),W_S(IJK1,M),J_OF(JM_OF(IJK1))&
959                    ),I_OF(IJK2))
960     !
961                 W_S_E = W_S(IJK1,M)
962     !
963                 W_S_W = W_S(IJK2,M)
964     !
965                 W_S_T = AVG_X(AVG_Z_T(W_S(IJK2,M),W_S(IJKP2,M)),AVG_Z_T(W_S(IJK1&
966                    ,M),W_S(IPJKP2,M)),I_OF(IJKP2))
967     !
968                 W_S_B = AVG_X(AVG_Z_T(W_S(KM_OF(IJK2),M),W_S(IJK2,M)),AVG_Z_T(&
969                    W_S(KM_OF(IJK1),M),W_S(IJK1,M)),I_OF(IJK2))
970     !
971                 IF (CYLINDRICAL) THEN
972                    U_S_C = AVG_Z(U_S(IJK2,M),U_S(IJKP2,M),K_OF(IJK2))
973                    W_S_C = AVG_X(W_S(IJK2,M),W_S(IJK1,M),I_OF(IJK2))
974                 ELSE
975                    U_S_C = ZERO
976                    W_S_C = ZERO
977                 ENDIF
978     !
979                 CALL SDDOTS (IJK2, FCELL, 'Y', U_S_N, U_S_S, U_S_E, U_S_W, U_S_T, &
980                    U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, &
981                    W_S_S, W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, &
982                    S_DD)
983     !
984              END SELECT
985           END SELECT
986           RETURN
987           END SUBROUTINE CALC_S_DDOT_S
988     !
989     !
990     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
991     !                                                                      C
992     !  Module name: SUBROUTINE SDDOTS(IJK, NORMAL, DZVALUE,                C
993     !                 U_s_N, U_s_S, U_s_E, U_s_W, U_s_T, U_s_B, U_s_C,     C
994     !                 V_s_N, V_s_S, V_s_E,  V_s_W, V_s_T, V_s_B,           C
995     !                 W_s_N, W_s_S, W_s_E, W_s_W, W_s_T, W_s_B, W_s_C,     C
996     !                 DEL_DOT_U, S_DDOT_S)                                 C
997     !                                                                      C
998     !  Purpose: Calculate del.U (trace of D_s), S:S and S_xx, S_yy or S_zz C
999     !           at the boundary                                            C
1000     !                                                                      C
1001     !                                                                      C
1002     !  Author: Anuj Srivastava, Princeton University      Date: 4-APR-98   C
1003     !  Reviewer:                                          Date:            C
1004     !                                                                      C
1005     !                                                                      C
1006     !  Literature/Document References:                                     C
1007     !                                                                      C
1008     !  Variables referenced:                                               C
1009     !  Variables modified:                                                 C
1010     !                                                                      C
1011     !  Local variables:                                                    C
1012     !                                                                      C
1013     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
1014     !
1015           SUBROUTINE SDDOTS(IJK, NORMAL, DZVALUE, U_S_N, U_S_S, U_S_E, U_S_W, U_S_T&
1016              , U_S_B, U_S_C, V_S_N, V_S_S, V_S_E, V_S_W, V_S_T, V_S_B, W_S_N, W_S_S&
1017              , W_S_E, W_S_W, W_S_T, W_S_B, W_S_C, DEL_DOT_U, S_DDOT_S, S_DD)
1018     !...Translated by Pacific-Sierra Research VAST-90 2.06G5  12:17:31  12/09/98
1019     !...Switches: -xf
1020     !
1021     !
1022     !-----------------------------------------------
1023     !   M o d u l e s
1024     !-----------------------------------------------
1025           USE param
1026           USE param1
1027           USE constant
1028           USE fldvar
1029           USE geometry
1030           USE indices
1031           USE compar
1032           USE fun_avg
1033           USE functions
1034           IMPLICIT NONE
1035     !-----------------------------------------------
1036     !   G l o b a l   P a r a m e t e r s
1037     !-----------------------------------------------
1038     !-----------------------------------------------
1039     !   D u m m y   A r g u m e n t s
1040     !-----------------------------------------------
1041     !                      Strain rate tensor components for mth solids phase
1042            DOUBLE PRECISION D_s(3,3)
1043     
1044     !                      direction of normal to wall
1045            CHARACTER        NORMAL
1046     
1047     !                      tells what value should odelta_Z should take
1048            CHARACTER        DZVALUE
1049     
1050     !  The location where D is calculated in located at the center of 4
1051     !  cells - 2 fluid cells and 2 wall cells. Coordinates of this are i,j,k
1052     
1053     !                      U_s at the north (i, j+1/2, k)
1054            DOUBLE PRECISION U_s_N
1055     !
1056     !                      U_s at the south (i, j-1/2, k)
1057            DOUBLE PRECISION U_s_S
1058     
1059     !                      U_s at the east (i+1/2, j, k)
1060            DOUBLE PRECISION U_s_E
1061     !
1062     !                      U_s at the west (i-1/2, j, k)
1063            DOUBLE PRECISION U_s_W
1064     !
1065     !                      U_s at the top (i, j, k+1/2)
1066            DOUBLE PRECISION U_s_T
1067     !
1068     !                      U_s at the bottom (i, j, k-1/2)
1069            DOUBLE PRECISION U_s_B
1070     !
1071     !                      U_s at the center (i, j, k)
1072     !                      Calculated for Cylindrical coordinates only.
1073            DOUBLE PRECISION U_s_C
1074     !
1075     !                      V_s at the north (i, j+1/2, k)
1076            DOUBLE PRECISION V_s_N
1077     !
1078     !                      V_s at the south (i, j-1/2, k)
1079            DOUBLE PRECISION V_s_S
1080     !
1081     !                      V_s at the east (i+1/2, j, k)
1082            DOUBLE PRECISION V_s_E
1083     !
1084     !                      V_s at the west (i-1/2, j, k)
1085            DOUBLE PRECISION V_s_W
1086     
1087     !                      V_s at the top (i, j, k+1/2)
1088            DOUBLE PRECISION V_s_T
1089     !
1090     !                      V_s at the bottom (i, j, k-1/2)
1091            DOUBLE PRECISION V_s_B
1092     
1093     !                      W_s at the north (i, j+1/2, k)
1094            DOUBLE PRECISION W_s_N
1095     !
1096     !                      W_s at the south (i, j-1/2, k)
1097            DOUBLE PRECISION W_s_S
1098     !
1099     !                      W_s at the east (i+1/2, j, k)
1100            DOUBLE PRECISION W_s_E
1101     !
1102     !                      W_s at the west (1-1/2, j, k)
1103            DOUBLE PRECISION W_s_W
1104     !
1105     !                      W_s at the top (i, j, k+1/2)
1106            DOUBLE PRECISION W_s_T
1107     !
1108     !                      W_s at the bottom (i, j, k-1/2)
1109            DOUBLE PRECISION W_s_B
1110     !
1111     !                      W_s at the center (i, j, k).
1112     !                      Calculated for Cylindrical coordinates only.
1113            DOUBLE PRECISION W_s_C
1114     
1115     !                      del.u
1116            DOUBLE PRECISION DEL_DOT_U
1117     
1118     !                      S:S
1119            DOUBLE PRECISION S_DDOT_S
1120     
1121     !                      S_dd (d is x,y, or z)
1122            DOUBLE PRECISION S_dd
1123     
1124     !                      trace of D
1125            DOUBLE PRECISION TRACE_D
1126     
1127     !                      trace of the square of D
1128            DOUBLE PRECISION TRACE_sD
1129     
1130     !                      Local indices
1131            INTEGER          IJK, I, J, K, I1, I2
1132     
1133            DOUBLE PRECISION odelta_Z
1134     
1135     !-----------------------------------------------
1136     !
1137     !         Define I, J, K
1138     !     IJK is the cell whose coordinates are i-1/2, j-1/2 and k-1/2
1139     !     (this cell actually has two of the above coordinates. The other
1140     !     coordinate is i, j or k)
1141     !     This is necessary because we are using oDX_E, oDY_N, and oDZ_T to
1142     !     calculate D_s
1143     !
1144     !
1145           I = I_OF(IJK)
1146           J = J_OF(IJK)
1147           K = K_OF(IJK)
1148     !
1149           IF (DZVALUE == 'Y') THEN
1150              ODELTA_Z = (ODZ(K)+ODZ(K_OF(IP_OF(IJK))))/2D0
1151           ELSE
1152              ODELTA_Z = ODZ_T(K)
1153           ENDIF
1154     !
1155     !
1156     !
1157     !         Find components of Mth solids phase continuum strain rate
1158     !         tensor, D_s, at i,j,k
1159     !
1160           D_S(1,1) = (U_S_E - U_S_W)*ODX_E(I)
1161           D_S(1,2) = HALF*((U_S_N - U_S_S)*ODY_N(J)+(V_S_E-V_S_W)*ODX_E(I))
1162           D_S(1,3) = HALF*((W_S_E - W_S_W)*ODX_E(I)+(U_S_T-U_S_B)*(OX_E(I)*ODELTA_Z&
1163              )-W_S_C*OX_E(I))
1164           D_S(2,1) = D_S(1,2)
1165           D_S(2,2) = (V_S_N - V_S_S)*ODY_N(J)
1166           D_S(2,3)=HALF*((V_S_T-V_S_B)*(OX_E(I)*ODELTA_Z)+(W_S_N-W_S_S)*ODY_N(J))
1167           D_S(3,1) = D_S(1,3)
1168           D_S(3,2) = D_S(2,3)
1169           D_S(3,3) = (W_S_T - W_S_B)*(OX_E(I)*ODELTA_Z) + U_S_C*OX_E(I)
1170     !
1171     !         Calculate the trace of D_s
1172           TRACE_D = D_S(1,1) + D_S(2,2) + D_S(3,3)
1173     !
1174     !         Calculate trace of the square of D_s
1175           TRACE_SD = 0.D0                            !Initialize the totalizer
1176           DO I1 = 1, 3
1177              TRACE_SD = TRACE_SD + SUM(D_S(I1,:)*D_S(I1,:))
1178              I2 = 4
1179           END DO
1180           DEL_DOT_U = TRACE_D
1181     !
1182           S_DDOT_S = TRACE_SD - (TRACE_D*TRACE_D)/3.D0
1183     !
1184           S_DDOT_S = DMAX1(1D-10,S_DDOT_S)
1185     !
1186           IF (NORMAL=='E' .OR. NORMAL=='W') THEN
1187              S_DD = D_S(1,1) - TRACE_D/3D0
1188     !
1189           ELSE IF (NORMAL=='N' .OR. NORMAL=='S') THEN
1190              S_DD = D_S(2,2) - TRACE_D/3D0
1191     !
1192           ELSE
1193              S_DD = D_S(3,3) - TRACE_D/3D0
1194           ENDIF
1195     !
1196           RETURN
1197           END SUBROUTINE SDDOTS
1198