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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Module name: MOD_BC_K (BC, I_w, J_s, K_b, K_t, PLANE)               !
4     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
5     !                                                                      !
6     !  Purpose: modify the "K" values for the b.c. plane                   !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE MOD_BC_K(BCV)
10     
11           use bc, only: BC_I_W, BC_I_E
12           use bc, only: BC_J_S, BC_J_N
13           use bc, only: BC_K_B, BC_K_T
14           use bc, only: BC_PLANE
15     
16           USE geometry, only: ICBC_FLAG
17     
18           USE compar
19           USE mpi_utility
20     
21           use error_manager
22           USE functions
23     
24           IMPLICIT NONE
25     
26     ! boundary condition index
27           INTEGER, INTENT(in) :: BCV
28     
29     ! calculated cell indices in I,J,K directions
30           INTEGER :: K_b, K_t
31           INTEGER :: I_w, J_s
32     
33           INTEGER :: OWNER
34     
35           INTEGER :: I, J
36           INTEGER :: IJK, IJKP
37     
38           INTEGER :: IER
39           LOGICAL :: ERROR
40           INTEGER :: K_FLUID, IJK_FLUID
41           INTEGER :: K_WALL,  IJK_WALL
42     
43     
44     !-----------------------------------------------
45     
46           CALL INIT_ERR_MSG("MOD_BC_K")
47     
48           K_B = BC_K_B(BCV)
49           K_T = BC_K_T(BCV)
50     
51           I_W = BC_I_W(BCV)
52           J_S = BC_J_S(BCV)
53     
54     
55     ! Establish the OWNER of the BC
56           OWNER = merge(myPE, 0, IS_ON_myPE_owns(I_W, J_S, K_B))
57           CALL GLOBAL_ALL_SUM(OWNER)
58     
59           IF(myPE == OWNER) THEN
60     
61              IJK  = FUNIJK(I_W, J_S, K_B)
62              IJKP = FUNIJK(I_W, J_S, K_B+1)
63     
64              IF(WALL_ICBC_FLAG(IJK) .AND. ICBC_FLAG(IJKP)(1:1)=='.')THEN
65                 K_B = K_B
66                 K_T = K_T
67                 BC_PLANE(BCV) = 'T'
68              ELSEIF(WALL_ICBC_FLAG(IJKP) .AND. ICBC_FLAG(IJK)(1:1)=='.')THEN
69                 K_B = K_B + 1
70                 K_T = K_T + 1
71                 BC_PLANE(BCV) = 'B'
72              ELSE
73                 BC_PLANE(BCV) = '.'
74              ENDIF
75           ENDIF
76     
77     ! The owner distributes the new Iw/Ie coordinates to the other ranks.
78           CALL BCAST(K_B,OWNER)
79           CALL BCAST(K_T,OWNER)
80           CALL BCAST(BC_PLANE(BCV),OWNER)
81     
82     ! If there is an error, send IJK/IPJK to all ranks. Report and exit.
83           IF(BC_PLANE(BCV) == '.') THEN
84              CALL BCAST(IJKP,OWNER)
85              CALL BCAST(IJK, OWNER)
86     
87              WRITE(ERR_MSG, 1100) BCV, K_B, K_T, I_W, J_S,                 &
88                 IJK, ICBC_FLAG(IJK),  IJKP, ICBC_FLAG(IJKP)
89              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
90           ENDIF
91     
92      1100 FORMAT('Error 1100: Cannot locate flow plane for boundary ',     &
93              'condition ',I3,'.',2/3x,'K Bottom =  ',I6,' K Top    = ',I6,/&
94              3x,'I West   =  ',I6,' J South  = ',I6,2/' The following ',   &
95              'should conttain a wall cell and fluid cell:',/3x,'IJK  ',I9, &
96              ' :: ',A3,/3x,'IJKP ',I9,' :: ',A3,2/' Maybe no IC was ',     &
97              'specified for the fluid cell.')
98     
99     ! Store the new values in the global data array.
100           BC_K_B(BCV) = K_B
101           BC_K_T(BCV) = K_T
102     
103     ! Set up the I-indices for checking the entire BC region.
104           K_WALL = BC_K_B(BCV)
105           K_FLUID = merge(K_WALL-1, K_WALL+1, BC_PLANE(BCV)=='B')
106     
107     
108           ERROR = .FALSE.
109           DO J = BC_J_S(BCV), BC_J_N(BCV)
110           DO I = BC_I_W(BCV), BC_I_E(BCV)
111     
112     ! Only check cells that you own and contain fluid.
113              IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_FLUID)) CYCLE
114              IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_WALL )) CYCLE
115              IF(DEAD_CELL_AT(I,J,K_FLUID)) CYCLE
116              IF(DEAD_CELL_AT(I,J,K_WALL )) CYCLE
117     
118              IJK_WALL = FUNIJK(I,J,K_WALL)
119              IJK_FLUID = FUNIJK(I,J,K_FLUID)
120     
121              IF(.NOT.(WALL_ICBC_FLAG(IJK_WALL) .AND.                       &
122                 ICBC_FLAG(IJK_FLUID)(1:1)=='.')) ERROR = .TRUE.
123     
124           ENDDO
125           ENDDO
126     
127     ! Sync up the error flag across all processes.
128           CALL GLOBAL_ALL_OR(ERROR)
129     ! If an error is detected, have each rank open a log file and write
130     ! it's own message. Otherwise, we need to send all the data back to
131     ! PE_IO and that's too much work!
132           IF(ERROR) THEN
133     
134              CALL OPEN_PE_LOG(IER)
135     
136              WRITE(ERR_MSG, 1200) BCV
137              CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
138     
139      1200 FORMAT('Error 1200: Illegal geometry for boundary condition:',I3)
140     
141              DO J = BC_J_S(BCV), BC_J_N(BCV)
142              DO I = BC_I_W(BCV), BC_I_E(BCV)
143     
144     ! Only check cells that you own and contain fluid.
145                 IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_FLUID)) CYCLE
146                 IF(.NOT.IS_ON_myPE_plus2layers(I,J,K_WALL )) CYCLE
147                 IF(DEAD_CELL_AT(I,J,K_FLUID)) CYCLE
148                 IF(DEAD_CELL_AT(I,J,K_WALL )) CYCLE
149     
150                 IJK_WALL = FUNIJK(I,J,K_WALL)
151                 IJK_FLUID = FUNIJK(I,J,K_FLUID)
152     
153                 IF(.NOT.(WALL_ICBC_FLAG(IJK_WALL) .AND.                    &
154                    ICBC_FLAG(IJK_FLUID)(1:1)=='.')) THEN
155     
156                    WRITE(ERR_MSG, 1201) &
157                       I, J, K_WALL,  IJK_WALL,  ICBC_FLAG(IJK_WALL),       &
158                       I, J, K_FLUID, IJK_FLUID, ICBC_FLAG(IJK_FLUID)
159                    CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
160                 ENDIF
161     
162      1201 FORMAT(' ',/14X,'I',7X,'J',7X,'K',7X,'IJK',4x,'FLAG',/3x,        &
163              'WALL ',3(2x,I6),2x,I9,3x,A,/3x,'FLUID',3(2x,I6),2x,I9,3x,A)
164     
165              ENDDO
166              ENDDO
167     
168              WRITE(ERR_MSG,"('Please correct the mfix.dat file.')")
169              CALL FLUSH_ERR_MSG(HEADER=.FALSE., ABORT=.TRUE.)
170     
171           ENDIF
172     
173           CALL FINL_ERR_MSG
174     
175           RETURN
176           END SUBROUTINE MOD_BC_K
177