File: N:\mfix\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              IF(DO_K) THEN
109                 K_b = KofPOS(BC_Z_b(BCV)); K_t = KofPOS(BC_Z_t(BCV))
110              ELSE
111                 K_b = 1; K_t = 1
112              ENDIF
113     
114     ! Depending on the flow plane, the 'common' index needs shifted to
115     ! reference the fluid cell.
116              SELECT CASE (BC_PLANE(BCV))
117              CASE('N'); J_s = J_s+1;  J_n = J_s
118              CASE('S'); J_s = J_s-1;  J_n = J_s
119              CASE('E'); I_w = I_w+1;  I_e = I_w
120              CASE('W'); I_w = I_w-1;  I_e = I_w
121              CASE('T'); K_b = K_b+1;  K_t = K_b
122              CASE('B'); K_b = K_b-1;  K_t = K_b
123             END SELECT
124     
125              if(dFlag) then
126                 write(*,"(4x,'Search bounds: ')")
127                 write(*,"(6x,'I_w/I_e:',2(2x,I6))") I_w, I_e
128                 write(*,"(6x,'J_s/J_n:',2(2x,I6))") J_s, J_n
129                 write(*,"(6x,'K_b/K_t:',2(2x,I6))") K_b, K_t
130              endif
131     
132     ! Store the IJKs.
133              DO K = K_b, K_t
134              DO J = J_s, J_n
135              DO I = I_w, I_e
136     ! Skip cells that this rank does not own or are considered dead.
137                 IF(.NOT.dg_is_ON_myPE_plus1layers(I,J,K))CYCLE
138     
139                 IJK = DG_FUNIJK(I,J,K)
140                 LOC_DEM_BCMO_IJK(LC) = IJK
141                 LC = LC+1
142              ENDDO
143              ENDDO
144              ENDDO
145     
146              if(dFlag) write(*,"(/2x,'Adding boundary cells:',I3)") BCV
147     
148              I_w = IofPOS(BC_X_w(BCV))-1; I_e = IofPOS(BC_X_e(BCV))+1
149              J_s = JofPOS(BC_Y_s(BCV))-1; J_n = JofPOS(BC_Y_n(BCV))+1
150     
151              IF(DO_K) THEN
152                 K_b = KofPOS(BC_Z_b(BCV))-1; K_t = KofPOS(BC_Z_t(BCV))+1
153              ELSE
154                 K_b = 1;   K_t = 1
155              ENDIF
156     
157     ! Depending on the flow plane, the 'common' index needs shifted to
158     ! reference the fluid cell.
159              SELECT CASE (BC_PLANE(BCV))
160              CASE('N','S'); J_s = J_s+1;  J_n = J_n-1
161              CASE('E','W'); I_w = I_w+1;  I_e = I_e-1
162              CASE('T','B'); K_b = K_b+1;  K_t = K_t-1
163              END SELECT
164     
165              if(dFlag) then
166                 write(*,"(4x,'Search bounds: ')")
167                 write(*,"(6x,'I_w/I_e:',2(2x,I6))") I_w, I_e
168                 write(*,"(6x,'J_s/J_n:',2(2x,I6))") J_s, J_n
169                 write(*,"(6x,'K_b/K_t:',2(2x,I6))") K_b, K_t
170              endif
171     
172     ! Store the IJKs.
173              DO K = K_b, K_t
174              DO J = J_s, J_n
175              DO I = I_w, I_e
176     ! Skip cells that this rank does not own or are considered dead.
177                 IF(.NOT.dg_is_ON_myPE_plus1layers(I,J,K))CYCLE
178     
179                 IJK = DG_FUNIJK(I,J,K)
180                 LOC_DEM_BCMO_IJK(LC) = IJK
181                 LC = LC+1
182              ENDDO
183              ENDDO
184              ENDDO
185     
186              DEM_BCMO_IJKEND(BCV_I) = LC-1
187     
188              if(dFLAG) write(*,1111) BCV, BCV_I,                           &
189                 DEM_BCMO_IJKSTART(BCV_I),DEM_BCMO_IJKEND(BCV_I)
190     
191           ENDDO
192     
193      1111 FORMAT(/2x,'DEM Mass Outflow:',/4x,'BC:',I4,3x,'MAP:',I4,&
194              /4x,'IJKSTART:',I6,/4x,'IJKEND:  ',I6)
195     
196     ! Allocate the global store arrary array. This changes across MPI ranks.
197           IF(LC > 1) THEN
198              allocate( DEM_BCMO_IJK(LC-1) )
199              DEM_BCMO_IJK(1:LC-1) = LOC_DEM_BCMO_IJK(1:LC-1)
200           ELSE
201              allocate( DEM_BCMO_IJK(1) )
202              DEM_BCMO_IJK(1) = LOC_DEM_BCMO_IJK(1)
203           ENDIF
204     
205           deallocate(LOC_DEM_BCMO_IJK)
206     
207           CALL FINL_ERR_MSG
208     
209           RETURN
210           END SUBROUTINE SET_BC_DEM_MO
211     
212     
213     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
214     !                                                                      !
215     !  Module name: CHECK_DES_LE_BC                                        !
216     !                                                                      !
217     !  Purpose: Check/set parameters for DES Lees Edeards BC.              !
218     !                                                                      !
219     !  Author: J.Musser                                   Date: 11-DEC-13  !
220     !                                                                      !
221     !  Comments: *** DES Lees Edwards BC funcionality has been lost. ***   !
222     !                                                                      !
223     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
224           SUBROUTINE CHECK_DES_LE_BC
225     
226           use discretelement
227           use exit, only: mfix_exit
228           use mpi_utility
229     
230           IMPLICIT NONE
231     
232     ! Lees Edwards BC functionality has been lost in current DEM code
233           IF(DES_LE_BC) THEN
234              IF (DES_CONTINUUM_COUPLED) THEN
235                 WRITE(UNIT_LOG, 1064)
236                  CALL MFIX_EXIT(myPE)
237              ENDIF
238              IF (DES_NEIGHBOR_SEARCH .NE. 4) THEN
239                 WRITE(UNIT_LOG, 1060)
240                 CALL MFIX_EXIT(myPE)
241              ENDIF
242     ! not all possible shear directions are fully coded
243              IF (DIMN .EQ. 2) THEN
244                 IF(TRIM(DES_LE_SHEAR_DIR) .NE. 'DUDY' .AND. &
245                    TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDX') THEN
246                    WRITE(UNIT_LOG, 1061)
247                    CALL MFIX_EXIT(myPE)
248                 ENDIF
249              ELSEIF(DIMN.EQ.3) THEN
250                 IF(TRIM(DES_LE_SHEAR_DIR) .NE. 'DUDY') THEN ! .AND. &
251     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DUDZ' .AND. &
252     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDX' .AND. &
253     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DVDZ' .AND. &
254     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DWDX' .AND. &
255     !               TRIM(DES_LE_SHEAR_DIR) .NE. 'DWDY') THEN
256                    WRITE(UNIT_LOG, 1062)
257                    CALL MFIX_EXIT(myPE)
258                 ENDIF
259              ENDIF
260              IF (DES_PERIODIC_WALLS) THEN
261                 DES_PERIODIC_WALLS = .FALSE.
262                 DES_PERIODIC_WALLS_X = .FALSE.
263                 DES_PERIODIC_WALLS_Y = .FALSE.
264                 DES_PERIODIC_WALLS_Z = .FALSE.
265                 WRITE(UNIT_LOG, 1063)
266                 WRITE(*,1063)
267              ENDIF
268           ENDIF
269     
270           RETURN
271     
272      1060 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
273              'Only the grid based search option is allowed when using',&
274              'using',/10X,'Lees & Edwards BC.',/1X,70('*')/)
275     
276      1061 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
277              'Invalid option for DES_LE_SHEAR_DIR in mfix.dat. When',/10X,&
278              'DIMN=2 shear options are DUDY or DVDX',/1X,70('*')/)
279     
280      1062 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
281              'Invalid option for DES_LE_SHEAR_DIR in mfix.dat. When',/10X,&
282              'DIMN=3 shear options are DUDY, DUDZ, DVDX, DVDZ, DWDX or',&
283              'DWDY.',/1X,70('*')/)
284     
285      1063 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
286              'WARNING: DES_PERIODIC_WALLS set to false when DES_LE_BC.',&
287              /10X,'DES_LE_BC implies periodic walls, however, the ',&
288              'periodicity is handled',/10X, 'independently of ',&
289              'DES_PERIODIC_WALLS option and so it is shut off.',&
290              /1X,70('*')/)
291     
292      1064 FORMAT(/1X,70('*')//' From: CHECK_DES_DATA',/' Message: ',&
293              'DES_CONTINUUM_COUPLED cannot be true when using ',&
294              'DES_LE_BC.',/1X,70('*')/)
295     
296           END SUBROUTINE CHECK_DES_LE_BC
297