Airfoil

Description

The purpose of this Mathematica  Notebook is to show a method for displaying and analyzing airfoils, using ComplexMapPlot.m. This entire package is included at the end of this notebook.

Dan Cohen
Wolfram Research, Inc.

Symmetrical Joukowski Profile

The Joukowski class of profiles, although not used in practice, resemble some real profiles both geometrically and in respect to flow pattern.  Also, since their aerodynamic properties can be found relatively easily, they are suitable for analytic studies, the results of which are sometimes a useful guide to the characteristics of real profiles.

The transformation, z + 1/z, when applied to a circle with center on the a-axis and passing through the point (-1, 0) produces the Joukowski airfoil.

ComplexMapPlot[z + 1/z, z, {Circle[{0.25, 0}, 1.25]}];

We can now develop a range of profiles.  To show the profiles as a "movie",
double-click the first graphics cell below.

Do[
    ComplexMapPlot[
         z + 1/z, z, {Disk[{n, 0}, n + 1]},
         PlotRange -> {{-2, 3.5}, {-2, 2}}
    ],
    {n, 0, 1, 0.1}
]

Useful Airfoils

A functional airfoil must be nonsymmetrical.  Otherwise it would not develop the pressure difference across the top and bottom of the airfoil, which is responsible for lift.  To develop a more useful airfoil we will need to modify the Joukowski profile.  Moving the circle above or below  the horizontal axis should provide the asymmetry required.

Do[
    ComplexMapPlot[
         z + 1/z, z, {Disk[{0.3, n}, 0.3 + 1]},
         PlotRange -> {{-2, 3.5}, {-2, 2}}
    ],
    {n, -0.3, 0.3, 0.05}
]

Implementation

This Notebook makes use of a function that implements a sophisticated form of complex function mapping.  It is included in the book   Exploring Mathematics with Mathematica, Jerry Glynn and Theodore Gray, Addison-Wesley, 1991.

Preparation

Create the context representing the contents of this Notebook:

BeginPackage["ComplexMapPlot`"];
EndPackage[];

Load any needed packages:

Needs["Graphics`Colors`"];

Declare all the globally visible symbols:

MapGraphics;
RectangularGrid;
HorizontalLines;
VerticalLines;
PolarGrid;
PolarCircles;
PolarLines;
ComplexMapPlot;

PlotPoints;
IncludePreimage;

Begin private context:

Begin["ComplexMapPlot`Private`"];

Declare all the private symbols:

`pairToComplex;
`complexToPair;
`transformList;
`listParameter;
`transformCircle;
`MG0;

Definitions

MapGraphics

