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

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Subroutine: SET_BC_PIC_MO                                           !
4     !                                                                      !
5     !                                                                      !
6     !  Author: R.Garg                                     Date: 23-June-14 !
7     !                                                                      !
8     !  Comments:                                                           !
9     !                                                                      !
10     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
11           SUBROUTINE SET_BC_PIC_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 pic_bc, only: PIC_BCMO, PIC_BCMO_MAP, PIC_BCMO_IJK
17           use pic_bc, only: PIC_BCMO_IJKSTART, PIC_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_PIC_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_PIC_MO")
45     
46           dFlag = (DMP_LOG .AND. setDBG)
47           if(dFlag) write(*,"(2/,2x,'PIC outlet count: ',I4)") PIC_BCMO
48     
49     ! Loop over the outflow BCs to get an approximate count of the number
50     ! of fluid cells that are adjacent to the outlet.
51           MAX_CELLS = 0
52           DO BCV_I = 1, PIC_BCMO
53              BCV = PIC_BCMO_MAP(BCV_I)
54     
55     ! Set the search area to the dimensions of the inlet.
56              if(dFlag) WRITE(*,"(/2x,'Adding cells for BCV: ',I3)") BCV
57              SELECT CASE (BC_PLANE(BCV))
58              CASE('N','S')
59                 BND1 = BC_I_e(BCV) - BC_I_w(BCV)
60                 BND2 = BC_K_t(BCV) - BC_K_b(BCV)
61     
62              CASE('E','W')
63                 BND1 = BC_J_n(BCV) - BC_J_s(BCV)
64                 BND2 = BC_K_t(BCV) - BC_K_b(BCV)
65     
66              CASE('T','B')
67                 BND1 = BC_I_e(BCV) - BC_I_w(BCV)
68                 BND2 = BC_J_n(BCV) - BC_J_s(BCV)
69              END SELECT
70     
71              MAX_CELLS = MAX_CELLS +                                      &
72                 2*(BND1+1)*(BND2+1) + 2*(BND1+2) + 2*(BND2+2)
73     
74              if(dFlag) WRITE(*,"(4x,'Plane:   ',A)") BC_PLANE(BCV)
75              if(dFlag) WRITE(*,"(4x,'Cells: ', I8)") (BND1+1)*(BND2+1)
76           ENDDO
77     
78           if(dFlag) write(*,"(2x,'Max Cells: ',I8)") MAX_CELLS
79     
80     ! Allocate an array to hold the IJK values. This array should be
81     ! more than enough to store all the IJKs.
82           allocate( LOC_PIC_BCMO_IJK(MAX_CELLS) )
83     
84     ! Loop over the IJKs for each BC and store only the IJKs that you
85     ! own as well as the start/end array positions for each BC.
86           LC = 1
87           DO BCV_I = 1, PIC_BCMO
88     
89              PIC_BCMO_IJKSTART(BCV_I) = LC
90              BCV = PIC_BCMO_MAP(BCV_I)
91     
92              if(dFlag) write(*,"(/2x,'Searching for fluid cells:',I3)") BCV
93     
94              I_w = BC_I_w(BCV); I_e = BC_I_e(BCV)
95              J_s = BC_J_s(BCV); J_n = BC_J_n(BCV)
96              K_b = BC_K_b(BCV); K_t = BC_K_t(BCV)
97     
98     ! Depending on the flow plane, the 'common' index needs shifted to
99     ! reference the fluid cell.
100              SELECT CASE (BC_PLANE(BCV))
101              CASE('N'); J_s = J_s+1;  J_n = J_s
102              CASE('S'); J_s = J_s-1;  J_n = J_s
103              CASE('E'); I_w = I_w+1;  I_e = I_w
104              CASE('W'); I_w = I_w-1;  I_e = I_w
105              CASE('T'); K_b = K_b+1;  K_t = K_b
106              CASE('B'); K_b = K_b-1;  K_t = K_b
107             END SELECT
108     
109              if(dFlag) then
110                 write(*,"(4x,'Search bounds: ')")
111                 write(*,"(6x,'I_w/I_e:',2(2x,I6))") I_w, I_e
112                 write(*,"(6x,'J_s/J_n:',2(2x,I6))") J_s, J_n
113                 write(*,"(6x,'K_b/K_t:',2(2x,I6))") K_b, K_t
114              endif
115     
116     ! Store the IJKs.
117              DO K = K_b, K_t
118              DO J = J_s, J_n
119              DO I = I_w, I_e
120     ! Skip cells that this rank does not own or are considered dead.
121     ! Limit only to fluid cells
122                 IF(.NOT.IS_ON_myPE_wobnd(I,J,K)) CYCLE
123                 IJK = FUNIJK(I,J,K)
124     
125                 IF(.NOT.FLUID_AT(IJK)) CYCLE
126     
127                 LOC_PIC_BCMO_IJK(LC) = IJK
128                 LC = LC+1
129              ENDDO
130              ENDDO
131              ENDDO
132     
133              PIC_BCMO_IJKEND(BCV_I) = LC-1
134     
135              if(dFLAG) write(*,1111) BCV, BCV_I,                           &
136                 PIC_BCMO_IJKSTART(BCV_I),PIC_BCMO_IJKEND(BCV_I)
137     
138           ENDDO
139     
140      1111 FORMAT(/2x,'PIC Mass Outflow:',/4x,'BC:',I4,3x,'MAP:',I4,&
141              /4x,'IJKSTART:',I6,/4x,'IJKEND:  ',I6)
142     
143     ! Allocate the global store arrary array. This changes across MPI ranks.
144           IF(LC > 1) THEN
145              allocate( PIC_BCMO_IJK(LC-1) )
146              PIC_BCMO_IJK(1:LC-1) = LOC_PIC_BCMO_IJK(1:LC-1)
147           ELSE
148              allocate( PIC_BCMO_IJK(1) )
149              PIC_BCMO_IJK(1) = LOC_PIC_BCMO_IJK(1)
150           ENDIF
151     
152           deallocate(LOC_PIC_BCMO_IJK)
153     
154           CALL FINL_ERR_MSG
155     
156           RETURN
157           END SUBROUTINE SET_BC_PIC_MO
158     
159     
160