File: RELATIVE:/../../../mfix.git/model/des/set_bc_dem_mo.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: SET_BC_DEM_MO                                           !
4     !                                                                      !
5     !                                                                      !
6     !  Author: J.Musser                                   Date: 23-Nov-09  !
7     !                                                                      !
8     !  Comments:                                                           !
9     !                                                                      !
10     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
11           SUBROUTINE SET_BC_DEM_MO
12     
13           use bc, only: BC_PLANE
14           use bc, only: BC_X_w, BC_X_e, BC_Y_s, BC_Y_n, BC_Z_b, BC_Z_t
15     
16           use des_bc, only: DEM_BCMO, DEM_BCMO_MAP, DEM_BCMO_IJK
17           use des_bc, only: DEM_BCMO_IJKSTART, DEM_BCMO_IJKEND
18     
19           use funits, only: DMP_LOG
20     
21           use mpi_utility
22           use error_manager
23           use functions
24     
25           use desgrid, only: DG_FUNIJK
26           use desgrid, only: IofPOS, JofPOS, KofPOS
27           use desgrid, only: dg_is_ON_myPE_plus1layers
28     
29           IMPLICIT NONE
30     
31     !-----------------------------------------------
32     ! Local variables
33     !-----------------------------------------------
34           INTEGER :: BCV, BCV_I      ! BC loop counter
35     
36           INTEGER :: LC
37     
38           LOGICAL, parameter :: setDBG = .FALSE.
39           LOGICAL :: dFlag
40     
41           INTEGER :: MAX_CELLS, BND1, BND2
42     
43           INTEGER, ALLOCATABLE :: LOC_DEM_BCMO_IJK(:)
44     
45           INTEGER :: I,J,K,IJK
46           INTEGER :: I_w, I_e, J_s, J_n, K_b, K_t
47     
48           CALL INIT_ERR_MSG("SET_BC_DEM_MO")
49     
50     
51     ! Initialize the data structures:
52           allocate( DEM_BCMO_IJKSTART(DEM_BCMO) )
53           allocate( DEM_BCMO_IJKEND(DEM_BCMO) )
54     
55           DEM_BCMO_IJKSTART = -1
56           DEM_BCMO_IJKEND   = -1
57     
58           dFlag = (DMP_LOG .AND. setDBG)
59           if(dFlag) write(*,"(2/,2x,'DEM outlet count: ',I4)") DEM_BCMO
60     
61     ! Loop over the outflow BCs to get an approximate count of the number
62     ! of fluid cells that are adjacent to the outlet.
63           MAX_CELLS = 0
64           DO BCV_I = 1, DEM_BCMO
65              BCV = DEM_BCMO_MAP(BCV_I)
66     
67     ! Set the search area to the dimensions of the inlet.
68              if(dFlag) WRITE(*,"(/2x,'Adding cells for BCV: ',I3)") BCV
69              SELECT CASE (BC_PLANE(BCV))
70              CASE('N','S')
71                 BND1 = IofPOS(BC_X_e(BCV)) - IofPOS(BC_X_w(BCV))
72                 BND2 = KofPOS(BC_Z_t(BCV)) - KofPOS(BC_Z_b(BCV))
73     
74              CASE('E','W')
75                 BND1 = JofPOS(BC_Y_n(BCV)) - JofPOS(BC_Y_s(BCV))
76                 BND2 = KofPOS(BC_Z_t(BCV)) - KofPOS(BC_Z_b(BCV))
77     
78              CASE('T','B')
79                 BND1 = IofPOS(BC_X_e(BCV)) - IofPOS(BC_X_w(BCV))
80                 BND2 = JofPOS(BC_Y_n(BCV)) - JofPOS(BC_Y_s(BCV))
81              END SELECT
82     
83              MAX_CELLS = MAX_CELLS +                                      &
84                 2*(BND1+1)*(BND2+1) + 2*(BND1+2) + 2*(BND2+2)
85     
86              if(dFlag) WRITE(*,"(4x,'Plane:   ',A)") BC_PLANE(BCV)
87              if(dFlag) WRITE(*,"(4x,'Cells: ', I8)") (BND1+1)*(BND2+1)
88           ENDDO
89     
90           if(dFlag) write(*,"(2x,'Max Cells: ',I8)") MAX_CELLS
91     
92     ! Allocate an array to hold the IJK values. This array should be
93     ! more than enough to store all the IJKs.
94           allocate( LOC_DEM_BCMO_IJK(MAX_CELLS) )
95     
96     ! Loop over the IJKs for each BC and store only the IJKs that you
97     ! own as well as the start/end array positions for each BC.
98           LC = 1
99           DO BCV_I = 1, DEM_BCMO
100     
101              DEM_BCMO_IJKSTART(BCV_I) = LC
102              BCV = DEM_BCMO_MAP(BCV_I)
103     
104              if(dFlag) write(*,"(/2x,'Searching for fluid cells:',I3)") BCV
105     
106              I_w = IofPOS(BC_X_w(BCV)); I_e = IofPOS(BC_X_e(BCV))
107              J_s = JofPOS(BC_Y_s(BCV)); J_n = JofPOS(BC_Y_n(BCV))
108              K_b = KofPOS(BC_Z_b(BCV)); K_t = KofPOS(BC_Z_t(BCV))
109     
110     ! Depending on the flow plane, the 'common' index needs shifted to
111     ! reference the fluid cell.
112              SELECT CASE (BC_PLANE(BCV))
113              CASE('N'); J_s = J_s+1;  J_n = J_s
114              CASE('S'); J_s = J_s-1;  J_n = J_s
115              CASE('E'); I_w = I_w+1;  I_e = I_w
116              CASE('W'); I_w = I_w-1;  I_e = I_w
117              CASE('T'); K_b = K_b+1;  K_t = K_b
118              CASE('B'); K_b = K_b-1;  K_t = K_b
119             END SELECT
120     
121              if(dFlag) then
122                 write(*,"(4x,'Search bounds: ')")
123                 write(*,"(6x,'I_w/I_e:',2(2x,I6))") I_w, I_e
124                 write(*,"(6x,'J_s/J_n:',2(2x,I6))") J_s, J_n
125                 write(*,"(6x,'K_b/K_t:',2(2x,I6))") K_b, K_t
126              endif
127     
128     ! Store the IJKs.
129              DO K = K_b, K_t
130              DO J = J_s, J_n
131              DO I = I_w, I_e
132     ! Skip cells that this rank does not own or are considered dead.
133                 IF(.NOT.dg_is_ON_myPE_plus1layers(I,J,K))CYCLE
134     
135                 IJK = DG_FUNIJK(I,J,K)
136                 LOC_DEM_BCMO_IJK(LC) = IJK
137                 LC = LC+1
138              ENDDO
139              ENDDO
140              ENDDO
141     
142              if(dFlag) write(*,"(/2x,'Adding boundary cells:',I3)") BCV
143     
144              I_w = IofPOS(BC_X_w(BCV))-1; I_e = IofPOS(BC_X_e(BCV))+1
145              J_s = JofPOS(BC_Y_s(BCV))-1; J_n = JofPOS(BC_Y_n(BCV))+1
146     
147              IF(DO_K) THEN
148                 K_b = KofPOS(BC_Z_b(BCV))-1; K_t = KofPOS(BC_Z_t(BCV))+1
149              ELSE
150                 K_b = KofPOS(BC_Z_b(BCV));   K_t = KofPOS(BC_Z_t(BCV))
151              ENDIF
152     
153     ! Depending on the flow plane, the 'common' index needs shifted to
154     ! reference the fluid cell.
155              SELECT CASE (BC_PLANE(BCV))
156              CASE('N','S'); J_s = J_s+1;  J_n = J_n-1
157              CASE('E','W'); I_w = I_w+1;  I_e = I_e-1
158              CASE('T','B'); K_b = K_b+1;  K_t = K_t-1
159              END SELECT
160     
161              if(dFlag) then
162                 write(*,"(4x,'Search bounds: ')")
163                 write(*,"(6x,'I_w/I_e:',2(2x,I6))") I_w, I_e
164                 write(*,"(6x,'J_s/J_n:',2(2x,I6))") J_s, J_n
165                 write(*,"(6x,'K_b/K_t:',2(2x,I6))") K_b, K_t
166              endif
167     
168     ! Store the IJKs.
169              DO K = K_b, K_t
170              DO J = J_s, J_n
171              DO I = I_w, I_e
172     ! Skip cells that this rank does not own or are considered dead.
173                 IF(.NOT.dg_is_ON_myPE_plus1layers(I,J,K))CYCLE
174     
175                 IJK = DG_FUNIJK(I,J,K)
176                 LOC_DEM_BCMO_IJK(LC) = IJK
177                 LC = LC+1
178              ENDDO
179              ENDDO
180              ENDDO
181     
182              DEM_BCMO_IJKEND(BCV_I) = LC-1
183     
184              if(dFLAG) write(*,1111) BCV, BCV_I,                           &
185                 DEM_BCMO_IJKSTART(BCV_I),DEM_BCMO_IJKEND(BCV_I)
186     
187           ENDDO
188     
189      1111 FORMAT(/2x,'DEM Mass Outflow:',/4x,'BC:',I4,3x,'MAP:',I4,&
190              /4x,'IJKSTART:',I6,/4x,'IJKEND:  ',I6)
191     
192     ! Allocate the global store arrary array. This changes across MPI ranks.
193           IF(LC > 1) THEN
194              allocate( DEM_BCMO_IJK(LC-1) )
195              DEM_BCMO_IJK(1:LC-1) = LOC_DEM_BCMO_IJK(1:LC-1)
196           ELSE
197              allocate( DEM_BCMO_IJK(1) )
198              DEM_BCMO_IJK(1) = LOC_DEM_BCMO_IJK(1)
199           ENDIF
200     
201           deallocate(LOC_DEM_BCMO_IJK)
202     
203           CALL FINL_ERR_MSG
204     
205           RETURN
206           END SUBROUTINE SET_BC_DEM_MO
207     
208     
209     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
210     !                                                                      !
211     !  Module name: CHECK_DES_LE_BC                                        !
212     !                                                                      !
213     !  Purpose: Check/set parameters for DES Lees Edeards BC.              !
214     !                                                                      !
215     !  Author: J.Musser                                   Date: 11-DEC-13  !
216     !                                                                      !
217     !  Comments: *** DES Lees Edwards BC funcionality has been lost. ***   !
218     !                                                                      !
219     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
220           SUBROUTINE CHECK_DES_LE_BC
221     
222           use discretelement
223           use mpi_utility
224     
225           IMPLICIT NONE
226     
227     ! Lees Edwards BC functionality has been lost in current DEM code
228           IF(DES_LE_BC) THEN
229              IF (DES_CONTINUUM_COUPLED) THEN
230                 WRITE(UNIT_LOG, 1064)
231                  CALL MFIX_EXIT(myPE)
232              ENDIF
233              IF (DES_NEIGHBOR_SEARCH .NE. 4) THEN
234                 WRITE(UNIT_LOG, 1060)
235                 CALL MFIX_EXIT(myPE)
236              ENDIF
237     ! not all possible shear directions are fully coded
238              IF (DIMN .EQ. 2) THEN
239                 IF(TRIM(DES_LE_SHEAR_DIR) .NE. 'DUDY' .AND. &
240                    TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDX') THEN
241                    WRITE(UNIT_LOG, 1061)
242                    CALL MFIX_EXIT(myPE)
243                 ENDIF
244              ELSEIF(DIMN.EQ.3) THEN
245                 IF(TRIM(DES_LE_SHEAR_DIR) .NE. 'DUDY') THEN ! .AND. &
246     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DUDZ' .AND. &
247     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDX' .AND. &
248     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDZ' .AND. &
249     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DWDX' .AND. &
250     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DWDY') THEN
251                    WRITE(UNIT_LOG, 1062)
252                    CALL MFIX_EXIT(myPE)
253                 ENDIF
254              ENDIF
255              IF (DES_PERIODIC_WALLS) THEN
256                 DES_PERIODIC_WALLS = .FALSE.
257                 DES_PERIODIC_WALLS_X = .FALSE.
258                 DES_PERIODIC_WALLS_Y = .FALSE.
259                 DES_PERIODIC_WALLS_Z = .FALSE.
260                 WRITE(UNIT_LOG, 1063)
261                 WRITE(*,1063)
262              ENDIF
263           ENDIF
264     
265           RETURN
266     
267      1060 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
268              'Only the grid based search option is allowed when using',&
269              'using',/10X,'Lees & Edwards BC.',/1X,70('*')/)
270     
271      1061 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
272              'Invalid option for DES_LE_SHEAR_DIR in mfix.dat. When',/10X,&
273              'DIMN=2 shear options are DUDY or DVDX',/1X,70('*')/)
274     
275      1062 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
276              'Invalid option for DES_LE_SHEAR_DIR in mfix.dat. When',/10X,&
277              'DIMN=3 shear options are DUDY, DUDZ, DVDX, DVDZ, DWDX or',&
278              'DWDY.',/1X,70('*')/)
279     
280      1063 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
281              'WARNING: DES_PERIODIC_WALLS set to false when DES_LE_BC.',&
282              /10X,'DES_LE_BC implies periodic walls, however, the ',&
283              'periodicity is handled',/10X, 'independently of ',&
284              'DES_PERIODIC_WALLS option and so it is shut off.',&
285              /1X,70('*')/)
286     
287      1064 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
288              'DES_CONTINUUM_COUPLED cannot be true when using ',&
289              'DES_LE_BC.',/1X,70('*')/)
290     
291           END SUBROUTINE CHECK_DES_LE_BC
292