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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2     !                                                                      C
3     !  Module name: QMOMK_BC                                               C
4     !  Author: Alberto Passalacqua (A.P.)                 Date:            C
5     !  Reviewer:                                          Date:            C
6     !                                                                      C
7     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
8     
9     MODULE qmomk_bc
10     
11       USE param
12       USE param1
13       USE constant
14       USE physprop
15       USE fldvar
16       USE geometry
17       USE compar
18       USE indices
19       USE bc
20       USE qmom_kinetic_equation
21       USE qmomk_quadrature
22       USE functions
23     
24       IMPLICIT NONE
25     
26       PRIVATE
27     
28       PUBLIC :: QMOMK_REFLECTIVE_WALL_BC
29       PUBLIC :: QMOMK_OUTLET_BC
30       PUBLIC :: QMOMK_INLET_BC
31       PUBLIC :: QMOMK_CYCLIC_BC
32     
33     CONTAINS
34     
35      ! A.P. Purely reflective boundary condition with restitution coefficien e_w
36      SUBROUTINE QMOMK_REFLECTIVE_WALL_BC(L, I1, I2, J1, J2, K1, K2, INIT)
37        IMPLICIT NONE
38     
39        INTEGER, INTENT(IN) :: L, I1, I2, J1, J2, K1, K2
40        LOGICAL, INTENT(IN) :: INIT
41     
42        INTEGER :: I, J, K, M, IJK, LFLUID
43     
44        IF (INIT) THEN
45          DO K = K1, K2
46            DO J = J1, J2
47              DO I = I1, I2
48       !//SP Check if current i,j,k resides on this PE
49               IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
50               IJK = FUNIJK(I,J,K)
51       !
52       ! Fluid cell at West
53       !
54               IF (FLUID_AT(IM_OF(IJK))) THEN
55                 LFLUID = IM_OF(IJK)
56                 DO M = 1, MMAX
57                   QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)/e_w
58                   QMOMK_U0(:,IJK,M) = -e_w*QMOMK_U0(:,LFLUID,M)
59                   QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
60                   QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
61                 END DO
62               ENDIF
63     
64       !
65       ! Fluid cell at East
66       !
67               IF (FLUID_AT(IP_OF(IJK))) THEN
68                 LFLUID = IP_OF(IJK)
69                 DO M = 1, MMAX
70                   QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)/e_w
71                   QMOMK_U0(:,IJK,M) = -e_w*QMOMK_U0(:,LFLUID,M)
72                   QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
73                   QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
74                 END DO
75               END IF
76     
77       !
78       ! Fluid cell at South
79       !
80               IF (FLUID_AT(JM_OF(IJK))) THEN
81                 LFLUID = JM_OF(IJK)
82                 DO M = 1, MMAX
83                   QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)/e_w
84                   QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
85                   QMOMK_V0(:,IJK,M) = -e_w*QMOMK_V0(:,LFLUID,M)
86                   QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
87                 END DO
88               ENDIF
89       !
90       ! Fluid cell at North
91       !
92               IF (FLUID_AT(JP_OF(IJK))) THEN
93                 LFLUID = JP_OF(IJK)
94                 DO M = 1, MMAX
95                   QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)/e_w
96                   QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
97                   QMOMK_V0(:,IJK,M) = -e_w*QMOMK_V0(:,LFLUID,M)
98                   QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
99                 END DO
100               ENDIF
101       !
102       ! Fluid cell at Bottom
103       !
104               IF (FLUID_AT(KM_OF(IJK))) THEN
105                 LFLUID = KM_OF(IJK)
106                 DO M = 1, MMAX
107                   QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)/e_w
108                   QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
109                   QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
110                   QMOMK_W0(:,IJK,M) = -e_w*QMOMK_W0(:,LFLUID,M)
111                 END DO
112               ENDIF
113       !
114       ! Fluid cell at Top
115       !
116               IF (FLUID_AT(KP_OF(IJK))) THEN
117                 LFLUID = KP_OF(IJK)
118                 DO M = 1, MMAX
119                   QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)/e_w
120                   QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
121                   QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
122                   QMOMK_W0(:,IJK,M) = -e_w*QMOMK_W0(:,LFLUID,M)
123                 END DO
124               ENDIF
125              END DO
126            END DO
127          END DO
128     
129        ! Running...
130        ELSE
131          DO K = K1, K2
132            DO J = J1, J2
133              DO I = I1, I2
134       !//SP Check if current i,j,k resides on this PE
135               IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
136               IJK = FUNIJK(I,J,K)
137       !
138       ! Fluid cell at West
139       !
140               IF (FLUID_AT(IM_OF(IJK))) THEN
141                 LFLUID = IM_OF(IJK)
142                 DO M = 1, MMAX
143                   QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)/e_w
144                   QMOMK_U1(:,IJK,M) = -e_w*QMOMK_U1(:,LFLUID,M)
145                   QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
146                   QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
147                 END DO
148               ENDIF
149     
150       !
151       ! Fluid cell at East
152       !
153               IF (FLUID_AT(IP_OF(IJK))) THEN
154                 LFLUID = IP_OF(IJK)
155                 DO M = 1, MMAX
156                   QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)/e_w
157                   QMOMK_U1(:,IJK,M) = -e_w*QMOMK_U1(:,LFLUID,M)
158                   QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
159                   QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
160                 END DO
161               END IF
162     
163       !
164       ! Fluid cell at South
165       !
166               IF (FLUID_AT(JM_OF(IJK))) THEN
167                 LFLUID = JM_OF(IJK)
168                 DO M = 1, MMAX
169                   QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)/e_w
170                   QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
171                   QMOMK_V1(:,IJK,M) = -e_w*QMOMK_V1(:,LFLUID,M)
172                   QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
173                 END DO
174               ENDIF
175       !
176       ! Fluid cell at North
177       !
178               IF (FLUID_AT(JP_OF(IJK))) THEN
179                 LFLUID = JP_OF(IJK)
180                 DO M = 1, MMAX
181                   QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)/e_w
182                   QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
183                   QMOMK_V1(:,IJK,M) = -e_w*QMOMK_V1(:,LFLUID,M)
184                   QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
185                 END DO
186               ENDIF
187       !
188       ! Fluid cell at Bottom
189       !
190               IF (FLUID_AT(KM_OF(IJK))) THEN
191                 LFLUID = KM_OF(IJK)
192                 DO M = 1, MMAX
193                   QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)/e_w
194                   QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
195                   QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
196                   QMOMK_W1(:,IJK,M) = -e_w*QMOMK_W1(:,LFLUID,M)
197                 END DO
198               ENDIF
199       !
200       ! Fluid cell at Top
201       !
202               IF (FLUID_AT(KP_OF(IJK))) THEN
203                 LFLUID = KP_OF(IJK)
204                 DO M = 1, MMAX
205                   QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)/e_w
206                   QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
207                   QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
208                   QMOMK_W1(:,IJK,M) = -e_w*QMOMK_W1(:,LFLUID,M)
209                 END DO
210               ENDIF
211              END DO
212            END DO
213          END DO
214         END IF
215        RETURN
216     
217      END SUBROUTINE QMOMK_REFLECTIVE_WALL_BC
218     
219      ! A.P. Zero-gradient outlet
220      SUBROUTINE QMOMK_OUTLET_BC(L, I1, I2, J1, J2, K1, K2, INIT)
221        IMPLICIT NONE
222     
223        INTEGER, INTENT(IN) :: I1, I2, J1, J2, K1, K2, L
224        LOGICAL, INTENT(IN) :: INIT
225     
226        INTEGER :: I, J, K, M, IJK, LFLUID
227     
228        IF (INIT) THEN
229          DO K = K1, K2
230            DO J = J1, J2
231              DO I = I1, I2
232     !//SP Check if current i,j,k resides on this PE
233                 IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
234                 IJK = FUNIJK(I,J,K)
235     !
236     ! Fluid cell at West
237     !
238                 IF (FLUID_AT(IM_OF(IJK))) THEN
239                   LFLUID = IM_OF(IJK)
240                   DO M = 1, MMAX
241                     QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)
242                     QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
243                     QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
244                     QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
245                   END DO
246                 ENDIF
247     
248     !
249     ! Fluid cell at East
250     !
251                 IF (FLUID_AT(IP_OF(IJK))) THEN
252                   LFLUID = IP_OF(IJK)
253                   DO M = 1, MMAX
254                     QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)
255                     QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
256                     QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
257                     QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
258                   END DO
259                 END IF
260     
261     !
262     ! Fluid cell at South
263     !
264                 IF (FLUID_AT(JM_OF(IJK))) THEN
265                   LFLUID = JM_OF(IJK)
266                   DO M = 1, MMAX
267                     QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)
268                     QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
269                     QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
270                     QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
271                   END DO
272                 ENDIF
273     !
274     ! Fluid cell at North
275     !
276                 IF (FLUID_AT(JP_OF(IJK))) THEN
277                   LFLUID = JP_OF(IJK)
278                   DO M = 1, MMAX
279                     QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)
280                     QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
281                     QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
282                     QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
283                   END DO
284                 ENDIF
285     !
286     ! Fluid cell at Bottom
287     !
288                 IF (FLUID_AT(KM_OF(IJK))) THEN
289                   LFLUID = KM_OF(IJK)
290                   DO M = 1, MMAX
291                     QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)
292                     QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
293                     QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
294                     QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
295                   END DO
296                 ENDIF
297     !
298     ! Fluid cell at Top
299     !
300                 IF (FLUID_AT(KP_OF(IJK))) THEN
301                   LFLUID = KP_OF(IJK)
302                   DO M = 1, MMAX
303                     QMOMK_N0(:,IJK,M) = QMOMK_N0(:,LFLUID,M)
304                     QMOMK_U0(:,IJK,M) = QMOMK_U0(:,LFLUID,M)
305                     QMOMK_V0(:,IJK,M) = QMOMK_V0(:,LFLUID,M)
306                     QMOMK_W0(:,IJK,M) = QMOMK_W0(:,LFLUID,M)
307                   END DO
308                 ENDIF
309              END DO
310            END DO
311          END DO
312     
313        ELSE
314          DO K = K1, K2
315            DO J = J1, J2
316              DO I = I1, I2
317     !//SP Check if current i,j,k resides on this PE
318                 IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
319                 IJK = FUNIJK(I,J,K)
320     !
321     ! Fluid cell at West
322     !
323                 IF (FLUID_AT(IM_OF(IJK))) THEN
324                   LFLUID = IM_OF(IJK)
325                   DO M = 1, MMAX
326                     QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)
327                     QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
328                     QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
329                     QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
330                   END DO
331                 ENDIF
332     
333     !
334     ! Fluid cell at East
335     !
336                 IF (FLUID_AT(IP_OF(IJK))) THEN
337                   LFLUID = IP_OF(IJK)
338                   DO M = 1, MMAX
339                     QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)
340                     QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
341                     QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
342                     QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
343                   END DO
344                 END IF
345     
346     !
347     ! Fluid cell at South
348     !
349                 IF (FLUID_AT(JM_OF(IJK))) THEN
350                   LFLUID = JM_OF(IJK)
351                   DO M = 1, MMAX
352                     QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)
353                     QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
354                     QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
355                     QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
356                   END DO
357                 ENDIF
358     !
359     ! Fluid cell at North
360     !
361                 IF (FLUID_AT(JP_OF(IJK))) THEN
362                   LFLUID = JP_OF(IJK)
363                   DO M = 1, MMAX
364                     QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)
365                     QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
366                     QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
367                     QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
368                   END DO
369                 ENDIF
370     !
371     ! Fluid cell at Bottom
372     !
373                 IF (FLUID_AT(KM_OF(IJK))) THEN
374                   LFLUID = KM_OF(IJK)
375                   DO M = 1, MMAX
376                     QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)
377                     QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
378                     QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
379                     QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
380                   END DO
381                 ENDIF
382     !
383     ! Fluid cell at Top
384     !
385                 IF (FLUID_AT(KP_OF(IJK))) THEN
386                   LFLUID = KP_OF(IJK)
387                   DO M = 1, MMAX
388                     QMOMK_N1(:,IJK,M) = QMOMK_N1(:,LFLUID,M)
389                     QMOMK_U1(:,IJK,M) = QMOMK_U1(:,LFLUID,M)
390                     QMOMK_V1(:,IJK,M) = QMOMK_V1(:,LFLUID,M)
391                     QMOMK_W1(:,IJK,M) = QMOMK_W1(:,LFLUID,M)
392                   END DO
393                 ENDIF
394              END DO
395            END DO
396          END DO
397        END IF
398     
399       RETURN
400     
401      END SUBROUTINE QMOMK_OUTLET_BC
402     
403     
404      ! A.P. Velocity inlet
405      SUBROUTINE QMOMK_INLET_BC(L, INIT)
406        IMPLICIT NONE
407     
408        INTEGER, INTENT(IN) :: L
409        LOGICAL, INTENT(IN) :: INIT
410     
411        INTEGER :: I, J, K, M, IJK, IJK2, LFLUID
412        DOUBLE PRECISION :: InitVal
413     
414        IF (INIT) THEN
415         DO K = BC_K_B(L), BC_K_T(L)
416           DO J = BC_J_S(L), BC_J_N(L)
417             DO I = BC_I_W(L), BC_I_E(L)
418               IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
419               IJK = FUNIJK(I,J,K)
420               SELECT CASE (TRIM(BC_PLANE(L)))
421               CASE ('W')
422                 IJK2 = IM_OF(IJK)
423                 QMOMK_N0 (:, IJK2, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK2,M))
424     
425                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
426     
427                 QMOMK_U0(1, IJK2, M) = -InitVal + BC_U_S(L, M)
428                 QMOMK_U0(2, IJK2, M) = +InitVal + BC_U_S(L, M)
429                 QMOMK_U0(3, IJK2, M) = -InitVal + BC_U_S(L, M)
430                 QMOMK_U0(4, IJK2, M) = +InitVal + BC_U_S(L, M)
431                 QMOMK_U0(5, IJK2, M) = -InitVal + BC_U_S(L, M)
432                 QMOMK_U0(6, IJK2, M) = +InitVal + BC_U_S(L, M)
433                 QMOMK_U0(7, IJK2, M) = -InitVal + BC_U_S(L, M)
434                 QMOMK_U0(8, IJK2, M) = +InitVal + BC_U_S(L, M)
435     
436                 QMOMK_V0(1, IJK2, M) = -InitVal
437                 QMOMK_V0(2, IJK2, M) = -InitVal
438                 QMOMK_V0(3, IJK2, M) = +InitVal
439                 QMOMK_V0(4, IJK2, M) = +InitVal
440                 QMOMK_V0(5, IJK2, M) = -InitVal
441                 QMOMK_V0(6, IJK2, M) = -InitVal
442                 QMOMK_V0(7, IJK2, M) = +InitVal
443                 QMOMK_V0(8, IJK2, M) = +InitVal
444     
445                 QMOMK_W0(1, IJK2, M) = -InitVal
446                 QMOMK_W0(2, IJK2, M) = -InitVal
447                 QMOMK_W0(3, IJK2, M) = -InitVal
448                 QMOMK_W0(4, IJK2, M) = -InitVal
449                 QMOMK_W0(5, IJK2, M) = +InitVal
450                 QMOMK_W0(6, IJK2, M) = +InitVal
451                 QMOMK_W0(7, IJK2, M) = +InitVal
452                 QMOMK_W0(8, IJK2, M) = +InitVal
453     
454               CASE ('E')
455                 QMOMK_N0 (:, IJK, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK,M))
456     
457                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
458     
459                 QMOMK_U0(1, IJK, M) = -InitVal + BC_U_S(IJK, M)
460                 QMOMK_U0(2, IJK, M) = +InitVal + BC_U_S(IJK, M)
461                 QMOMK_U0(3, IJK, M) = -InitVal + BC_U_S(IJK, M)
462                 QMOMK_U0(4, IJK, M) = +InitVal + BC_U_S(IJK, M)
463                 QMOMK_U0(5, IJK, M) = -InitVal + BC_U_S(IJK, M)
464                 QMOMK_U0(6, IJK, M) = +InitVal + BC_U_S(IJK, M)
465                 QMOMK_U0(7, IJK, M) = -InitVal + BC_U_S(IJK, M)
466                 QMOMK_U0(8, IJK, M) = +InitVal + BC_U_S(IJK, M)
467     
468                 QMOMK_V0(1, IJK, M) = -InitVal
469                 QMOMK_V0(2, IJK, M) = -InitVal
470                 QMOMK_V0(3, IJK, M) = +InitVal
471                 QMOMK_V0(4, IJK, M) = +InitVal
472                 QMOMK_V0(5, IJK, M) = -InitVal
473                 QMOMK_V0(6, IJK, M) = -InitVal
474                 QMOMK_V0(7, IJK, M) = +InitVal
475                 QMOMK_V0(8, IJK, M) = +InitVal
476     
477                 QMOMK_W0(1, IJK, M) = -InitVal
478                 QMOMK_W0(2, IJK, M) = -InitVal
479                 QMOMK_W0(3, IJK, M) = -InitVal
480                 QMOMK_W0(4, IJK, M) = -InitVal
481                 QMOMK_W0(5, IJK, M) = +InitVal
482                 QMOMK_W0(6, IJK, M) = +InitVal
483                 QMOMK_W0(7, IJK, M) = +InitVal
484                 QMOMK_W0(8, IJK, M) = +InitVal
485               CASE ('S')
486                 IJK2 = JM_OF(IJK)
487                 QMOMK_N0 (:, IJK2, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK,M))
488     
489                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
490     
491                 QMOMK_U0(1, IJK2, M) = -InitVal
492                 QMOMK_U0(2, IJK2, M) = +InitVal
493                 QMOMK_U0(3, IJK2, M) = -InitVal
494                 QMOMK_U0(4, IJK2, M) = +InitVal
495                 QMOMK_U0(5, IJK2, M) = -InitVal
496                 QMOMK_U0(6, IJK2, M) = +InitVal
497                 QMOMK_U0(7, IJK2, M) = -InitVal
498                 QMOMK_U0(8, IJK2, M) = +InitVal
499     
500                 QMOMK_V0(1, IJK2, M) = -InitVal + BC_V_S(L, M)
501                 QMOMK_V0(2, IJK2, M) = -InitVal + BC_V_S(L, M)
502                 QMOMK_V0(3, IJK2, M) = +InitVal + BC_V_S(L, M)
503                 QMOMK_V0(4, IJK2, M) = +InitVal + BC_V_S(L, M)
504                 QMOMK_V0(5, IJK2, M) = -InitVal + BC_V_S(L, M)
505                 QMOMK_V0(6, IJK2, M) = -InitVal + BC_V_S(L, M)
506                 QMOMK_V0(7, IJK2, M) = +InitVal + BC_V_S(L, M)
507                 QMOMK_V0(8, IJK2, M) = +InitVal + BC_V_S(L, M)
508     
509                 QMOMK_W0(1, IJK2, M) = -InitVal
510                 QMOMK_W0(2, IJK2, M) = -InitVal
511                 QMOMK_W0(3, IJK2, M) = -InitVal
512                 QMOMK_W0(4, IJK2, M) = -InitVal
513                 QMOMK_W0(5, IJK2, M) = +InitVal
514                 QMOMK_W0(6, IJK2, M) = +InitVal
515                 QMOMK_W0(7, IJK2, M) = +InitVal
516                 QMOMK_W0(8, IJK2, M) = +InitVal
517     
518               CASE ('N')
519                 QMOMK_N0 (:, IJK, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK,M))
520     
521                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
522     
523                 QMOMK_U0(1, IJK, M) = -InitVal
524                 QMOMK_U0(2, IJK, M) = +InitVal
525                 QMOMK_U0(3, IJK, M) = -InitVal
526                 QMOMK_U0(4, IJK, M) = +InitVal
527                 QMOMK_U0(5, IJK, M) = -InitVal
528                 QMOMK_U0(6, IJK, M) = +InitVal
529                 QMOMK_U0(7, IJK, M) = -InitVal
530                 QMOMK_U0(8, IJK, M) = +InitVal
531     
532                 QMOMK_V0(1, IJK, M) = -InitVal + BC_V_S(IJK, M)
533                 QMOMK_V0(2, IJK, M) = -InitVal + BC_V_S(IJK, M)
534                 QMOMK_V0(3, IJK, M) = +InitVal + BC_V_S(IJK, M)
535                 QMOMK_V0(4, IJK, M) = +InitVal + BC_V_S(IJK, M)
536                 QMOMK_V0(5, IJK, M) = -InitVal + BC_V_S(IJK, M)
537                 QMOMK_V0(6, IJK, M) = -InitVal + BC_V_S(IJK, M)
538                 QMOMK_V0(7, IJK, M) = +InitVal + BC_V_S(IJK, M)
539                 QMOMK_V0(8, IJK, M) = +InitVal + BC_V_S(IJK, M)
540     
541                 QMOMK_W0(1, IJK, M) = -InitVal
542                 QMOMK_W0(2, IJK, M) = -InitVal
543                 QMOMK_W0(3, IJK, M) = -InitVal
544                 QMOMK_W0(4, IJK, M) = -InitVal
545                 QMOMK_W0(5, IJK, M) = +InitVal
546                 QMOMK_W0(6, IJK, M) = +InitVal
547                 QMOMK_W0(7, IJK, M) = +InitVal
548                 QMOMK_W0(8, IJK, M) = +InitVal
549     
550               CASE ('B')
551                 IJK2 = KM_OF(IJK)
552                 QMOMK_N0 (:, IJK2, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK2,M))
553     
554                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
555     
556                 QMOMK_U0(1, IJK2, M) = -InitVal
557                 QMOMK_U0(2, IJK2, M) = +InitVal
558                 QMOMK_U0(3, IJK2, M) = -InitVal
559                 QMOMK_U0(4, IJK2, M) = +InitVal
560                 QMOMK_U0(5, IJK2, M) = -InitVal
561                 QMOMK_U0(6, IJK2, M) = +InitVal
562                 QMOMK_U0(7, IJK2, M) = -InitVal
563                 QMOMK_U0(8, IJK2, M) = +InitVal
564     
565                 QMOMK_V0(1, IJK2, M) = -InitVal
566                 QMOMK_V0(2, IJK2, M) = -InitVal
567                 QMOMK_V0(3, IJK2, M) = +InitVal
568                 QMOMK_V0(4, IJK2, M) = +InitVal
569                 QMOMK_V0(5, IJK2, M) = -InitVal
570                 QMOMK_V0(6, IJK2, M) = -InitVal
571                 QMOMK_V0(7, IJK2, M) = +InitVal
572                 QMOMK_V0(8, IJK2, M) = +InitVal
573     
574                 QMOMK_W0(1, IJK2, M) = -InitVal + BC_W_S(L, M)
575                 QMOMK_W0(2, IJK2, M) = -InitVal + BC_W_S(L, M)
576                 QMOMK_W0(3, IJK2, M) = -InitVal + BC_W_S(L, M)
577                 QMOMK_W0(4, IJK2, M) = -InitVal + BC_W_S(L, M)
578                 QMOMK_W0(5, IJK2, M) = +InitVal + BC_W_S(L, M)
579                 QMOMK_W0(6, IJK2, M) = +InitVal + BC_W_S(L, M)
580                 QMOMK_W0(7, IJK2, M) = +InitVal + BC_W_S(L, M)
581                 QMOMK_W0(8, IJK2, M) = +InitVal + BC_W_S(L, M)
582     
583               CASE ('T')
584                 QMOMK_N0 (:, IJK, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK,M))
585     
586                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
587     
588                 QMOMK_U0(1, IJK, M) = -InitVal
589                 QMOMK_U0(2, IJK, M) = +InitVal
590                 QMOMK_U0(3, IJK, M) = -InitVal
591                 QMOMK_U0(4, IJK, M) = +InitVal
592                 QMOMK_U0(5, IJK, M) = -InitVal
593                 QMOMK_U0(6, IJK, M) = +InitVal
594                 QMOMK_U0(7, IJK, M) = -InitVal
595                 QMOMK_U0(8, IJK, M) = +InitVal
596     
597                 QMOMK_V0(1, IJK, M) = -InitVal
598                 QMOMK_V0(2, IJK, M) = -InitVal
599                 QMOMK_V0(3, IJK, M) = +InitVal
600                 QMOMK_V0(4, IJK, M) = +InitVal
601                 QMOMK_V0(5, IJK, M) = -InitVal
602                 QMOMK_V0(6, IJK, M) = -InitVal
603                 QMOMK_V0(7, IJK, M) = +InitVal
604                 QMOMK_V0(8, IJK, M) = +InitVal
605     
606                 QMOMK_W0(1, IJK, M) = -InitVal + BC_W_S(L, M)
607                 QMOMK_W0(2, IJK, M) = -InitVal + BC_W_S(L, M)
608                 QMOMK_W0(3, IJK, M) = -InitVal + BC_W_S(L, M)
609                 QMOMK_W0(4, IJK, M) = -InitVal + BC_W_S(L, M)
610                 QMOMK_W0(5, IJK, M) = +InitVal + BC_W_S(L, M)
611                 QMOMK_W0(6, IJK, M) = +InitVal + BC_W_S(L, M)
612                 QMOMK_W0(7, IJK, M) = +InitVal + BC_W_S(L, M)
613                 QMOMK_W0(8, IJK, M) = +InitVal + BC_W_S(L, M)
614               END SELECT
615             END DO
616           END DO
617         END DO
618     
619        ELSE
620         DO K = BC_K_B(L), BC_K_T(L)
621           DO J = BC_J_S(L), BC_J_N(L)
622             DO I = BC_I_W(L), BC_I_E(L)
623               IF (.NOT.IS_ON_myPE_plus2layers(I,J,K)) CYCLE
624               IJK = FUNIJK(I,J,K)
625               SELECT CASE (TRIM(BC_PLANE(L)))
626     
627               CASE ('W')
628                 IJK2 = IM_OF(IJK)
629                 QMOMK_N1 (:, IJK2, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK2,M))
630     
631                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
632     
633                 QMOMK_U1(1, IJK2, M) = -InitVal + BC_U_S(L, M)
634                 QMOMK_U1(2, IJK2, M) = +InitVal + BC_U_S(L, M)
635                 QMOMK_U1(3, IJK2, M) = -InitVal + BC_U_S(L, M)
636                 QMOMK_U1(4, IJK2, M) = +InitVal + BC_U_S(L, M)
637                 QMOMK_U1(5, IJK2, M) = -InitVal + BC_U_S(L, M)
638                 QMOMK_U1(6, IJK2, M) = +InitVal + BC_U_S(L, M)
639                 QMOMK_U1(7, IJK2, M) = -InitVal + BC_U_S(L, M)
640                 QMOMK_U1(8, IJK2, M) = +InitVal + BC_U_S(L, M)
641     
642                 QMOMK_V1(1, IJK2, M) = -InitVal
643                 QMOMK_V1(2, IJK2, M) = -InitVal
644                 QMOMK_V1(3, IJK2, M) = +InitVal
645                 QMOMK_V1(4, IJK2, M) = +InitVal
646                 QMOMK_V1(5, IJK2, M) = -InitVal
647                 QMOMK_V1(6, IJK2, M) = -InitVal
648                 QMOMK_V1(7, IJK2, M) = +InitVal
649                 QMOMK_V1(8, IJK2, M) = +InitVal
650     
651                 QMOMK_W1(1, IJK2, M) = -InitVal
652                 QMOMK_W1(2, IJK2, M) = -InitVal
653                 QMOMK_W1(3, IJK2, M) = -InitVal
654                 QMOMK_W1(4, IJK2, M) = -InitVal
655                 QMOMK_W1(5, IJK2, M) = +InitVal
656                 QMOMK_W1(6, IJK2, M) = +InitVal
657                 QMOMK_W1(7, IJK2, M) = +InitVal
658                 QMOMK_W1(8, IJK2, M) = +InitVal
659     
660               CASE ('E')
661                 QMOMK_N1 (:, IJK, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK,M))
662     
663                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
664     
665                 QMOMK_U1(1, IJK, M) = -InitVal + BC_U_S(IJK, M)
666                 QMOMK_U1(2, IJK, M) = +InitVal + BC_U_S(IJK, M)
667                 QMOMK_U1(3, IJK, M) = -InitVal + BC_U_S(IJK, M)
668                 QMOMK_U1(4, IJK, M) = +InitVal + BC_U_S(IJK, M)
669                 QMOMK_U1(5, IJK, M) = -InitVal + BC_U_S(IJK, M)
670                 QMOMK_U1(6, IJK, M) = +InitVal + BC_U_S(IJK, M)
671                 QMOMK_U1(7, IJK, M) = -InitVal + BC_U_S(IJK, M)
672                 QMOMK_U1(8, IJK, M) = +InitVal + BC_U_S(IJK, M)
673     
674                 QMOMK_V1(1, IJK, M) = -InitVal
675                 QMOMK_V1(2, IJK, M) = -InitVal
676                 QMOMK_V1(3, IJK, M) = +InitVal
677                 QMOMK_V1(4, IJK, M) = +InitVal
678                 QMOMK_V1(5, IJK, M) = -InitVal
679                 QMOMK_V1(6, IJK, M) = -InitVal
680                 QMOMK_V1(7, IJK, M) = +InitVal
681                 QMOMK_V1(8, IJK, M) = +InitVal
682     
683                 QMOMK_W1(1, IJK, M) = -InitVal
684                 QMOMK_W1(2, IJK, M) = -InitVal
685                 QMOMK_W1(3, IJK, M) = -InitVal
686                 QMOMK_W1(4, IJK, M) = -InitVal
687                 QMOMK_W1(5, IJK, M) = +InitVal
688                 QMOMK_W1(6, IJK, M) = +InitVal
689                 QMOMK_W1(7, IJK, M) = +InitVal
690                 QMOMK_W1(8, IJK, M) = +InitVal
691     
692               CASE ('S')
693                 IJK2 = JM_OF(IJK)
694                 QMOMK_N1 (:, IJK2, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK2,M))
695     
696                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
697     
698                 QMOMK_U1(1, IJK2, M) = -InitVal
699                 QMOMK_U1(2, IJK2, M) = +InitVal
700                 QMOMK_U1(3, IJK2, M) = -InitVal
701                 QMOMK_U1(4, IJK2, M) = +InitVal
702                 QMOMK_U1(5, IJK2, M) = -InitVal
703                 QMOMK_U1(6, IJK2, M) = +InitVal
704                 QMOMK_U1(7, IJK2, M) = -InitVal
705                 QMOMK_U1(8, IJK2, M) = +InitVal
706     
707                 QMOMK_V1(1, IJK2, M) = -InitVal + BC_V_S(L, M)
708                 QMOMK_V1(2, IJK2, M) = -InitVal + BC_V_S(L, M)
709                 QMOMK_V1(3, IJK2, M) = +InitVal + BC_V_S(L, M)
710                 QMOMK_V1(4, IJK2, M) = +InitVal + BC_V_S(L, M)
711                 QMOMK_V1(5, IJK2, M) = -InitVal + BC_V_S(L, M)
712                 QMOMK_V1(6, IJK2, M) = -InitVal + BC_V_S(L, M)
713                 QMOMK_V1(7, IJK2, M) = +InitVal + BC_V_S(L, M)
714                 QMOMK_V1(8, IJK2, M) = +InitVal + BC_V_S(L, M)
715     
716                 QMOMK_W1(1, IJK2, M) = -InitVal
717                 QMOMK_W1(2, IJK2, M) = -InitVal
718                 QMOMK_W1(3, IJK2, M) = -InitVal
719                 QMOMK_W1(4, IJK2, M) = -InitVal
720                 QMOMK_W1(5, IJK2, M) = +InitVal
721                 QMOMK_W1(6, IJK2, M) = +InitVal
722                 QMOMK_W1(7, IJK2, M) = +InitVal
723                 QMOMK_W1(8, IJK2, M) = +InitVal
724     
725               CASE ('N')
726                 QMOMK_N1 (:, IJK, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK,M))
727     
728                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
729     
730                 QMOMK_U1(1, IJK, M) = -InitVal
731                 QMOMK_U1(2, IJK, M) = +InitVal
732                 QMOMK_U1(3, IJK, M) = -InitVal
733                 QMOMK_U1(4, IJK, M) = +InitVal
734                 QMOMK_U1(5, IJK, M) = -InitVal
735                 QMOMK_U1(6, IJK, M) = +InitVal
736                 QMOMK_U1(7, IJK, M) = -InitVal
737                 QMOMK_U1(8, IJK, M) = +InitVal
738     
739                 QMOMK_V1(1, IJK, M) = -InitVal + BC_V_S(IJK, M)
740                 QMOMK_V1(2, IJK, M) = -InitVal + BC_V_S(IJK, M)
741                 QMOMK_V1(3, IJK, M) = +InitVal + BC_V_S(IJK, M)
742                 QMOMK_V1(4, IJK, M) = +InitVal + BC_V_S(IJK, M)
743                 QMOMK_V1(5, IJK, M) = -InitVal + BC_V_S(IJK, M)
744                 QMOMK_V1(6, IJK, M) = -InitVal + BC_V_S(IJK, M)
745                 QMOMK_V1(7, IJK, M) = +InitVal + BC_V_S(IJK, M)
746                 QMOMK_V1(8, IJK, M) = +InitVal + BC_V_S(IJK, M)
747     
748                 QMOMK_W1(1, IJK, M) = -InitVal
749                 QMOMK_W1(2, IJK, M) = -InitVal
750                 QMOMK_W1(3, IJK, M) = -InitVal
751                 QMOMK_W1(4, IJK, M) = -InitVal
752                 QMOMK_W1(5, IJK, M) = +InitVal
753                 QMOMK_W1(6, IJK, M) = +InitVal
754                 QMOMK_W1(7, IJK, M) = +InitVal
755                 QMOMK_W1(8, IJK, M) = +InitVal
756     
757               CASE ('B')
758                 IJK2 = KM_OF(IJK)
759                 QMOMK_N1 (:, IJK2, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK2,M))
760     
761                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
762     
763                 QMOMK_U1(1, IJK2, M) = -InitVal
764                 QMOMK_U1(2, IJK2, M) = +InitVal
765                 QMOMK_U1(3, IJK2, M) = -InitVal
766                 QMOMK_U1(4, IJK2, M) = +InitVal
767                 QMOMK_U1(5, IJK2, M) = -InitVal
768                 QMOMK_U1(6, IJK2, M) = +InitVal
769                 QMOMK_U1(7, IJK2, M) = -InitVal
770                 QMOMK_U1(8, IJK2, M) = +InitVal
771     
772                 QMOMK_V1(1, IJK2, M) = -InitVal
773                 QMOMK_V1(2, IJK2, M) = -InitVal
774                 QMOMK_V1(3, IJK2, M) = +InitVal
775                 QMOMK_V1(4, IJK2, M) = +InitVal
776                 QMOMK_V1(5, IJK2, M) = -InitVal
777                 QMOMK_V1(6, IJK2, M) = -InitVal
778                 QMOMK_V1(7, IJK2, M) = +InitVal
779                 QMOMK_V1(8, IJK2, M) = +InitVal
780     
781                 QMOMK_W1(1, IJK2, M) = -InitVal + BC_W_S(L, M)
782                 QMOMK_W1(2, IJK2, M) = -InitVal + BC_W_S(L, M)
783                 QMOMK_W1(3, IJK2, M) = -InitVal + BC_W_S(L, M)
784                 QMOMK_W1(4, IJK2, M) = -InitVal + BC_W_S(L, M)
785                 QMOMK_W1(5, IJK2, M) = +InitVal + BC_W_S(L, M)
786                 QMOMK_W1(6, IJK2, M) = +InitVal + BC_W_S(L, M)
787                 QMOMK_W1(7, IJK2, M) = +InitVal + BC_W_S(L, M)
788                 QMOMK_W1(8, IJK2, M) = +InitVal + BC_W_S(L, M)
789     
790               CASE ('T')
791                 QMOMK_N1 (:, IJK, M) = BC_ROP_s (L, M)/(QMOMK_NN * RO_s(IJK,M))
792     
793                 InitVal = MAX(SQRT(BC_THETA_M(L,M)), MINIMUM_THETA)
794     
795                 QMOMK_U1(1, IJK, M) = -InitVal
796                 QMOMK_U1(2, IJK, M) = +InitVal
797                 QMOMK_U1(3, IJK, M) = -InitVal
798                 QMOMK_U1(4, IJK, M) = +InitVal
799                 QMOMK_U1(5, IJK, M) = -InitVal
800                 QMOMK_U1(6, IJK, M) = +InitVal
801                 QMOMK_U1(7, IJK, M) = -InitVal
802                 QMOMK_U1(8, IJK, M) = +InitVal
803     
804                 QMOMK_V1(1, IJK, M) = -InitVal
805                 QMOMK_V1(2, IJK, M) = -InitVal
806                 QMOMK_V1(3, IJK, M) = +InitVal
807                 QMOMK_V1(4, IJK, M) = +InitVal
808                 QMOMK_V1(5, IJK, M) = -InitVal
809                 QMOMK_V1(6, IJK, M) = -InitVal
810                 QMOMK_V1(7, IJK, M) = +InitVal
811                 QMOMK_V1(8, IJK, M) = +InitVal
812     
813                 QMOMK_W1(1, IJK, M) = -InitVal + BC_W_S(L, M)
814                 QMOMK_W1(2, IJK, M) = -InitVal + BC_W_S(L, M)
815                 QMOMK_W1(3, IJK, M) = -InitVal + BC_W_S(L, M)
816                 QMOMK_W1(4, IJK, M) = -InitVal + BC_W_S(L, M)
817                 QMOMK_W1(5, IJK, M) = +InitVal + BC_W_S(L, M)
818                 QMOMK_W1(6, IJK, M) = +InitVal + BC_W_S(L, M)
819                 QMOMK_W1(7, IJK, M) = +InitVal + BC_W_S(L, M)
820                 QMOMK_W1(8, IJK, M) = +InitVal + BC_W_S(L, M)
821               END SELECT
822             END DO
823           END DO
824         END DO
825        END IF
826        RETURN
827      END SUBROUTINE QMOMK_INLET_BC
828     
829      ! A.P. Cyclic boundary conditions
830      SUBROUTINE QMOMK_CYCLIC_BC(INIT)
831       IMPLICIT NONE
832     
833       LOGICAL, INTENT(IN) :: INIT
834       INTEGER :: IJK, IJK_CYCLIC, I, J, K, IJKN, IJKS, IJKE, IJKW, IJKT, IJKB, M
835       DOUBLE PRECISION, DIMENSION(QMOMK_NN) :: QMOMK_N_TMP, QMOMK_U_TMP
836       DOUBLE PRECISION, DIMENSION(QMOMK_NN) :: QMOMK_V_TMP, QMOMK_W_TMP
837     
838       IF (INIT) THEN
839         DO M = 1, MMAX
840          DO IJK = ijkstart3, ijkend3
841           IF (FLUID_AT(IJK)) THEN
842             IJKN = NORTH_OF(IJK)
843             IJKS = SOUTH_OF(IJK)
844             IJKE = EAST_OF(IJK)
845             IJKW = WEST_OF(IJK)
846             IJKT = TOP_OF(IJK)
847             IJKB = BOTTOM_OF(IJK)
848     
849             !  x direction cyclic
850             IF (CYCLIC_X .OR. CYCLIC_X_PD) THEN
851               IF (CYCLIC_AT_E(IJK)) THEN
852                   I = I_OF(IJKE)
853                   J = J_OF(IJKE)
854                   K = K_OF(IJKE)
855     
856                   IJK_CYCLIC = FUNIJK(IP1(I), J, K)
857     
858                   QMOMK_N_TMP(:) = QMOMK_N0(:,IJKE,M)
859                   QMOMK_U_TMP(:) = QMOMK_U0(:,IJKE,M)
860                   QMOMK_V_TMP(:) = QMOMK_V0(:,IJKE,M)
861                   QMOMK_W_TMP(:) = QMOMK_W0(:,IJKE,M)
862     
863                   QMOMK_N0(:,IJKE,M) = QMOMK_N0(:,IJK_CYCLIC,M)
864                   QMOMK_U0(:,IJKE,M) = QMOMK_U0(:,IJK_CYCLIC,M)
865                   QMOMK_V0(:,IJKE,M) = QMOMK_V0(:,IJK_CYCLIC,M)
866                   QMOMK_W0(:,IJKE,M) = QMOMK_W0(:,IJK_CYCLIC,M)
867     
868                   QMOMK_N0(:,IJK_CYCLIC,M) = QMOMK_N_TMP(:)
869                   QMOMK_U0(:,IJK_CYCLIC,M) = QMOMK_U_TMP(:)
870                   QMOMK_V0(:,IJK_CYCLIC,M) = QMOMK_V_TMP(:)
871                   QMOMK_W0(:,IJK_CYCLIC,M) = QMOMK_W_TMP(:)
872               END IF
873             END IF
874             ! y direction cyclic
875             IF (CYCLIC_Y .OR. CYCLIC_Y_PD) THEN
876               IF (CYCLIC_AT_N(IJK)) THEN
877                   I = I_OF(IJKN)
878                   J = J_OF(IJKN)
879                   K = K_OF(IJKN)
880     
881                   IJK_CYCLIC = FUNIJK(I, JP1(J), K)
882     
883                   QMOMK_N_TMP(:) = QMOMK_N0(:,IJKN,M)
884                   QMOMK_U_TMP(:) = QMOMK_U0(:,IJKN,M)
885                   QMOMK_V_TMP(:) = QMOMK_V0(:,IJKN,M)
886                   QMOMK_W_TMP(:) = QMOMK_W0(:,IJKN,M)
887     
888                   QMOMK_N0(:,IJKN,M) = QMOMK_N0(:,IJK_CYCLIC,M)
889                   QMOMK_U0(:,IJKN,M) = QMOMK_U0(:,IJK_CYCLIC,M)
890                   QMOMK_V0(:,IJKN,M) = QMOMK_V0(:,IJK_CYCLIC,M)
891                   QMOMK_W0(:,IJKN,M) = QMOMK_W0(:,IJK_CYCLIC,M)
892     
893                   QMOMK_N0(:,IJK_CYCLIC,M) = QMOMK_N_TMP(:)
894                   QMOMK_U0(:,IJK_CYCLIC,M) = QMOMK_U_TMP(:)
895                   QMOMK_V0(:,IJK_CYCLIC,M) = QMOMK_V_TMP(:)
896                   QMOMK_W0(:,IJK_CYCLIC,M) = QMOMK_W_TMP(:)
897               END IF
898             END IF
899             ! z direction cyclic
900             IF (CYCLIC_Z .OR. CYCLIC_Z_PD) THEN
901               IF (CYCLIC_AT_T(IJK)) THEN
902                   I = I_OF(IJKT)
903                   J = J_OF(IJKT)
904                   K = K_OF(IJKT)
905     
906                   IJK_CYCLIC = FUNIJK(I, J, KP1(K))
907     
908                   QMOMK_N_TMP(:) = QMOMK_N0(:,IJKT,M)
909                   QMOMK_U_TMP(:) = QMOMK_U0(:,IJKT,M)
910                   QMOMK_V_TMP(:) = QMOMK_V0(:,IJKT,M)
911                   QMOMK_W_TMP(:) = QMOMK_W0(:,IJKT,M)
912     
913                   QMOMK_N0(:,IJKT,M) = QMOMK_N0(:,IJK_CYCLIC,M)
914                   QMOMK_U0(:,IJKT,M) = QMOMK_U0(:,IJK_CYCLIC,M)
915                   QMOMK_V0(:,IJKT,M) = QMOMK_V0(:,IJK_CYCLIC,M)
916                   QMOMK_W0(:,IJKT,M) = QMOMK_W0(:,IJK_CYCLIC,M)
917     
918                   QMOMK_N0(:,IJK_CYCLIC,M) = QMOMK_N_TMP(:)
919                   QMOMK_U0(:,IJK_CYCLIC,M) = QMOMK_U_TMP(:)
920                   QMOMK_V0(:,IJK_CYCLIC,M) = QMOMK_V_TMP(:)
921                   QMOMK_W0(:,IJK_CYCLIC,M) = QMOMK_W_TMP(:)
922               END IF
923             END IF
924           END IF
925          END DO
926         END DO
927       ELSE
928         DO M = 1, MMAX
929          DO IJK = ijkstart3, ijkend3
930           IF (FLUID_AT(IJK)) THEN
931             IJKN = NORTH_OF(IJK)
932             IJKS = SOUTH_OF(IJK)
933             IJKE = EAST_OF(IJK)
934             IJKW = WEST_OF(IJK)
935             IJKT = TOP_OF(IJK)
936             IJKB = BOTTOM_OF(IJK)
937     
938             !  x direction cyclic
939             IF (CYCLIC_X .OR. CYCLIC_X_PD) THEN
940               IF (CYCLIC_AT_E(IJK)) THEN
941                   I = I_OF(IJKE)
942                   J = J_OF(IJKE)
943                   K = K_OF(IJKE)
944     
945                   IJK_CYCLIC = FUNIJK(IP1(I), J, K)
946     
947                   QMOMK_N_TMP(:) = QMOMK_N1(:,IJKE,M)
948                   QMOMK_U_TMP(:) = QMOMK_U1(:,IJKE,M)
949                   QMOMK_V_TMP(:) = QMOMK_V1(:,IJKE,M)
950                   QMOMK_W_TMP(:) = QMOMK_W1(:,IJKE,M)
951     
952                   QMOMK_N1(:,IJKE,M) = QMOMK_N1(:,IJK_CYCLIC,M)
953                   QMOMK_U1(:,IJKE,M) = QMOMK_U1(:,IJK_CYCLIC,M)
954                   QMOMK_V1(:,IJKE,M) = QMOMK_V1(:,IJK_CYCLIC,M)
955                   QMOMK_W1(:,IJKE,M) = QMOMK_W1(:,IJK_CYCLIC,M)
956     
957                   QMOMK_N1(:,IJK_CYCLIC,M) = QMOMK_N_TMP(:)
958                   QMOMK_U1(:,IJK_CYCLIC,M) = QMOMK_U_TMP(:)
959                   QMOMK_V1(:,IJK_CYCLIC,M) = QMOMK_V_TMP(:)
960                   QMOMK_W1(:,IJK_CYCLIC,M) = QMOMK_W_TMP(:)
961               END IF
962             END IF
963             ! y direction cyclic
964             IF (CYCLIC_Y .OR. CYCLIC_Y_PD) THEN
965               IF (CYCLIC_AT_N(IJK)) THEN
966                   I = I_OF(IJKN)
967                   J = J_OF(IJKN)
968                   K = K_OF(IJKN)
969     
970                   IJK_CYCLIC = FUNIJK(I, JP1(J), K)
971     
972                   QMOMK_N_TMP(:) = QMOMK_N1(:,IJKN,M)
973                   QMOMK_U_TMP(:) = QMOMK_U1(:,IJKN,M)
974                   QMOMK_V_TMP(:) = QMOMK_V1(:,IJKN,M)
975                   QMOMK_W_TMP(:) = QMOMK_W1(:,IJKN,M)
976     
977                   QMOMK_N1(:,IJKN,M) = QMOMK_N1(:,IJK_CYCLIC,M)
978                   QMOMK_U1(:,IJKN,M) = QMOMK_U1(:,IJK_CYCLIC,M)
979                   QMOMK_V1(:,IJKN,M) = QMOMK_V1(:,IJK_CYCLIC,M)
980                   QMOMK_W1(:,IJKN,M) = QMOMK_W1(:,IJK_CYCLIC,M)
981     
982                   QMOMK_N1(:,IJK_CYCLIC,M) = QMOMK_N_TMP(:)
983                   QMOMK_U1(:,IJK_CYCLIC,M) = QMOMK_U_TMP(:)
984                   QMOMK_V1(:,IJK_CYCLIC,M) = QMOMK_V_TMP(:)
985                   QMOMK_W1(:,IJK_CYCLIC,M) = QMOMK_W_TMP(:)
986               END IF
987             END IF
988             ! z direction cyclic
989             IF (CYCLIC_Z .OR. CYCLIC_Z_PD) THEN
990               IF (CYCLIC_AT_T(IJK)) THEN
991                   I = I_OF(IJKT)
992                   J = J_OF(IJKT)
993                   K = K_OF(IJKT)
994     
995                   IJK_CYCLIC = FUNIJK(I, J, KP1(K))
996     
997                   QMOMK_N_TMP(:) = QMOMK_N1(:,IJKT,M)
998                   QMOMK_U_TMP(:) = QMOMK_U1(:,IJKT,M)
999                   QMOMK_V_TMP(:) = QMOMK_V1(:,IJKT,M)
1000                   QMOMK_W_TMP(:) = QMOMK_W1(:,IJKT,M)
1001     
1002                   QMOMK_N1(:,IJKT,M) = QMOMK_N1(:,IJK_CYCLIC,M)
1003                   QMOMK_U1(:,IJKT,M) = QMOMK_U1(:,IJK_CYCLIC,M)
1004                   QMOMK_V1(:,IJKT,M) = QMOMK_V1(:,IJK_CYCLIC,M)
1005                   QMOMK_W1(:,IJKT,M) = QMOMK_W1(:,IJK_CYCLIC,M)
1006     
1007                   QMOMK_N1(:,IJK_CYCLIC,M) = QMOMK_N_TMP(:)
1008                   QMOMK_U1(:,IJK_CYCLIC,M) = QMOMK_U_TMP(:)
1009                   QMOMK_V1(:,IJK_CYCLIC,M) = QMOMK_V_TMP(:)
1010                   QMOMK_W1(:,IJK_CYCLIC,M) = QMOMK_W_TMP(:)
1011               END IF
1012             END IF
1013           END IF
1014          END DO
1015         END DO
1016       END IF
1017      END SUBROUTINE QMOMK_CYCLIC_BC
1018     
1019     END MODULE qmomk_bc
1020