`parametricPlotOptions;

pairToComplex[{re_, im_}] = re + im I;

complexToPair[z_] = {Re[z], Im[z]};

transformList[f_, {min:{_, _}, max:{_, _}}] := 
	Module[
		{t, minz, deltaz},
		minz = pairToComplex[min];
		deltaz = pairToComplex[max] - minz;
		ParametricPlot[
			complexToPair[f[minz + t * deltaz]],
			{t, 0.0, 1.0},
			Release[parametricPlotOptions]
		][[1, 1, 1, 1]]
	]

transformList[f_, list_] := 
	Module[
		{t},
		ParametricPlot[
			complexToPair[f[pairToComplex[
				listParameter[
					t, 
					list
				]
			]]],
			{t, 0.0, 1.0},
			Release[parametricPlotOptions]
		][[1, 1, 1, 1]]
	]

listParameter[t_, {min_, max_}] := 
					min + t * (max - min);

listParameter[t_, list_] := Module[
	{parameter, length, startIndex, startPoint},
	length = Length[list];
	parameter = t (length - 1);
	startIndex = Floor[parameter] + 1;
	startPoint = list[[startIndex]];
	If[startIndex == length,
		startPoint,
	(*else*)
		startPoint + 
			(parameter - startIndex + 1) *
				(list[[startIndex + 1]] - startPoint)
	]
]

transformCircle[f_, center_, {rx_, ry_}, 
							{mint_, maxt_}] := 
	Module[
		{t, zcenter},
		zcenter = pairToComplex[center];
		ParametricPlot[
			complexToPair[f[
				rx Cos[t] + I ry Sin[t] + zcenter
			]],
			{t, N[mint], N[maxt]},
			Release[parametricPlotOptions]
		][[1, 1, 1, 1]]
	]

MapGraphics[Graphics[list_List, opts___], 
								f_, options___] :=
	(
	parametricPlotOptions = 
		Join[{DisplayFunction -> Identity}, options];
	Graphics[ MG0[list, f], opts ]
	)

MG0[d_List, f_] := Map[ MG0[#, f]& , d ]

MG0[Point[d_List], f_] := 
	Point[complexToPair[f[pairToComplex[d]]]]

MG0[Line[d_List], f_] := Line[transformList[f, d]]

MG0[Rectangle[{xmin_, ymin_}, {xmax_, ymax_}], f_] :=
	MG0[Polygon[{
		{xmin,ymin}, 
		{xmin,ymax}, 
		{xmax, ymax}, 
		{xmax, ymin}
	}], f]

MG0[Polygon[d_List]] := 
	MG0[Polygon[Join[d, First[d]]]] /; 
							First[d] =!= Last[d]

MG0[Polygon[d_List], f_] := 
	Polygon[transformList[f, d]]

MG0[Circle[center_List, r_?NumberQ], f_] :=
	Line[transformCircle[
			f, center, {r, r}, {0, 2Pi}]]

MG0[Circle[center_List, r_?List], f_] :=
	Line[transformCircle[f, center, r, {0, 2Pi}]]

MG0[Circle[center_List, 
				r_?NumberQ, range_List], f_] :=
	Line[transformCircle[f, center, {r, r}, range]]

MG0[Circle[center_List, r_?List, range_List], f_] :=
	Line[transformCircle[f, center, r, range]]

MG0[Disk[center_List, r_?NumberQ], f_] :=
	Polygon[transformCircle[
			f, center, {r, r}, {0, 2Pi}]]

MG0[Disk[center_List, r_?List], f_] :=
	Polygon[transformCircle[f, center, r, {0, 2Pi}]]

MG0[Disk[center_List, r_?NumberQ, range_List], f_] :=
	Polygon[transformCircle[
			f, center, {r, r}, range]]

MG0[Disk[center_List, r_?List, range_List], f_] :=
	Polygon[transformCircle[f, center, r, range]]

MG0[CellArray[array_, 
		range_List:{{0,0}, {1,1}}, zrange___], f_] := 
	CellArray[
		array, 
		{
			complexToPair[
				f[pairToComplex[First[range]]]],
			complexToPair[
				f[pairToComplex[Last[range]]]]
		},
		zrange
	]

MG0[Text[expr_, d_List, opts___], f_] := 
	Text[expr, 
		complexToPair[f[pairToComplex[d]]], opts]

MG0[expr_, f_] := expr

RectangularGrid

Options[RectangularGrid] = 
	{
		PlotPoints -> 14
	};

RectangularGrid[{{Remin_, Remax_}, {Immin_, Immax_}}, 
				options___] := Module[
	{plotPoints, n, x},
	
	(* Extract options *)
	{plotPoints} = {PlotPoints} /. 
			{options} /. Options[RectangularGrid];
	
	If[Head[plotPoints] =!= List,
		plotPoints = {plotPoints, plotPoints}
	];
	
	{
	GrayLevel[0.5],
	VerticalLines[{{Remin, Remax}, {Immin, Immax}}, 
			PlotPoints -> plotPoints[[1]], options],
	GrayLevel[0.0],
	HorizontalLines[{{Remin, Remax}, {Immin, Immax}}, 
			PlotPoints -> plotPoints[[1]], options]
	}
]

VerticalLines

Options[VerticalLines] = 
	{
		PlotPoints -> 14
	};

VerticalLines[{{Remin_, Remax_}, {Immin_, Immax_}}, 
				options___] := Module[
	{plotPoints, n, x},
	
	(* Extract options *)
	{plotPoints} = {PlotPoints} /. 
			{options} /. Options[VerticalLines];
	
	Table[
		x = Remin + 
				(Remax - Remin) (n-1)/(plotPoints-1);
		Line[N[{{x, Immin}, {x, Immax}}]],
		{n, 1, plotPoints}
	]
]

HorizontalLines

Options[HorizontalLines] = 
	{
		PlotPoints -> 14
	};

HorizontalLines[{{Remin_, Remax_}, {Immin_, Immax_}}, 
				options___] := 
Module[
	{plotPoints, n, x},
	
	(* Extract options *)
	{plotPoints} = {PlotPoints} /. 
			{options} /. Options[HorizontalLines];
	
	Table[
		x = Immin + 
				(Immax - Immin) (n-1)/(plotPoints-1);
		Line[N[{{Remin, x}, {Remax, x}}]],
		{n, 1, plotPoints}
	]
]

PolarGrid

Options[PolarGrid] = 
	{
		PlotPoints -> 14
	};

PolarGrid[center:{_, _}, radius_, options___] := 
Module[
	{
		plotPoints, 
		ncenter, nradius, n, t,
	},
	
	(* Extract options *)
	{plotPoints} = {PlotPoints}
			/. {options} /. Options[PolarGrid];
	
	If[Head[plotPoints] =!= List,
		plotPoints = {plotPoints, plotPoints}
	];
	
	{
		GrayLevel[0.5],
		PolarLines[center, radius, 
			PlotPoints -> plotPoints[[2]], options],
		GrayLevel[0.0],
		PolarCircles[center, radius, 
			PlotPoints -> plotPoints[[1]], options]
	}
]

PolarCircles

Options[PolarCircles] = 
	{
		PlotPoints -> 14
	};

PolarCircles[center:{_, _}, radius_, options___] := 
Module[
	{
		plotPoints, 
		nradius, ncenter, n, t,
		minradius, deltaradius
	},
	
	(* Extract options *)
	{plotPoints} = {PlotPoints}
			/. {options} /. Options[PolarCircles];
	
	ncenter = N[center];
	nradius = N[radius];
	If[Head[nradius] =!= List, nradius = {0, nradius}];
	minradius = N[nradius[[1]]];
	deltaradius = N[nradius[[2]] - minradius];
	
	Table[
		Circle[ncenter, minradius + 
				deltaradius (n-1)/(plotPoints-1)],
		{n, 1, plotPoints}
	]
]

PolarLines

Options[PolarLines] = 
	{
		PlotPoints -> 14
	};

PolarLines[center:{_, _}, radius_, options___] := 
Module[
	{
		plotPoints, 
		nradius, ncenter, n, t,
		minradius, maxradius
	},
	
	(* Extract options *)
	{plotPoints} = {PlotPoints}
			/. {options} /. Options[PolarLines];
	
	ncenter = N[center];
	nradius = N[radius];
	If[Head[nradius]=!=List, nradius = {0, nradius}];
	minradius = N[nradius[[1]]];
	maxradius = N[nradius[[2]]];
	
	Table[
		t = 2Pi n / plotPoints;
		Line[{
			ncenter + minradius N[{Cos[t], Sin[t]}], 
			ncenter + maxradius N[{Cos[t], Sin[t]}]
		}],
		{n, 1, plotPoints}
	]
]

ComplexMapPlot

Clear[ComplexMapPlot];

Options[ComplexMapPlot] = 
	{
		AspectRatio -> Automatic,
		Axes -> Automatic,
		IncludePreimage -> True,
		Prolog -> {},
		Epilog -> {}
	};

ComplexMapPlot[f_, var_, 
			Graphics[domain_, ___], options___] :=
	ComplexMapPlot[f, var, domain, options];

ComplexMapPlot[f_, var_, domain_, options___] := 
Module[
	{output, mapOptions, showOptions, 
	 includePreimage},
	
	{includePreimage} = {IncludePreimage} /. 
				{options} /. 
				Options[ComplexMapPlot];
	
	mapOptions = Select[
		Join[{options}, Options[ComplexMapPlot]], 
		(
			   !FreeQ[#, PlotPoints]
			|| !FreeQ[#, PlotDivision]
			|| !FreeQ[#, MaxBend]
		)&
	];
	
	showOptions = Select[
		Join[{options}, Options[ComplexMapPlot]], 
		(
			   FreeQ[#, PlotPoints]
			&& FreeQ[#, PlotDivision]
			&& FreeQ[#, MaxBend]
			&& FreeQ[#, Prolog]
			&& FreeQ[#, Epilog]
			&& FreeQ[#, IncludePreimage]
		)&
	];
	
	output = Map[First,
		Map[
			Function[ff, MapGraphics[
				Graphics[{domain}], 
				Function[var2, ff /. var -> var2], 
				mapOptions
			]],
			Flatten[{f}]
		]];
	{prolog, epilog} = {Prolog, Epilog} /. {options} /. Options[ComplexMapPlot];
	
	If[TrueQ[includePreimage],
		Show[
			Graphics[{
				Rectangle[{0,   0}, {1,   1}, 
					Graphics[{domain}, showOptions]],
				Rectangle[{1.1, 0}, {2.1, 1}, 
					Graphics[{prolog, output, epilog}, 
							showOptions]]
			}],
			Axes -> None, 
			PlotRange -> {{0, 2.1}, {0, 1}}, 
			showOptions
		],
		Show[
			Graphics[{output, epilog}], 
			showOptions
		]
	]
]

Finish

End private context:

End[];