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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Module name: MOD_BC_J(BC, I_w, J_s, J_n, K_b, PLANE)                !
4     !  Author: P. Nicoletti                               Date: 10-DEC-91  !
5     !                                                                      !
6     !  Purpose: modify the "J" values for the b.c. plane                   !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE MOD_BC_J(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 :: J_s, J_n
31           INTEGER :: I_w, K_b
32     
33           INTEGER :: OWNER
34           INTEGER :: I, K
35           INTEGER :: IJK , IJPK
36     
37           INTEGER :: IER
38           LOGICAL :: ERROR
39           INTEGER :: J_FLUID, IJK_FLUID
40           INTEGER :: J_WALL,  IJK_WALL
41     
42     
43     !-----------------------------------------------
44     
45           CALL INIT_ERR_MSG("MOD_BC_J")
46     
47           J_S = BC_J_S(BCV)
48           J_N = BC_J_N(BCV)
49     
50           I_W = BC_I_W(BCV)
51           K_B = BC_K_B(BCV)
52     
53     ! Establish the OWNER of the BC
54           OWNER = merge(myPE, 0, IS_ON_myPE_owns(I_W,J_S,K_B))
55           CALL GLOBAL_ALL_SUM(OWNER)
56     
57           IF(myPE == OWNER)THEN
58     
59              IJK  = FUNIJK(I_W, J_S,   K_B)
60              IJPK = FUNIJK(I_W, J_S+1, K_B)
61     
62              IF (WALL_ICBC_FLAG(IJK) .AND. ICBC_FLAG(IJPK)(1:1)=='.') THEN
63                 J_S = J_S
64                 J_N = J_N
65                 BC_PLANE(BCV) = 'N'
66     
67              ELSE IF (WALL_ICBC_FLAG(IJPK) .AND. ICBC_FLAG(IJK)(1:1)=='.') THEN
68                 J_S = J_S + 1
69                 J_N = J_N + 1
70                 BC_PLANE(BCV) = 'S'
71     
72              ELSE
73                 BC_PLANE(BCV) = '.'
74              ENDIF
75           ENDIF
76     
77           CALL BCAST(J_S,OWNER)
78           CALL BCAST(J_N,OWNER)
79           CALL BCAST(BC_PLANE(BCV),OWNER)
80     
81     ! If there is an error, send IJK/IPJK to all ranks. Report and exit.
82           IF(BC_PLANE(BCV) == '.') THEN
83              CALL BCAST(IJPK,OWNER)
84              CALL BCAST(IJK, OWNER)
85     
86              WRITE(ERR_MSG, 1100) BCV, J_S, J_N, I_W, K_B,                 &
87                 IJK, ICBC_FLAG(IJK),  IJPK, ICBC_FLAG(IJPK)
88              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
89           ENDIF
90     
91      1100 FORMAT('Error 1100: Cannot locate flow plane for boundary ',     &
92              'condition ',I3,'.',2/3x,'J South  =  ',I6,' J North  = ',I6,/&
93              3x,'I West   =  ',I6,' K Bottom = ',I6,2/' The following ',   &
94              'should conttain a wall cell and fluid cell:',/3x,'IJK  ',I9, &
95              ' :: ',A3,/3x,'IJPK ',I9,' :: ',A3,2/' Maybe no IC was ',     &
96              'specified for the fluid cell.')
97     
98     ! Store the new values in the global data array.
99           BC_J_S(BCV) = J_S
100           BC_J_N(BCV) = J_N
101     
102     
103           J_WALL = BC_J_S(BCV)
104           J_FLUID = merge(J_WALL-1, J_WALL+1, BC_PLANE(BCV)=='S')
105     
106     
107     ! First pass through all of the BC region and verify that you have
108     ! inflow/outflow specified against a wall. Flag any errors.
109           ERROR = .FALSE.
110           DO K = BC_K_B(BCV), BC_K_T(BCV)
111           DO I = BC_I_W(BCV), BC_I_E(BCV)
112              IF(.NOT.IS_ON_myPE_plus2layers(I,J_FLUID,K)) CYCLE
113              IF(.NOT.IS_ON_myPE_plus2layers(I,J_WALL, K)) CYCLE
114              IF(DEAD_CELL_AT(I,J_FLUID,K)) CYCLE
115              IF(DEAD_CELL_AT(I,J_WALL, K)) CYCLE
116     
117              IJK_WALL  = FUNIJK(I,J_WALL, K)
118              IJK_FLUID = FUNIJK(I,J_FLUID,K)
119     
120               IF(.NOT.(WALL_ICBC_FLAG(IJK_WALL) .AND. &
121                  ICBC_FLAG(IJK_FLUID)(1:1)=='.')) ERROR = .TRUE.
122     
123            ENDDO
124            ENDDO
125     
126     
127     ! Sync up the error flag across all processes.
128           CALL GLOBAL_ALL_OR(ERROR)
129     
130     ! If an error is detected, have each rank open a log file and write
131     ! it's own message. Otherwise, we need to send all the data back to
132     ! PE_IO and that's too much work!
133           IF(ERROR) THEN
134     
135              CALL OPEN_PE_LOG(IER)
136     
137              WRITE(ERR_MSG, 1200) BCV
138              CALL FLUSH_ERR_MSG(FOOTER=.FALSE.)
139     
140      1200 FORMAT('Error 1200: Illegal geometry for boundary condition:',I3)
141     
142              DO K = BC_K_B(BCV), BC_K_T(BCV)
143              DO I = BC_I_W(BCV), BC_I_E(BCV)
144     
145                 IF(.NOT.IS_ON_myPE_plus2layers(I,J_FLUID,K)) CYCLE
146                 IF(.NOT.IS_ON_myPE_plus2layers(I,J_WALL, K)) CYCLE
147                 IF(DEAD_CELL_AT(I, J_FLUID,K)) CYCLE
148                 IF(DEAD_CELL_AT(I, J_WALL, K)) CYCLE
149     
150                 IJK_WALL  = FUNIJK(I,J_WALL ,K)
151                 IJK_FLUID = FUNIJK(I,J_FLUID,K)
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_WALL,  K, IJK_WALL, ICBC_FLAG(IJK_WALL),        &
158                       I, J_FLUID, K, 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_J
177