CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
Functions/Subroutines
cd_lab_straight.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine cd_lab_straight (n, p2p1, s, b, reynolds, cd_lab)
 

Function/Subroutine Documentation

◆ cd_lab_straight()

subroutine cd_lab_straight ( integer  n,
real*8  p2p1,
real*8  s,
real*8  b,
real*8  reynolds,
real*8  cd_lab 
)
31 !
32  implicit none
33 !
34  integer i,j,n,idx,idy,nx,ny
35 !
36  real*8 szb,p2p1,p1p2,s,b,reynolds,cd_lab,z1,z2,z3,z4,
37  & et,xi
38 !
39  real*8 szb1(3)
40  data szb1
41  & /0.230000d0,0.440000d0,0.830000d0/
42 !
43  real*8 reynlds1(21)
44  data reynlds1
45  & /100.0d0,200.0d0,300.d0,400.0d0,500.00d0,1000.0d0,
46  & 2000.d0,3000.d0,5000.d0,7000.d0,9000.d0,11000.d0,13000.d0,
47  & 15000.d0,18000.d0,21000.d0,25000.d0,30000.d0,35000.d0,
48  & 40000.d0,50000.d0/
49 !
50  real*8 tcd1(3,21)
51  data ((tcd1(i,j),i=1,3),j=1,21)
52  & /0.470d0,0.330d0,0.230d0,
53  & 0.500d0,0.365d0,0.274d0,
54  & 0.517d0,0.385d0,0.300d0,
55  & 0.520d0,0.400d0,0.320d0,
56  & 0.530d0,0.415d0,0.333d0,
57  & 0.550d0,0.449d0,0.376d0,
58  & 0.575d0,0.483d0,0.420d0,
59  & 0.590d0,0.500d0,0.450d0,
60  & 0.607d0,0.530d0,0.480d0,
61  & 0.620d0,0.550d0,0.500d0,
62  & 0.625d0,0.565d0,0.515d0,
63  & 0.630d0,0.570d0,0.527d0,
64  & 0.630d0,0.580d0,0.540d0,
65  & 0.630d0,0.585d0,0.555d0,
66  & 0.630d0,0.589d0,0.565d0,
67  & 0.630d0,0.589d0,0.576d0,
68  & 0.630d0,0.590d0,0.580d0,
69  & 0.630d0,0.590d0,0.588d0,
70  & 0.630d0,0.590d0,0.590d0,
71  & 0.630d0,0.590d0,0.590d0,
72  & 0.630d0,0.590d0,0.590d0/
73 !
74  real*8 szb2(3)
75  data szb2
76  & /0.230000d0,0.440000d0,0.830000d0/
77 !
78  real*8 reynlds2(21)
79  data reynlds2
80  & /100.0d0,200.0d0,300.d0,400.0d0,500.00d0,1000.0d0,
81  & 2000.d0,3000.d0,5000.d0,7000.d0,9000.d0,11000.d0,13000.d0,
82  & 15000.d0,18000.d0,21000.d0,25000.d0,30000.d0,35000.d0,
83  & 40000.d0,50000.d0/
84 !
85  real*8 tcd2(3,21)
86  data ((tcd2(i,j),i=1,3),j=1,21)
87  & /0.400d0,0.335d0,0.250d0,
88  & 0.445d0,0.390d0,0.308d0,
89  & 0.470d0,0.420d0,0.340d0,
90  & 0.490d0,0.440d0,0.360d0,
91  & 0.505d0,0.455d0,0.380d0,
92  & 0.550d0,0.500d0,0.442d0,
93  & 0.600d0,0.555d0,0.500d0,
94  & 0.625d0,0.580d0,0.525d0,
95  & 0.650d0,0.615d0,0.570d0,
96  & 0.660d0,0.640d0,0.600d0,
97  & 0.660d0,0.650d0,0.617d0,
98  & 0.660d0,0.655d0,0.635d0,
99  & 0.660d0,0.657d0,0.645d0,
100  & 0.660d0,0.660d0,0.650d0,
101  & 0.660d0,0.660d0,0.655d0,
102  & 0.660d0,0.660d0,0.660d0,
103  & 0.660d0,0.660d0,0.660d0,
104  & 0.660d0,0.660d0,0.660d0,
105  & 0.660d0,0.660d0,0.660d0,
106  & 0.660d0,0.660d0,0.660d0,
107  & 0.660d0,0.660d0,0.660d0/
108 !
109  p1p2=1/p2p1
110  szb=s/b
111 !
112 ! which table is to be used?
113 !
114  if(n.le.2) then
115 ! cd is interpolated in tcd1
116 !
117  nx=3
118  ny=22
119 ! interpolation in the 2d table.
120 !
121  call ident(szb1,szb,nx,idx)
122  call ident(reynlds1,reynolds,ny,idy)
123 !
124  if (idx.eq.0) then
125  if(idy.eq.0) then
126  cd_lab=tcd1(1,1)
127  else
128  if(idy.eq.ny) then
129  cd_lab=tcd1(1,ny)
130  else
131  cd_lab=tcd1(1,idy)+(tcd1(1,idy+1)-tcd1(1,idy))
132  & *(reynolds-reynlds1(idy))
133  & /(reynlds1(idy+1)-reynlds1(idy))
134  endif
135  endif
136 !
137  elseif(idx.ge.nx) then
138  if(idy.le.0) then
139  cd_lab=tcd1(nx,1)
140  else
141  if(idy.ge.ny) then
142  cd_lab=tcd1(nx,ny)
143  else
144  cd_lab=tcd1(nx,idy)+(tcd1(nx,idy+1)-tcd1(nx,idy))
145  & *(reynolds-reynlds1(idy))
146  & /(reynlds1(idy+1)-reynlds1(idy))
147  endif
148  endif
149  else
150  if(idy.le.0) then
151 
152  cd_lab=tcd1(idx,1)+(tcd1(idx+1,1)-tcd1(idx,1))
153  & *(szb-szb1(idx))/(szb1(idx+1)-szb1(idx))
154  elseif(idy.ge.ny) then
155  cd_lab=tcd1(idx,ny)+(tcd1(idx+1,ny)-tcd1(idx,ny))
156  & *(szb-szb1(idx))/(szb1(idx+1)-szb1(idx))
157  else
158  xi=(szb-szb1(idx))/(szb1(idx+1)-szb1(idx))
159  et=(reynolds-reynlds1(idy))/
160  & (reynlds1(idy+1)-reynlds1(idy))
161  z1=tcd1(idx,idy)
162  z2=tcd1(idx+1,idy)
163  z3=tcd1(idx,idy+1)
164  z4=tcd1(idx+1,idy+1)
165  cd_lab=(1-xi)*(1-et)*z1+(1-xi)*et*z3
166  & +xi*(1-et)*z2+xi*et*z4
167  endif
168  endif
169 !
170  else
171 ! cd is interpolated in tcd2
172 !
173  nx=3
174  ny=21
175 ! interpolation in the 2d table.
176 !
177  call ident(szb2,szb,nx,idx)
178  call ident(reynlds2,reynolds,ny,idy)
179 !
180  if (idx.eq.0) then
181  if(idy.eq.0) then
182  cd_lab=tcd2(1,1)
183  else
184  if(idy.eq.ny) then
185  cd_lab=tcd2(1,ny)
186  else
187  cd_lab=tcd2(1,idy)+(tcd2(1,idy+1)-tcd2(1,idy))
188  & *(reynolds-reynlds2(idy))
189  & /(reynlds2(idy+1)-reynlds2(idy))
190  endif
191  endif
192 !
193  elseif(idx.ge.nx) then
194  if(idy.le.0) then
195  cd_lab=tcd2(nx,1)
196  else
197  if(idy.ge.ny) then
198  cd_lab=tcd2(nx,ny)
199  else
200  cd_lab=tcd2(nx,idy)+(tcd2(nx,idy+1)-tcd2(nx,idy))
201  & *(reynolds-reynlds2(idy))
202  & /(reynlds2(idy+1)-reynlds2(idy))
203  endif
204  endif
205  else
206  if(idy.le.0) then
207 
208  cd_lab=tcd2(idx,1)+(tcd2(idx+1,1)-tcd2(idx,1))
209  & *(szb-szb2(idx))/(szb2(idx+1)-szb2(idx))
210  elseif(idy.ge.ny) then
211  cd_lab=tcd2(idx,ny)+(tcd2(idx+1,ny)-tcd2(idx,ny))
212  & *(szb-szb2(idx))/(szb2(idx+1)-szb2(idx))
213  else
214  xi=(szb-szb2(idx))/(szb2(idx+1)-szb2(idx))
215  et=(reynolds-reynlds2(idy))/
216  & (reynlds2(idy+1)-reynlds2(idy))
217  z1=tcd2(idx,idy)
218  z2=tcd2(idx+1,idy)
219  z3=tcd2(idx,idy+1)
220  z4=tcd2(idx+1,idy+1)
221  cd_lab=(1-xi)*(1-et)*z1+(1-xi)*et*z3
222  & +xi*(1-et)*z2+xi*et*z4
223  endif
224  endif
225 !
226  endif
227 !
228  return
ident
subroutine ident(x, px, n, id)
Definition: ident.f:26
z1
static double * z1
Definition: filtermain.c:48
Hosted by OpenAircraft.com, (Michigan UAV, LLC)