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