File: RELATIVE:/../../../mfix.git/model/radial_vel_correction.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14 SUBROUTINE RADIAL_VEL_CORRECTION
15
16 use physprop
17 use fldvar
18 use constant
19 use mpi_utility
20 use functions
21
22 IMPLICIT NONE
23
24
25 INTEGER :: M
26
27 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Wg_Temp, Wg_Temp_GL
28 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: Ws_Temp, Ws_Temp_GL
29
30 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: SUMX_G, SUMZ_G
31 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: SUMX_S, SUMZ_S
32
33 INTEGER :: I1, I2, J1, K1, K2
34 INTEGER :: abIJK, abIJK1, abIJK2
35
36 DOUBLE PRECISION :: Angle_Temp, WgAvg, WsAvg
37
38
39
40
41 DOUBLE PRECISION, EXTERNAL :: VAVG_U_G, VAVG_V_G, VAVG_W_G, &
42 VAVG_U_S, VAVG_V_S, VAVG_W_S
43
44 IF(NO_K .OR. KMAX==1) RETURN
45
46 I1=1
47 I2=2
48
49
50
51
52 ALLOCATE (Wg_Temp(ijkstart3:ijkend3))
53
54 DO J1 = JSTART3, JEND3
55 DO K1 = KSTART3, KEND3
56 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
57
58 abIJK1=FUNIJK(I2,J1,K1)
59 Wg_Temp (abIJK1) = W_g(abIJK1)
60 END DO
61 END DO
62
63 ALLOCATE (Wg_Temp_GL(ijkmax3))
64 CALL GATHER (Wg_Temp, Wg_Temp_GL, root)
65 CALL BCAST (Wg_Temp_GL, root)
66
67 ALLOCATE (SUMX_G(JMIN3:JMAX3))
68 ALLOCATE (SUMZ_G(JMIN3:JMAX3))
69
70 DO J1=1, JMAX3
71 SUMX_G(J1)=0
72 SUMZ_G(J1)=0
73 DO K1=1, KMAX
74 Angle_Temp = (K1-1)*2*(Pi/KMAX)
75 IF (K1 .LE. 0.5*KMAX) THEN
76 K2=(K1-1)+(0.5*KMAX2)
77 ELSE
78 K2=(K1+1)-(0.5*KMAX2)
79 ENDIF
80
81 abIJK1=FUNIJK_GL (I2,J1,K1)
82 abIJK2=FUNIJK_GL (I2,J1,K2)
83 WgAvg=0.5*(Wg_Temp_GL(abIJK1)-Wg_Temp_GL(abIJK2))
84 SUMX_G(J1)=SUMX_G(J1)-((2*WgAvg*sin(Angle_Temp))/KMAX)
85 SUMZ_G(J1)=SUMZ_G(J1)+((2*WgAvg*cos(Angle_Temp))/KMAX)
86 ENDDO
87 ENDDO
88
89 DO J1= JSTART3, JEND3
90 DO K1= KSTART3, KEND3
91
92 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
93 abIJK = FUNIJK (I1,J1,K1)
94 Angle_Temp = (-Pi/KMAX)+((K1-1)*2*(Pi/KMAX))
95 U_g(abIJK)=(SUMX_G(J1)*cos(Angle_Temp)) + &
96 (SUMZ_G(J1)*sin(Angle_Temp))
97 ENDDO
98 ENDDO
99
100 DEALLOCATE (Wg_Temp)
101 DEALLOCATE (Wg_Temp_GL)
102 DEALLOCATE (SUMX_G)
103 DEALLOCATE (SUMZ_G)
104
105
106
107
108 ALLOCATE (Ws_Temp(ijkstart3:ijkend3))
109 ALLOCATE (Ws_Temp_GL(ijkmax3))
110 ALLOCATE (SUMX_S(JMIN3:JMAX3))
111 ALLOCATE (SUMZ_S(JMIN3:JMAX3))
112
113 DO M=1, MMAX
114
115 DO J1 = JSTART3, JEND3
116 DO K1 = KSTART3, KEND3
117 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
118 abIJK1=FUNIJK(I2,J1,K1)
119 Ws_Temp (abIJK1) = W_s(abIJK1,M)
120 ENDDO
121 ENDDO
122
123 CALL GATHER (Ws_Temp, Ws_Temp_GL, root)
124 CALL BCAST (Ws_Temp_GL, root)
125
126 DO J1=1, JMAX3
127 SUMX_S(J1)=0
128 SUMZ_S(J1)=0
129 DO K1=1, KMAX
130 Angle_Temp = (K1-1)*2*(Pi/KMAX)
131 IF (K1 .LE. 0.5*KMAX) THEN
132 K2=(K1-1)+(0.5*KMAX2)
133 ELSE
134 K2=(K1+1)-(0.5*KMAX2)
135 END IF
136 abIJK1=FUNIJK_GL (I2,J1,K1)
137 abIJK2=FUNIJK_GL (I2,J1,K2)
138 WsAvg=0.5*(Ws_Temp_GL(abIJK1)-Ws_Temp_GL(abIJK2))
139 SUMX_S(J1)=SUMX_S(J1)-((2*WsAvg*sin(Angle_Temp))/KMAX)
140 SUMZ_S(J1)=SUMZ_S(J1)+((2*WsAvg*cos(Angle_Temp))/KMAX)
141 ENDDO
142 ENDDO
143
144 DO J1= JSTART3, JEND3
145 DO K1= KSTART3, KEND3
146 IF (.NOT.IS_ON_myPE_plus2layers(I1,J1,K1)) CYCLE
147 abIJK = FUNIJK (I1,J1,K1)
148 Angle_Temp = (-Pi/KMAX)+((K1-1)*2*(Pi/KMAX))
149 U_s(abIJK,M)=(SUMX_S(J1)*cos(Angle_Temp)) + &
150 (SUMZ_S(J1)*sin(Angle_Temp))
151 ENDDO
152 ENDDO
153 ENDDO
154
155 DEALLOCATE (Ws_Temp)
156 DEALLOCATE (Ws_Temp_GL)
157 DEALLOCATE (SUMX_S)
158 DEALLOCATE (SUMZ_S)
159
160 RETURN
161 END SUBROUTINE RADIAL_VEL_CORRECTION
162