My Project
Functions/Subroutines
shape_coef_gcy.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine shape_coef_gcy
 

Function/Subroutine Documentation

◆ shape_coef_gcy()

subroutine shape_coef_gcy ( )

Definition at line 41 of file shape_coef_gcy.f90.

41 
42 !----------------------------------------------------------------------!
43 ! This subroutine is used to calculate the coefficient for a linear !
44 ! function on the x-y plane, i.e.: !
45 ! !
46 ! r(x,y;phai)=phai_c+cofa1*x+cofa2*y !
47 ! !
48 ! This subroutine is used for ghost cell boundary condition cases !
49 !----------------------------------------------------------------------!
50 
51  USE all_vars
52  USE mod_utils
53  IMPLICIT NONE
54  REAL(DP) X1,X2,X3,Y1,Y2,Y3,DELT,AI1,AI2,AI3,BI1,BI2,BI3,CI1,CI2,CI3
55  REAL(DP) DELTX,DELTY,TEMP1,ANG1,ANG2,B1,B2,ANGLE
56  INTEGER I,II,J,JJ,J1,J2
57  REAL(SP) AA1,AA2,BB1,BB2,CC1,CC2,XTMP1,YTMP1,XTMP2,YTMP2
58 !
59 !---------------interior and boundary cells------------------------------------!
60 !
61 
62  IF(dbg_set(dbg_log)) THEN
63  WRITE(ipt,*) "!"
64  WRITE(ipt,*) "! SETTING UP LINEAR INTEROPOLATION COEFFICIENTS"
65  END IF
66 
67  DO i = 1, n
68  IF(isbce(i) == 0) THEN
69  y1 = yc(nbe(i,1))-yc(i)
70  y2 = yc(nbe(i,2))-yc(i)
71  y3 = yc(nbe(i,3))-yc(i)
72  x1 = xc(nbe(i,1))-xc(i)
73  x2 = xc(nbe(i,2))-xc(i)
74  x3 = xc(nbe(i,3))-xc(i)
75  ELSE IF(isbce(i) == 1) THEN
76  DO j = 1, 3
77  IF(nbe(i,j) == 0) jj = j
78  END DO
79  j1 = jj+1-int((jj+1)/4)*3
80  j2 = jj+2-int((jj+2)/4)*3
81 
82 
83 
84  IF(jj == 1)THEN
85  x1 = xtmp1-xc(i)
86  y1 = ytmp1-yc(i)
87  x2 = xc(nbe(i,j1))-xc(i)
88  y2 = yc(nbe(i,j1))-yc(i)
89  x3 = xc(nbe(i,j2))-xc(i)
90  y3 = yc(nbe(i,j2))-yc(i)
91  ELSE IF(jj == 2)THEN
92  x1 = xc(nbe(i,j2))-xc(i)
93  y1 = yc(nbe(i,j2))-yc(i)
94  x2 = xtmp1-xc(i)
95  y2 = ytmp1-yc(i)
96  x3 = xc(nbe(i,j1))-xc(i)
97  y3 = yc(nbe(i,j1))-yc(i)
98  ELSE
99  x1 = xc(nbe(i,j1))-xc(i)
100  y1 = yc(nbe(i,j1))-yc(i)
101  x2 = xc(nbe(i,j2))-xc(i)
102  y2 = yc(nbe(i,j2))-yc(i)
103  x3 = xtmp1-xc(i)
104  y3 = ytmp1-yc(i)
105  END IF
106 ! else if(isbce(i) == 2) then
107 ! do j=1,4
108 ! a1u(i,j)=0.0_SP
109 ! a2u(i,j)=0.0_SP
110 ! end do
111  ELSE IF(isbce(i) == 2) THEN
112  DO j = 1, 3
113  IF(nbe(i,j) == 0) jj = j
114  END DO
115  j1 = jj+1-int((jj+1)/4)*3
116  j2 = jj+2-int((jj+2)/4)*3
117 
118  deltx = vx(nv(i,j1))-vx(nv(i,j2))
119  delty = vy(nv(i,j1))-vy(nv(i,j2))
120 
121  alpha(i) = atan2(delty,deltx)
122  alpha(i) = alpha(i)-3.1415926_sp/2.0_sp
123 
124  aa1 = -delty
125  bb1 = deltx
126  cc1 = -aa1*vx(nv(i,j1))-bb1*vy(nv(i,j1))
127 
128  aa2 = bb1
129  bb2 = -aa1
130  cc2 = -aa2*xc(i)-bb2*yc(i)
131 
132  xtmp1 = -(cc1*bb2-cc2*bb1)/(aa1*bb2-aa2*bb1)
133  ytmp1 = -(cc1*aa2-cc2*aa1)/(bb1*aa2-bb2*aa1)
134 
135  IF(jj == 1)THEN
136  x1 = (xtmp1-xc(i))*2.0_sp
137  y1 = (ytmp1-yc(i))*2.0_sp
138  x2 = xc(nbe(i,j1))-xc(i)
139  y2 = yc(nbe(i,j1))-yc(i)
140  x3 = xc(nbe(i,j2))-xc(i)
141  y3 = yc(nbe(i,j2))-yc(i)
142  ELSE IF(jj == 2)THEN
143  x1 = xc(nbe(i,j2))-xc(i)
144  y1 = yc(nbe(i,j2))-yc(i)
145  x2 = (xtmp1-xc(i))*2.0_sp
146  y2 = (ytmp1-yc(i))*2.0_sp
147  x3 = xc(nbe(i,j1))-xc(i)
148  y3 = yc(nbe(i,j1))-yc(i)
149  ELSE
150  x1 = xc(nbe(i,j1))-xc(i)
151  y1 = yc(nbe(i,j1))-yc(i)
152  x2 = xc(nbe(i,j2))-xc(i)
153  y2 = yc(nbe(i,j2))-yc(i)
154  x3 = (xtmp1-xc(i))*2.0_sp
155  y3 = (ytmp1-yc(i))*2.0_sp
156  END IF
157  ELSE IF(isbce(i) == 3)THEN
158  DO j = 1, 3
159  IF(nbe(i,j) /= 0) jj = j
160  END DO
161  j1 = jj+1-int((jj+1)/4)*3
162  j2 = jj+2-int((jj+2)/4)*3
163 
164 
165 
166  IF(jj == 1)THEN
167  x1 = xc(nbe(i,jj))-xc(i)
168  y1 = yc(nbe(i,jj))-yc(i)
169  x2 = xtmp1-xc(i)
170  y2 = ytmp1-yc(i)
171  x3 = xtmp2-xc(i)
172  y3 = ytmp2-yc(i)
173  ELSE IF(jj == 2)THEN
174  x1 = xtmp2-xc(i)
175  y1 = ytmp2-yc(i)
176  x2 = xc(nbe(i,jj))-xc(i)
177  y2 = yc(nbe(i,jj))-yc(i)
178  x3 = xtmp1-xc(i)
179  y3 = ytmp1-yc(i)
180  ELSE
181  x1 = xtmp1-xc(i)
182  y1 = ytmp1-yc(i)
183  x2 = xtmp2-xc(i)
184  y2 = ytmp2-yc(i)
185  x3 = xc(nbe(i,jj))-xc(i)
186  y3 = yc(nbe(i,jj))-yc(i)
187  END IF
188  END IF
189 
190  x1 = x1/1000.0_sp
191  x2 = x2/1000.0_sp
192  x3 = x3/1000.0_sp
193  y1 = y1/1000.0_sp
194  y2 = y2/1000.0_sp
195  y3 = y3/1000.0_sp
196 
197  delt = (x1*y2-x2*y1)**2+(x1*y3-x3*y1)**2+(x2*y3-x3*y2)**2
198  delt = delt*1000._sp
199 
200  a1u(i,1) = (y1+y2+y3)*(x1*y1+x2*y2+x3*y3)- &
201  (x1+x2+x3)*(y1**2+y2**2+y3**2)
202  a1u(i,1) = a1u(i,1)/delt
203  a1u(i,2) = (y1**2+y2**2+y3**2)*x1-(x1*y1+x2*y2+x3*y3)*y1
204  a1u(i,2) = a1u(i,2)/delt
205  a1u(i,3) = (y1**2+y2**2+y3**2)*x2-(x1*y1+x2*y2+x3*y3)*y2
206  a1u(i,3) = a1u(i,3)/delt
207  a1u(i,4) = (y1**2+y2**2+y3**2)*x3-(x1*y1+x2*y2+x3*y3)*y3
208  a1u(i,4) = a1u(i,4)/delt
209 
210  a2u(i,1) = (x1+x2+x3)*(x1*x1+x2*x2+x3*x3)- &
211  (y1+y2+y3)*(x1**2+x2**2+x3**2)
212  a2u(i,1) = a2u(i,1)/delt
213  a2u(i,2) = (x1**2+x2**2+x3**2)*y1-(x1*y1+x2*y2+x3*y3)*x1
214  a2u(i,2) = a2u(i,2)/delt
215  a2u(i,3) = (x1**2+x2**2+x3**2)*y2-(x1*y1+x2*y2+x3*y3)*x2
216  a2u(i,3) = a2u(i,3)/delt
217  a2u(i,4) = (x1**2+x2**2+x3**2)*y3-(x1*y1+x2*y2+x3*y3)*x3
218  a2u(i,4) = a2u(i,4)/delt
219 ! end if
220 
221  x1 = vx(nv(i,1))-xc(i)
222  x2 = vx(nv(i,2))-xc(i)
223  x3 = vx(nv(i,3))-xc(i)
224  y1 = vy(nv(i,1))-yc(i)
225  y2 = vy(nv(i,2))-yc(i)
226  y3 = vy(nv(i,3))-yc(i)
227 
228 
229  ai1 = y2-y3
230  ai2 = y3-y1
231  ai3 = y1-y2
232  bi1 = x3-x2
233  bi2 = x1-x3
234  bi3 = x2-x1
235  ci1 = x2*y3-x3*y2
236  ci2 = x3*y1-x1*y3
237  ci3 = x1*y2-x2*y1
238 
239  aw0(i,1) = -ci1/2./art(i)
240  aw0(i,2) = -ci2/2./art(i)
241  aw0(i,3) = -ci3/2./art(i)
242  awx(i,1) = -ai1/2./art(i)
243  awx(i,2) = -ai2/2./art(i)
244  awx(i,3) = -ai3/2./art(i)
245  awy(i,1) = -bi1/2./art(i)
246  awy(i,2) = -bi2/2./art(i)
247  awy(i,3) = -bi3/2./art(i)
248  END DO
249 
250 
251  ang1=359.9_sp/180.0_sp*3.1415926_sp
252  ang2=-0.1_sp/180.0_sp*3.1415926_sp
253 
254  do i=1,m
255  if((isonb(i).eq.1).and.(ntve(i).gt.2)) then
256  angle=alpha(nbve(i,ntve(i)))-alpha(nbve(i,1))
257  if(angle.gt.ang1) then
258  angle=100000.0_sp
259  else if(angle.gt.3.1415926_sp) then
260  angle=angle-2.0_sp*3.1415926_sp
261  else if(angle.lt.-3.1415926_sp) then
262  angle=angle+2.0_sp*3.1415926_sp
263  else if(angle.lt.ang2) then
264  angle=100000.0_sp
265  end if
266  do j=2,ntve(i)-1
267  ii=nbve(i,j)
268  if(isbce(ii).ne.1) then
269  alpha(ii)=alpha(nbve(i,1))+ &
270  angle/float(ntve(i)-1)*float(j-1)
271  end if
272  end do
273  end if
274  end do
275 !end>
276 
277  IF(dbg_set(dbg_log)) THEN
278  WRITE(ipt,*) "!"
279  WRITE(ipt,*) "! INTERP COEFFICIENTS : COMPLETE"
280  END IF
281 
282  RETURN
real(sp), dimension(:), allocatable, target alpha
Definition: mod_main.f90:1336
real(sp), dimension(:), allocatable, target art
Definition: mod_main.f90:1009
logical function dbg_set(vrb)
Definition: mod_utils.f90:182
real(sp), dimension(:), allocatable, target yc
Definition: mod_main.f90:1004
real(sp), dimension(:,:), allocatable, target a1u
Definition: mod_main.f90:1331
real(sp), dimension(:,:), allocatable, target awx
Definition: mod_main.f90:1333
integer m
Definition: mod_main.f90:56
real(sp), dimension(:,:), allocatable, target aw0
Definition: mod_main.f90:1335
real(sp), dimension(:,:), allocatable, target awy
Definition: mod_main.f90:1334
real(sp), dimension(:), allocatable, target vx
Definition: mod_main.f90:1001
integer n
Definition: mod_main.f90:55
real(sp), dimension(:), allocatable, target vy
Definition: mod_main.f90:1002
integer, dimension(:), allocatable, target ntve
Definition: mod_main.f90:1022
integer, dimension(:,:), allocatable, target nbe
Definition: mod_main.f90:1020
integer, dimension(:,:), allocatable, target nv
Definition: mod_main.f90:1018
real(sp), dimension(:,:), allocatable, target a2u
Definition: mod_main.f90:1332
integer, dimension(:,:), allocatable, target nbve
Definition: mod_main.f90:1034
real(sp), dimension(:), allocatable, target xc
Definition: mod_main.f90:1003
integer, dimension(:), allocatable, target isbce
Definition: mod_main.f90:1027
integer ipt
Definition: mod_main.f90:922
integer, dimension(:), allocatable, target isonb
Definition: mod_main.f90:1024
integer, parameter dbg_log
Definition: mod_utils.f90:65
Here is the call graph for this function: