diff --git a/LICENSE b/LICENSE index 3912109..2c66374 100644 --- a/LICENSE +++ b/LICENSE @@ -1,340 +1,21 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. +MIT License + +Copyright (c) 2020 Taylor McDonnell and contributors + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Project.toml b/Project.toml index 23b542a..e5a7c6b 100644 --- a/Project.toml +++ b/Project.toml @@ -1,15 +1,8 @@ name = "Xfoil" uuid = "19641d66-a62d-11e8-2441-8f57a969a9c4" authors = ["Taylor McDonnell "] -version = "0.1.0" +version = "0.3.0" [deps] -BinDeps = "9e28174c-4ba2-5203-b857-d8d62c4213ee" -Libdl = "8f399da3-3557-5675-b5ff-fb832c97cbdb" +xfoil_light_jll = "70cc596b-f351-5640-b155-76ddf0ff62ca" Printf = "de0858da-6303-5e67-8744-51eddeeeb8d7" - -[extras] -Test = "8dfed614-e22c-5e08-85e1-65c5234f0b40" - -[targets] -test = ["Test"] diff --git a/deps/build.jl b/deps/build.jl deleted file mode 100644 index 18380ce..0000000 --- a/deps/build.jl +++ /dev/null @@ -1,32 +0,0 @@ -using BinDeps - -@BinDeps.setup - -libxfoil = library_dependency("libxfoil") -libxfoil_cs = library_dependency("libxfoil_cs") - -installdir=joinpath(BinDeps.depsdir(libxfoil),"usr","lib") -xfoilsrc = joinpath(BinDeps.depsdir(libxfoil),"src","xfoil") -xfoilsrc_cs = joinpath(BinDeps.depsdir(libxfoil),"src","xfoil_cs") - -if !isfile(installdir) - mkpath(installdir) -end - -suffix = Sys.isapple() ? "dylib" : "so" - -provides(SimpleBuild, - (@build_steps begin - ChangeDirectory(xfoilsrc) - `make SUFFIX=$suffix` - `make -j1 install INSTALL_DIR=$installdir SUFFIX=$suffix` - end),libxfoil, os = :Unix) - -provides(SimpleBuild, - (@build_steps begin - ChangeDirectory(xfoilsrc_cs) - `make SUFFIX=$suffix` - `make -j1 install INSTALL_DIR=$installdir SUFFIX=$suffix` - end),libxfoil_cs, os = :Unix) - -@BinDeps.install Dict(:libxfoil => :libxfoil,:libxfoil_cs => :libxfoil_cs) diff --git a/deps/src/xfoil/LICENSE b/deps/src/xfoil/LICENSE deleted file mode 100644 index 3912109..0000000 --- a/deps/src/xfoil/LICENSE +++ /dev/null @@ -1,340 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/deps/src/xfoil/Makefile b/deps/src/xfoil/Makefile deleted file mode 100644 index 18ebaed..0000000 --- a/deps/src/xfoil/Makefile +++ /dev/null @@ -1,50 +0,0 @@ -#********************************************************* -# Makefile for XFOIL V6.93 programs -# H.Youngren 4/24/01 -# M.Drela -#********************************************************* -RM = /bin/rm -rf -FC = gfortran -FFLAGS = -O3 -fdefault-real-8 -fPIC -shared -LIB = libxfoil -SUFFIX = so - -OBJ = xfoil.o\ - xpanel.o\ - xoper.o\ - xsolve.o\ - xgdes.o\ - xbl.o\ - xblsys.o\ - xgeom.o\ - xutils.o\ - aread.o\ - userio.o\ - spline.o\ - naca.o\ - xdriver.o - -default: libxfoil - -clean: - $(RM) *.o $(LIB).$(SUFFIX) - -libxfoil: $(OBJ) - $(FC) -O3 -shared -fPIC -o $(LIB).$(SUFFIX) $(OBJ) - -.SUFFIXES: .o .f .f90 - -%.o : %.f - $(FC) $(FFLAGS) -c $< -o $*.o - @echo - @echo " --- Compiled $*.f successfully ---" - @echo - -%.o : %.f90 - $(FC) $(FFLAGS) -c $< -o $*.o - @echo - @echo " --- Compiled $*.f90 successfully ---" - @echo - -install: - install $(LIB).$(SUFFIX) $(INSTALL_DIR) diff --git a/deps/src/xfoil/XBL.INC b/deps/src/xfoil/XBL.INC deleted file mode 100644 index 200c9f4..0000000 --- a/deps/src/xfoil/XBL.INC +++ /dev/null @@ -1,77 +0,0 @@ -C - PARAMETER (NCOM=73) - REAL COM1(NCOM), COM2(NCOM) - REAL M1, M1_U1, M1_MS, M2, M2_U2, M2_MS - LOGICAL SIMI,TRAN,TURB,WAKE - LOGICAL TRFORC,TRFREE -C -C- SCCON = shear coefficient lag constant -C- GACON = G-beta locus constants... -C- GBCON = G = GACON * sqrt(1.0 + GBCON*beta) -C- GCCON = + GCCON / [H*Rtheta*sqrt(Cf/2)] <-- wall term -C- DLCON = wall/wake dissipation length ratio Lo/L -C- CTCON = Ctau weighting coefficient (implied by G-beta constants) -C - PARAMETER (SCCON = 5.6 , - & GACON = 6.70 , - & GBCON = 0.75 , - & GBC0 = 0.60, - & GBC1 = 0.40, - & GCCON = 18.0 , - & DLCON = 0.9 ) - PARAMETER (CTCON = 0.5/(GACON**2 * GBCON)) -C - COMMON/VAR1/ X1, U1, T1, D1, S1, AMPL1, U1_UEI, U1_MS, DW1 - & , H1, H1_T1, H1_D1 - & , M1, M1_U1, M1_MS - & , R1, R1_U1, R1_MS - & , V1, V1_U1, V1_MS, V1_RE - & , HK1, HK1_U1, HK1_T1, HK1_D1, HK1_MS - & , HS1, HS1_U1, HS1_T1, HS1_D1, HS1_MS, HS1_RE - & , HC1, HC1_U1, HC1_T1, HC1_D1, HC1_MS - & , RT1, RT1_U1, RT1_T1, RT1_MS, RT1_RE - & , CF1, CF1_U1, CF1_T1, CF1_D1, CF1_MS, CF1_RE - & , DI1, DI1_U1, DI1_T1, DI1_D1, DI1_S1, DI1_MS, DI1_RE - & , US1, US1_U1, US1_T1, US1_D1, US1_MS, US1_RE - & , CQ1, CQ1_U1, CQ1_T1, CQ1_D1, CQ1_MS, CQ1_RE - & , DE1, DE1_U1, DE1_T1, DE1_D1, DE1_MS - COMMON/VAR2/ X2, U2, T2, D2, S2, AMPL2, U2_UEI, U2_MS, DW2 - & , H2, H2_T2, H2_D2 - & , M2, M2_U2, M2_MS - & , R2, R2_U2, R2_MS - & , V2, V2_U2, V2_MS, V2_RE - & , HK2, HK2_U2, HK2_T2, HK2_D2, HK2_MS - & , HS2, HS2_U2, HS2_T2, HS2_D2, HS2_MS, HS2_RE - & , HC2, HC2_U2, HC2_T2, HC2_D2, HC2_MS - & , RT2, RT2_U2, RT2_T2, RT2_MS, RT2_RE - & , CF2, CF2_U2, CF2_T2, CF2_D2, CF2_MS, CF2_RE - & , DI2, DI2_U2, DI2_T2, DI2_D2, DI2_S2, DI2_MS, DI2_RE - & , US2, US2_U2, US2_T2, US2_D2, US2_MS, US2_RE - & , CQ2, CQ2_U2, CQ2_T2, CQ2_D2, CQ2_MS, CQ2_RE - & , DE2, DE2_U2, DE2_T2, DE2_D2, DE2_MS - EQUIVALENCE (X1,COM1(1)), (X2,COM2(1)) -C - COMMON/VARA/ CFM, CFM_MS, CFM_RE - & , CFM_U1, CFM_T1, CFM_D1 - & , CFM_U2, CFM_T2, CFM_D2 - & , XT, XT_A1, XT_MS, XT_RE, XT_XF - & , XT_X1, XT_T1, XT_D1, XT_U1 - & , XT_X2, XT_T2, XT_D2, XT_U2 -C -C - COMMON/SAV/ C1SAV(NCOM), C2SAV(NCOM) -C - COMMON/VAR/ DWTE - & , QINFBL - & , TKBL , TKBL_MS - & , RSTBL , RSTBL_MS - & , HSTINV, HSTINV_MS - & , REYBL , REYBL_MS, REYBL_RE - & , GAMBL, GM1BL, HVRAT - & , BULE, XIFORC, AMCRIT - & , SIMI,TRAN,TURB,WAKE - & , TRFORC,TRFREE -C - COMMON/SYS/ VS1(4,5),VS2(4,5),VSREZ(4),VSR(4),VSM(4),VSX(4) -C - diff --git a/deps/src/xfoil/XFOIL.INC b/deps/src/xfoil/XFOIL.INC deleted file mode 100644 index 42dfa33..0000000 --- a/deps/src/xfoil/XFOIL.INC +++ /dev/null @@ -1,570 +0,0 @@ -C -C==== XFOIL code global INCLUDE file ===== -C -C------ Primary dimensioning limit parameters -C IQX number of surface panel nodes + 6 -C IWX number of wake panel nodes -C IPX number of Qspec(s) distributions -C ISX number of airfoil sides -C -C------ Derived dimensioning limit parameters -C IBX number of buffer airfoil nodes -C IMX number of complex mapping coefficients Cn -C IZX number of panel nodes (airfoil + wake) -C IVX number of nodes along BL on one side of airfoil and wake -C NAX number of points in stored polar -C NPX number of polars and reference polars -C NFX number of points in one reference polar -C NTX number of points in thickness/camber arrays -C - PARAMETER (IQX=286, IWX=36, IPX=5, ISX=2) - PARAMETER (IBX=572) - PARAMETER (IZX=322) - PARAMETER (IVX=229) - PARAMETER (NAX=800,NPX=8,NFX=128) - CHARACTER*32 LABREF - CHARACTER*64 FNAME, PFNAME, PFNAMX, ONAME, PREFIX - CHARACTER*48 NAME, NAMEPOL, CODEPOL, NAMEREF - CHARACTER*80 ISPARS - LOGICAL OK,LIMAGE, - & LGAMU,LQINU,SHARP,LVISC,LALFA,LWAKE,LPACC, - & LBLINI,LIPAN,LQAIJ,LADIJ,LWDIJ,LCPXX,LQVDES,LQREFL, - & LQSPEC,LVCONV,LCPREF,LCLOCK,LPFILE,LPFILX,LPPSHO, - & LBFLAP,LFLAP,LEIW,LSCINI,LFOREF,LNORM,LGSAME, - & LPLCAM, LQSYM ,LGSYM , LQGRID, LGGRID, LGTICK, - & LQSLOP,LGSLOP, LCSLOP, LQSPPL, LGEOPL, LGPARM, - & LCPGRD,LBLGRD, LBLSYM, LCMINP, LHMOMP - LOGICAL LPLOT,LSYM,LIQSET,LCLIP,LVLAB,LCURS,LLAND - LOGICAL LPGRID, LPCDW, LPLIST, LPLEGN - LOGICAL TFORCE - REAL NX, NY, MASS, MINF1, MINF, MINF_CL, MVISC, MACHP1 - INTEGER RETYP, MATYP, AIJPIV - CHARACTER*1 VMXBL - - REAL W1(6*IQX),W2(6*IQX),W3(6*IQX),W4(6*IQX), - & W5(6*IQX),W6(6*IQX),W7(6*IQX),W8(6*IQX) - REAL BIJ(IQX,IZX), CIJ(IWX,IQX) - - COMMON/CR01/ VERSION - COMMON/CC01/ FNAME, - & NAME,ISPARS,ONAME,PREFIX, - & PFNAME(NPX),PFNAMX(NPX), - & NAMEPOL(NPX), CODEPOL(NPX), - & NAMEREF(NPX) - COMMON/QMAT/ Q(IQX,IQX),DQ(IQX), - & DZDG(IQX),DZDN(IQX),DZDM(IZX), - & DQDG(IQX),DQDM(IZX),QTAN1,QTAN2, - & Z_QINF,Z_ALFA,Z_QDOF0,Z_QDOF1,Z_QDOF2,Z_QDOF3 - COMMON/CR03/ AIJ(IQX,IQX),DIJ(IZX,IZX) - COMMON/CR04/ QINV(IZX),QVIS(IZX),CPI(IZX),CPV(IZX), - & QINVU(IZX,2), QINV_A(IZX) - COMMON/CR05/ X(IZX),Y(IZX),XP(IZX),YP(IZX),S(IZX), - & SLE,XLE,YLE,XTE,YTE,CHORD,YIMAGE, - & WGAP(IWX),WAKLEN - COMMON/CR06/ GAM(IQX),GAMU(IQX,2),GAM_A(IQX),SIG(IZX), - & NX(IZX),NY(IZX),APANEL(IZX), - & SST,SST_GO,SST_GP, - & GAMTE,GAMTE_A, - & SIGTE,SIGTE_A, - & DSTE,ANTE,ASTE - COMMON/CR07/ SSPLE, - & SSPEC(IBX),XSPOC(IBX),YSPOC(IBX), - & QGAMM(IBX), - & QSPEC(IBX,IPX),QSPECP(IBX,IPX), - & ALGAM,CLGAM,CMGAM, - & ALQSP(IPX),CLQSP(IPX),CMQSP(IPX), - & QF0(IQX),QF1(IQX),QF2(IQX),QF3(IQX), - & QDOF0,QDOF1,QDOF2,QDOF3,CLSPEC,FFILT - COMMON/CI01/ IQ1,IQ2,NSP,NQSP,KQTARG,IACQSP,NC1,NNAME,NPREFIX - COMMON/CR09/ ADEG,ALFA,AWAKE,MVISC,AVISC, - & XCMREF,YCMREF, - & CL,CM,CD,CDP,CDF,CL_ALF,CL_MSQ, - & PSIO,CIRC,COSA,SINA,QINF, - & GAMMA,GAMM1, - & MINF1,MINF,MINF_CL,TKLAM,TKL_MSQ,CPSTAR,QSTAR, - & CPMN,CPMNI,CPMNV,XCPMNI,XCPMNV - COMMON/CI03/ NCPREF, NAPOL(NPX), NPOL, IPACT, NLREF, - & ICOLP(NPX),ICOLR(NPX), - & IMATYP(NPX),IRETYP(NPX), NXYPOL(NPX), - & NPOLREF, NDREF(4,NPX) - COMMON/CR10/ XPREF(IQX),CPREF(IQX), VERSPOL(NPX), - & CPOLXY(IQX,2,NPX), - & MACHP1(NPX), - & REYNP1(NPX), - & ACRITP(NPX),XSTRIPP(ISX,NPX) - - COMMON/CC02/ LABREF - - COMMON/CR11/ PI,HOPI,QOPI,DTOR - COMMON/CR12/ CVPAR,CTERAT,CTRRAT,XSREF1,XSREF2,XPREF1,XPREF2 - COMMON/CI04/ N,NB,NW,NPAN,IST,KIMAGE, - & ITMAX,NSEQEX,RETYP,MATYP,AIJPIV(IQX), - & IDEV,IDEVRP,IPSLU,NCOLOR, - & ICOLS(ISX),NOVER, NCM,NTK - COMMON/CR13/ SIZE,SCRNFR,PLOTAR, PFAC,QFAC,VFAC, - & XWIND,YWIND, - & XPAGE,YPAGE,XMARG,YMARG, - & CH, CHG, CHQ, - & XOFAIR,YOFAIR,FACAIR, XOFA,YOFA,FACA,UPRWT, - & CPMIN,CPMAX,CPDEL, - & CPOLPLF(3,4), - & XCDWID,XALWID,XOCWID - COMMON/CL01/ OK,LIMAGE,SHARP, - & LGAMU,LQINU,LVISC,LALFA,LWAKE,LPACC, - & LBLINI,LIPAN,LQAIJ,LADIJ,LWDIJ,LCPXX,LQVDES,LQREFL, - & LQSPEC,LVCONV,LCPREF,LCLOCK,LPFILE,LPFILX,LPPSHO, - & LBFLAP,LFLAP,LEIW,LSCINI,LFOREF,LNORM,LGSAME, - & LPLCAM,LQSYM ,LGSYM, - & LQGRID,LGGRID,LGTICK, - & LQSLOP,LGSLOP,LCSLOP,LQSPPL,LGEOPL,LGPARM, - & LCPGRD,LBLGRD,LBLSYM, - & LPLOT,LSYM,LIQSET,LCLIP,LVLAB,LCURS,LLAND, - & LPGRID,LPCDW,LPLIST,LPLEGN, - & LCMINP, LHMOMP - COMMON/CR14/ XB(IBX),YB(IBX), - & XBP(IBX),YBP(IBX),SB(IBX),SNEW(4*IBX), - & XBF,YBF,XOF,YOF,HMOM,HFX,HFY, - & XBMIN,XBMAX,YBMIN,YBMAX, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB, - & XCM(2*IBX),YCM(2*IBX),SCM(2*IBX),XCMP(2*IBX),YCMP(2*IBX), - & XTK(2*IBX),YTK(2*IBX),STK(2*IBX),XTKP(2*IBX),YTKP(2*IBX) - - COMMON/CR15/ XSSI(IVX,ISX),UEDG(IVX,ISX),UINV(IVX,ISX), - & MASS(IVX,ISX),THET(IVX,ISX),DSTR(IVX,ISX), - & CTAU(IVX,ISX),DELT(IVX,ISX),USLP(IVX,ISX), - & GUXQ(IVX,ISX),GUXD(IVX,ISX), - & TAU(IVX,ISX),DIS(IVX,ISX),CTQ(IVX,ISX), - & VTI(IVX,ISX), - & REINF1,REINF,REINF_CL,ACRIT, - & XSTRIP(ISX),XOCTR(ISX),YOCTR(ISX),XSSITR(ISX), - & UINV_A(IVX,ISX) - COMMON/CI05/ IBLTE(ISX),NBL(ISX),IPAN(IVX,ISX),ISYS(IVX,ISX),NSYS, - & ITRAN(ISX) - COMMON/CL02/ TFORCE(ISX) - COMMON/CR17/ RMSBL,RMXBL,RLX,VACCEL - COMMON/CI06/ IMXBL,ISMXBL - COMMON/CC03/ VMXBL - COMMON/CR18/ XSF,YSF,XOFF,YOFF, - & XGMIN,XGMAX,YGMIN,YGMAX,DXYG, - & XCMIN,XCMAX,YCMIN,YCMAX,DXYC,DYOFFC, - & XPMIN,XPMAX,YPMIN,YPMAX,DXYP,DYOFFP, - & YSFP,GTICK - COMMON/VMAT/ VA(3,2,IZX),VB(3,2,IZX),VDEL(3,2,IZX), - & VM(3,IZX,IZX),VZ(3,2) - EQUIVALENCE (Q(1,1 ),W1(1)), (Q(1,7 ),W2(1)), - & (Q(1,13),W3(1)), (Q(1,19),W4(1)), - & (Q(1,25),W5(1)), (Q(1,31),W6(1)), - & (Q(1,37),W7(1)), (Q(1,43),W8(1)) - EQUIVALENCE (VM(1,1,1),BIJ(1,1)), (VM(1,1,IZX/2),CIJ(1,1)) - -C -C -C VERSION version number of this XFOIL implementation -C -C FNAME airfoil data filename -C PFNAME(.) polar append filename -C PFNAMX(.) polar append x/c dump filename -C ONAME default overlay airfoil filename -C PREFIX default filename prefix -C OCNAME default Cp(x) overlay filename -C NAME airfoil name -C -C ISPARS ISES domain parameters (not used in XFOIL) -C -C Q(..) generic coefficient matrix -C DQ(.) generic matrix righthand side -C -C DZDG(.) dPsi/dGam -C DZDN(.) dPsi/dn -C DZDM(.) dPsi/dSig -C -C DQDG(.) dQtan/dGam -C DQDM(.) dQtan/dSig -C QTAN1 Qtan at alpha = 0 deg. -C QTAN2 Qtan at alpha = 90 deg. -C -C Z_QINF dPsi/dQinf -C Z_ALFA dPsi/dalfa -C Z_QDOF0 dPsi/dQdof0 -C Z_QDOF1 dPsi/dQdof1 -C Z_QDOF2 dPsi/dQdof2 -C Z_QDOF3 dPsi/dQdof3 -C -C AIJ(..) dPsi/dGam influence coefficient matrix (factored if LQAIJ=t) -C BIJ(..) dGam/dSig influence coefficient matrix -C CIJ(..) dQtan/dGam influence coefficient matrix -C DIJ(..) dQtan/dSig influence coefficient matrix -C QINV(.) tangential velocity due to surface vorticity -C QVIS(.) tangential velocity due to surface vorticity & mass sources -C QINVU(..) QINV for alpha = 0, 90 deg. -C QINV_A(.) dQINV/dalpha -C -C X(.),Y(.) airfoil (1panel pointers IPAN have been calculated -C LQAIJ .TRUE. if dPsi/dGam matrix has been computed and factored -C LADIJ .TRUE. if dQ/dSig matrix for the airfoil has been computed -C LWDIJ .TRUE. if dQ/dSig matrix for the wake has been computed -C LQVDES .TRUE. if viscous Ue is to be plotted in QDES routines -C LQSPEC .TRUE. if Qspec has been initialized -C LQREFL .TRUE. if reflected Qspec is to be plotted in QDES routines -C LVCONV .TRUE. if converged BL solution exists -C LCPREF .TRUE. if reference data is to be plotted on Cp vs x/c plots -C LCLOCK .TRUE. if source airfoil coordinates are clockwise -C LPFILE .TRUE. if polar file is ready to be appended to -C LPFILX .TRUE. if polar dump file is ready to be appended to -C LPPSHO .TRUE. if CL-CD polar is plotted during point sequence -C LBFLAP .TRUE. if buffer airfoil flap parameters are defined -C LFLAP .TRUE. if current airfoil flap parameters are defined -C LEIW .TRUE. if unit circle complex number array is initialized -C LSCINI .TRUE. if old-airfoil circle-plane arc length s(w) exists -C LFOREF .TRUE. if CL,CD... data is to be plotted on Cp vs x/c plots -C LNORM .TRUE. if input buffer airfoil is to be normalized -C LGSAME .TRUE. if current and buffer airfoils are identical -C LDCPLOT .TRUE. if delta(Cp) plot is to be plotted in CAMB menu -C -C LPLCAM .TRUE. if thickness and camber are to be plotted -C LQSYM .TRUE. if symmetric Qspec will be enforced -C LGSYM .TRUE. if symmetric geometry will be enforced -C LQGRID .TRUE. if grid is to overlaid on Qspec(s) plot -C LGGRID .TRUE. if grid is to overlaid on buffer airfoil geometry plot -C LGTICK .TRUE. if node tick marks are to be plotted on buffer airfoil -C LQSLOP .TRUE. if modified Qspec(s) segment is to match slopes -C LGSLOP .TRUE. if modified geometry segment is to match slopes -C LCSLOP .TRUE. if modified camber line segment is to match slopes -C LQSPPL .TRUE. if current Qspec(s) in in plot -C LGEOPL .TRUE. if current geometry in in plot -C LCPGRD .TRUE. if grid is to be plotted on Cp plots -C LBLGRD .TRUE. if grid is to be plotted on BL variable plots -C LBLSYM .TRUE. if symbols are to be plotted on BL variable plots -C LCMINP .TRUE. if min Cp is to be written to polar file for cavitation -C LHMOMP .TRUE. if hinge moment is to be written to polar file -C LFREQP .TRUE. if individual TS-wave frequencies are to be plotted -C -C LPGRID .TRUE. if polar grid overlay is enabled -C LPCDW .TRUE. if polar CDwave is plotted -C LPLIST .TRUE. if polar listing lines (at top of plot) are enabled -C LPLEGN .TRUE. if polar legend is enabled -C -C LPLOT .TRUE. if plot page is open -C LSYM .TRUE. if symbols are to be plotted in QDES routines -C LIQSET .TRUE. if inverse target segment is marked off in QDES -C LCLIP .TRUE. if line-plot clipping is to be performed -C LVLAB .TRUE. if label is to be plotted on viscous-variable plots -C LCURS .TRUE. if cursor input is to be used for blowups, etc. -C LLAND .TRUE. if Landscape orientation for PostScript is used -C -C -C XB(.),YB(.) buffer airfoil coordinate arrays -C XBP(.) dXB/dSB -C YBP(.) dYB/dSB -C SB(.) spline parameter for buffer airfoil -C SNEW(.) new panel endpoint arc length array -C -C XBF,YBF buffer airfoil flap hinge coordinates -C XOF,YOF current airfoil flap hinge coordinates -C HMOM moment of flap about hinge point -C HFX x-force of flap on hinge point -C HFY y-force of flap on hinge point -C -C~~~~~~~~~~~~~~ properties of current buffer airfoil -C -C XBMIN,XBMAX limits of XB array -C YBMIN,YBMAX limits of YB array -C SBLE LE tangency-point SB location -C CHORDB chord -C AREAB area -C RADBLE LE radius -C ANGBTE TE angle (rad) -C -C EI11BA bending inertia about axis 1 x^2 dx dy -C EI22BA bending inertia about axis 2 y^2 dx dy -C APX1BA principal axis 1 angle -C APX2BA principal axis 2 angle -C -C EI11BT bending inertia about axis 1 x^2 t ds -C EI22BT bending inertia about axis 2 y^2 t ds -C APX1BT principal axis 1 angle -C APX2BT principal axis 2 angle -C -C THICKB max thickness -C CAMBRB max camber -C -C~~~~~~~~~~~~~~ -C -C XSSI(..) BL arc length coordinate array on each surface -C UEDG(..) BL edge velocity array -C UINV(..) BL edge velocity array without mass defect influence -C MASS(..) BL mass defect array ( = UEDG*DSTR ) -C THET(..) BL momentum thickness array -C DSTR(..) BL displacement thickness array -C TSTR(..) BL kin. energy thickness array -C CTAU(..) sqrt(max shear coefficient) array -C (in laminar regions, log of amplification ratio) -C -C TAU(..) wall shear stress array (for plotting only) -C DIS(..) dissipation array (for plotting only) -C CTQ(..) sqrt(equilibrium max shear coefficient) array ( " ) -C VTI(..) +/-1 conversion factor between panel and BL variables -C UINV_A(..) dUINV/dalfa array -C -C REINF1 Reynolds number Vinf c / ve for CL=1 -C REINF Reynolds number for current CL -C REINF_CL dREINF/dCL -C -C ACRIT log (critical amplification ratio) -C XSTRIP(.) transition trip x/c locations (if XTRIP > 0), -C transition trip -s/s_side locations (if XTRIP < 0), -C XOCTR(.) actual transition x/c locations -C YOCTR(.) actual transition y/c locations -C XSSITR(.) actual transition xi locations -C -C IXBLP = 1 plot BL variables vs x -C = 2 plot BL variables vs s -C IBLTE(.) BL array index at trailing edge -C NBL(.) max BL array index -C IPAN(..) panel index corresponding to BL location -C ISYS(..) BL Newton system line number corresponding to BL location -C NSYS total number of lines in BL Newton system -C ITRAN(.) BL array index of transition interval -C TFORCE(.) .TRUE. if transition is forced due to transition strip -C TINDEX(.) -C -C IDAMP = 0 use original enelope e^n f(H,Rtheta) for all profiles -C = 1 use modified enelope e^n f(H,Rtheta) for separating profile -C -C VA,VB(...) diagonal and off-diagonal blocks in BL Newton system -C VZ(..) way-off-diagonal block at TE station line -C VM(...) mass-influence coefficient vectors in BL Newton system -C VDEL(..) residual and solution vectors in BL Newton system -C -C RMSBL rms change from BL Newton system solution -C RMXBL max change from BL Newton system solution -C IMXBL location of max change -C ISMXBL index of BL side containing max change -C VMXBL character identifying variable with max change -C RLX underrelaxation factor for Newton update -C VACCEL parameter for accelerating BL Newton system solution -C (any off-diagonal element < VACCEL is not eliminated, -C which speeds up each iteration, but MAY increase -C iteration count) -C Can be set to zero for unadulterated Newton method -C -C XOFF,YOFF x and y offsets for windowing in QDES,GDES routines -C XSF ,YSF x and y scaling factors for windowing in QDES,GDES routines -C -C XGMIN airfoil grid plot limits -C XGMAX -C YGMIN -C YGMAX -C DXYG airfoil grid-plot annotation increment -C GTICK airfoil-plot tick marks size (as fraction of arc length) diff --git a/deps/src/xfoil/aread.f b/deps/src/xfoil/aread.f deleted file mode 100644 index ff988e6..0000000 --- a/deps/src/xfoil/aread.f +++ /dev/null @@ -1,153 +0,0 @@ - - SUBROUTINE AREAD(LU,FNAME,NMAX,X,Y,N,NAME,ISPARS,ITYPE,INFO) - DIMENSION X(NMAX), Y(NMAX) - CHARACTER*(*) FNAME - CHARACTER*(*) NAME - CHARACTER*(*) ISPARS -C-------------------------------------------------------- -C Reads in several types of airfoil coordinate file. -C -C Input: -C LU logical unit to use for reading -C FNAME name of coordinate file to be read, -C if FNAME(1:1).eq.' ', unit LU is assumed -C to be already open -C INFO 0 keep quiet -C 1 print info on airfoil -C Output: -C X,Y coordinates -C N number of X,Y coordinates -C NAME character name string (if ITYPE > 1) -C ISPARS ISES/MSES domain-size string (if ITYPE > 2) -C ITYPE returns type of file: -C 0 None. Read error occurred. -C 1 Generic. -C 2 Labeled generic. -C 3 MSES single element. -C 4 MSES multi-element. -C-------------------------------------------------------- -C***************************************************************** -CModified 2.24.06 by D. Berkenstock to suppress text output -C***************************************************************** -C - CHARACTER*80 LINE1,LINE2,LINE - LOGICAL LOPEN, ERROR - DIMENSION A(10) -C - IEL = 0 - NEL = 0 -C -C---- assume read error will occur - ITYPE = 0 -C - LOPEN = FNAME(1:1) .NE. ' ' - IF(LOPEN) OPEN(LU,FILE=FNAME,STATUS='OLD',ERR=98) -C - 11 READ(LU,1000,END=99,ERR=98) LINE1 - IF(INDEX('#!',LINE1(1:1)) .NE. 0) GO TO 11 -C - 12 READ(LU,1000,END=99) LINE2 - IF(INDEX('#!',LINE2(1:1)) .NE. 0) GO TO 12 -C - I = 1 -C -C---- try to read numbers from first line - NA = 10 - CALL GETFLT(LINE1,A,NA,ERROR) - IF(ERROR .OR. NA.LT.2) THEN - NAME = LINE1 - ELSE - IF(INFO.GT.0) THEN -C WRITE(*,*) -C WRITE(*,*) 'Plain airfoil file' - ENDIF - ITYPE = 1 - REWIND(LU) - GO TO 50 - ENDIF -C -C---- try to read numbers from second line - NA = 10 - CALL GETFLT(LINE2,A,NA,ERROR) - IF(ERROR .OR. NA.GE.4) THEN - ISPARS = LINE2 - ELSE - NAME = LINE1 - IF(INFO.GT.0) THEN -C WRITE(*,*) -C WRITE(*,*) 'Labeled airfoil file. Name: ', NAME - ENDIF - ITYPE = 2 - REWIND(LU) - READ(LU,1000,END=99) LINE1 - GO TO 50 - ENDIF -C - IF(INFO.GT.0) THEN -C WRITE(*,*) -C WRITE(*,*) 'MSES airfoil file. Name: ', NAME - ENDIF - ITYPE = 3 -C -C---- read each element until 999.0 or end of file is encountered - 50 NEL = NEL + 1 - DO 55 I=1, NMAX - 51 READ(LU,1000,END=60) LINE -C -C------ skip comment line - IF(INDEX('#!',LINE(1:1)) .NE. 0) GO TO 51 -C - NA = 2 - CALL GETFLT(LINE,A,NA,ERROR) - IF(ERROR) GO TO 99 -C -C------ skip line without at least two numbers - IF(NA.LT.2) GO TO 51 -C - X(I) = A(1) - Y(I) = A(2) -C - IF (X(I) .EQ. 999.0) THEN -C-------- if this is the element we want, just exit - IF(IEL .EQ. NEL) GO TO 60 -C - IF(IEL.EQ.0) THEN - CALL ASKI('Enter element number^',IEL) - ITYPE = 4 - ENDIF -C -C-------- if this is the specified element, exit. - IF(IEL .EQ. NEL) GO TO 60 - GO TO 50 - ENDIF - 55 CONTINUE -C WRITE(*,5030) NMAX -C WRITE(*,5900) - IF(LOPEN) CLOSE(LU) - ITYPE = 0 - RETURN -C - 60 N = I-1 - IF(LOPEN) CLOSE(LU) - RETURN -C - 98 CONTINUE -C WRITE(*,5050) -C WRITE(*,5900) - ITYPE = 0 - RETURN -C - 99 CONTINUE - IF(LOPEN) CLOSE(LU) -C WRITE(*,5100) -C WRITE(*,5900) - ITYPE = 0 - RETURN -C............................................................... - 1000 FORMAT(A) - 5030 FORMAT(/' Buffer array size exceeded' - & /' Maximum number of points: ', I4 ) - 5050 FORMAT(/' File OPEN error. Nonexistent file') - 5100 FORMAT(/' File READ error. Unrecognizable file format') - 5900 FORMAT( ' *** LOAD NOT COMPLETED ***' ) - END ! AREAD diff --git a/deps/src/xfoil/naca.f b/deps/src/xfoil/naca.f deleted file mode 100644 index 2e8e320..0000000 --- a/deps/src/xfoil/naca.f +++ /dev/null @@ -1,243 +0,0 @@ -C*********************************************************************** -C Module: naca.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE NACA4(IDES,XX,YT,YC,NSIDE,XB,YB,NB,NAME) - REAL XX(NSIDE), YT(NSIDE), YC(NSIDE) - REAL XB(2*NSIDE), YB(2*NSIDE) - REAL M - CHARACTER*(*) NAME -C - CHARACTER*10 DIGITS - DATA DIGITS / '0123456789' / -C -C---- TE point bunching parameter - DATA AN / 1.5 / -C - N4 = IDES / 1000 - N3 = (IDES - N4*1000 ) / 100 - N2 = (IDES - N4*1000 - N3*100 ) / 10 - N1 = (IDES - N4*1000 - N3*100 - N2*10) -C - M = FLOAT(N4) / 100.0 - P = FLOAT(N3) / 10.0 - T = FLOAT(N2*10 + N1) / 100.0 -C - ANP = AN + 1.0 - DO 10 I=1, NSIDE - FRAC = FLOAT(I-1)/FLOAT(NSIDE-1) - IF(I.EQ.NSIDE) THEN - XX(I) = 1.0 - ELSE - XX(I) = 1.0 - ANP*FRAC*(1.0-FRAC)**AN - (1.0-FRAC)**ANP - ENDIF - YT(I) = ( 0.29690*SQRT(XX(I)) - & - 0.12600*XX(I) - & - 0.35160*XX(I)**2 - & + 0.28430*XX(I)**3 - & - 0.10150*XX(I)**4) * T / 0.20 - IF(XX(I).LT.P) THEN - YC(I) = M/P**2 * (2.0*P*XX(I) - XX(I)**2) - ELSE - YC(I) = M/(1.0-P)**2 * ((1.0-2.0*P) + 2.0*P*XX(I)-XX(I)**2) - ENDIF - 10 CONTINUE -C - IB = 0 - DO 20 I=NSIDE, 1, -1 - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) + YT(I) - 20 CONTINUE - DO 30 I=2, NSIDE - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) - YT(I) - 30 CONTINUE - NB = IB -C - NAME = 'NACA' - NAME(6:9) = DIGITS(N4+1:N4+1) - & // DIGITS(N3+1:N3+1) - & // DIGITS(N2+1:N2+1) - & // DIGITS(N1+1:N1+1) -C - RETURN - END - - - SUBROUTINE NACA4B(M,P,T,XX,YT,YC,NSIDE,XB,YB,NB,NAME) - REAL XX(NSIDE), YT(NSIDE), YC(NSIDE) - REAL XB(2*NSIDE), YB(2*NSIDE) - REAL M - CHARACTER*(*) NAME -C - CHARACTER*10 DIGITS - DATA DIGITS / '0123456789' / -C -C---- TE point bunching parameter - DATA AN / 1.5 / -C -c N4 = IDES / 1000 -c N3 = (IDES - N4*1000 ) / 100 -c N2 = (IDES - N4*1000 - N3*100 ) / 10 -c N1 = (IDES - N4*1000 - N3*100 - N2*10) -C -c M = FLOAT(N4) / 100.0 -c P = FLOAT(N3) / 10.0 -c T = FLOAT(N2*10 + N1) / 100.0 -C - ANP = AN + 1.0 - DO 10 I=1, NSIDE - FRAC = FLOAT(I-1)/FLOAT(NSIDE-1) - IF(I.EQ.NSIDE) THEN - XX(I) = 1.0 - ELSE - XX(I) = 1.0 - ANP*FRAC*(1.0-FRAC)**AN - (1.0-FRAC)**ANP - ENDIF - YT(I) = ( 0.29690*SQRT(XX(I)) - & - 0.12600*XX(I) - & - 0.35160*XX(I)**2 - & + 0.28430*XX(I)**3 - & - 0.10150*XX(I)**4) * T / 0.20 - IF(XX(I).LT.P) THEN - YC(I) = M/P**2 * (2.0*P*XX(I) - XX(I)**2) - ELSE - YC(I) = M/(1.0-P)**2 * ((1.0-2.0*P) + 2.0*P*XX(I)-XX(I)**2) - ENDIF - 10 CONTINUE -C - IB = 0 - DO 20 I=NSIDE, 1, -1 - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) + YT(I) - 20 CONTINUE - DO 30 I=2, NSIDE - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) - YT(I) - 30 CONTINUE - NB = IB -C - NAME = 'NACA' - NAME(6:9) = DIGITS(N4+1:N4+1) - & // DIGITS(N3+1:N3+1) - & // DIGITS(N2+1:N2+1) - & // DIGITS(N1+1:N1+1) -C - RETURN - END - - - SUBROUTINE NACA5(IDES,XX,YT,YC,NSIDE,XB,YB,NB,NAME) - REAL XX(NSIDE), YT(NSIDE), YC(NSIDE) - REAL XB(2*NSIDE), YB(2*NSIDE) - REAL M -C - CHARACTER*(*) NAME -C - CHARACTER*10 DIGITS - DATA DIGITS / '0123456789' / -C -C---- TE point bunching parameter - DATA AN / 1.5 / -C - N5 = IDES / 10000 - N4 = (IDES - N5*10000 ) / 1000 - N3 = (IDES - N5*10000 - N4*1000 ) / 100 - N2 = (IDES - N5*10000 - N4*1000 - N3*100 ) / 10 - N1 = (IDES - N5*10000 - N4*1000 - N3*100 - N2*10) -C - N543 = 100*N5 + 10*N4 + N3 -C - IF (N543 .EQ. 210) THEN -cc P = 0.05 - M = 0.0580 - C = 361.4 - ELSE IF (N543 .EQ. 220) THEN -cc P = 0.10 - M = 0.1260 - C = 51.64 - ELSE IF (N543 .EQ. 230) THEN -cc P = 0.15 - M = 0.2025 - C = 15.957 - ELSE IF (N543 .EQ. 240) THEN -cc P = 0.20 - M = 0.2900 - C = 6.643 - ELSE IF (N543 .EQ. 250) THEN -cc P = 0.25 - M = 0.3910 - C = 3.230 - ELSE - WRITE(*,*) 'Illegal 5-digit designation' - WRITE(*,*) 'First three digits must be 210, 220, ... 250' - IDES = 0 - RETURN - ENDIF -C -C - T = FLOAT(N2*10 + N1) / 100.0 -C - ANP = AN + 1.0 - DO 10 I=1, NSIDE - FRAC = FLOAT(I-1)/FLOAT(NSIDE-1) - IF(I.EQ.NSIDE) THEN - XX(I) = 1.0 - ELSE - XX(I) = 1.0 - ANP*FRAC*(1.0-FRAC)**AN - (1.0-FRAC)**ANP - ENDIF -C - YT(I) = ( 0.29690*SQRT(XX(I)) - & - 0.12600*XX(I) - & - 0.35160*XX(I)**2 - & + 0.28430*XX(I)**3 - & - 0.10150*XX(I)**4) * T / 0.20 - IF(XX(I).LT.M) THEN - YC(I) = (C/6.0) * (XX(I)**3 - 3.0*M*XX(I)**2 - & + M*M*(3.0-M)*XX(I)) - ELSE - YC(I) = (C/6.0) * M**3 * (1.0 - XX(I)) - ENDIF - 10 CONTINUE -C - IB = 0 - DO 20 I=NSIDE, 1, -1 - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) + YT(I) - 20 CONTINUE - DO 30 I=2, NSIDE - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) - YT(I) - 30 CONTINUE - NB = IB -C - NAME = 'NACA' - NAME(6:10) = DIGITS(N5+1:N5+1) - & // DIGITS(N4+1:N4+1) - & // DIGITS(N3+1:N3+1) - & // DIGITS(N2+1:N2+1) - & // DIGITS(N1+1:N1+1) -C - RETURN - END diff --git a/deps/src/xfoil/spline.f b/deps/src/xfoil/spline.f deleted file mode 100644 index 64b876b..0000000 --- a/deps/src/xfoil/spline.f +++ /dev/null @@ -1,592 +0,0 @@ -C*********************************************************************** -C Module: spline.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE SPLINE(X,XS,S,N) - DIMENSION X(N),XS(N),S(N) - PARAMETER (NMAX=600) - DIMENSION A(NMAX),B(NMAX),C(NMAX) -C------------------------------------------------------- -C Calculates spline coefficients for X(S). | -C Zero 2nd derivative end conditions are used. | -C To evaluate the spline at some value of S, | -C use SEVAL and/or DEVAL. | -C | -C S independent variable array (input) | -C X dependent variable array (input) | -C XS dX/dS array (calculated) | -C N number of points (input) | -C | -C------------------------------------------------------- - - IF(N.GT.NMAX) STOP 'SPLINE: array overflow, increase NMAX' -C - DO 1 I=2, N-1 - DSM = S(I) - S(I-1) - DSP = S(I+1) - S(I) - B(I) = DSP - A(I) = 2.0*(DSM+DSP) - C(I) = DSM - XS(I) = 3.0*((X(I+1)-X(I))*DSM/DSP + (X(I)-X(I-1))*DSP/DSM) - 1 CONTINUE -C -C---- set zero second derivative end conditions - A(1) = 2.0 - C(1) = 1.0 - XS(1) = 3.0*(X(2)-X(1)) / (S(2)-S(1)) - B(N) = 1.0 - A(N) = 2.0 - XS(N) = 3.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) -C -C---- solve for derivative array XS - CALL TRISOL(A,B,C,XS,N) -C - RETURN - END ! SPLINE - - - SUBROUTINE SPLIND(X,XS,S,N,XS1,XS2) - DIMENSION X(N),XS(N),S(N) - PARAMETER (NMAX=600) - DIMENSION A(NMAX),B(NMAX),C(NMAX) -C------------------------------------------------------- -C Calculates spline coefficients for X(S). | -C Specified 1st derivative and/or usual zero 2nd | -C derivative end conditions are used. | -C To evaluate the spline at some value of S, | -C use SEVAL and/or DEVAL. | -C | -C S independent variable array (input) | -C X dependent variable array (input) | -C XS dX/dS array (calculated) | -C N number of points (input) | -C XS1,XS2 endpoint derivatives (input) | -C If = 999.0, then usual zero second | -C derivative end condition(s) are used | -C If = -999.0, then zero third | -C derivative end condition(s) are used | -C | -C------------------------------------------------------- - IF(N.GT.NMAX) STOP 'SPLIND: array overflow, increase NMAX' -C - DO 1 I=2, N-1 - DSM = S(I) - S(I-1) - DSP = S(I+1) - S(I) - B(I) = DSP - A(I) = 2.0*(DSM+DSP) - C(I) = DSM - XS(I) = 3.0*((X(I+1)-X(I))*DSM/DSP + (X(I)-X(I-1))*DSP/DSM) - 1 CONTINUE -C - IF(XS1.EQ.999.0) THEN -C----- set zero second derivative end condition - A(1) = 2.0 - C(1) = 1.0 - XS(1) = 3.0*(X(2)-X(1)) / (S(2)-S(1)) - ELSE IF(XS1.EQ.-999.0) THEN -C----- set zero third derivative end condition - A(1) = 1.0 - C(1) = 1.0 - XS(1) = 2.0*(X(2)-X(1)) / (S(2)-S(1)) - ELSE -C----- set specified first derivative end condition - A(1) = 1.0 - C(1) = 0. - XS(1) = XS1 - ENDIF -C - IF(XS2.EQ.999.0) THEN - B(N) = 1.0 - A(N) = 2.0 - XS(N) = 3.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) - ELSE IF(XS2.EQ.-999.0) THEN - B(N) = 1.0 - A(N) = 1.0 - XS(N) = 2.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) - ELSE - A(N) = 1.0 - B(N) = 0. - XS(N) = XS2 - ENDIF -C - IF(N.EQ.2 .AND. XS1.EQ.-999.0 .AND. XS2.EQ.-999.0) THEN - B(N) = 1.0 - A(N) = 2.0 - XS(N) = 3.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) - ENDIF -C -C---- solve for derivative array XS - CALL TRISOL(A,B,C,XS,N) -C - RETURN - END ! SPLIND - - - - SUBROUTINE SPLINA(X,XS,S,N) - IMPLICIT REAL (A-H,O-Z) - DIMENSION X(N),XS(N),S(N) - LOGICAL LEND -C------------------------------------------------------- -C Calculates spline coefficients for X(S). | -C A simple averaging of adjacent segment slopes | -C is used to achieve non-oscillatory curve | -C End conditions are set by end segment slope | -C To evaluate the spline at some value of S, | -C use SEVAL and/or DEVAL. | -C | -C S independent variable array (input) | -C X dependent variable array (input) | -C XS dX/dS array (calculated) | -C N number of points (input) | -C | -C------------------------------------------------------- -C - LEND = .TRUE. - DO 1 I=1, N-1 - DS = S(I+1)-S(I) - IF (DS.EQ.0.) THEN - XS(I) = XS1 - LEND = .TRUE. - ELSE - DX = X(I+1)-X(I) - XS2 = DX / DS - IF (LEND) THEN - XS(I) = XS2 - LEND = .FALSE. - ELSE - XS(I) = 0.5*(XS1 + XS2) - ENDIF - ENDIF - XS1 = XS2 - 1 CONTINUE - XS(N) = XS1 -C - RETURN - END ! SPLINA - - - - SUBROUTINE TRISOL(A,B,C,D,KK) - DIMENSION A(KK),B(KK),C(KK),D(KK) -C----------------------------------------- -C Solves KK long, tri-diagonal system | -C | -C A C D | -C B A C D | -C B A . . | -C . . C . | -C B A D | -C | -C The righthand side D is replaced by | -C the solution. A, C are destroyed. | -C----------------------------------------- -C - DO 1 K=2, KK - KM = K-1 - C(KM) = C(KM) / A(KM) - D(KM) = D(KM) / A(KM) - A(K) = A(K) - B(K)*C(KM) - D(K) = D(K) - B(K)*D(KM) - 1 CONTINUE -C - D(KK) = D(KK)/A(KK) -C - DO 2 K=KK-1, 1, -1 - D(K) = D(K) - C(K)*D(K+1) - 2 CONTINUE -C - RETURN - END ! TRISOL - - - FUNCTION SEVAL(SS,X,XS,S,N) - DIMENSION X(N), XS(N), S(N) -C-------------------------------------------------- -C Calculates X(SS) | -C XS array must have been calculated by SPLINE | -C-------------------------------------------------- - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - SEVAL = T*X(I) + (1.0-T)*X(I-1) + (T-T*T)*((1.0-T)*CX1 - T*CX2) - RETURN - END ! SEVAL - - FUNCTION DEVAL(SS,X,XS,S,N) - DIMENSION X(N), XS(N), S(N) -C-------------------------------------------------- -C Calculates dX/dS(SS) | -C XS array must have been calculated by SPLINE | -C-------------------------------------------------- - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - DEVAL = X(I) - X(I-1) + (1.-4.0*T+3.0*T*T)*CX1 + T*(3.0*T-2.)*CX2 - DEVAL = DEVAL/DS - RETURN - END ! DEVAL - - FUNCTION D2VAL(SS,X,XS,S,N) - DIMENSION X(N), XS(N), S(N) -C-------------------------------------------------- -C Calculates d2X/dS2(SS) | -C XS array must have been calculated by SPLINE | -C-------------------------------------------------- - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - D2VAL = (6.*T-4.)*CX1 + (6.*T-2.0)*CX2 - D2VAL = D2VAL/DS**2 - RETURN - END ! D2VAL - - - FUNCTION CURV(SS,X,XS,Y,YS,S,N) - DIMENSION X(N), XS(N), Y(N), YS(N), S(N) -C----------------------------------------------- -C Calculates curvature of splined 2-D curve | -C at S = SS | -C | -C S arc length array of curve | -C X, Y coordinate arrays of curve | -C XS,YS derivative arrays | -C (calculated earlier by SPLINE) | -C----------------------------------------------- -C - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS -C - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - XD = X(I) - X(I-1) + (1.0-4.0*T+3.0*T*T)*CX1 + T*(3.0*T-2.0)*CX2 - XDD = (6.0*T-4.0)*CX1 + (6.0*T-2.0)*CX2 -C - CY1 = DS*YS(I-1) - Y(I) + Y(I-1) - CY2 = DS*YS(I) - Y(I) + Y(I-1) - YD = Y(I) - Y(I-1) + (1.0-4.0*T+3.0*T*T)*CY1 + T*(3.0*T-2.0)*CY2 - YDD = (6.0*T-4.0)*CY1 + (6.0*T-2.0)*CY2 -C - SD = SQRT(XD*XD + YD*YD) - SD = MAX(SD,0.001*DS) -C - CURV = (XD*YDD - YD*XDD) / SD**3 -C - RETURN - END ! CURV - - - FUNCTION CURVS(SS,X,XS,Y,YS,S,N) - DIMENSION X(N), XS(N), Y(N), YS(N), S(N) -C----------------------------------------------- -C Calculates curvature derivative of | -C splined 2-D curve at S = SS | -C | -C S arc length array of curve | -C X, Y coordinate arrays of curve | -C XS,YS derivative arrays | -C (calculated earlier by SPLINE) | -C----------------------------------------------- -C - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS -C - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - XD = X(I) - X(I-1) + (1.0-4.0*T+3.0*T*T)*CX1 + T*(3.0*T-2.0)*CX2 - XDD = (6.0*T-4.0)*CX1 + (6.0*T-2.0)*CX2 - XDDD = 6.0*CX1 + 6.0*CX2 -C - CY1 = DS*YS(I-1) - Y(I) + Y(I-1) - CY2 = DS*YS(I) - Y(I) + Y(I-1) - YD = Y(I) - Y(I-1) + (1.0-4.0*T+3.0*T*T)*CY1 + T*(3.0*T-2.0)*CY2 - YDD = (6.0*T-4.0)*CY1 + (6.0*T-2.0)*CY2 - YDDD = 6.0*CY1 + 6.0*CY2 -C - SD = SQRT(XD*XD + YD*YD) - SD = MAX(SD,0.001*DS) -C - BOT = SD**3 - DBOTDT = 3.0*SD*(XD*XDD + YD*YDD) -C - TOP = XD*YDD - YD*XDD - DTOPDT = XD*YDDD - YD*XDDD -C - CURVS = (DTOPDT*BOT - DBOTDT*TOP) / BOT**2 -C - RETURN - END ! CURVS - - - SUBROUTINE SINVRT(SI,XI,X,XS,S,N) - DIMENSION X(N), XS(N), S(N) -C------------------------------------------------------- -C Calculates the "inverse" spline function S(X). | -C Since S(X) can be multi-valued or not defined, | -C this is not a "black-box" routine. The calling | -C program must pass via SI a sufficiently good | -C initial guess for S(XI). | -C | -C XI specified X value (input) | -C SI calculated S(XI) value (input,output) | -C X,XS,S usual spline arrays (input) | -C | -C------------------------------------------------------- -C - SISAV = SI -C - DO 10 ITER=1, 10 - RES = SEVAL(SI,X,XS,S,N) - XI - RESP = DEVAL(SI,X,XS,S,N) - DS = -RES/RESP - SI = SI + DS - IF(ABS(DS/(S(N)-S(1))) .LT. 1.0E-5) RETURN - 10 CONTINUE - WRITE(*,*) - & 'SINVRT: spline inversion failed. Input value returned.' - SI = SISAV -C - RETURN - END ! SINVRT - - - SUBROUTINE SCALC(X,Y,S,N) - DIMENSION X(N), Y(N), S(N) -C---------------------------------------- -C Calculates the arc length array S | -C for a 2-D array of points (X,Y). | -C---------------------------------------- -C - S(1) = 0. - - DO 10 I=2, N - - S(I) = S(I-1) + SQRT((X(I)-X(I-1))**2 + (Y(I)-Y(I-1))**2) - 10 CONTINUE -C - RETURN - - END ! SCALC - - - SUBROUTINE SPLNXY(X,XS,Y,YS,S,N) - DIMENSION X(N), XS(N), Y(N), YS(N), S(N) -C----------------------------------------- -C Splines 2-D shape X(S), Y(S), along | -C with true arc length parameter S. | -C----------------------------------------- - PARAMETER (KMAX=32) - DIMENSION XT(0:KMAX), YT(0:KMAX) -C - KK = KMAX - NPASS = 10 -C -C---- set first estimate of arc length parameter - CALL SCALC(X,Y,S,N) -C -C---- spline X(S) and Y(S) - CALL SEGSPL(X,XS,S,N) - CALL SEGSPL(Y,YS,S,N) -C -C---- re-integrate true arc length - DO 100 IPASS=1, NPASS -C - SERR = 0. -C - DS = S(2) - S(1) - DO I = 2, N - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) -C - CX1 = DS*XS(I-1) - DX - CX2 = DS*XS(I ) - DX - CY1 = DS*YS(I-1) - DY - CY2 = DS*YS(I ) - DY -C - XT(0) = 0. - YT(0) = 0. - DO K=1, KK-1 - T = FLOAT(K) / FLOAT(KK) - XT(K) = T*DX + (T-T*T)*((1.0-T)*CX1 - T*CX2) - YT(K) = T*DY + (T-T*T)*((1.0-T)*CY1 - T*CY2) - ENDDO - XT(KK) = DX - YT(KK) = DY -C - SINT1 = 0. - DO K=1, KK - SINT1 = SINT1 - & + SQRT((XT(K)-XT(K-1))**2 + (YT(K)-YT(K-1))**2) - ENDDO -C - SINT2 = 0. - DO K=2, KK, 2 - SINT2 = SINT2 - & + SQRT((XT(K)-XT(K-2))**2 + (YT(K)-YT(K-2))**2) - ENDDO -C - SINT = (4.0*SINT1 - SINT2) / 3.0 -C - IF(ABS(SINT-DS) .GT. ABS(SERR)) SERR = SINT - DS -C - IF(I.LT.N) DS = S(I+1) - S(I) -C - S(I) = S(I-1) + SQRT(SINT) - ENDDO -C - SERR = SERR / (S(N) - S(1)) - WRITE(*,*) IPASS, SERR -C -C------ re-spline X(S) and Y(S) - CALL SEGSPL(X,XS,S,N) - CALL SEGSPL(Y,YS,S,N) -C - IF(ABS(SERR) .LT. 1.0E-7) RETURN -C - 100 CONTINUE -C - RETURN - END ! SPLNXY - - - - SUBROUTINE SEGSPL(X,XS,S,N) -C----------------------------------------------- -C Splines X(S) array just like SPLINE, | -C but allows derivative discontinuities | -C at segment joints. Segment joints are | -C defined by identical successive S values. | -C----------------------------------------------- - DIMENSION X(N), XS(N), S(N) -C - IF(S(1).EQ.S(2) ) STOP 'SEGSPL: First input point duplicated' - IF(S(N).EQ.S(N-1)) STOP 'SEGSPL: Last input point duplicated' -C - ISEG0 = 1 - DO 10 ISEG=2, N-2 - IF(S(ISEG).EQ.S(ISEG+1)) THEN - NSEG = ISEG - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,-999.0,-999.0) - ISEG0 = ISEG+1 - ENDIF - 10 CONTINUE -C - NSEG = N - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,-999.0,-999.0) -C - RETURN - END ! SEGSPL - - - - SUBROUTINE SEGSPLD(X,XS,S,N,XS1,XS2) -C----------------------------------------------- -C Splines X(S) array just like SPLIND, | -C but allows derivative discontinuities | -C at segment joints. Segment joints are | -C defined by identical successive S values. | -C----------------------------------------------- - DIMENSION X(N), XS(N), S(N) -C - IF(S(1).EQ.S(2) ) STOP 'SEGSPL: First input point duplicated' - IF(S(N).EQ.S(N-1)) STOP 'SEGSPL: Last input point duplicated' -C - ISEG0 = 1 - DO 10 ISEG=2, N-2 - IF(S(ISEG).EQ.S(ISEG+1)) THEN - NSEG = ISEG - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,XS1,XS2) - ISEG0 = ISEG+1 - ENDIF - 10 CONTINUE -C - NSEG = N - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,XS1,XS2) -C - RETURN - END ! SEGSPL - diff --git a/deps/src/xfoil/userio.f b/deps/src/xfoil/userio.f deleted file mode 100644 index bf205eb..0000000 --- a/deps/src/xfoil/userio.f +++ /dev/null @@ -1,449 +0,0 @@ -C*********************************************************************** -C Module: userio.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C -C -C==== user input routines with prompting and error trapping -C -C - SUBROUTINE ASKI(PROMPT,IINPUT) -C -C---- integer input -C - CHARACTER*(*) PROMPT - INTEGER IINPUT - CHARACTER LINE*80 -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.EQ.0) NP = LEN(PROMPT) -C - 10 WRITE(*,1000) PROMPT(1:NP) -C - READ (*,1001,ERR=10) LINE - IF(LINE.NE.' ') THEN - READ (LINE,*,ERR=10) IINPUT - ENDIF - RETURN -C - 1000 FORMAT(/A,' i> ',$) - 1001 FORMAT(A) - END ! ASKI - - - SUBROUTINE ASKR(PROMPT,RINPUT) -C -C---- real input -C - CHARACTER*(*) PROMPT - REAL RINPUT - CHARACTER LINE*80 -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.EQ.0) NP = LEN(PROMPT) -C - 10 WRITE(*,1000) PROMPT(1:NP) -C - READ (*,1001,ERR=10) LINE - IF(LINE.NE.' ') THEN - READ (LINE,*,ERR=10) RINPUT - ENDIF - RETURN -C - 1000 FORMAT(/A,' r> ',$) - 1001 FORMAT(A) - END ! ASKR - - - SUBROUTINE ASKL(PROMPT,LINPUT) -C -C---- logical input -C - CHARACTER*(*) PROMPT - LOGICAL LINPUT - CHARACTER*1 CHAR -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.EQ.0) NP = LEN(PROMPT) -C - 10 WRITE(*,1000) PROMPT(1:NP) - READ (*,1010) CHAR - IF(CHAR.EQ.'y') CHAR = 'Y' - IF(CHAR.EQ.'n') CHAR = 'N' - IF(CHAR.NE.'Y' .AND. CHAR.NE.'N') GO TO 10 -C - LINPUT = CHAR .EQ. 'Y' - RETURN -C - 1000 FORMAT(/A,' y/n> ',$) - 1010 FORMAT(A) - END ! ASKL - - - SUBROUTINE ASKS(PROMPT,INPUT) -C -C---- string of arbitrary length input -C - CHARACTER*(*) PROMPT - CHARACTER*(*) INPUT -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.EQ.0) NP = LEN(PROMPT) -C - WRITE(*,1000) PROMPT(1:NP) - READ (*,1010) INPUT -C - RETURN -C - 1000 FORMAT(/A,' s> ',$) - 1010 FORMAT(A) - END ! ASKS - - - SUBROUTINE ASKC(PROMPT,COMAND,CARGS) -C -C---- returns 4-byte character string input converted to uppercase -C---- also returns rest of input characters in CARGS string -C - CHARACTER*(*) PROMPT - CHARACTER*(*) COMAND, CARGS -C - CHARACTER*128 LINE - LOGICAL ERROR -C - IZERO = ICHAR('0') -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.EQ.0) NP = LEN(PROMPT) -C - WRITE(*,1000) PROMPT(1:NP) - READ (*,1020) LINE -C -C---- strip off leading blanks - DO K=1, 128 - IF(LINE(1:1) .EQ. ' ') THEN - LINE = LINE(2:128) - ELSE - GO TO 5 - ENDIF - ENDDO - 5 CONTINUE -C -C---- find position of first blank, "+", "-", ".", ",", or numeral - K = INDEX(LINE,' ') - KI = INDEX(LINE,'-') - IF(KI.NE.0) K = MIN(K,KI) - KI = INDEX(LINE,'+') - IF(KI.NE.0) K = MIN(K,KI) - KI = INDEX(LINE,'.') - IF(KI.NE.0) K = MIN(K,KI) - KI = INDEX(LINE,',') - IF(KI.NE.0) K = MIN(K,KI) - DO I=0, 9 - KI = INDEX(LINE,CHAR(IZERO+I)) - IF(KI.NE.0) K = MIN(K,KI) - ENDDO -C -C---- there is no blank between command and argument... use first 4 characters - IF(K.LE.0) K = 5 -C - IF(K.EQ.1) THEN -C------ the "command" is a number... set entire COMAND string with it - COMAND = LINE - ELSE -C------ the "command" is some string... just use the part up to the argument - COMAND = LINE(1:K-1) - ENDIF -C -C---- convert it to uppercase - CALL LC2UC(COMAND) -C - CARGS = LINE(K:128) - CALL STRIP(CARGS,NCARGS) - RETURN -C - 1000 FORMAT(/A,' c> ',$) - 1020 FORMAT(A) - END ! ASKC - - - SUBROUTINE LC2UC(INPUT) - CHARACTER*(*) INPUT -C - CHARACTER*26 LCASE, UCASE - DATA LCASE / 'abcdefghijklmnopqrstuvwxyz' / - DATA UCASE / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' / -C - N = LEN(INPUT) -C - DO 10 I=1, N - K = INDEX( LCASE , INPUT(I:I) ) - IF(K.GT.0) INPUT(I:I) = UCASE(K:K) - 10 CONTINUE -C - RETURN - END ! LC2UC - - - - SUBROUTINE READI(N,IVAR,ERROR) - DIMENSION IVAR(N) - LOGICAL ERROR -C-------------------------------------------------- -C Reads N integer variables, leaving unchanged -C if only is entered. -C-------------------------------------------------- - DIMENSION IVTMP(40) - CHARACTER*80 LINE -C - READ(*,1000) LINE - 1000 FORMAT(A80) -C - DO 10 I=1, N - IVTMP(I) = IVAR(I) - 10 CONTINUE -C - NTMP = 40 - CALL GETINT(LINE,IVTMP,NTMP,ERROR) -C - IF(ERROR) RETURN -C - DO 20 I=1, N - IVAR(I) = IVTMP(I) - 20 CONTINUE -C - RETURN - END ! READI - - - - SUBROUTINE READR(N,VAR,ERROR) - DIMENSION VAR(N) - LOGICAL ERROR -C------------------------------------------------- -C Reads N real variables, leaving unchanged -C if only is entered. -C------------------------------------------------- - DIMENSION VTMP(40) - CHARACTER*80 LINE -C - READ(*,1000) LINE - 1000 FORMAT(A80) -C - DO 10 I=1, N - VTMP(I) = VAR(I) - 10 CONTINUE -C - NTMP = 40 - CALL GETFLT(LINE,VTMP,NTMP,ERROR) -C - IF(ERROR) RETURN -C - DO 20 I=1, N - VAR(I) = VTMP(I) - 20 CONTINUE -C - RETURN - END ! READR - - - - - SUBROUTINE GETINT(INPUT,A,N,ERROR) - CHARACTER*(*) INPUT - INTEGER A(*) - LOGICAL ERROR -C---------------------------------------------------------- -C Parses character string INPUT into an array -C of integer numbers returned in A(1...N) -C -C Will attempt to extract no more than N numbers, -C unless N = 0, in which case all numbers present -C in INPUT will be extracted. -C -C N returns how many numbers were actually extracted. -C---------------------------------------------------------- - CHARACTER*130 REC -C -C---- only first 128 characters in INPUT will be parsed - ILEN = MIN( LEN(INPUT) , 128 ) - ILENP = ILEN + 2 -C -C---- put input into local work string (which will be munched) - REC(1:ILENP) = INPUT(1:ILEN) // ' ,' -C -C---- ignore everything after a "!" character - K = INDEX(REC,'!') - IF(K.GT.0) REC(1:ILEN) = REC(1:K-1) -C - NINP = N -C -C---- count up how many numbers are to be extracted - N = 0 - K = 1 - DO 10 IPASS=1, ILEN -C------ search for next space or comma starting with current index K - KSPACE = INDEX(REC(K:ILENP),' ') + K - 1 - KCOMMA = INDEX(REC(K:ILENP),',') + K - 1 -C - IF(K.EQ.KSPACE) THEN -C------- just skip this space - K = K+1 - GO TO 9 - ENDIF -C - IF(K.EQ.KCOMMA) THEN -C------- comma found.. increment number count and keep looking - N = N+1 - K = K+1 - GO TO 9 - ENDIF -C -C------ neither space nor comma found, so we ran into a number... -C- ...increment number counter and keep looking after next space or comma - N = N+1 - K = MIN(KSPACE,KCOMMA) + 1 -C - 9 IF(K.GE.ILEN) GO TO 11 - 10 CONTINUE -C -C---- decide on how many numbers to read, and go ahead and read them - 11 IF(NINP.GT.0) N = MIN( N, NINP ) - READ(REC(1:ILEN),*,ERR=20) (A(I),I=1,N) - ERROR = .FALSE. - RETURN -C -C---- bzzzt !!! - 20 CONTINUE -ccc WRITE(*,*) 'GETINT: String-to-integer conversion error.' - N = 0 - ERROR = .TRUE. - RETURN - END - - - SUBROUTINE GETFLT(INPUT,A,N,ERROR) - CHARACTER*(*) INPUT - REAL A(*) - LOGICAL ERROR -C---------------------------------------------------------- -C Parses character string INPUT into an array -C of real numbers returned in A(1...N) -C -C Will attempt to extract no more than N numbers, -C unless N = 0, in which case all numbers present -C in INPUT will be extracted. -C -C N returns how many numbers were actually extracted. -C---------------------------------------------------------- - CHARACTER*130 REC -C -C---- only first 128 characters in INPUT will be parsed - ILEN = MIN( LEN(INPUT) , 128 ) - ILENP = ILEN + 2 -C -C---- put input into local work string (which will be munched) - REC(1:ILENP) = INPUT(1:ILEN) // ' ,' -C -C---- ignore everything after a "!" character - K = INDEX(REC,'!') - IF(K.GT.0) REC(1:ILEN) = REC(1:K-1) -C - NINP = N -C -C---- count up how many numbers are to be extracted - N = 0 - K = 1 - DO 10 IPASS=1, ILEN -C------ search for next space or comma starting with current index K - KSPACE = INDEX(REC(K:ILENP),' ') + K - 1 - KCOMMA = INDEX(REC(K:ILENP),',') + K - 1 -C - IF(K.EQ.KSPACE) THEN -C------- just skip this space - K = K+1 - GO TO 9 - ENDIF -C - IF(K.EQ.KCOMMA) THEN -C------- comma found.. increment number count and keep looking - N = N+1 - K = K+1 - GO TO 9 - ENDIF -C -C------ neither space nor comma found, so we ran into a number... -C- ...increment number counter and keep looking after next space or comma - N = N+1 - K = MIN(KSPACE,KCOMMA) + 1 -C - 9 IF(K.GE.ILEN) GO TO 11 - 10 CONTINUE -C -C---- decide on how many numbers to read, and go ahead and read them - 11 IF(NINP.GT.0) N = MIN( N, NINP ) - READ(REC(1:ILEN),*,ERR=20) (A(I),I=1,N) - ERROR = .FALSE. - RETURN -C -C---- bzzzt !!! - 20 CONTINUE -ccc WRITE(*,*) 'GETFLT: String-to-integer conversion error.' - N = 0 - ERROR = .TRUE. - RETURN - END - - - - SUBROUTINE STRIP(STRING,NS) - CHARACTER*(*) STRING -C------------------------------------------- -C Strips leading blanks off string -C and returns length of non-blank part. -C------------------------------------------- - N = LEN(STRING) -C -C---- find last non-blank character - DO 10 K2=N, 1, -1 - IF(STRING(K2:K2).NE.' ') GO TO 11 - 10 CONTINUE - K2 = 0 - 11 CONTINUE -C -C---- find first non-blank character - DO 20 K1=1, K2 - IF(STRING(K1:K1).NE.' ') GO TO 21 - 20 CONTINUE - 21 CONTINUE -C -C---- number of non-blank characters - NS = K2 - K1 + 1 - IF(NS.EQ.0) RETURN -C -C---- shift STRING so first character is non-blank - STRING(1:NS) = STRING(K1:K2) -C -C---- pad tail of STRING with blanks - DO 30 K=NS+1, N - STRING(K:K) = ' ' - 30 CONTINUE -C - RETURN - END - diff --git a/deps/src/xfoil/xbl.f b/deps/src/xfoil/xbl.f deleted file mode 100644 index cbb5df4..0000000 --- a/deps/src/xfoil/xbl.f +++ /dev/null @@ -1,1578 +0,0 @@ -C*********************************************************************** -C Module: xbl.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C -C MODIFIED 2.24.06 by D. BERKENSTOCK TO REMOVE TEXT OUTPUTS -C - - SUBROUTINE SETBL -C------------------------------------------------- -C Sets up the BL Newton system coefficients -C for the current BL variables and the edge -C velocities received from SETUP. The local -C BL system coefficients are then -C incorporated into the global Newton system. -C------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' - REAL USAV(IVX,2) - REAL U1_M(2*IVX), U2_M(2*IVX) - REAL D1_M(2*IVX), D2_M(2*IVX) - REAL ULE1_M(2*IVX), ULE2_M(2*IVX) - REAL UTE1_M(2*IVX), UTE2_M(2*IVX) - REAL MA_CLMR, MSQ_CLMR, MDI -C -C - -C---- set the CL used to define Mach, Reynolds numbers - IF(LALFA) THEN - CLMR = CL - ELSE - CLMR = CLSPEC - ENDIF -C -C---- set current MINF(CL) - CALL MRCL(CLMR,MA_CLMR,RE_CLMR) - MSQ_CLMR = 2.0*MINF*MA_CLMR -C -C---- set compressibility parameter TKLAM and derivative TK_MSQ - CALL COMSET -C -C---- set gas constant (= Cp/Cv) - GAMBL = GAMMA - GM1BL = GAMM1 -C -C---- set parameters for compressibility correction - QINFBL = QINF - TKBL = TKLAM - TKBL_MS = TKL_MSQ -C -C---- stagnation density and 1/enthalpy - RSTBL = (1.0 + 0.5*GM1BL*MINF**2) ** (1.0/GM1BL) - RSTBL_MS = 0.5*RSTBL/(1.0 + 0.5*GM1BL*MINF**2) -C - HSTINV = GM1BL*(MINF/QINFBL)**2 / (1.0 + 0.5*GM1BL*MINF**2) - HSTINV_MS = GM1BL*( 1.0/QINFBL)**2 / (1.0 + 0.5*GM1BL*MINF**2) - & - 0.5*GM1BL*HSTINV / (1.0 + 0.5*GM1BL*MINF**2) -C -C---- Sutherland's const./To (assumes stagnation conditions are at STP) - HVRAT = 0.35 -C -C---- set Reynolds number based on freestream density, velocity, viscosity - HERAT = 1.0 - 0.5*QINFBL**2*HSTINV - HERAT_MS = - 0.5*QINFBL**2*HSTINV_MS -C - REYBL = REINF * SQRT(HERAT**3) * (1.0+HVRAT)/(HERAT+HVRAT) - REYBL_RE = SQRT(HERAT**3) * (1.0+HVRAT)/(HERAT+HVRAT) - REYBL_MS = REYBL * (1.5/HERAT - 1.0/(HERAT+HVRAT))*HERAT_MS -C - AMCRIT = ACRIT -C -C---- save TE thickness - DWTE = WGAP(1) -C - IF(.NOT.LBLINI) THEN -C----- initialize BL by marching with Ue (fudge at separation) -C WRITE(*,*) -C WRITE(*,*) 'Initializing BL ...' - CALL MRCHUE - LBLINI = .TRUE. - ENDIF -C -C WRITE(*,*) -C -C---- march BL with current Ue and Ds to establish transition - CALL MRCHDU -C - DO 5 IS=1, 2 - DO 6 IBL=2, NBL(IS) - USAV(IBL,IS) = UEDG(IBL,IS) - 6 CONTINUE - 5 CONTINUE -C - CALL UESET -C - DO 7 IS=1, 2 - DO 8 IBL=2, NBL(IS) - TEMP = USAV(IBL,IS) - USAV(IBL,IS) = UEDG(IBL,IS) - UEDG(IBL,IS) = TEMP - 8 CONTINUE - 7 CONTINUE -C - ILE1 = IPAN(2,1) - ILE2 = IPAN(2,2) - ITE1 = IPAN(IBLTE(1),1) - ITE2 = IPAN(IBLTE(2),2) -C - JVTE1 = ISYS(IBLTE(1),1) - JVTE2 = ISYS(IBLTE(2),2) -C - DULE1 = UEDG(2,1) - USAV(2,1) - DULE2 = UEDG(2,2) - USAV(2,2) -C -C---- set LE and TE Ue sensitivities wrt all m values - DO 10 JS=1, 2 - DO 110 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - ULE1_M(JV) = -VTI( 2,1)*VTI(JBL,JS)*DIJ(ILE1,J) - ULE2_M(JV) = -VTI( 2,2)*VTI(JBL,JS)*DIJ(ILE2,J) - UTE1_M(JV) = -VTI(IBLTE(1),1)*VTI(JBL,JS)*DIJ(ITE1,J) - UTE2_M(JV) = -VTI(IBLTE(2),2)*VTI(JBL,JS)*DIJ(ITE2,J) - 110 CONTINUE - 10 CONTINUE -C - ULE1_A = UINV_A(2,1) - ULE2_A = UINV_A(2,2) -C -C**** Go over each boundary layer/wake - DO 2000 IS=1, 2 -C -C---- there is no station "1" at similarity, so zero everything out - DO 20 JS=1, 2 - DO 210 JBL=2, NBL(JS) - JV = ISYS(JBL,JS) - U1_M(JV) = 0. - D1_M(JV) = 0. - 210 CONTINUE - 20 CONTINUE - U1_A = 0. - D1_A = 0. -C - DUE1 = 0. - DDS1 = 0. -C -C---- similarity station pressure gradient parameter x/u du/dx - IBL = 2 - BULE = 1.0 -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C - TRAN = .FALSE. - TURB = .FALSE. -C -C**** Sweep downstream setting up BL equation linearizations - DO 1000 IBL=2, NBL(IS) -C - IV = ISYS(IBL,IS) -C - SIMI = IBL.EQ.2 - WAKE = IBL.GT.IBLTE(IS) - TRAN = IBL.EQ.ITRAN(IS) - TURB = IBL.GT.ITRAN(IS) -C - I = IPAN(IBL,IS) -C -C---- set primary variables for current station - XSI = XSSI(IBL,IS) - IF(IBL.LT.ITRAN(IS)) AMI = CTAU(IBL,IS) - IF(IBL.GE.ITRAN(IS)) CTI = CTAU(IBL,IS) - UEI = UEDG(IBL,IS) - THI = THET(IBL,IS) - MDI = MASS(IBL,IS) -C - DSI = MDI/UEI -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C -C---- set derivatives of DSI (= D2) - D2_M2 = 1.0/UEI - D2_U2 = -DSI/UEI -C - DO 30 JS=1, 2 - DO 310 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - U2_M(JV) = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - D2_M(JV) = D2_U2*U2_M(JV) - 310 CONTINUE - 30 CONTINUE - D2_M(IV) = D2_M(IV) + D2_M2 -C - U2_A = UINV_A(IBL,IS) - D2_A = D2_U2*U2_A -C -C---- "forced" changes due to mismatch between UEDG and USAV=UINV+dij*MASS - DUE2 = UEDG(IBL,IS) - USAV(IBL,IS) - DDS2 = D2_U2*DUE2 -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C---- check for transition and set TRAN, XT, etc. if found - IF(TRAN) THEN -c WRITE(*,*) 'Calling TRCHECK 1...' - CALL TRCHEK - -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - AMI = AMPL2 - ENDIF - IF(IBL.EQ.ITRAN(IS) .AND. .NOT.TRAN) THEN -C WRITE(*,*) 'SETBL: Xtr??? n1 n2: ', AMPL1, AMPL2 - ENDIF -C -C---- assemble 10x4 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C - IF(IBL.EQ.IBLTE(IS)+1) THEN -C -C----- define quantities at start of wake, adding TE base thickness to Dstar - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) -C - TTE_TTE1 = 1.0 - TTE_TTE2 = 1.0 - DTE_MTE1 = 1.0 / UEDG(IBLTE(1),1) - DTE_UTE1 = -DSTR(IBLTE(1),1) / UEDG(IBLTE(1),1) - DTE_MTE2 = 1.0 / UEDG(IBLTE(2),2) - DTE_UTE2 = -DSTR(IBLTE(2),2) / UEDG(IBLTE(2),2) - CTE_CTE1 = THET(IBLTE(1),1)/TTE - CTE_CTE2 = THET(IBLTE(2),2)/TTE - CTE_TTE1 = (CTAU(IBLTE(1),1) - CTE)/TTE - CTE_TTE2 = (CTAU(IBLTE(2),2) - CTE)/TTE -C -C----- re-define D1 sensitivities wrt m since D1 depends on both TE Ds values - DO 35 JS=1, 2 - DO 350 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - D1_M(JV) = DTE_UTE1*UTE1_M(JV) + DTE_UTE2*UTE2_M(JV) - 350 CONTINUE - 35 CONTINUE - D1_M(JVTE1) = D1_M(JVTE1) + DTE_MTE1 - D1_M(JVTE2) = D1_M(JVTE2) + DTE_MTE2 -C -C----- "forced" changes from UEDG --- USAV=UINV+dij*MASS mismatch - DUE1 = 0. - DDS1 = DTE_UTE1*(UEDG(IBLTE(1),1) - USAV(IBLTE(1),1)) - & + DTE_UTE2*(UEDG(IBLTE(2),2) - USAV(IBLTE(2),2)) -C - ELSE -C - CALL BLSYS -C - ENDIF -C -C -C---- Save wall shear and equil. max shear coefficient for plotting output - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 - DELT(IBL,IS) = DE2 - USLP(IBL,IS) = 1.60/(1.0+US2) -C -C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -c IF(WAKE) THEN -c ALD = DLCON -c ELSE -c ALD = 1.0 -c ENDIF -cC -c IF(TURB .AND. .NOT.WAKE) THEN -c GCC = GCCON -c HKC = HK2 - 1.0 - GCC/RT2 -c IF(HKC .LT. 0.01) THEN -c HKC = 0.01 -c ENDIF -c ELSE -c HKC = HK2 - 1.0 -c ENDIF -cC -c HR = HKC / (GACON*ALD*HK2) -c UQ = (0.5*CF2 - HR**2) / (GBCON*D2) -cC -c IF(TURB) THEN -c IBLP = MIN(IBL+1,NBL(IS)) -c IBLM = MAX(IBL-1,2 ) -c DXSSI = XSSI(IBLP,IS) - XSSI(IBLM,IS) -c IF(DXXSI.EQ.0.0) DXSSI = 1.0 -c GUXD(IBL,IS) = -LOG(UEDG(IBLP,IS)/UEDG(IBLM,IS)) / DXSSI -c GUXQ(IBL,IS) = -UQ -c ELSE -c GUXD(IBL,IS) = 0.0 -c GUXQ(IBL,IS) = 0.0 -c ENDIF -C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -C -C---- set XI sensitivities wrt LE Ue changes - IF(IS.EQ.1) THEN - XI_ULE1 = SST_GO - XI_ULE2 = -SST_GP - ELSE - XI_ULE1 = -SST_GO - XI_ULE2 = SST_GP - ENDIF -C -C---- stuff BL system coefficients into main Jacobian matrix -C - DO 40 JV=1, NSYS - VM(1,JV,IV) = VS1(1,3)*D1_M(JV) + VS1(1,4)*U1_M(JV) - & + VS2(1,3)*D2_M(JV) + VS2(1,4)*U2_M(JV) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 40 CONTINUE -C - VB(1,1,IV) = VS1(1,1) - VB(1,2,IV) = VS1(1,2) -C - VA(1,1,IV) = VS2(1,1) - VA(1,2,IV) = VS2(1,2) -C - IF(LALFA) THEN - VDEL(1,2,IV) = VSR(1)*RE_CLMR + VSM(1)*MSQ_CLMR - ELSE - VDEL(1,2,IV) = - & (VS1(1,4)*U1_A + VS1(1,3)*D1_A) - & + (VS2(1,4)*U2_A + VS2(1,3)*D2_A) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(1,1,IV) = VSREZ(1) - & + (VS1(1,4)*DUE1 + VS1(1,3)*DDS1) - & + (VS2(1,4)*DUE2 + VS2(1,3)*DDS2) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - DO 50 JV=1, NSYS - VM(2,JV,IV) = VS1(2,3)*D1_M(JV) + VS1(2,4)*U1_M(JV) - & + VS2(2,3)*D2_M(JV) + VS2(2,4)*U2_M(JV) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 50 CONTINUE -C - VB(2,1,IV) = VS1(2,1) - VB(2,2,IV) = VS1(2,2) -C - VA(2,1,IV) = VS2(2,1) - VA(2,2,IV) = VS2(2,2) -C - IF(LALFA) THEN - VDEL(2,2,IV) = VSR(2)*RE_CLMR + VSM(2)*MSQ_CLMR - ELSE - VDEL(2,2,IV) = - & (VS1(2,4)*U1_A + VS1(2,3)*D1_A) - & + (VS2(2,4)*U2_A + VS2(2,3)*D2_A) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(2,1,IV) = VSREZ(2) - & + (VS1(2,4)*DUE1 + VS1(2,3)*DDS1) - & + (VS2(2,4)*DUE2 + VS2(2,3)*DDS2) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - DO 60 JV=1, NSYS - VM(3,JV,IV) = VS1(3,3)*D1_M(JV) + VS1(3,4)*U1_M(JV) - & + VS2(3,3)*D2_M(JV) + VS2(3,4)*U2_M(JV) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 60 CONTINUE -C - VB(3,1,IV) = VS1(3,1) - VB(3,2,IV) = VS1(3,2) -C - VA(3,1,IV) = VS2(3,1) - VA(3,2,IV) = VS2(3,2) -C - IF(LALFA) THEN - VDEL(3,2,IV) = VSR(3)*RE_CLMR + VSM(3)*MSQ_CLMR - ELSE - VDEL(3,2,IV) = - & (VS1(3,4)*U1_A + VS1(3,3)*D1_A) - & + (VS2(3,4)*U2_A + VS2(3,3)*D2_A) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(3,1,IV) = VSREZ(3) - & + (VS1(3,4)*DUE1 + VS1(3,3)*DDS1) - & + (VS2(3,4)*DUE2 + VS2(3,3)*DDS2) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - IF(IBL.EQ.IBLTE(IS)+1) THEN -C -C----- redefine coefficients for TTE, DTE, etc - VZ(1,1) = VS1(1,1)*CTE_CTE1 - VZ(1,2) = VS1(1,1)*CTE_TTE1 + VS1(1,2)*TTE_TTE1 - VB(1,1,IV) = VS1(1,1)*CTE_CTE2 - VB(1,2,IV) = VS1(1,1)*CTE_TTE2 + VS1(1,2)*TTE_TTE2 -C - VZ(2,1) = VS1(2,1)*CTE_CTE1 - VZ(2,2) = VS1(2,1)*CTE_TTE1 + VS1(2,2)*TTE_TTE1 - VB(2,1,IV) = VS1(2,1)*CTE_CTE2 - VB(2,2,IV) = VS1(2,1)*CTE_TTE2 + VS1(2,2)*TTE_TTE2 -C - VZ(3,1) = VS1(3,1)*CTE_CTE1 - VZ(3,2) = VS1(3,1)*CTE_TTE1 + VS1(3,2)*TTE_TTE1 - VB(3,1,IV) = VS1(3,1)*CTE_CTE2 - VB(3,2,IV) = VS1(3,1)*CTE_TTE2 + VS1(3,2)*TTE_TTE2 -C - ENDIF -C -C---- turbulent intervals will follow if currently at transition interval - IF(TRAN) THEN - TURB = .TRUE. -C -C------ save transition location - ITRAN(IS) = IBL - TFORCE(IS) = TRFORC - XSSITR(IS) = XT -C -C------ interpolate airfoil geometry to find transition x/c -C- (for user output) - IF(IS.EQ.1) THEN - STR = SST - XT - ELSE - STR = SST + XT - ENDIF - CHX = XTE - XLE - CHY = YTE - YLE - CHSQ = CHX**2 + CHY**2 - XTR = SEVAL(STR,X,XP,S,N) - YTR = SEVAL(STR,Y,YP,S,N) - XOCTR(IS) = ((XTR-XLE)*CHX + (YTR-YLE)*CHY)/CHSQ - YOCTR(IS) = ((YTR-YLE)*CHX - (XTR-XLE)*CHY)/CHSQ - ENDIF -C - TRAN = .FALSE. -C - IF(IBL.EQ.IBLTE(IS)) THEN -C----- set "2" variables at TE to wake correlations for next station -C - TURB = .TRUE. - WAKE = .TRUE. - CALL BLVAR(3) - CALL BLMID(3) - ENDIF -C - DO 80 JS=1, 2 - DO 810 JBL=2, NBL(JS) - JV = ISYS(JBL,JS) - U1_M(JV) = U2_M(JV) - D1_M(JV) = D2_M(JV) - 810 CONTINUE - 80 CONTINUE -C - U1_A = U2_A - D1_A = D2_A -C - DUE1 = DUE2 - DDS1 = DDS2 -C -C---- set BL variables for next station - DO 190 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 190 CONTINUE -C -C---- next streamwise station - 1000 CONTINUE -C - IF(TFORCE(IS)) THEN -C WRITE(*,9100) IS,XOCTR(IS),ITRAN(IS) - 9100 FORMAT(1X,'Side',I2,' forced transition at x/c = ',F7.4,I5) - ELSE -C WRITE(*,9200) IS,XOCTR(IS),ITRAN(IS) - 9200 FORMAT(1X,'Side',I2,' free transition at x/c = ',F7.4,I5) - ENDIF -C -C---- next airfoil side - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE IBLSYS -C--------------------------------------------- -C Sets the BL Newton system line number -C corresponding to each BL station. -C--------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' -C - IV = 0 - DO 10 IS=1, 2 - DO 110 IBL=2, NBL(IS) - IV = IV+1 - ISYS(IBL,IS) = IV - 110 CONTINUE - 10 CONTINUE -C - NSYS = IV - IF(NSYS.GT.2*IVX) STOP '*** IBLSYS: BL system array overflow. ***' -C - RETURN - END - - - SUBROUTINE MRCHUE -C---------------------------------------------------- -C Marches the BLs and wake in direct mode using -C the UEDG array. If separation is encountered, -C a plausible value of Hk extrapolated from -C upstream is prescribed instead. Continuous -C checking of transition onset is performed. -C---------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' - LOGICAL DIRECT - REAL MSQ -C -C---- shape parameters for separation criteria - HLMAX = 3.8 - HTMAX = 2.5 -C - DO 2000 IS=1, 2 -C -C WRITE(*,*) ' side ', IS, ' ...' -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C -C---- initialize similarity station with Thwaites' formula - IBL = 2 - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -C BULE = LOG(UEDG(IBL+1,IS)/UEI) / LOG(XSSI(IBL+1,IS)/XSI) -C BULE = MAX( -.08 , BULE ) - BULE = 1.0 - UCON = UEI/XSI**BULE - TSQ = 0.45/(UCON*(5.0*BULE+1.0)*REYBL) * XSI**(1.0-BULE) - THI = SQRT(TSQ) - DSI = 2.2*THI - AMI = 0.0 -C -C---- initialize Ctau for first turbulent station - CTI = 0.03 -C - TRAN = .FALSE. - TURB = .FALSE. - ITRAN(IS) = IBLTE(IS) -C -C---- march downstream - DO 1000 IBL=2, NBL(IS) - IBM = IBL-1 -C - IW = IBL - IBLTE(IS) -C - SIMI = IBL.EQ.2 - WAKE = IBL.GT.IBLTE(IS) -C -C------ prescribed quantities - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C - DIRECT = .TRUE. -C -C------ Newton iteration loop for current station - DO 100 ITBL=1, 25 -C -C-------- assemble 10x3 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C (the "1" station coefficients will be ignored) -C -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C-------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 2...' - - CALL TRCHEK -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 -C -C--------- fixed BUG MD 7 Jun 99 - IF(TRAN) THEN - ITRAN(IS) = IBL - IF(CTI.LE.0.0) THEN - CTI = 0.03 - S2 = CTI - ENDIF - ELSE - ITRAN(IS) = IBL+2 - ENDIF -C -C - ENDIF -C - IF(IBL.EQ.IBLTE(IS)+1) THEN - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) - ELSE - CALL BLSYS - ENDIF -C - IF(DIRECT) THEN -C -C--------- try direct mode (set dUe = 0 in currently empty 4th line) - VS2(4,1) = 0. - VS2(4,2) = 0. - VS2(4,3) = 0. - VS2(4,4) = 1.0 - VSREZ(4) = 0. -C -C--------- solve Newton system for current "2" station - CALL GAUSS(4,4,VS2,VSREZ,1) -C -C--------- determine max changes and underrelax if necessary - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - IF(IBL.LT.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/10.0)) - IF(IBL.GE.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/CTI )) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C--------- see if direct mode is not applicable - IF(IBL .NE. IBLTE(IS)+1) THEN -C -C---------- calculate resulting kinematic shape parameter Hk - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - HTEST = (DSI + RLX*VSREZ(3)) / (THI + RLX*VSREZ(2)) - CALL HKIN( HTEST, MSQ, HKTEST, DUMMY, DUMMY) -C -C---------- decide whether to do direct or inverse problem based on Hk - IF(IBL.LT.ITRAN(IS)) HMAX = HLMAX - IF(IBL.GE.ITRAN(IS)) HMAX = HTMAX - DIRECT = HKTEST.LT.HMAX - ENDIF -C - IF(DIRECT) THEN -C---------- update as usual -ccc IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - ELSE -C---------- set prescribed Hk for inverse calculation at the current station - IF(IBL.LT.ITRAN(IS)) THEN -C----------- laminar case: relatively slow increase in Hk downstream - HTARG = HK1 + 0.03*(X2-X1)/T1 - ELSE IF(IBL.EQ.ITRAN(IS)) THEN -C----------- transition interval: weighted laminar and turbulent case - HTARG = HK1 + (0.03*(XT-X1) - 0.15*(X2-XT))/T1 - ELSE IF(WAKE) THEN -C----------- turbulent wake case: -C- asymptotic wake behavior with approximate Backward Euler - CONST = 0.03*(X2-X1)/T1 - HK2 = HK1 - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HTARG = HK2 - ELSE -C----------- turbulent case: relatively fast decrease in Hk downstream - HTARG = HK1 - 0.15*(X2-X1)/T1 - ENDIF -C -C---------- limit specified Hk to something reasonable - IF(WAKE) THEN - HTARG = MAX( HTARG , 1.01 ) - ELSE - HTARG = MAX( HTARG , HMAX ) - ENDIF -C -C WRITE(*,1300) IBL, HTARG - 1300 FORMAT(' MRCHUE: Inverse mode at', I4, ' Hk =', F8.3) -C -C---------- try again with prescribed Hk - GO TO 100 -C - ENDIF -C - ELSE -C -C-------- inverse mode (force Hk to prescribed value HTARG) - VS2(4,1) = 0. - VS2(4,2) = HK2_T2 - VS2(4,3) = HK2_D2 - VS2(4,4) = HK2_U2 - VSREZ(4) = HTARG - HK2 -C - CALL GAUSS(4,4,VS2,VSREZ,1) -C - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - IF(IBL.GE.ITRAN(IS)) DMAX = MAX( DMAX , ABS(VSREZ(1)/CTI)) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C--------- update variables -ccc IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - UEI = UEI + RLX*VSREZ(4) -C - ENDIF -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) THEN - CTI = MIN(CTI , 0.30 ) - CTI = MAX(CTI , 0.0000001 ) - ENDIF -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - DSW = DSI - DSWAKI - CALL DSLIM(DSW,THI,UEI,MSQ,HKLIM) - DSI = DSW + DSWAKI -C - IF(DMAX.LE.1.0E-5) GO TO 110 -C - 100 CONTINUE -C WRITE(*,1350) IBL, IS, DMAX - 1350 FORMAT(' MRCHUE: Convergence failed at',I4,' side',I2, - & ' Res =', E12.4) -C -C------ the current unconverged solution might still be reasonable... -CCC IF(DMAX .LE. 0.1) GO TO 110 - IF(DMAX .LE. 0.1) GO TO 109 -C -C------- the current solution is garbage --> extrapolate values instead - IF(IBL.GT.3) THEN - IF(IBL.LE.IBLTE(IS)) THEN - THI = THET(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - DSI = DSTR(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - ELSE IF(IBL.EQ.IBLTE(IS)+1) THEN - CTI = CTE - THI = TTE - DSI = DTE - ELSE - THI = THET(IBM,IS) - RATLEN = (XSSI(IBL,IS)-XSSI(IBM,IS)) / (10.0*DSTR(IBM,IS)) - DSI = (DSTR(IBM,IS) + THI*RATLEN) / (1.0 + RATLEN) - ENDIF - IF(IBL.EQ.ITRAN(IS)) CTI = 0.05 - IF(IBL.GT.ITRAN(IS)) CTI = CTAU(IBM,IS) -C - UEI = UEDG(IBL,IS) - IF(IBL.GT.2 .AND. IBL.LT.NBL(IS)) - & UEI = 0.5*(UEDG(IBL-1,IS) + UEDG(IBL+1,IS)) - ENDIF -C - 109 CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 3...' - - CALL TRCHEK -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C -C------- set all other extrapolated values for current station - IF(IBL.LT.ITRAN(IS)) CALL BLVAR(1) - IF(IBL.GE.ITRAN(IS)) CALL BLVAR(2) - IF(WAKE) CALL BLVAR(3) -C - IF(IBL.LT.ITRAN(IS)) CALL BLMID(1) - IF(IBL.GE.ITRAN(IS)) CALL BLMID(2) - IF(WAKE) CALL BLMID(3) -C -C------ pick up here after the Newton iterations - 110 CONTINUE -C -C------ store primary variables - IF(IBL.LT.ITRAN(IS)) CTAU(IBL,IS) = AMI - IF(IBL.GE.ITRAN(IS)) CTAU(IBL,IS) = CTI - THET(IBL,IS) = THI - DSTR(IBL,IS) = DSI - UEDG(IBL,IS) = UEI - MASS(IBL,IS) = DSI*UEI - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 - DELT(IBL,IS) = DE2 -C -C------ set "1" variables to "2" variables for next streamwise station - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN - DO 310 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 310 CONTINUE -C -C------ turbulent intervals will follow transition interval or TE - IF(TRAN .OR. IBL.EQ.IBLTE(IS)) THEN - TURB = .TRUE. -C -C------- save transition location - TFORCE(IS) = TRFORC - XSSITR(IS) = XT - ENDIF -C - TRAN = .FALSE. -C - IF(IBL.EQ.IBLTE(IS)) THEN - THI = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DSI = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - ENDIF -C - 1000 CONTINUE - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE MRCHDU -C---------------------------------------------------- -C Marches the BLs and wake in mixed mode using -C the current Ue and Hk. The calculated Ue -C and Hk lie along a line quasi-normal to the -C natural Ue-Hk characteristic line of the -C current BL so that the Goldstein or Levy-Lees -C singularity is never encountered. Continuous -C checking of transition onset is performed. -C---------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' - REAL VTMP(4,5), VZTMP(4) - REAL MSQ - REAL SENNEW -ccc REAL MDI -C - DATA DEPS / 5.0E-4 / -C -C---- constant controlling how far Hk is allowed to deviate -C- from the specified value. - SENSWT = 1000.0 - SENNEW = 0.0 -C - DO 2000 IS=1, 2 -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C -C---- set leading edge pressure gradient parameter x/u du/dx - IBL = 2 - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -CCC BULE = LOG(UEDG(IBL+1,IS)/UEI) / LOG(XSSI(IBL+1,IS)/XSI) -CCC BULE = MAX( -.08 , BULE ) - BULE = 1.0 -C -C---- old transition station - ITROLD = ITRAN(IS) -C - TRAN = .FALSE. - TURB = .FALSE. - ITRAN(IS) = IBLTE(IS) -C -C---- march downstream - DO 1000 IBL=2, NBL(IS) - IBM = IBL-1 -C - SIMI = IBL.EQ.2 - WAKE = IBL.GT.IBLTE(IS) -C -C------ initialize current station to existing variables - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) - THI = THET(IBL,IS) - DSI = DSTR(IBL,IS) -CCC MDI = MASS(IBL,IS) -C -C------ fixed BUG MD 7 June 99 - IF(IBL.LT.ITROLD) THEN - AMI = CTAU(IBL,IS) - CTI = 0.03 - ELSE - CTI = CTAU(IBL,IS) - IF(CTI.LE.0.0) CTI = 0.03 - ENDIF -C -CCC DSI = MDI/UEI -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C - IF(IBL.LE.IBLTE(IS)) DSI = MAX(DSI-DSWAKI,1.02000*THI) + DSWAKI - IF(IBL.GT.IBLTE(IS)) DSI = MAX(DSI-DSWAKI,1.00005*THI) + DSWAKI -C -C------ Newton iteration loop for current station - DO 100 ITBL=1, 25 -C -C-------- assemble 10x3 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C (the "1" station coefficients will be ignored) -C -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C-------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 4...' - - CALL TRCHEK -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C - IF(IBL.EQ.IBLTE(IS)+1) THEN - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) - ELSE - CALL BLSYS - ENDIF -C -C-------- set stuff at first iteration... - IF(ITBL.EQ.1) THEN -C -C--------- set "baseline" Ue and Hk for forming Ue(Hk) relation - UEREF = U2 - HKREF = HK2 -C -C--------- if current point IBL was turbulent and is now laminar, then... - IF(IBL.LT.ITRAN(IS) .AND. IBL.GE.ITROLD ) THEN -C---------- extrapolate baseline Hk - UEM = UEDG(IBL-1,IS) - DSM = DSTR(IBL-1,IS) - THM = THET(IBL-1,IS) - MSQ = UEM*UEM*HSTINV / (GM1BL*(1.0 - 0.5*UEM*UEM*HSTINV)) - CALL HKIN( DSM/THM, MSQ, HKREF, DUMMY, DUMMY ) - ENDIF -C -C--------- if current point IBL was laminar, then... - IF(IBL.LT.ITROLD) THEN -C---------- reinitialize or extrapolate Ctau if it's now turbulent - IF(TRAN) CTAU(IBL,IS) = 0.03 - IF(TURB) CTAU(IBL,IS) = CTAU(IBL-1,IS) - IF(TRAN .OR. TURB) THEN - CTI = CTAU(IBL,IS) - S2 = CTI - ENDIF - ENDIF -C - ENDIF -C -C - IF(SIMI .OR. IBL.EQ.IBLTE(IS)+1) THEN -C -C--------- for similarity station or first wake point, prescribe Ue - VS2(4,1) = 0. - VS2(4,2) = 0. - VS2(4,3) = 0. - VS2(4,4) = U2_UEI - VSREZ(4) = UEREF - U2 -C - ELSE -C -C********* calculate Ue-Hk characteristic slope -C - DO 20 K=1, 4 - VZTMP(K) = VSREZ(K) - DO 201 L=1, 5 - VTMP(K,L) = VS2(K,L) - 201 CONTINUE - 20 CONTINUE -C -C--------- set unit dHk - VTMP(4,1) = 0. - VTMP(4,2) = HK2_T2 - VTMP(4,3) = HK2_D2 - VTMP(4,4) = HK2_U2*U2_UEI - VZTMP(4) = 1.0 -C -C--------- calculate dUe response - CALL GAUSS(4,4,VTMP,VZTMP,1) -C -C--------- set SENSWT * (normalized dUe/dHk) - SENNEW = SENSWT * VZTMP(4) * HKREF/UEREF - IF(ITBL.LE.5) THEN - SENS = SENNEW - ELSE IF(ITBL.LE.15) THEN - SENS = 0.5*(SENS + SENNEW) - ENDIF -C -C--------- set prescribed Ue-Hk combination - VS2(4,1) = 0. - VS2(4,2) = HK2_T2 * HKREF - VS2(4,3) = HK2_D2 * HKREF - VS2(4,4) =( HK2_U2 * HKREF + SENS/UEREF )*U2_UEI - VSREZ(4) = -(HKREF**2)*(HK2 / HKREF - 1.0) - & - SENS*(U2 / UEREF - 1.0) -C - ENDIF -C -C-------- solve Newton system for current "2" station - CALL GAUSS(4,4,VS2,VSREZ,1) -C -C-------- determine max changes and underrelax if necessary - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - IF(IBL.GE.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/(10.0*CTI))) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C-------- update as usual - IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - UEI = UEI + RLX*VSREZ(4) -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) THEN - CTI = MIN(CTI , 0.30 ) - CTI = MAX(CTI , 0.0000001 ) - ENDIF -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - DSW = DSI - DSWAKI - CALL DSLIM(DSW,THI,UEI,MSQ,HKLIM) - DSI = DSW + DSWAKI -C - IF(DMAX.LE.DEPS) GO TO 110 -C - 100 CONTINUE -C -C WRITE(*,1350) IBL, IS, DMAX - 1350 FORMAT(' MRCHDU: Convergence failed at',I4,' side',I2, - & ' Res =', E12.4) -C -C------ the current unconverged solution might still be reasonable... -CCC IF(DMAX .LE. 0.1) GO TO 110 - IF(DMAX .LE. 0.1) GO TO 109 -C -C------- the current solution is garbage --> extrapolate values instead - IF(IBL.GT.3) THEN - IF(IBL.LE.IBLTE(IS)) THEN - THI = THET(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - DSI = DSTR(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - UEI = UEDG(IBM,IS) - ELSE IF(IBL.EQ.IBLTE(IS)+1) THEN - CTI = CTE - THI = TTE - DSI = DTE - UEI = UEDG(IBM,IS) - ELSE - THI = THET(IBM,IS) - RATLEN = (XSSI(IBL,IS)-XSSI(IBM,IS)) / (10.0*DSTR(IBM,IS)) - DSI = (DSTR(IBM,IS) + THI*RATLEN) / (1.0 + RATLEN) - UEI = UEDG(IBM,IS) - ENDIF - IF(IBL.EQ.ITRAN(IS)) CTI = 0.05 - IF(IBL.GT.ITRAN(IS)) CTI = CTAU(IBM,IS) - ENDIF -C - 109 CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 5...' - - CALL TRCHEK -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C -C------- set all other extrapolated values for current station - IF(IBL.LT.ITRAN(IS)) CALL BLVAR(1) - IF(IBL.GE.ITRAN(IS)) CALL BLVAR(2) - IF(WAKE) CALL BLVAR(3) -C - IF(IBL.LT.ITRAN(IS)) CALL BLMID(1) - IF(IBL.GE.ITRAN(IS)) CALL BLMID(2) - IF(WAKE) CALL BLMID(3) -C -C------ pick up here after the Newton iterations - 110 CONTINUE -C - SENS = SENNEW -C -C------ store primary variables - IF(IBL.LT.ITRAN(IS)) CTAU(IBL,IS) = AMI - IF(IBL.GE.ITRAN(IS)) CTAU(IBL,IS) = CTI - THET(IBL,IS) = THI - DSTR(IBL,IS) = DSI - UEDG(IBL,IS) = UEI - MASS(IBL,IS) = DSI*UEI - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 -C -C------ set "1" variables to "2" variables for next streamwise station - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN - DO 310 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 310 CONTINUE -C -C -C------ turbulent intervals will follow transition interval or TE - IF(TRAN .OR. IBL.EQ.IBLTE(IS)) THEN - TURB = .TRUE. -C -C------- save transition location - TFORCE(IS) = TRFORC - XSSITR(IS) = XT - ENDIF -C - TRAN = .FALSE. -C - 1000 CONTINUE -C - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE XIFSET(IS) -C----------------------------------------------------- -C Sets forced-transition BL coordinate locations. -C----------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' -C - IF(XSTRIP(IS).GE.1.0) THEN - XIFORC = XSSI(IBLTE(IS),IS) - RETURN - ENDIF -C - CHX = XTE - XLE - CHY = YTE - YLE - CHSQ = CHX**2 + CHY**2 -C -C---- calculate chord-based x/c, y/c - DO 10 I=1, N - W1(I) = ((X(I)-XLE)*CHX + (Y(I)-YLE)*CHY) / CHSQ - W2(I) = ((Y(I)-YLE)*CHX - (X(I)-XLE)*CHY) / CHSQ - 10 CONTINUE -C - CALL SPLIND(W1,W3,S,N,-999.0,-999.0) - CALL SPLIND(W2,W4,S,N,-999.0,-999.0) -C - IF(IS.EQ.1) THEN -C -C----- set approximate arc length of forced transition point for SINVRT - STR = SLE + (S(1)-SLE)*XSTRIP(IS) -C -C----- calculate actual arc length - CALL SINVRT(STR,XSTRIP(IS),W1,W3,S,N) -C -C----- set BL coordinate value - XIFORC = MIN( (SST - STR) , XSSI(IBLTE(IS),IS) ) -C - ELSE -C----- same for bottom side -C - STR = SLE + (S(N)-SLE)*XSTRIP(IS) - CALL SINVRT(STR,XSTRIP(IS),W1,W3,S,N) - XIFORC = MIN( (STR - SST) , XSSI(IBLTE(IS),IS) ) -C - ENDIF -C - IF(XIFORC .LT. 0.0) THEN -C WRITE(*,1000) IS - 1000 FORMAT(/' *** Stagnation point is past trip on side',I2,' ***') - XIFORC = XSSI(IBLTE(IS),IS) - ENDIF -C - RETURN - END - - - - - SUBROUTINE UPDATE -C------------------------------------------------------------------ -C Adds on Newton deltas to boundary layer variables. -C Checks for excessive changes and underrelaxes if necessary. -C Calculates max and rms changes. -C Also calculates the change in the global variable "AC". -C If LALFA=.TRUE. , "AC" is CL -C If LALFA=.FALSE., "AC" is alpha -C------------------------------------------------------------------ - INCLUDE 'XFOIL.INC' - REAL UNEW(IVX,2), U_AC(IVX,2) - REAL QNEW(IQX), Q_AC(IQX) - EQUIVALENCE (VA(1,1,1), UNEW(1,1)) , - & (VB(1,1,1), QNEW(1) ) - EQUIVALENCE (VA(1,1,IVX), U_AC(1,1)) , - & (VB(1,1,IVX), Q_AC(1) ) - REAL MSQ -C -C---- max allowable alpha changes per iteration - DALMAX = 0.5*DTOR - DALMIN = -0.5*DTOR -C -C---- max allowable CL change per iteration - DCLMAX = 0.5 - DCLMIN = -0.5 - IF(MATYP.NE.1) DCLMIN = MAX(-0.5 , -0.9*CL) -C - HSTINV = GAMM1*(MINF/QINF)**2 / (1.0 + 0.5*GAMM1*MINF**2) -C -C---- calculate new Ue distribution assuming no under-relaxation -C- also set the sensitivity of Ue wrt to alpha or Re - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - I = IPAN(IBL,IS) -C - DUI = 0. - DUI_AC = 0. - DO 100 JS=1, 2 - DO 1000 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - UE_M = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - DUI = DUI + UE_M*(MASS(JBL,JS)+VDEL(3,1,JV)) - DUI_AC = DUI_AC + UE_M*( -VDEL(3,2,JV)) - 1000 CONTINUE - 100 CONTINUE -C -C-------- UINV depends on "AC" only if "AC" is alpha - IF(LALFA) THEN - UINV_AC = 0. - ELSE - UINV_AC = UINV_A(IBL,IS) - ENDIF -C - UNEW(IBL,IS) = UINV(IBL,IS) + DUI - U_AC(IBL,IS) = UINV_AC + DUI_AC -C - 10 CONTINUE - 1 CONTINUE -C -C---- set new Qtan from new Ue with appropriate sign change - DO 2 IS=1, 2 - DO 20 IBL=2, IBLTE(IS) - I = IPAN(IBL,IS) - QNEW(I) = VTI(IBL,IS)*UNEW(IBL,IS) - Q_AC(I) = VTI(IBL,IS)*U_AC(IBL,IS) - 20 CONTINUE - 2 CONTINUE -C -C---- calculate new CL from this new Qtan - SA = SIN(ALFA) - CA = COS(ALFA) -C - BETA = SQRT(1.0 - MINF**2) - BETA_MSQ = -0.5/BETA -C - BFAC = 0.5*MINF**2 / (1.0 + BETA) - BFAC_MSQ = 0.5 / (1.0 + BETA) - & - BFAC / (1.0 + BETA) * BETA_MSQ -C - CLNEW = 0. - CL_A = 0. - CL_MS = 0. - CL_AC = 0. -C - I = 1 - CGINC = 1.0 - (QNEW(I)/QINF)**2 - CPG1 = CGINC / (BETA + BFAC*CGINC) - CPG1_MS = -CPG1/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_Q = -2.0*QNEW(I)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG1)/ (BETA + BFAC*CGINC) - CPG1_AC = CPC_CPI*CPI_Q*Q_AC(I) -C - DO 3 I=1, N - IP = I+1 - IF(I.EQ.N) IP = 1 -C - CGINC = 1.0 - (QNEW(IP)/QINF)**2 - CPG2 = CGINC / (BETA + BFAC*CGINC) - CPG2_MS = -CPG2/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_Q = -2.0*QNEW(IP)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG2)/ (BETA + BFAC*CGINC) - CPG2_AC = CPC_CPI*CPI_Q*Q_AC(IP) -C - DX = (X(IP) - X(I))*CA + (Y(IP) - Y(I))*SA - DX_A = -(X(IP) - X(I))*SA + (Y(IP) - Y(I))*CA -C - AG = 0.5*(CPG2 + CPG1 ) - AG_MS = 0.5*(CPG2_MS + CPG1_MS) - AG_AC = 0.5*(CPG2_AC + CPG1_AC) -C - CLNEW = CLNEW + DX *AG - CL_A = CL_A + DX_A*AG - CL_MS = CL_MS + DX *AG_MS - CL_AC = CL_AC + DX *AG_AC -C - CPG1 = CPG2 - CPG1_MS = CPG2_MS - CPG1_AC = CPG2_AC - 3 CONTINUE -C -C---- initialize under-relaxation factor - RLX = 1.0 -C - IF(LALFA) THEN -C===== alpha is prescribed: AC is CL -C -C----- set change in Re to account for CL changing, since Re = Re(CL) - DAC = (CLNEW - CL) / (1.0 - CL_AC - CL_MS*2.0*MINF*MINF_CL) -C -C----- set under-relaxation factor if Re change is too large - IF(RLX*DAC .GT. DCLMAX) RLX = DCLMAX/DAC - IF(RLX*DAC .LT. DCLMIN) RLX = DCLMIN/DAC -C - ELSE -C===== CL is prescribed: AC is alpha -C -C----- set change in alpha to drive CL to prescribed value - DAC = (CLNEW - CLSPEC) / (0.0 - CL_AC - CL_A) -C -C----- set under-relaxation factor if alpha change is too large - IF(RLX*DAC .GT. DALMAX) RLX = DALMAX/DAC - IF(RLX*DAC .LT. DALMIN) RLX = DALMIN/DAC -C - ENDIF -C - RMSBL = 0. - RMXBL = 0. -C - DHI = 1.5 - DLO = -.5 -C -C---- calculate changes in BL variables and under-relaxation if needed - DO 4 IS=1, 2 - DO 40 IBL=2, NBL(IS) - IV = ISYS(IBL,IS) -C -C-------- set changes without underrelaxation - DCTAU = VDEL(1,1,IV) - DAC*VDEL(1,2,IV) - DTHET = VDEL(2,1,IV) - DAC*VDEL(2,2,IV) - DMASS = VDEL(3,1,IV) - DAC*VDEL(3,2,IV) - DUEDG = UNEW(IBL,IS) + DAC*U_AC(IBL,IS) - UEDG(IBL,IS) - DDSTR = (DMASS - DSTR(IBL,IS)*DUEDG)/UEDG(IBL,IS) -C -C-------- normalize changes - IF(IBL.LT.ITRAN(IS)) DN1 = DCTAU / 10.0 - IF(IBL.GE.ITRAN(IS)) DN1 = DCTAU / CTAU(IBL,IS) - DN2 = DTHET / THET(IBL,IS) - DN3 = DDSTR / DSTR(IBL,IS) - DN4 = ABS(DUEDG)/0.25 -C -C-------- accumulate for rms change - RMSBL = RMSBL + DN1**2 + DN2**2 + DN3**2 + DN4**2 -C -C-------- see if Ctau needs underrelaxation - RDN1 = RLX*DN1 - IF(ABS(DN1) .GT. ABS(RMXBL)) THEN - RMXBL = DN1 - IF(IBL.LT.ITRAN(IS)) VMXBL = 'n' - IF(IBL.GE.ITRAN(IS)) VMXBL = 'C' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN1 .GT. DHI) RLX = DHI/DN1 - IF(RDN1 .LT. DLO) RLX = DLO/DN1 -C -C-------- see if Theta needs underrelaxation - RDN2 = RLX*DN2 - IF(ABS(DN2) .GT. ABS(RMXBL)) THEN - RMXBL = DN2 - VMXBL = 'T' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN2 .GT. DHI) RLX = DHI/DN2 - IF(RDN2 .LT. DLO) RLX = DLO/DN2 -C -C-------- see if Dstar needs underrelaxation - RDN3 = RLX*DN3 - IF(ABS(DN3) .GT. ABS(RMXBL)) THEN - RMXBL = DN3 - VMXBL = 'D' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN3 .GT. DHI) RLX = DHI/DN3 - IF(RDN3 .LT. DLO) RLX = DLO/DN3 -C -C-------- see if Ue needs underrelaxation - RDN4 = RLX*DN4 - IF(ABS(DN4) .GT. ABS(RMXBL)) THEN - RMXBL = DUEDG - VMXBL = 'U' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN4 .GT. DHI) RLX = DHI/DN4 - IF(RDN4 .LT. DLO) RLX = DLO/DN4 -C - 40 CONTINUE - 4 CONTINUE -C -C---- set true rms change - RMSBL = SQRT( RMSBL / (4.0*FLOAT( NBL(1)+NBL(2) )) ) -C -C - IF(LALFA) THEN -C----- set underrelaxed change in Reynolds number from change in lift - CL = CL + RLX*DAC - ELSE -C----- set underrelaxed change in alpha - ALFA = ALFA + RLX*DAC - ADEG = ALFA/DTOR - ENDIF -C -C---- update BL variables with underrelaxed changes - DO 5 IS=1, 2 - DO 50 IBL=2, NBL(IS) - IV = ISYS(IBL,IS) -C - DCTAU = VDEL(1,1,IV) - DAC*VDEL(1,2,IV) - DTHET = VDEL(2,1,IV) - DAC*VDEL(2,2,IV) - DMASS = VDEL(3,1,IV) - DAC*VDEL(3,2,IV) - DUEDG = UNEW(IBL,IS) + DAC*U_AC(IBL,IS) - UEDG(IBL,IS) - DDSTR = (DMASS - DSTR(IBL,IS)*DUEDG)/UEDG(IBL,IS) -C - CTAU(IBL,IS) = CTAU(IBL,IS) + RLX*DCTAU - THET(IBL,IS) = THET(IBL,IS) + RLX*DTHET - DSTR(IBL,IS) = DSTR(IBL,IS) + RLX*DDSTR - UEDG(IBL,IS) = UEDG(IBL,IS) + RLX*DUEDG -C - IF(IBL.GT.IBLTE(IS)) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) - & CTAU(IBL,IS) = MIN( CTAU(IBL,IS) , 0.25 ) -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEDG(IBL,IS)**2*HSTINV - & / (GAMM1*(1.0 - 0.5*UEDG(IBL,IS)**2*HSTINV)) - DSW = DSTR(IBL,IS) - DSWAKI - CALL DSLIM(DSW,THET(IBL,IS),UEDG(IBL,IS),MSQ,HKLIM) - DSTR(IBL,IS) = DSW + DSWAKI -C -C-------- set new mass defect (nonlinear update) - MASS(IBL,IS) = DSTR(IBL,IS) * UEDG(IBL,IS) -C - 50 CONTINUE - 5 CONTINUE -C -C -C---- equate upper wake arrays to lower wake arrays - DO 6 KBL=1, NBL(2)-IBLTE(2) - CTAU(IBLTE(1)+KBL,1) = CTAU(IBLTE(2)+KBL,2) - THET(IBLTE(1)+KBL,1) = THET(IBLTE(2)+KBL,2) - DSTR(IBLTE(1)+KBL,1) = DSTR(IBLTE(2)+KBL,2) - UEDG(IBLTE(1)+KBL,1) = UEDG(IBLTE(2)+KBL,2) - TAU(IBLTE(1)+KBL,1) = TAU(IBLTE(2)+KBL,2) - DIS(IBLTE(1)+KBL,1) = DIS(IBLTE(2)+KBL,2) - CTQ(IBLTE(1)+KBL,1) = CTQ(IBLTE(2)+KBL,2) - 6 CONTINUE -C - RETURN - END - - - - SUBROUTINE DSLIM(DSTR,THET,UEDG,MSQ,HKLIM) - IMPLICIT REAL (A-H,M,O-Z) -C - H = DSTR/THET - CALL HKIN(H,MSQ,HK,HK_H,HK_M) -C - DH = MAX( 0.0 , HKLIM-HK ) / HK_H - DSTR = DSTR + DH*THET -C - RETURN - END - - diff --git a/deps/src/xfoil/xblsys.f b/deps/src/xfoil/xblsys.f deleted file mode 100644 index b2d1bbc..0000000 --- a/deps/src/xfoil/xblsys.f +++ /dev/null @@ -1,2351 +0,0 @@ -C*********************************************************************** -C Module: xblsys.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - - SUBROUTINE TRCHEK -C -C---- 1st-order amplification equation -cc CALL TRCHEK1 -C -C---- 2nd-order amplification equation - CALL TRCHEK2 -C - - RETURN - END - - - - SUBROUTINE AXSET( HK1, T1, RT1, A1, - & HK2, T2, RT2, A2, ACRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -C---------------------------------------------------------- -C Returns average amplification AX over interval 1..2 -C---------------------------------------------------------- -C -cC========================== -cC---- 1st-order -- based on "1" quantities only -c CALL DAMPL( HK1, T1, RT1, AX1, AX1_HK1, AX1_T1, AX1_RT1 ) -c AX2_HK2 = 0.0 -c AX2_T2 = 0.0 -c AX2_RT2 = 0.0 -cC -c AX1_A1 = 0.0 -c AX2_A2 = 0.0 -cC -c AX = AX1 -c AX_AX1 = 1.0 -c AX_AX2 = 0.0 -cC -c ARG = MIN( 20.0*(ACRIT-A1) , 20.0 ) -c EXN = EXP(-ARG) -c EXN_A1 = 20.0*EXN -c EXN_A2 = 0. -cC -c DAX = EXN * 0.0004/T1 -c DAX_A1 = EXN_A1* 0.0004/T1 -c DAX_A2 = 0. -c DAX_T1 = -DAX/T1 -c DAX_T2 = 0. -C -C========================== -C---- 2nd-order - CALL DAMPL( HK1, T1, RT1, AX1, AX1_HK1, AX1_T1, AX1_RT1 ) - CALL DAMPL( HK2, T2, RT2, AX2, AX2_HK2, AX2_T2, AX2_RT2 ) -C -CC---- simple-average version -C AXA = 0.5*(AX1 + AX2) -C IF(AXA .LE. 0.0) THEN -C AXA = 0.0 -C AXA_AX1 = 0.0 -C AXA_AX2 = 0.0 -C ELSE -C AXA_AX1 = 0.5 -C AXA_AX2 = 0.5 -C ENDIF -C -C---- rms-average version (seems a little better on coarse grids) - AXSQ = 0.5*(AX1**2 + AX2**2) - IF(AXSQ .LE. 0.0) THEN - AXA = 0.0 - AXA_AX1 = 0.0 - AXA_AX2 = 0.0 - ELSE - AXA = SQRT(AXSQ) - AXA_AX1 = 0.5*AX1/AXA - AXA_AX2 = 0.5*AX2/AXA - ENDIF -C -C----- small additional term to ensure dN/dx > 0 near N = Ncrit - ARG = MIN( 20.0*(ACRIT-0.5*(A1+A2)) , 20.0 ) - IF(ARG.LE.0.0) THEN - EXN = 1.0 -CC EXN_AC = 0. - EXN_A1 = 0. - EXN_A2 = 0. - ELSE - EXN = EXP(-ARG) -CC EXN_AC = -20.0 *EXN - EXN_A1 = 20.0*0.5*EXN - EXN_A2 = 20.0*0.5*EXN - ENDIF -C - DAX = EXN * 0.002/(T1+T2) -CC DAX_AC = EXN_AC * 0.002/(T1+T2) - DAX_A1 = EXN_A1 * 0.002/(T1+T2) - DAX_A2 = EXN_A2 * 0.002/(T1+T2) - DAX_T1 = -DAX/(T1+T2) - DAX_T2 = -DAX/(T1+T2) -C -c -c DAX = 0. -c DAX_A1 = 0. -c DAX_A2 = 0. -c DAX_AC = 0. -c DAX_T1 = 0. -c DAX_T2 = 0. -C========================== -C - AX = AXA + DAX -C - AX_HK1 = AXA_AX1*AX1_HK1 - AX_T1 = AXA_AX1*AX1_T1 + DAX_T1 - AX_RT1 = AXA_AX1*AX1_RT1 - AX_A1 = DAX_A1 -C - AX_HK2 = AXA_AX2*AX2_HK2 - AX_T2 = AXA_AX2*AX2_T2 + DAX_T2 - AX_RT2 = AXA_AX2*AX2_RT2 - AX_A2 = DAX_A2 -C - - RETURN - END - - -c SUBROUTINE TRCHEK1 -cC------------------------------------------------- -cC Checks if transition occurs in the current -cC interval 1..2 (IBL-1...IBL) on side IS. -cC -cC Old first-order version. -cC -cC Growth rate is evaluated at the upstream -cC point "1". The discrete amplification -cC equation is -cC -cC Ncrit - N(X1) -cC ------------- = N'(X1) -cC XT - X1 -cC -cC which can be immediately solved for -cC the transition location XT. -cC------------------------------------------------- -c INCLUDE 'XBL.INC' -cC -cC---- calculate AMPL2 value -c CALL AXSET( HK1, T1, RT1, AMPL1, -c & HK2, T2, RT2, AMPL2, AMCRIT, -c & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, -c & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -c AMPL2 = AMPL1 + AX*(X2-X1) -cC -cC---- test for free or forced transition -c TRFREE = AMPL2.GE.AMCRIT -c TRFORC = XIFORC.GT.X1 .AND. XIFORC.LE.X2 -cC -cC---- set transition interval flag -c TRAN = TRFORC .OR. TRFREE -cC -cC---- if no transition yet, just return -c IF(.NOT.TRAN) RETURN -cC -cC---- resolve if both forced and free transition -c IF(TRFREE .AND. TRFORC) THEN -c XT = (AMCRIT-AMPL1)/AX + X1 -c TRFORC = XIFORC .LT. XT -c TRFREE = XIFORC .GE. XT -c ENDIF -cC -c IF(TRFORC) THEN -cC----- if forced transition, then XT is prescribed -c XT = XIFORC -c XT_A1 = 0. -c XT_X1 = 0. -c XT_T1 = 0. -c XT_D1 = 0. -c XT_U1 = 0. -c XT_X2 = 0. -c XT_T2 = 0. -c XT_D2 = 0. -c XT_U2 = 0. -c XT_MS = 0. -c XT_RE = 0. -c XT_XF = 1.0 -c ELSE -cC----- if free transition, XT is related to BL variables -cC- by the amplification equation -cC -c XT = (AMCRIT-AMPL1)/AX + X1 -c XT_AX = -(AMCRIT-AMPL1)/AX**2 -cC -c XT_A1 = -1.0/AX - (AMCRIT-AMPL1)/AX**2 * AX_A1 -c XT_X1 = 1.0 -c XT_T1 = XT_AX*(AX_HK1*HK1_T1 + AX_T1 + AX_RT1*RT1_T1) -c XT_D1 = XT_AX*(AX_HK1*HK1_D1 ) -c XT_U1 = XT_AX*(AX_HK1*HK1_U1 + AX_RT1*RT1_U1) -c XT_X2 = 0. -c XT_T2 = 0. -c XT_D2 = 0. -c XT_U2 = 0. -c XT_MS = XT_AX*(AX_HK1*HK1_MS + AX_RT1*RT1_MS) -c XT_RE = XT_AX*( AX_RT1*RT1_RE) -c XT_XF = 0.0 -c ENDIF -cC -c RETURN -c END - - - SUBROUTINE TRCHEK2 -C---------------------------------------------------------------- -C New second-order version: December 1994. -C -C Checks if transition occurs in the current interval X1..X2. -C If transition occurs, then set transition location XT, and -C its sensitivities to "1" and "2" variables. If no transition, -C set amplification AMPL2. -C -C -C Solves the implicit amplification equation for N2: -C -C N2 - N1 N'(XT,NT) + N'(X1,N1) -C ------- = --------------------- -C X2 - X1 2 -C -C In effect, a 2-point central difference is used between -C X1..X2 (no transition), or X1..XT (transition). The switch -C is done by defining XT,NT in the equation above depending -C on whether N2 exceeds Ncrit. -C -C If N2Ncrit: NT=Ncrit , XT=(Ncrit-N1)/(N2-N1) (transition) -C -C -C---------------------------------------------------------------- - INCLUDE 'XFOIL.INC' - INCLUDE 'XBL.INC' - DATA DAEPS / 5.0E-5 / -CCC DATA DAEPS / 1.0D-12 / -C -C---- save variables and sensitivities at IBL ("2") for future restoration - DO 5 ICOM=1, NCOM - C2SAV(ICOM) = COM2(ICOM) - 5 CONTINUE -C -C---- calculate average amplification rate AX over X1..X2 interval - CALL AXSET( HK1, T1, RT1, AMPL1, - & HK2, T2, RT2, AMPL2, AMCRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -C -C---- set initial guess for iterate N2 (AMPL2) at X2 - AMPL2 = AMPL1 + AX*(X2-X1) -C -C---- solve implicit system for amplification AMPL2 - DO 100 ITAM=1, 30 -C -C---- define weighting factors WF1,WF2 for defining "T" quantities from 1,2 -C - IF(AMPL2 .LE. AMCRIT) THEN -C------ there is no transition yet, "T" is the same as "2" - AMPLT = AMPL2 - AMPLT_A2 = 1.0 - SFA = 1.0 - SFA_A1 = 0. - SFA_A2 = 0. - ELSE -C------ there is transition in X1..X2, "T" is set from N1, N2 - AMPLT = AMCRIT - AMPLT_A2 = 0. - SFA = (AMPLT - AMPL1)/(AMPL2-AMPL1) - SFA_A1 = ( SFA - 1.0 )/(AMPL2-AMPL1) - SFA_A2 = ( - SFA )/(AMPL2-AMPL1) - ENDIF -C - IF(XIFORC.LT.X2) THEN - SFX = (XIFORC - X1 )/(X2-X1) - SFX_X1 = (SFX - 1.0)/(X2-X1) - SFX_X2 = ( - SFX)/(X2-X1) - SFX_XF = 1.0 /(X2-X1) - ELSE - SFX = 1.0 - SFX_X1 = 0. - SFX_X2 = 0. - SFX_XF = 0. - ENDIF -C -C---- set weighting factor from free or forced transition - IF(SFA.LT.SFX) THEN - WF2 = SFA - WF2_A1 = SFA_A1 - WF2_A2 = SFA_A2 - WF2_X1 = 0. - WF2_X2 = 0. - WF2_XF = 0. - ELSE - WF2 = SFX - WF2_A1 = 0. - WF2_A2 = 0. - WF2_X1 = SFX_X1 - WF2_X2 = SFX_X2 - WF2_XF = SFX_XF - ENDIF -C -C -C===================== -CC---- 1st-order (based on "1" quantites only, for testing) -C WF2 = 0.0 -C WF2_A1 = 0.0 -C WF2_A2 = 0.0 -C WF2_X1 = 0.0 -C WF2_X2 = 0.0 -C WF2_XF = 0.0 -C===================== -C - WF1 = 1.0 - WF2 - WF1_A1 = - WF2_A1 - WF1_A2 = - WF2_A2 - WF1_X1 = - WF2_X1 - WF1_X2 = - WF2_X2 - WF1_XF = - WF2_XF -C -C---- interpolate BL variables to XT - XT = X1*WF1 + X2*WF2 - TT = T1*WF1 + T2*WF2 - DT = D1*WF1 + D2*WF2 - UT = U1*WF1 + U2*WF2 -C - XT_A2 = X1*WF1_A2 + X2*WF2_A2 - TT_A2 = T1*WF1_A2 + T2*WF2_A2 - DT_A2 = D1*WF1_A2 + D2*WF2_A2 - UT_A2 = U1*WF1_A2 + U2*WF2_A2 -C -C---- temporarily set "2" variables from "T" for BLKIN - X2 = XT - T2 = TT - D2 = DT - U2 = UT -C -C---- calculate laminar secondary "T" variables HKT, RTT - CALL BLKIN -C - HKT = HK2 - HKT_TT = HK2_T2 - HKT_DT = HK2_D2 - HKT_UT = HK2_U2 - HKT_MS = HK2_MS -C - RTT = RT2 - RTT_TT = RT2_T2 - RTT_UT = RT2_U2 - RTT_MS = RT2_MS - RTT_RE = RT2_RE -C -C---- restore clobbered "2" variables, except for AMPL2 - AMSAVE = AMPL2 - DO 8 ICOM=1, NCOM - COM2(ICOM) = C2SAV(ICOM) - 8 CONTINUE - AMPL2 = AMSAVE -C -C---- calculate amplification rate AX over current X1-XT interval - CALL AXSET( HK1, T1, RT1, AMPL1, - & HKT, TT, RTT, AMPLT, AMCRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HKT, AX_TT, AX_RTT, AX_AT ) -C -C---- punch out early if there is no amplification here - IF(AX .LE. 0.0) GO TO 101 -C -C---- set sensitivity of AX(A2) - AX_A2 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_A2 - & + (AX_HKT*HKT_DT )*DT_A2 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_A2 - & + AX_AT *AMPLT_A2 -C -C---- residual for implicit AMPL2 definition (amplification equation) - RES = AMPL2 - AMPL1 - AX *(X2-X1) - RES_A2 = 1.0 - AX_A2*(X2-X1) -C - DA2 = -RES/RES_A2 -C - RLX = 1.0 - DXT = XT_A2*DA2 -C - IF(RLX*ABS(DXT/(X2-X1)) .GT. 0.05) RLX = 0.05*ABS((X2-X1)/DXT) - IF(RLX*ABS(DA2) .GT. 1.0 ) RLX = 1.0 *ABS( 1.0 /DA2) -C -C---- check if converged - IF(ABS(DA2) .LT. DAEPS) GO TO 101 -C - IF((AMPL2.GT.AMCRIT .AND. AMPL2+RLX*DA2.LT.AMCRIT).OR. - & (AMPL2.LT.AMCRIT .AND. AMPL2+RLX*DA2.GT.AMCRIT) ) THEN -C------ limited Newton step so AMPL2 doesn't step across AMCRIT either way - AMPL2 = AMCRIT - ELSE -C------ regular Newton step - AMPL2 = AMPL2 + RLX*DA2 - ENDIF -C - 100 CONTINUE -C DO SOMETHING ABOUT THIS! - -C WRITE(*,*) 'TRCHEK2: N2 convergence failed.' -C WRITE(*,6700) X1, XT, X2, AMPL1, AMPLT, AMPL2, AX, DA2 -c WRITE(*,*) "CONVERGENCE PROBLEMS IN BL ANALYSIS, XBLSYS.F" - cl = -10 - cd = -10 - cm = -10 -c write(*,*) cl - LVCONV = .FALSE. -c GOTO 123 -c STOP - RETURN - 6700 FORMAT(1X,'x:', 3F9.5,' N:',3F7.3,' Nx:',F8.3,' dN:',E10.3) -C - 101 CONTINUE -C -C -C---- test for free or forced transition - TRFREE = AMPL2 .GE. AMCRIT - TRFORC = XIFORC.GT.X1 .AND. XIFORC.LE.X2 -C -C---- set transition interval flag - TRAN = TRFORC .OR. TRFREE -C - IF(.NOT.TRAN) RETURN -C -C---- resolve if both forced and free transition - IF(TRFREE .AND. TRFORC) THEN - TRFORC = XIFORC .LT. XT - TRFREE = XIFORC .GE. XT - ENDIF -C - IF(TRFORC) THEN -C----- if forced transition, then XT is prescribed, -C- no sense calculating the sensitivities, since we know them... - XT = XIFORC - XT_A1 = 0. - XT_X1 = 0. - XT_T1 = 0. - XT_D1 = 0. - XT_U1 = 0. - XT_X2 = 0. - XT_T2 = 0. - XT_D2 = 0. - XT_U2 = 0. - XT_MS = 0. - XT_RE = 0. - XT_XF = 1.0 - RETURN - ENDIF -C -C---- free transition ... set sensitivities of XT -C -C---- XT( X1 X2 A1 A2 XF ), TT( T1 T2 A1 A2 X1 X2 XF), DT( ... -CC XT = X1*WF1 + X2*WF2 -CC TT = T1*WF1 + T2*WF2 -CC DT = D1*WF1 + D2*WF2 -CC UT = U1*WF1 + U2*WF2 -C - XT_X1 = WF1 - TT_T1 = WF1 - DT_D1 = WF1 - UT_U1 = WF1 -C - XT_X2 = WF2 - TT_T2 = WF2 - DT_D2 = WF2 - UT_U2 = WF2 -C - XT_A1 = X1*WF1_A1 + X2*WF2_A1 - TT_A1 = T1*WF1_A1 + T2*WF2_A1 - DT_A1 = D1*WF1_A1 + D2*WF2_A1 - UT_A1 = U1*WF1_A1 + U2*WF2_A1 -C -CC XT_A2 = X1*WF1_A2 + X2*WF2_A2 -CC TT_A2 = T1*WF1_A2 + T2*WF2_A2 -CC DT_A2 = D1*WF1_A2 + D2*WF2_A2 -CC UT_A2 = U1*WF1_A2 + U2*WF2_A2 -C - XT_X1 = X1*WF1_X1 + X2*WF2_X1 + XT_X1 - TT_X1 = T1*WF1_X1 + T2*WF2_X1 - DT_X1 = D1*WF1_X1 + D2*WF2_X1 - UT_X1 = U1*WF1_X1 + U2*WF2_X1 -C - XT_X2 = X1*WF1_X2 + X2*WF2_X2 + XT_X2 - TT_X2 = T1*WF1_X2 + T2*WF2_X2 - DT_X2 = D1*WF1_X2 + D2*WF2_X2 - UT_X2 = U1*WF1_X2 + U2*WF2_X2 -C - XT_XF = X1*WF1_XF + X2*WF2_XF - TT_XF = T1*WF1_XF + T2*WF2_XF - DT_XF = D1*WF1_XF + D2*WF2_XF - UT_XF = U1*WF1_XF + U2*WF2_XF -C -C---- at this point, AX = AX( HK1, T1, RT1, A1, HKT, TT, RTT, AT ) -C -C---- set sensitivities of AX( T1 D1 U1 A1 T2 D2 U2 A2 MS RE ) - AX_T1 = AX_HK1*HK1_T1 + AX_T1 + AX_RT1*RT1_T1 - & + (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_T1 - AX_D1 = AX_HK1*HK1_D1 - & + (AX_HKT*HKT_DT )*DT_D1 - AX_U1 = AX_HK1*HK1_U1 + AX_RT1*RT1_U1 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_U1 - AX_A1 = AX_A1 - & + (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_A1 - & + (AX_HKT*HKT_DT )*DT_A1 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_A1 - AX_X1 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_X1 - & + (AX_HKT*HKT_DT )*DT_X1 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_X1 -C - AX_T2 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_T2 - AX_D2 = (AX_HKT*HKT_DT )*DT_D2 - AX_U2 = (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_U2 - AX_A2 = AX_AT *AMPLT_A2 - & + (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_A2 - & + (AX_HKT*HKT_DT )*DT_A2 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_A2 - AX_X2 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_X2 - & + (AX_HKT*HKT_DT )*DT_X2 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_X2 -C - AX_XF = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_XF - & + (AX_HKT*HKT_DT )*DT_XF - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_XF -C - AX_MS = AX_HKT*HKT_MS + AX_RTT*RTT_MS - & + AX_HK1*HK1_MS + AX_RT1*RT1_MS - AX_RE = AX_RTT*RTT_RE - & + AX_RT1*RT1_RE -C -C -C---- set sensitivities of residual RES -CCC RES = AMPL2 - AMPL1 - AX*(X2-X1) - Z_AX = - (X2-X1) -C - Z_A1 = Z_AX*AX_A1 - 1.0 - Z_T1 = Z_AX*AX_T1 - Z_D1 = Z_AX*AX_D1 - Z_U1 = Z_AX*AX_U1 - Z_X1 = Z_AX*AX_X1 + AX -C - Z_A2 = Z_AX*AX_A2 + 1.0 - Z_T2 = Z_AX*AX_T2 - Z_D2 = Z_AX*AX_D2 - Z_U2 = Z_AX*AX_U2 - Z_X2 = Z_AX*AX_X2 - AX -C - Z_XF = Z_AX*AX_XF - Z_MS = Z_AX*AX_MS - Z_RE = Z_AX*AX_RE -C -C---- set sensitivities of XT, with RES being stationary for A2 constraint - XT_A1 = XT_A1 - (XT_A2/Z_A2)*Z_A1 - XT_T1 = - (XT_A2/Z_A2)*Z_T1 - XT_D1 = - (XT_A2/Z_A2)*Z_D1 - XT_U1 = - (XT_A2/Z_A2)*Z_U1 - XT_X1 = XT_X1 - (XT_A2/Z_A2)*Z_X1 - XT_T2 = - (XT_A2/Z_A2)*Z_T2 - XT_D2 = - (XT_A2/Z_A2)*Z_D2 - XT_U2 = - (XT_A2/Z_A2)*Z_U2 - XT_X2 = XT_X2 - (XT_A2/Z_A2)*Z_X2 - XT_MS = - (XT_A2/Z_A2)*Z_MS - XT_RE = - (XT_A2/Z_A2)*Z_RE - XT_XF = 0.0 -C - 123 CONTINUE - RETURN - END - - - SUBROUTINE BLSYS -C------------------------------------------------------------------ -C -C Sets up the BL Newton system governing the current interval: -C -C | ||dA1| | ||dA2| | | -C | VS1 ||dT1| + | VS2 ||dT2| = |VSREZ| -C | ||dD1| | ||dD2| | | -C |dU1| |dU2| -C |dX1| |dX2| -C -C 3x5 5x1 3x5 5x1 3x1 -C -C The system as shown corresponds to a laminar station -C If TRAN, then dS2 replaces dA2 -C If TURB, then dS1, dS2 replace dA1, dA2 -C -C------------------------------------------------------------------ - IMPLICIT REAL(M) - INCLUDE 'XBL.INC' -C -C---- calculate secondary BL variables and their sensitivities - IF(WAKE) THEN - CALL BLVAR(3) - CALL BLMID(3) - ELSE IF(TURB.OR.TRAN) THEN - CALL BLVAR(2) - CALL BLMID(2) - ELSE - CALL BLVAR(1) - CALL BLMID(1) - ENDIF -C -C---- for the similarity station, "1" and "2" variables are the same - IF(SIMI) THEN - DO 3 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 3 CONTINUE - ENDIF -C -C---- set up appropriate finite difference system for current interval - IF(TRAN) THEN - CALL TRDIF - ELSE IF(SIMI) THEN - CALL BLDIF(0) - ELSE IF(.NOT.TURB) THEN - CALL BLDIF(1) - ELSE IF(WAKE) THEN - CALL BLDIF(3) - ELSE IF(TURB) THEN - CALL BLDIF(2) - ENDIF -C - IF(SIMI) THEN -C----- at similarity station, "1" variables are really "2" variables - DO 10 K=1, 4 - DO 101 L=1, 5 - VS2(K,L) = VS1(K,L) + VS2(K,L) - VS1(K,L) = 0. - 101 CONTINUE - 10 CONTINUE - ENDIF -C -C---- change system over into incompressible Uei and Mach - DO 20 K=1, 4 -C -C------ residual derivatives wrt compressible Uec - RES_U1 = VS1(K,4) - RES_U2 = VS2(K,4) - RES_MS = VSM(K) -C -C------ combine with derivatives of compressible U1,U2 = Uec(Uei M) - VS1(K,4) = RES_U1*U1_UEI - VS2(K,4) = RES_U2*U2_UEI - VSM(K) = RES_U1*U1_MS + RES_U2*U2_MS + RES_MS - 20 CONTINUE -C - RETURN - END - - - SUBROUTINE TESYS(CTE,TTE,DTE) -C-------------------------------------------------------- -C Sets up "dummy" BL system between airfoil TE point -C and first wake point infinitesimally behind TE. -C-------------------------------------------------------- - IMPLICIT REAL (M) - INCLUDE 'XBL.INC' -C - DO 55 K=1, 4 - VSREZ(K) = 0. - VSM(K) = 0. - VSR(K) = 0. - VSX(K) = 0. - DO 551 L=1, 5 - VS1(K,L) = 0. - VS2(K,L) = 0. - 551 CONTINUE - 55 CONTINUE -C - CALL BLVAR(3) -C - VS1(1,1) = -1.0 - VS2(1,1) = 1.0 - VSREZ(1) = CTE - S2 -C - VS1(2,2) = -1.0 - VS2(2,2) = 1.0 - VSREZ(2) = TTE - T2 -C - VS1(3,3) = -1.0 - VS2(3,3) = 1.0 - VSREZ(3) = DTE - D2 - DW2 -C - RETURN - END - - - SUBROUTINE BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) -C---------------------------------------------------------- -C Set BL primary "2" variables from parameter list -C---------------------------------------------------------- - IMPLICIT REAL(M) - INCLUDE 'XBL.INC' -C - X2 = XSI - AMPL2 = AMI - S2 = CTI - T2 = THI - D2 = DSI - DSWAKI - DW2 = DSWAKI -C - U2 = UEI*(1.0-TKBL) / (1.0 - TKBL*(UEI/QINFBL)**2) - U2_UEI = (1.0 + TKBL*(2.0*U2*UEI/QINFBL**2 - 1.0)) - & / (1.0 - TKBL*(UEI/QINFBL)**2) - U2_MS = (U2*(UEI/QINFBL)**2 - UEI)*TKBL_MS - & / (1.0 - TKBL*(UEI/QINFBL)**2) -C - RETURN - END ! BLPRV - - - SUBROUTINE BLKIN -C---------------------------------------------------------- -C Calculates turbulence-independent secondary "2" -C variables from the primary "2" variables. -C---------------------------------------------------------- - IMPLICIT REAL(M) - INCLUDE 'XBL.INC' -C -C---- set edge Mach number ** 2 - M2 = U2*U2*HSTINV / (GM1BL*(1.0 - 0.5*U2*U2*HSTINV)) - TR2 = 1.0 + 0.5*GM1BL*M2 - M2_U2 = 2.0*M2*TR2/U2 - M2_MS = U2*U2*TR2 / (GM1BL*(1.0 - 0.5*U2*U2*HSTINV)) - & * HSTINV_MS -C -C---- set edge static density (isentropic relation) - R2 = RSTBL *TR2**(-1.0/GM1BL) - R2_U2 = -R2/TR2 * 0.5*M2_U2 - R2_MS = -R2/TR2 * 0.5*M2_MS - & + RSTBL_MS*TR2**(-1.0/GM1BL) -C -C---- set shape parameter - H2 = D2/T2 - H2_D2 = 1.0/T2 - H2_T2 = -H2/T2 -C -C---- set edge static/stagnation enthalpy - HERAT = 1.0 - 0.5*U2*U2*HSTINV - HE_U2 = - U2*HSTINV - HE_MS = - 0.5*U2*U2*HSTINV_MS -C -C---- set molecular viscosity - V2 = SQRT((HERAT)**3) * (1.0+HVRAT)/(HERAT+HVRAT)/REYBL - V2_HE = V2*(1.5/HERAT - 1.0/(HERAT+HVRAT)) -C - V2_U2 = V2_HE*HE_U2 - V2_MS = -V2/REYBL * REYBL_MS + V2_HE*HE_MS - V2_RE = -V2/REYBL * REYBL_RE -C -C---- set kinematic shape parameter - CALL HKIN( H2, M2, HK2, HK2_H2, HK2_M2 ) -C - HK2_U2 = HK2_M2*M2_U2 - HK2_T2 = HK2_H2*H2_T2 - HK2_D2 = HK2_H2*H2_D2 - HK2_MS = HK2_M2*M2_MS -C -C---- set momentum thickness Reynolds number - RT2 = R2*U2*T2/V2 - RT2_U2 = RT2*(1.0/U2 + R2_U2/R2 - V2_U2/V2) - RT2_T2 = RT2/T2 - RT2_MS = RT2*( R2_MS/R2 - V2_MS/V2) - RT2_RE = RT2*( - V2_RE/V2) -C - RETURN - END ! BLKIN - - - - SUBROUTINE BLVAR(ITYP) -C---------------------------------------------------- -C Calculates all secondary "2" variables from -C the primary "2" variables X2, U2, T2, D2, S2. -C Also calculates the sensitivities of the -C secondary variables wrt the primary variables. -C -C ITYP = 1 : laminar -C ITYP = 2 : turbulent -C ITYP = 3 : turbulent wake -C---------------------------------------------------- - IMPLICIT REAL(M) - INCLUDE 'XBL.INC' -C - IF(ITYP.EQ.3) HK2 = MAX(HK2,1.00005) - IF(ITYP.NE.3) HK2 = MAX(HK2,1.05000) -C -C---- density thickness shape parameter ( H** ) - CALL HCT( HK2, M2, HC2, HC2_HK2, HC2_M2 ) - HC2_U2 = HC2_HK2*HK2_U2 + HC2_M2*M2_U2 - HC2_T2 = HC2_HK2*HK2_T2 - HC2_D2 = HC2_HK2*HK2_D2 - HC2_MS = HC2_HK2*HK2_MS + HC2_M2*M2_MS -C -C---- set KE thickness shape parameter from H - H* correlations - IF(ITYP.EQ.1) THEN - CALL HSL( HK2, RT2, M2, HS2, HS2_HK2, HS2_RT2, HS2_M2 ) - ELSE - CALL HST( HK2, RT2, M2, HS2, HS2_HK2, HS2_RT2, HS2_M2 ) - ENDIF -C - HS2_U2 = HS2_HK2*HK2_U2 + HS2_RT2*RT2_U2 + HS2_M2*M2_U2 - HS2_T2 = HS2_HK2*HK2_T2 + HS2_RT2*RT2_T2 - HS2_D2 = HS2_HK2*HK2_D2 - HS2_MS = HS2_HK2*HK2_MS + HS2_RT2*RT2_MS + HS2_M2*M2_MS - HS2_RE = HS2_RT2*RT2_RE -C -C---- normalized slip velocity Us - US2 = 0.5*HS2*( 1.0 - (HK2-1.0)/(GBCON*H2) ) - US2_HS2 = 0.5 * ( 1.0 - (HK2-1.0)/(GBCON*H2) ) - US2_HK2 = 0.5*HS2*( - 1.0 /(GBCON*H2) ) - US2_H2 = 0.5*HS2* (HK2-1.0)/(GBCON*H2**2) -C - US2_U2 = US2_HS2*HS2_U2 + US2_HK2*HK2_U2 - US2_T2 = US2_HS2*HS2_T2 + US2_HK2*HK2_T2 + US2_H2*H2_T2 - US2_D2 = US2_HS2*HS2_D2 + US2_HK2*HK2_D2 + US2_H2*H2_D2 - US2_MS = US2_HS2*HS2_MS + US2_HK2*HK2_MS - US2_RE = US2_HS2*HS2_RE -C - IF(ITYP.LE.2 .AND. US2.GT.0.95) THEN -CCC WRITE(*,*) 'BLVAR: Us clamped:', US2 - US2 = 0.98 - US2_U2 = 0. - US2_T2 = 0. - US2_D2 = 0. - US2_MS = 0. - US2_RE = 0. - ENDIF -C - IF(ITYP.EQ.3 .AND. US2.GT.0.99995) THEN -CCC WRITE(*,*) 'BLVAR: Wake Us clamped:', US2 - US2 = 0.99995 - US2_U2 = 0. - US2_T2 = 0. - US2_D2 = 0. - US2_MS = 0. - US2_RE = 0. - ENDIF -C -C---- equilibrium wake layer shear coefficient (Ctau)EQ ** 1/2 -C ... NEW 12 Oct 94 - GCC = 0.0 - HKC = HK2 - 1.0 - HKC_HK2 = 1.0 - HKC_RT2 = 0.0 - IF(ITYP.EQ.2) THEN - GCC = GCCON - HKC = HK2 - 1.0 - GCC/RT2 - HKC_HK2 = 1.0 - HKC_RT2 = GCC/RT2**2 - IF(HKC .LT. 0.01) THEN - HKC = 0.01 - HKC_HK2 = 0.0 - HKC_RT2 = 0.0 - ENDIF - ENDIF -C - HKB = HK2 - 1.0 - USB = 1.0 - US2 - CQ2 = - & SQRT( CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**2) ) - CQ2_HS2 = CTCON *HKB*HKC**2 / (USB*H2*HK2**2) * 0.5/CQ2 - CQ2_US2 = CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**2) / USB * 0.5/CQ2 - CQ2_HK2 = CTCON*HS2 *HKC**2 / (USB*H2*HK2**2) * 0.5/CQ2 - & - CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**3) * 2.0 * 0.5/CQ2 - & + CTCON*HS2*HKB*HKC / (USB*H2*HK2**2) * 2.0 * 0.5/CQ2 - & *HKC_HK2 - CQ2_RT2 = CTCON*HS2*HKB*HKC / (USB*H2*HK2**2) * 2.0 * 0.5/CQ2 - & *HKC_RT2 - CQ2_H2 =-CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**2) / H2 * 0.5/CQ2 -C - CQ2_U2 = CQ2_HS2*HS2_U2 + CQ2_US2*US2_U2 + CQ2_HK2*HK2_U2 - CQ2_T2 = CQ2_HS2*HS2_T2 + CQ2_US2*US2_T2 + CQ2_HK2*HK2_T2 - CQ2_D2 = CQ2_HS2*HS2_D2 + CQ2_US2*US2_D2 + CQ2_HK2*HK2_D2 - CQ2_MS = CQ2_HS2*HS2_MS + CQ2_US2*US2_MS + CQ2_HK2*HK2_MS - CQ2_RE = CQ2_HS2*HS2_RE + CQ2_US2*US2_RE -C - CQ2_U2 = CQ2_U2 + CQ2_RT2*RT2_U2 - CQ2_T2 = CQ2_T2 + CQ2_H2*H2_T2 + CQ2_RT2*RT2_T2 - CQ2_D2 = CQ2_D2 + CQ2_H2*H2_D2 - CQ2_MS = CQ2_MS + CQ2_RT2*RT2_MS - CQ2_RE = CQ2_RE + CQ2_RT2*RT2_RE -C -C -C---- set skin friction coefficient - IF(ITYP.EQ.3) THEN -C----- wake - CF2 = 0. - CF2_HK2 = 0. - CF2_RT2 = 0. - CF2_M2 = 0. - ELSE IF(ITYP.EQ.1) THEN -C----- laminar - CALL CFL( HK2, RT2, M2, CF2, CF2_HK2, CF2_RT2, CF2_M2 ) - ELSE -C----- turbulent - CALL CFT( HK2, RT2, M2, CF2, CF2_HK2, CF2_RT2, CF2_M2 ) - CALL CFL( HK2, RT2, M2, CF2L,CF2L_HK2,CF2L_RT2,CF2L_M2) - IF(CF2L.GT.CF2) THEN -C------- laminar Cf is greater than turbulent Cf -- use laminar -C- (this will only occur for unreasonably small Rtheta) -ccc write(*,*) 'Cft Cfl Rt Hk:', CF2, CF2L, RT2, HK2, X2 - CF2 = CF2L - CF2_HK2 = CF2L_HK2 - CF2_RT2 = CF2L_RT2 - CF2_M2 = CF2L_M2 - ENDIF - ENDIF -C - CF2_U2 = CF2_HK2*HK2_U2 + CF2_RT2*RT2_U2 + CF2_M2*M2_U2 - CF2_T2 = CF2_HK2*HK2_T2 + CF2_RT2*RT2_T2 - CF2_D2 = CF2_HK2*HK2_D2 - CF2_MS = CF2_HK2*HK2_MS + CF2_RT2*RT2_MS + CF2_M2*M2_MS - CF2_RE = CF2_RT2*RT2_RE -C -C---- dissipation function 2 CD / H* - IF(ITYP.EQ.1) THEN -C -C----- laminar - CALL DIL( HK2, RT2, DI2, DI2_HK2, DI2_RT2 ) -C - DI2_U2 = DI2_HK2*HK2_U2 + DI2_RT2*RT2_U2 - DI2_T2 = DI2_HK2*HK2_T2 + DI2_RT2*RT2_T2 - DI2_D2 = DI2_HK2*HK2_D2 - DI2_S2 = 0. - DI2_MS = DI2_HK2*HK2_MS + DI2_RT2*RT2_MS - DI2_RE = DI2_RT2*RT2_RE -C - ELSE IF(ITYP.EQ.2) THEN -C -CCC CALL DIT( HS2, US2, CF2, S2, DI2, -CCC & DI2_HS2, DI2_US2, DI2_CF2, DI2_S2 ) -C -C----- turbulent wall contribution - CALL CFT(HK2, RT2, M2, CF2T, CF2T_HK2, CF2T_RT2, CF2T_M2) - CF2T_U2 = CF2T_HK2*HK2_U2 + CF2T_RT2*RT2_U2 + CF2T_M2*M2_U2 - CF2T_T2 = CF2T_HK2*HK2_T2 + CF2T_RT2*RT2_T2 - CF2T_D2 = CF2T_HK2*HK2_D2 - CF2T_MS = CF2T_HK2*HK2_MS + CF2T_RT2*RT2_MS + CF2T_M2*M2_MS - CF2T_RE = CF2T_RT2*RT2_RE -C - DI2 = ( 0.5*CF2T*US2 ) * 2.0/HS2 - DI2_HS2 = -( 0.5*CF2T*US2 ) * 2.0/HS2**2 - DI2_US2 = ( 0.5*CF2T ) * 2.0/HS2 - DI2_CF2T = ( 0.5 *US2 ) * 2.0/HS2 -C - DI2_S2 = 0.0 - DI2_U2 = DI2_HS2*HS2_U2 + DI2_US2*US2_U2 + DI2_CF2T*CF2T_U2 - DI2_T2 = DI2_HS2*HS2_T2 + DI2_US2*US2_T2 + DI2_CF2T*CF2T_T2 - DI2_D2 = DI2_HS2*HS2_D2 + DI2_US2*US2_D2 + DI2_CF2T*CF2T_D2 - DI2_MS = DI2_HS2*HS2_MS + DI2_US2*US2_MS + DI2_CF2T*CF2T_MS - DI2_RE = DI2_HS2*HS2_RE + DI2_US2*US2_RE + DI2_CF2T*CF2T_RE -C -C -C----- set minimum Hk for wake layer to still exist - GRT = LOG(RT2) - HMIN = 1.0 + 2.1/GRT - HM_RT2 = -(2.1/GRT**2) / RT2 -C -C----- set factor DFAC for correcting wall dissipation for very low Hk - FL = (HK2-1.0)/(HMIN-1.0) - FL_HK2 = 1.0/(HMIN-1.0) - FL_RT2 = ( -FL/(HMIN-1.0) ) * HM_RT2 -C - TFL = TANH(FL) - DFAC = 0.5 + 0.5* TFL - DF_FL = 0.5*(1.0 - TFL**2) -C - DF_HK2 = DF_FL*FL_HK2 - DF_RT2 = DF_FL*FL_RT2 -C - DI2_S2 = DI2_S2*DFAC - DI2_U2 = DI2_U2*DFAC + DI2*(DF_HK2*HK2_U2 + DF_RT2*RT2_U2) - DI2_T2 = DI2_T2*DFAC + DI2*(DF_HK2*HK2_T2 + DF_RT2*RT2_T2) - DI2_D2 = DI2_D2*DFAC + DI2*(DF_HK2*HK2_D2 ) - DI2_MS = DI2_MS*DFAC + DI2*(DF_HK2*HK2_MS + DF_RT2*RT2_MS) - DI2_RE = DI2_RE*DFAC + DI2*( DF_RT2*RT2_RE) - DI2 = DI2 *DFAC -C - ELSE -C -C----- zero wall contribution for wake - DI2 = 0.0 - DI2_S2 = 0.0 - DI2_U2 = 0.0 - DI2_T2 = 0.0 - DI2_D2 = 0.0 - DI2_MS = 0.0 - DI2_RE = 0.0 -C - ENDIF -C -C -C---- Add on turbulent outer layer contribution - IF(ITYP.NE.1) THEN -C - DD = S2**2 * (0.995-US2) * 2.0/HS2 - DD_HS2 = -S2**2 * (0.995-US2) * 2.0/HS2**2 - DD_US2 = -S2**2 * 2.0/HS2 - DD_S2 = S2*2.0* (0.995-US2) * 2.0/HS2 -C - DI2 = DI2 + DD - DI2_S2 = DD_S2 - DI2_U2 = DI2_U2 + DD_HS2*HS2_U2 + DD_US2*US2_U2 - DI2_T2 = DI2_T2 + DD_HS2*HS2_T2 + DD_US2*US2_T2 - DI2_D2 = DI2_D2 + DD_HS2*HS2_D2 + DD_US2*US2_D2 - DI2_MS = DI2_MS + DD_HS2*HS2_MS + DD_US2*US2_MS - DI2_RE = DI2_RE + DD_HS2*HS2_RE + DD_US2*US2_RE -C -C----- add laminar stress contribution to outer layer CD -c### - DD = 0.15*(0.995-US2)**2 / RT2 * 2.0/HS2 - DD_US2 = -0.15*(0.995-US2)*2. / RT2 * 2.0/HS2 - DD_HS2 = -DD/HS2 - DD_RT2 = -DD/RT2 -C - DI2 = DI2 + DD - DI2_U2 = DI2_U2 + DD_HS2*HS2_U2 + DD_US2*US2_U2 + DD_RT2*RT2_U2 - DI2_T2 = DI2_T2 + DD_HS2*HS2_T2 + DD_US2*US2_T2 + DD_RT2*RT2_T2 - DI2_D2 = DI2_D2 + DD_HS2*HS2_D2 + DD_US2*US2_D2 - DI2_MS = DI2_MS + DD_HS2*HS2_MS + DD_US2*US2_MS + DD_RT2*RT2_MS - DI2_RE = DI2_RE + DD_HS2*HS2_RE + DD_US2*US2_RE + DD_RT2*RT2_RE -C - ENDIF -C -C - IF(ITYP.EQ.2) THEN - CALL DIL( HK2, RT2, DI2L, DI2L_HK2, DI2L_RT2 ) -C - IF(DI2L.GT.DI2) THEN -C------- laminar CD is greater than turbulent CD -- use laminar -C- (this will only occur for unreasonably small Rtheta) -ccc write(*,*) 'CDt CDl Rt Hk:', DI2, DI2L, RT2, HK2 - DI2 = DI2L - DI2_S2 = 0. - DI2_U2 = DI2L_HK2*HK2_U2 + DI2L_RT2*RT2_U2 - DI2_T2 = DI2L_HK2*HK2_T2 + DI2L_RT2*RT2_T2 - DI2_D2 = DI2L_HK2*HK2_D2 - DI2_MS = DI2L_HK2*HK2_MS + DI2L_RT2*RT2_MS - DI2_RE = DI2L_RT2*RT2_RE - ENDIF - ENDIF -C -cC----- add on CD contribution of inner shear layer -c IF(ITYP.EQ.3 .AND. DW2.GT.0.0) THEN -c DKON = 0.03*0.75**3 -c DDI = DKON*US2**3 -c DDI_US2 = 3.0*DKON*US2**2 -c DI2 = DI2 + DDI * DW2/DWTE -c DI2_U2 = DI2_U2 + DDI_US2*US2_U2 * DW2/DWTE -c DI2_T2 = DI2_T2 + DDI_US2*US2_T2 * DW2/DWTE -c DI2_D2 = DI2_D2 + DDI_US2*US2_D2 * DW2/DWTE -c DI2_MS = DI2_MS + DDI_US2*US2_MS * DW2/DWTE -c DI2_RE = DI2_RE + DDI_US2*US2_RE * DW2/DWTE -c ENDIF -C - IF(ITYP.EQ.3) THEN -C------ laminar wake CD - CALL DILW( HK2, RT2, DI2L, DI2L_HK2, DI2L_RT2 ) - IF(DI2L .GT. DI2) THEN -C------- laminar wake CD is greater than turbulent CD -- use laminar -C- (this will only occur for unreasonably small Rtheta) -ccc write(*,*) 'CDt CDl Rt Hk:', DI2, DI2L, RT2, HK2 - DI2 = DI2L - DI2_S2 = 0. - DI2_U2 = DI2L_HK2*HK2_U2 + DI2L_RT2*RT2_U2 - DI2_T2 = DI2L_HK2*HK2_T2 + DI2L_RT2*RT2_T2 - DI2_D2 = DI2L_HK2*HK2_D2 - DI2_MS = DI2L_HK2*HK2_MS + DI2L_RT2*RT2_MS - DI2_RE = DI2L_RT2*RT2_RE - ENDIF - ENDIF -C -C - IF(ITYP.EQ.3) THEN -C----- double dissipation for the wake (two wake halves) - DI2 = DI2 *2.0 - DI2_S2 = DI2_S2*2.0 - DI2_U2 = DI2_U2*2.0 - DI2_T2 = DI2_T2*2.0 - DI2_D2 = DI2_D2*2.0 - DI2_MS = DI2_MS*2.0 - DI2_RE = DI2_RE*2.0 - ENDIF -C -C---- BL thickness (Delta) from simplified Green's correlation - DE2 = (3.15 + 1.72/(HK2-1.0) )*T2 + D2 - DE2_HK2 = ( - 1.72/(HK2-1.0)**2)*T2 -C - DE2_U2 = DE2_HK2*HK2_U2 - DE2_T2 = DE2_HK2*HK2_T2 + (3.15 + 1.72/(HK2-1.0)) - DE2_D2 = DE2_HK2*HK2_D2 + 1.0 - DE2_MS = DE2_HK2*HK2_MS -C -ccc HDMAX = 15.0 - HDMAX = 12.0 - IF(DE2 .GT. HDMAX*T2) THEN -cccc IF(DE2 .GT. HDMAX*T2 .AND. (HK2 .GT. 4.0 .OR. ITYP.EQ.3)) THEN - DE2 = HDMAX*T2 - DE2_U2 = 0.0 - DE2_T2 = HDMAX - DE2_D2 = 0.0 - DE2_MS = 0.0 - ENDIF -C - RETURN - END - - - SUBROUTINE BLMID(ITYP) -C---------------------------------------------------- -C Calculates midpoint skin friction CFM -C -C ITYP = 1 : laminar -C ITYP = 2 : turbulent -C ITYP = 3 : turbulent wake -C---------------------------------------------------- - IMPLICIT REAL(M) - INCLUDE 'XBL.INC' -C -C---- set similarity variables if not defined - IF(SIMI) THEN - HK1 = HK2 - HK1_T1 = HK2_T2 - HK1_D1 = HK2_D2 - HK1_U1 = HK2_U2 - HK1_MS = HK2_MS - RT1 = RT2 - RT1_T1 = RT2_T2 - RT1_U1 = RT2_U2 - RT1_MS = RT2_MS - RT1_RE = RT2_RE - M1 = M2 - M1_U1 = M2_U2 - M1_MS = M2_MS - ENDIF -C -C---- define stuff for midpoint CF - HKA = 0.5*(HK1 + HK2) - RTA = 0.5*(RT1 + RT2) - MA = 0.5*(M1 + M2 ) -C -C---- midpoint skin friction coefficient (zero in wake) - IF(ITYP.EQ.3) THEN - CFM = 0. - CFM_HKA = 0. - CFM_RTA = 0. - CFM_MA = 0. - CFM_MS = 0. - ELSE IF(ITYP.EQ.1) THEN - CALL CFL( HKA, RTA, MA, CFM, CFM_HKA, CFM_RTA, CFM_MA ) - ELSE - CALL CFT( HKA, RTA, MA, CFM, CFM_HKA, CFM_RTA, CFM_MA ) - CALL CFL( HKA, RTA, MA, CFML,CFML_HKA,CFML_RTA,CFML_MA) - IF(CFML.GT.CFM) THEN -ccc write(*,*) 'Cft Cfl Rt Hk:', CFM, CFML, RTA, HKA, 0.5*(X1+X2) - CFM = CFML - CFM_HKA = CFML_HKA - CFM_RTA = CFML_RTA - CFM_MA = CFML_MA - ENDIF - ENDIF -C - CFM_U1 = 0.5*(CFM_HKA*HK1_U1 + CFM_MA*M1_U1 + CFM_RTA*RT1_U1) - CFM_T1 = 0.5*(CFM_HKA*HK1_T1 + CFM_RTA*RT1_T1) - CFM_D1 = 0.5*(CFM_HKA*HK1_D1 ) -C - CFM_U2 = 0.5*(CFM_HKA*HK2_U2 + CFM_MA*M2_U2 + CFM_RTA*RT2_U2) - CFM_T2 = 0.5*(CFM_HKA*HK2_T2 + CFM_RTA*RT2_T2) - CFM_D2 = 0.5*(CFM_HKA*HK2_D2 ) -C - CFM_MS = 0.5*(CFM_HKA*HK1_MS + CFM_MA*M1_MS + CFM_RTA*RT1_MS - & + CFM_HKA*HK2_MS + CFM_MA*M2_MS + CFM_RTA*RT2_MS) - CFM_RE = 0.5*( CFM_RTA*RT1_RE - & + CFM_RTA*RT2_RE) -C - RETURN - END ! BLMID - - - SUBROUTINE TRDIF -C----------------------------------------------- -C Sets up the Newton system governing the -C transition interval. Equations governing -C the laminar part X1 < xi < XT and -C the turbulent part XT < xi < X2 -C are simply summed. -C----------------------------------------------- - IMPLICIT REAL(M) - INCLUDE 'XBL.INC' - REAL BL1(4,5), BL2(4,5), BLREZ(4), BLM(4), BLR(4), BLX(4) - & , BT1(4,5), BT2(4,5), BTREZ(4), BTM(4), BTR(4), BTX(4) -C -C---- save variables and sensitivities for future restoration - DO 5 ICOM=1, NCOM - C1SAV(ICOM) = COM1(ICOM) - C2SAV(ICOM) = COM2(ICOM) - 5 CONTINUE -C -C---- weighting factors for linear interpolation to transition point - WF2 = (XT-X1)/(X2-X1) - WF2_XT = 1.0/(X2-X1) -C - WF2_A1 = WF2_XT*XT_A1 - WF2_X1 = WF2_XT*XT_X1 + (WF2-1.0)/(X2-X1) - WF2_X2 = WF2_XT*XT_X2 - WF2 /(X2-X1) - WF2_T1 = WF2_XT*XT_T1 - WF2_T2 = WF2_XT*XT_T2 - WF2_D1 = WF2_XT*XT_D1 - WF2_D2 = WF2_XT*XT_D2 - WF2_U1 = WF2_XT*XT_U1 - WF2_U2 = WF2_XT*XT_U2 - WF2_MS = WF2_XT*XT_MS - WF2_RE = WF2_XT*XT_RE - WF2_XF = WF2_XT*XT_XF -C - WF1 = 1.0 - WF2 - WF1_A1 = -WF2_A1 - WF1_X1 = -WF2_X1 - WF1_X2 = -WF2_X2 - WF1_T1 = -WF2_T1 - WF1_T2 = -WF2_T2 - WF1_D1 = -WF2_D1 - WF1_D2 = -WF2_D2 - WF1_U1 = -WF2_U1 - WF1_U2 = -WF2_U2 - WF1_MS = -WF2_MS - WF1_RE = -WF2_RE - WF1_XF = -WF2_XF -C -C -C**** FIRST, do laminar part between X1 and XT -C -C-----interpolate primary variables to transition point - TT = T1*WF1 + T2*WF2 - TT_A1 = T1*WF1_A1 + T2*WF2_A1 - TT_X1 = T1*WF1_X1 + T2*WF2_X1 - TT_X2 = T1*WF1_X2 + T2*WF2_X2 - TT_T1 = T1*WF1_T1 + T2*WF2_T1 + WF1 - TT_T2 = T1*WF1_T2 + T2*WF2_T2 + WF2 - TT_D1 = T1*WF1_D1 + T2*WF2_D1 - TT_D2 = T1*WF1_D2 + T2*WF2_D2 - TT_U1 = T1*WF1_U1 + T2*WF2_U1 - TT_U2 = T1*WF1_U2 + T2*WF2_U2 - TT_MS = T1*WF1_MS + T2*WF2_MS - TT_RE = T1*WF1_RE + T2*WF2_RE - TT_XF = T1*WF1_XF + T2*WF2_XF -C - DT = D1*WF1 + D2*WF2 - DT_A1 = D1*WF1_A1 + D2*WF2_A1 - DT_X1 = D1*WF1_X1 + D2*WF2_X1 - DT_X2 = D1*WF1_X2 + D2*WF2_X2 - DT_T1 = D1*WF1_T1 + D2*WF2_T1 - DT_T2 = D1*WF1_T2 + D2*WF2_T2 - DT_D1 = D1*WF1_D1 + D2*WF2_D1 + WF1 - DT_D2 = D1*WF1_D2 + D2*WF2_D2 + WF2 - DT_U1 = D1*WF1_U1 + D2*WF2_U1 - DT_U2 = D1*WF1_U2 + D2*WF2_U2 - DT_MS = D1*WF1_MS + D2*WF2_MS - DT_RE = D1*WF1_RE + D2*WF2_RE - DT_XF = D1*WF1_XF + D2*WF2_XF -C - UT = U1*WF1 + U2*WF2 - UT_A1 = U1*WF1_A1 + U2*WF2_A1 - UT_X1 = U1*WF1_X1 + U2*WF2_X1 - UT_X2 = U1*WF1_X2 + U2*WF2_X2 - UT_T1 = U1*WF1_T1 + U2*WF2_T1 - UT_T2 = U1*WF1_T2 + U2*WF2_T2 - UT_D1 = U1*WF1_D1 + U2*WF2_D1 - UT_D2 = U1*WF1_D2 + U2*WF2_D2 - UT_U1 = U1*WF1_U1 + U2*WF2_U1 + WF1 - UT_U2 = U1*WF1_U2 + U2*WF2_U2 + WF2 - UT_MS = U1*WF1_MS + U2*WF2_MS - UT_RE = U1*WF1_RE + U2*WF2_RE - UT_XF = U1*WF1_XF + U2*WF2_XF -C -C---- set primary "T" variables at XT (really placed into "2" variables) - X2 = XT - T2 = TT - D2 = DT - U2 = UT -C - AMPL2 = AMCRIT - S2 = 0. -C -C---- calculate laminar secondary "T" variables - CALL BLKIN - CALL BLVAR(1) -C -C---- calculate X1-XT midpoint CFM value - CALL BLMID(1) -C= -C= at this point, all "2" variables are really "T" variables at XT -C= -C -C---- set up Newton system for dAm, dTh, dDs, dUe, dXi at X1 and XT - CALL BLDIF(1) -C -C---- The current Newton system is in terms of "1" and "T" variables, -C- so calculate its equivalent in terms of "1" and "2" variables. -C- In other words, convert residual sensitivities wrt "T" variables -C- into sensitivities wrt "1" and "2" variables. The amplification -C- equation is unnecessary here, so the K=1 row is left empty. - DO 10 K=2, 3 - BLREZ(K) = VSREZ(K) - BLM(K) = VSM(K) - & + VS2(K,2)*TT_MS - & + VS2(K,3)*DT_MS - & + VS2(K,4)*UT_MS - & + VS2(K,5)*XT_MS - BLR(K) = VSR(K) - & + VS2(K,2)*TT_RE - & + VS2(K,3)*DT_RE - & + VS2(K,4)*UT_RE - & + VS2(K,5)*XT_RE - BLX(K) = VSX(K) - & + VS2(K,2)*TT_XF - & + VS2(K,3)*DT_XF - & + VS2(K,4)*UT_XF - & + VS2(K,5)*XT_XF -C - BL1(K,1) = VS1(K,1) - & + VS2(K,2)*TT_A1 - & + VS2(K,3)*DT_A1 - & + VS2(K,4)*UT_A1 - & + VS2(K,5)*XT_A1 - BL1(K,2) = VS1(K,2) - & + VS2(K,2)*TT_T1 - & + VS2(K,3)*DT_T1 - & + VS2(K,4)*UT_T1 - & + VS2(K,5)*XT_T1 - BL1(K,3) = VS1(K,3) - & + VS2(K,2)*TT_D1 - & + VS2(K,3)*DT_D1 - & + VS2(K,4)*UT_D1 - & + VS2(K,5)*XT_D1 - BL1(K,4) = VS1(K,4) - & + VS2(K,2)*TT_U1 - & + VS2(K,3)*DT_U1 - & + VS2(K,4)*UT_U1 - & + VS2(K,5)*XT_U1 - BL1(K,5) = VS1(K,5) - & + VS2(K,2)*TT_X1 - & + VS2(K,3)*DT_X1 - & + VS2(K,4)*UT_X1 - & + VS2(K,5)*XT_X1 -C - BL2(K,1) = 0. - BL2(K,2) = VS2(K,2)*TT_T2 - & + VS2(K,3)*DT_T2 - & + VS2(K,4)*UT_T2 - & + VS2(K,5)*XT_T2 - BL2(K,3) = VS2(K,2)*TT_D2 - & + VS2(K,3)*DT_D2 - & + VS2(K,4)*UT_D2 - & + VS2(K,5)*XT_D2 - BL2(K,4) = VS2(K,2)*TT_U2 - & + VS2(K,3)*DT_U2 - & + VS2(K,4)*UT_U2 - & + VS2(K,5)*XT_U2 - BL2(K,5) = VS2(K,2)*TT_X2 - & + VS2(K,3)*DT_X2 - & + VS2(K,4)*UT_X2 - & + VS2(K,5)*XT_X2 -C - 10 CONTINUE -C -C -C**** SECOND, set up turbulent part between XT and X2 **** -C -C---- calculate equilibrium shear coefficient CQT at transition point - CALL BLVAR(2) -C -C---- set initial shear coefficient value ST at transition point -C- ( note that CQ2, CQ2_T2, etc. are really "CQT", "CQT_TT", etc.) -C - CTR = 1.8*EXP(-3.3/(HK2-1.0)) - CTR_HK2 = CTR * 3.3/(HK2-1.0)**2 -C -c CTR = 1.1*EXP(-10.0/HK2**2) -c CTR_HK2 = CTR * 10.0 * 2.0/HK2**3 -C -CCC CTR = 1.2 -CCC CTR = 0.7 -CCC CTR_HK2 = 0.0 -C - ST = CTR*CQ2 - ST_TT = CTR*CQ2_T2 + CQ2*CTR_HK2*HK2_T2 - ST_DT = CTR*CQ2_D2 + CQ2*CTR_HK2*HK2_D2 - ST_UT = CTR*CQ2_U2 + CQ2*CTR_HK2*HK2_U2 - ST_MS = CTR*CQ2_MS + CQ2*CTR_HK2*HK2_MS - ST_RE = CTR*CQ2_RE -C -C---- calculate ST sensitivities wrt the actual "1" and "2" variables - ST_A1 = ST_TT*TT_A1 + ST_DT*DT_A1 + ST_UT*UT_A1 - ST_X1 = ST_TT*TT_X1 + ST_DT*DT_X1 + ST_UT*UT_X1 - ST_X2 = ST_TT*TT_X2 + ST_DT*DT_X2 + ST_UT*UT_X2 - ST_T1 = ST_TT*TT_T1 + ST_DT*DT_T1 + ST_UT*UT_T1 - ST_T2 = ST_TT*TT_T2 + ST_DT*DT_T2 + ST_UT*UT_T2 - ST_D1 = ST_TT*TT_D1 + ST_DT*DT_D1 + ST_UT*UT_D1 - ST_D2 = ST_TT*TT_D2 + ST_DT*DT_D2 + ST_UT*UT_D2 - ST_U1 = ST_TT*TT_U1 + ST_DT*DT_U1 + ST_UT*UT_U1 - ST_U2 = ST_TT*TT_U2 + ST_DT*DT_U2 + ST_UT*UT_U2 - ST_MS = ST_TT*TT_MS + ST_DT*DT_MS + ST_UT*UT_MS + ST_MS - ST_RE = ST_TT*TT_RE + ST_DT*DT_RE + ST_UT*UT_RE + ST_RE - ST_XF = ST_TT*TT_XF + ST_DT*DT_XF + ST_UT*UT_XF -C - AMPL2 = 0. - S2 = ST -C -C---- recalculate turbulent secondary "T" variables using proper CTI - CALL BLVAR(2) -C -C---- set "1" variables to "T" variables and reset "2" variables -C- to their saved turbulent values - DO 30 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - COM2(ICOM) = C2SAV(ICOM) - 30 CONTINUE -C -C---- calculate XT-X2 midpoint CFM value - CALL BLMID(2) -C -C---- set up Newton system for dCt, dTh, dDs, dUe, dXi at XT and X2 - CALL BLDIF(2) -C -C---- convert sensitivities wrt "T" variables into sensitivities -C- wrt "1" and "2" variables as done before for the laminar part - DO 40 K=1, 3 - BTREZ(K) = VSREZ(K) - BTM(K) = VSM(K) - & + VS1(K,1)*ST_MS - & + VS1(K,2)*TT_MS - & + VS1(K,3)*DT_MS - & + VS1(K,4)*UT_MS - & + VS1(K,5)*XT_MS - BTR(K) = VSR(K) - & + VS1(K,1)*ST_RE - & + VS1(K,2)*TT_RE - & + VS1(K,3)*DT_RE - & + VS1(K,4)*UT_RE - & + VS1(K,5)*XT_RE - BTX(K) = VSX(K) - & + VS1(K,1)*ST_XF - & + VS1(K,2)*TT_XF - & + VS1(K,3)*DT_XF - & + VS1(K,4)*UT_XF - & + VS1(K,5)*XT_XF -C - BT1(K,1) = VS1(K,1)*ST_A1 - & + VS1(K,2)*TT_A1 - & + VS1(K,3)*DT_A1 - & + VS1(K,4)*UT_A1 - & + VS1(K,5)*XT_A1 - BT1(K,2) = VS1(K,1)*ST_T1 - & + VS1(K,2)*TT_T1 - & + VS1(K,3)*DT_T1 - & + VS1(K,4)*UT_T1 - & + VS1(K,5)*XT_T1 - BT1(K,3) = VS1(K,1)*ST_D1 - & + VS1(K,2)*TT_D1 - & + VS1(K,3)*DT_D1 - & + VS1(K,4)*UT_D1 - & + VS1(K,5)*XT_D1 - BT1(K,4) = VS1(K,1)*ST_U1 - & + VS1(K,2)*TT_U1 - & + VS1(K,3)*DT_U1 - & + VS1(K,4)*UT_U1 - & + VS1(K,5)*XT_U1 - BT1(K,5) = VS1(K,1)*ST_X1 - & + VS1(K,2)*TT_X1 - & + VS1(K,3)*DT_X1 - & + VS1(K,4)*UT_X1 - & + VS1(K,5)*XT_X1 -C - BT2(K,1) = VS2(K,1) - BT2(K,2) = VS2(K,2) - & + VS1(K,1)*ST_T2 - & + VS1(K,2)*TT_T2 - & + VS1(K,3)*DT_T2 - & + VS1(K,4)*UT_T2 - & + VS1(K,5)*XT_T2 - BT2(K,3) = VS2(K,3) - & + VS1(K,1)*ST_D2 - & + VS1(K,2)*TT_D2 - & + VS1(K,3)*DT_D2 - & + VS1(K,4)*UT_D2 - & + VS1(K,5)*XT_D2 - BT2(K,4) = VS2(K,4) - & + VS1(K,1)*ST_U2 - & + VS1(K,2)*TT_U2 - & + VS1(K,3)*DT_U2 - & + VS1(K,4)*UT_U2 - & + VS1(K,5)*XT_U2 - BT2(K,5) = VS2(K,5) - & + VS1(K,1)*ST_X2 - & + VS1(K,2)*TT_X2 - & + VS1(K,3)*DT_X2 - & + VS1(K,4)*UT_X2 - & + VS1(K,5)*XT_X2 -C - 40 CONTINUE -C -C---- Add up laminar and turbulent parts to get final system -C- in terms of honest-to-God "1" and "2" variables. - VSREZ(1) = BTREZ(1) - VSREZ(2) = BLREZ(2) + BTREZ(2) - VSREZ(3) = BLREZ(3) + BTREZ(3) - VSM(1) = BTM(1) - VSM(2) = BLM(2) + BTM(2) - VSM(3) = BLM(3) + BTM(3) - VSR(1) = BTR(1) - VSR(2) = BLR(2) + BTR(2) - VSR(3) = BLR(3) + BTR(3) - VSX(1) = BTX(1) - VSX(2) = BLX(2) + BTX(2) - VSX(3) = BLX(3) + BTX(3) - DO 60 L=1, 5 - VS1(1,L) = BT1(1,L) - VS2(1,L) = BT2(1,L) - VS1(2,L) = BL1(2,L) + BT1(2,L) - VS2(2,L) = BL2(2,L) + BT2(2,L) - VS1(3,L) = BL1(3,L) + BT1(3,L) - VS2(3,L) = BL2(3,L) + BT2(3,L) - 60 CONTINUE -C -C---- To be sanitary, restore "1" quantities which got clobbered -C- in all of the numerical gymnastics above. The "2" variables -C- were already restored for the XT-X2 differencing part. - DO 70 ICOM=1, NCOM - COM1(ICOM) = C1SAV(ICOM) - 70 CONTINUE -C - RETURN - END - - - SUBROUTINE BLDIF(ITYP) -C----------------------------------------------------------- -C Sets up the Newton system coefficients and residuals -C -C ITYP = 0 : similarity station -C ITYP = 1 : laminar interval -C ITYP = 2 : turbulent interval -C ITYP = 3 : wake interval -C -C This routine knows nothing about a transition interval, -C which is taken care of by TRDIF. -C----------------------------------------------------------- - IMPLICIT REAL(M) - INCLUDE 'XBL.INC' -C - IF(ITYP.EQ.0) THEN -C----- similarity logarithmic differences (prescribed) - XLOG = 1.0 - ULOG = BULE - TLOG = 0.5*(1.0 - BULE) - HLOG = 0. - DDLOG = 0. - ELSE -C----- usual logarithmic differences - XLOG = LOG(X2/X1) - ULOG = LOG(U2/U1) - TLOG = LOG(T2/T1) - HLOG = LOG(HS2/HS1) -C XLOG = 2.0*(X2-X1)/(X2+X1) -C ULOG = 2.0*(U2-U1)/(U2+U1) -C TLOG = 2.0*(T2-T1)/(T2+T1) -C HLOG = 2.0*(HS2-HS1)/(HS2+HS1) - DDLOG = 1.0 - ENDIF -C - DO 55 K=1, 4 - VSREZ(K) = 0. - VSM(K) = 0. - VSR(K) = 0. - VSX(K) = 0. - DO 551 L=1, 5 - VS1(K,L) = 0. - VS2(K,L) = 0. - 551 CONTINUE - 55 CONTINUE -C -C---- set triggering constant for local upwinding - HUPWT = 1.0 -C -ccc HDCON = 5.0*HUPWT -ccc HD_HK1 = 0.0 -ccc HD_HK2 = 0.0 -C - HDCON = 5.0*HUPWT/HK2**2 - HD_HK1 = 0.0 - HD_HK2 = -HDCON*2.0/HK2 -C -C---- use less upwinding in the wake - IF(ITYP.EQ.3) THEN - HDCON = HUPWT/HK2**2 - HD_HK1 = 0.0 - HD_HK2 = -HDCON*2.0/HK2 - ENDIF -C -C---- local upwinding is based on local change in log(Hk-1) -C- (mainly kicks in at transition) - ARG = ABS((HK2-1.0)/(HK1-1.0)) - HL = LOG(ARG) - HL_HK1 = -1.0/(HK1-1.0) - HL_HK2 = 1.0/(HK2-1.0) -C -C---- set local upwinding parameter UPW and linearize it -C -C UPW = 0.5 Trapezoidal -C UPW = 1.0 Backward Euler -C - HLSQ = MIN( HL**2 , 15.0 ) - EHH = EXP(-HLSQ*HDCON) - UPW = 1.0 - 0.5*EHH - UPW_HL = EHH * HL *HDCON - UPW_HD = 0.5*EHH * HLSQ -C - UPW_HK1 = UPW_HL*HL_HK1 + UPW_HD*HD_HK1 - UPW_HK2 = UPW_HL*HL_HK2 + UPW_HD*HD_HK2 -C - UPW_U1 = UPW_HK1*HK1_U1 - UPW_T1 = UPW_HK1*HK1_T1 - UPW_D1 = UPW_HK1*HK1_D1 - UPW_U2 = UPW_HK2*HK2_U2 - UPW_T2 = UPW_HK2*HK2_T2 - UPW_D2 = UPW_HK2*HK2_D2 - UPW_MS = UPW_HK1*HK1_MS - & + UPW_HK2*HK2_MS -C -C - IF(ITYP.EQ.0) THEN -C -C***** LE point --> set zero amplification factor - VS2(1,1) = 1.0 - VSR(1) = 0. - VSREZ(1) = -AMPL2 -C - ELSE IF(ITYP.EQ.1) THEN -C -C***** laminar part --> set amplification equation -C -C----- set average amplification AX over interval X1..X2 - CALL AXSET( HK1, T1, RT1, AMPL1, - & HK2, T2, RT2, AMPL2, AMCRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -C - REZC = AMPL2 - AMPL1 - AX*(X2-X1) - Z_AX = -(X2-X1) -C - VS1(1,1) = Z_AX* AX_A1 - 1.0 - VS1(1,2) = Z_AX*(AX_HK1*HK1_T1 + AX_T1 + AX_RT1*RT1_T1) - VS1(1,3) = Z_AX*(AX_HK1*HK1_D1 ) - VS1(1,4) = Z_AX*(AX_HK1*HK1_U1 + AX_RT1*RT1_U1) - VS1(1,5) = AX - VS2(1,1) = Z_AX* AX_A2 + 1.0 - VS2(1,2) = Z_AX*(AX_HK2*HK2_T2 + AX_T2 + AX_RT2*RT2_T2) - VS2(1,3) = Z_AX*(AX_HK2*HK2_D2 ) - VS2(1,4) = Z_AX*(AX_HK2*HK2_U2 + AX_RT2*RT2_U2) - VS2(1,5) = -AX - VSM(1) = Z_AX*(AX_HK1*HK1_MS + AX_RT1*RT1_MS - & + AX_HK2*HK2_MS + AX_RT2*RT2_MS) - VSR(1) = Z_AX*( AX_RT1*RT1_RE - & + AX_RT2*RT2_RE) - VSX(1) = 0. - VSREZ(1) = -REZC -C - ELSE -C -C***** turbulent part --> set shear lag equation -C - SA = (1.0-UPW)*S1 + UPW*S2 - CQA = (1.0-UPW)*CQ1 + UPW*CQ2 - CFA = (1.0-UPW)*CF1 + UPW*CF2 - HKA = (1.0-UPW)*HK1 + UPW*HK2 -C - USA = 0.5*(US1 + US2) - RTA = 0.5*(RT1 + RT2) - DEA = 0.5*(DE1 + DE2) - DA = 0.5*(D1 + D2 ) -C -C - IF(ITYP.EQ.3) THEN -C------ increased dissipation length in wake (decrease its reciprocal) - ALD = DLCON - ELSE - ALD = 1.0 - ENDIF -C -C----- set and linearize equilibrium 1/Ue dUe/dx ... NEW 12 Oct 94 - IF(ITYP.EQ.2) THEN - GCC = GCCON - HKC = HKA - 1.0 - GCC/RTA - HKC_HKA = 1.0 - HKC_RTA = GCC/RTA**2 - IF(HKC .LT. 0.01) THEN - HKC = 0.01 - HKC_HKA = 0.0 - HKC_RTA = 0.0 - ENDIF - ELSE - GCC = 0.0 - HKC = HKA - 1.0 - HKC_HKA = 1.0 - HKC_RTA = 0.0 - ENDIF -C - HR = HKC / (GACON*ALD*HKA) - HR_HKA = HKC_HKA / (GACON*ALD*HKA) - HR / HKA - HR_RTA = HKC_RTA / (GACON*ALD*HKA) -C - UQ = (0.5*CFA - HR**2) / (GBCON*DA) - UQ_HKA = -2.0*HR*HR_HKA / (GBCON*DA) - UQ_RTA = -2.0*HR*HR_RTA / (GBCON*DA) - UQ_CFA = 0.5 / (GBCON*DA) - UQ_DA = -UQ/DA - UQ_UPW = UQ_CFA*(CF2-CF1) + UQ_HKA*(HK2-HK1) -C - UQ_T1 = (1.0-UPW)*(UQ_CFA*CF1_T1 + UQ_HKA*HK1_T1) + UQ_UPW*UPW_T1 - UQ_D1 = (1.0-UPW)*(UQ_CFA*CF1_D1 + UQ_HKA*HK1_D1) + UQ_UPW*UPW_D1 - UQ_U1 = (1.0-UPW)*(UQ_CFA*CF1_U1 + UQ_HKA*HK1_U1) + UQ_UPW*UPW_U1 - UQ_T2 = UPW *(UQ_CFA*CF2_T2 + UQ_HKA*HK2_T2) + UQ_UPW*UPW_T2 - UQ_D2 = UPW *(UQ_CFA*CF2_D2 + UQ_HKA*HK2_D2) + UQ_UPW*UPW_D2 - UQ_U2 = UPW *(UQ_CFA*CF2_U2 + UQ_HKA*HK2_U2) + UQ_UPW*UPW_U2 - UQ_MS = (1.0-UPW)*(UQ_CFA*CF1_MS + UQ_HKA*HK1_MS) + UQ_UPW*UPW_MS - & + UPW *(UQ_CFA*CF2_MS + UQ_HKA*HK2_MS) - UQ_RE = (1.0-UPW)* UQ_CFA*CF1_RE - & + UPW * UQ_CFA*CF2_RE -C - UQ_T1 = UQ_T1 + 0.5*UQ_RTA*RT1_T1 - UQ_D1 = UQ_D1 + 0.5*UQ_DA - UQ_U1 = UQ_U1 + 0.5*UQ_RTA*RT1_U1 - UQ_T2 = UQ_T2 + 0.5*UQ_RTA*RT2_T2 - UQ_D2 = UQ_D2 + 0.5*UQ_DA - UQ_U2 = UQ_U2 + 0.5*UQ_RTA*RT2_U2 - UQ_MS = UQ_MS + 0.5*UQ_RTA*RT1_MS - & + 0.5*UQ_RTA*RT2_MS - UQ_RE = UQ_RE + 0.5*UQ_RTA*RT1_RE - & + 0.5*UQ_RTA*RT2_RE -C - SCC = SCCON*1.333/(1.0+USA) - SCC_USA = -SCC/(1.0+USA) -C - SCC_US1 = SCC_USA*0.5 - SCC_US2 = SCC_USA*0.5 -C -C - SLOG = LOG(S2/S1) - DXI = X2 - X1 -C - REZC = SCC*(CQA - SA*ALD)*DXI - & - DEA*2.0* SLOG - & + DEA*2.0*(UQ*DXI - ULOG) -C - -c if( ! (rt2.gt.1.0e3 .and. rt1.le.1.0e3) .or. -c & (rt2.gt.1.0e4 .and. rt1.le.1.0e4) .or. -c & (rt2.gt.1.0e5 .and. rt1.le.1.0e5) ) then -c gga = (HKA-1.0-GCC/RTA)/HKA / sqrt(0.5*CFA) -c write(*,4455) rta, hka, gga, cfa, cqa, sa, uq, ulog/dxi -c 4455 format(1x,f7.0, 2f9.4,f10.6,2f8.5,2f10.5) -c endif - - - Z_CFA = DEA*2.0*UQ_CFA*DXI - Z_HKA = DEA*2.0*UQ_HKA*DXI - Z_DA = DEA*2.0*UQ_DA *DXI - Z_SL = -DEA*2.0 - Z_UL = -DEA*2.0 - Z_DXI = SCC *(CQA - SA*ALD) + DEA*2.0*UQ - Z_USA = SCC_USA*(CQA - SA*ALD)*DXI - Z_CQA = SCC*DXI - Z_SA = -SCC*DXI*ALD - Z_DEA = 2.0*(UQ*DXI - ULOG - SLOG) -C - Z_UPW = Z_CQA*(CQ2-CQ1) + Z_SA *(S2 -S1 ) - & + Z_CFA*(CF2-CF1) + Z_HKA*(HK2-HK1) - Z_DE1 = 0.5*Z_DEA - Z_DE2 = 0.5*Z_DEA - Z_US1 = 0.5*Z_USA - Z_US2 = 0.5*Z_USA - Z_D1 = 0.5*Z_DA - Z_D2 = 0.5*Z_DA - Z_U1 = - Z_UL/U1 - Z_U2 = Z_UL/U2 - Z_X1 = -Z_DXI - Z_X2 = Z_DXI - Z_S1 = (1.0-UPW)*Z_SA - Z_SL/S1 - Z_S2 = UPW *Z_SA + Z_SL/S2 - Z_CQ1 = (1.0-UPW)*Z_CQA - Z_CQ2 = UPW *Z_CQA - Z_CF1 = (1.0-UPW)*Z_CFA - Z_CF2 = UPW *Z_CFA - Z_HK1 = (1.0-UPW)*Z_HKA - Z_HK2 = UPW *Z_HKA -C - VS1(1,1) = Z_S1 - VS1(1,2) = Z_UPW*UPW_T1 + Z_DE1*DE1_T1 + Z_US1*US1_T1 - VS1(1,3) = Z_D1 + Z_UPW*UPW_D1 + Z_DE1*DE1_D1 + Z_US1*US1_D1 - VS1(1,4) = Z_U1 + Z_UPW*UPW_U1 + Z_DE1*DE1_U1 + Z_US1*US1_U1 - VS1(1,5) = Z_X1 - VS2(1,1) = Z_S2 - VS2(1,2) = Z_UPW*UPW_T2 + Z_DE2*DE2_T2 + Z_US2*US2_T2 - VS2(1,3) = Z_D2 + Z_UPW*UPW_D2 + Z_DE2*DE2_D2 + Z_US2*US2_D2 - VS2(1,4) = Z_U2 + Z_UPW*UPW_U2 + Z_DE2*DE2_U2 + Z_US2*US2_U2 - VS2(1,5) = Z_X2 - VSM(1) = Z_UPW*UPW_MS + Z_DE1*DE1_MS + Z_US1*US1_MS - & + Z_DE2*DE2_MS + Z_US2*US2_MS -C - VS1(1,2) = VS1(1,2) + Z_CQ1*CQ1_T1 + Z_CF1*CF1_T1 + Z_HK1*HK1_T1 - VS1(1,3) = VS1(1,3) + Z_CQ1*CQ1_D1 + Z_CF1*CF1_D1 + Z_HK1*HK1_D1 - VS1(1,4) = VS1(1,4) + Z_CQ1*CQ1_U1 + Z_CF1*CF1_U1 + Z_HK1*HK1_U1 -C - VS2(1,2) = VS2(1,2) + Z_CQ2*CQ2_T2 + Z_CF2*CF2_T2 + Z_HK2*HK2_T2 - VS2(1,3) = VS2(1,3) + Z_CQ2*CQ2_D2 + Z_CF2*CF2_D2 + Z_HK2*HK2_D2 - VS2(1,4) = VS2(1,4) + Z_CQ2*CQ2_U2 + Z_CF2*CF2_U2 + Z_HK2*HK2_U2 -C - VSM(1) = VSM(1) + Z_CQ1*CQ1_MS + Z_CF1*CF1_MS + Z_HK1*HK1_MS - & + Z_CQ2*CQ2_MS + Z_CF2*CF2_MS + Z_HK2*HK2_MS - VSR(1) = Z_CQ1*CQ1_RE + Z_CF1*CF1_RE - & + Z_CQ2*CQ2_RE + Z_CF2*CF2_RE - VSX(1) = 0. - VSREZ(1) = -REZC -C - ENDIF -C -C**** Set up momentum equation - HA = 0.5*(H1 + H2) - MA = 0.5*(M1 + M2) - XA = 0.5*(X1 + X2) - TA = 0.5*(T1 + T2) - HWA = 0.5*(DW1/T1 + DW2/T2) -C -C---- set Cf term, using central value CFM for better accuracy in drag - CFX = 0.50*CFM*XA/TA + 0.25*(CF1*X1/T1 + CF2*X2/T2) - CFX_XA = 0.50*CFM /TA - CFX_TA = -.50*CFM*XA/TA**2 -C - CFX_X1 = 0.25*CF1 /T1 + CFX_XA*0.5 - CFX_X2 = 0.25*CF2 /T2 + CFX_XA*0.5 - CFX_T1 = -.25*CF1*X1/T1**2 + CFX_TA*0.5 - CFX_T2 = -.25*CF2*X2/T2**2 + CFX_TA*0.5 - CFX_CF1 = 0.25* X1/T1 - CFX_CF2 = 0.25* X2/T2 - CFX_CFM = 0.50* XA/TA -C - BTMP = HA + 2.0 - MA + HWA -C - REZT = TLOG + BTMP*ULOG - XLOG*0.5*CFX - Z_CFX = -XLOG*0.5 - Z_HA = ULOG - Z_HWA = ULOG - Z_MA = -ULOG - Z_XL =-DDLOG * 0.5*CFX - Z_UL = DDLOG * BTMP - Z_TL = DDLOG -C - Z_CFM = Z_CFX*CFX_CFM - Z_CF1 = Z_CFX*CFX_CF1 - Z_CF2 = Z_CFX*CFX_CF2 -C - Z_T1 = -Z_TL/T1 + Z_CFX*CFX_T1 + Z_HWA*0.5*(-DW1/T1**2) - Z_T2 = Z_TL/T2 + Z_CFX*CFX_T2 + Z_HWA*0.5*(-DW2/T2**2) - Z_X1 = -Z_XL/X1 + Z_CFX*CFX_X1 - Z_X2 = Z_XL/X2 + Z_CFX*CFX_X2 - Z_U1 = -Z_UL/U1 - Z_U2 = Z_UL/U2 -C - VS1(2,2) = 0.5*Z_HA*H1_T1 + Z_CFM*CFM_T1 + Z_CF1*CF1_T1 + Z_T1 - VS1(2,3) = 0.5*Z_HA*H1_D1 + Z_CFM*CFM_D1 + Z_CF1*CF1_D1 - VS1(2,4) = 0.5*Z_MA*M1_U1 + Z_CFM*CFM_U1 + Z_CF1*CF1_U1 + Z_U1 - VS1(2,5) = Z_X1 - VS2(2,2) = 0.5*Z_HA*H2_T2 + Z_CFM*CFM_T2 + Z_CF2*CF2_T2 + Z_T2 - VS2(2,3) = 0.5*Z_HA*H2_D2 + Z_CFM*CFM_D2 + Z_CF2*CF2_D2 - VS2(2,4) = 0.5*Z_MA*M2_U2 + Z_CFM*CFM_U2 + Z_CF2*CF2_U2 + Z_U2 - VS2(2,5) = Z_X2 -C - VSM(2) = 0.5*Z_MA*M1_MS + Z_CFM*CFM_MS + Z_CF1*CF1_MS - & + 0.5*Z_MA*M2_MS + Z_CF2*CF2_MS - VSR(2) = Z_CFM*CFM_RE + Z_CF1*CF1_RE - & + Z_CF2*CF2_RE - VSX(2) = 0. - VSREZ(2) = -REZT -C -C**** Set up shape parameter equation -C - XOT1 = X1/T1 - XOT2 = X2/T2 -C - HA = 0.5*(H1 + H2 ) - HSA = 0.5*(HS1 + HS2) - HCA = 0.5*(HC1 + HC2) - HWA = 0.5*(DW1/T1 + DW2/T2) -C - DIX = (1.0-UPW)*DI1*XOT1 + UPW*DI2*XOT2 - CFX = (1.0-UPW)*CF1*XOT1 + UPW*CF2*XOT2 - DIX_UPW = DI2*XOT2 - DI1*XOT1 - CFX_UPW = CF2*XOT2 - CF1*XOT1 -C - BTMP = 2.0*HCA/HSA + 1.0 - HA - HWA -C - REZH = HLOG + BTMP*ULOG + XLOG*(0.5*CFX-DIX) - Z_CFX = XLOG*0.5 - Z_DIX = -XLOG - Z_HCA = 2.0*ULOG/HSA - Z_HA = -ULOG - Z_HWA = -ULOG - Z_XL = DDLOG * (0.5*CFX-DIX) - Z_UL = DDLOG * BTMP - Z_HL = DDLOG -C - Z_UPW = Z_CFX*CFX_UPW + Z_DIX*DIX_UPW -C - Z_HS1 = -HCA*ULOG/HSA**2 - Z_HL/HS1 - Z_HS2 = -HCA*ULOG/HSA**2 + Z_HL/HS2 -C - Z_CF1 = (1.0-UPW)*Z_CFX*XOT1 - Z_CF2 = UPW *Z_CFX*XOT2 - Z_DI1 = (1.0-UPW)*Z_DIX*XOT1 - Z_DI2 = UPW *Z_DIX*XOT2 -C - Z_T1 = (1.0-UPW)*(Z_CFX*CF1 + Z_DIX*DI1)*(-XOT1/T1) - Z_T2 = UPW *(Z_CFX*CF2 + Z_DIX*DI2)*(-XOT2/T2) - Z_X1 = (1.0-UPW)*(Z_CFX*CF1 + Z_DIX*DI1)/ T1 - Z_XL/X1 - Z_X2 = UPW *(Z_CFX*CF2 + Z_DIX*DI2)/ T2 + Z_XL/X2 - Z_U1 = - Z_UL/U1 - Z_U2 = Z_UL/U2 -C - Z_T1 = Z_T1 + Z_HWA*0.5*(-DW1/T1**2) - Z_T2 = Z_T2 + Z_HWA*0.5*(-DW2/T2**2) -C - VS1(3,1) = Z_DI1*DI1_S1 - VS1(3,2) = Z_HS1*HS1_T1 + Z_CF1*CF1_T1 + Z_DI1*DI1_T1 + Z_T1 - VS1(3,3) = Z_HS1*HS1_D1 + Z_CF1*CF1_D1 + Z_DI1*DI1_D1 - VS1(3,4) = Z_HS1*HS1_U1 + Z_CF1*CF1_U1 + Z_DI1*DI1_U1 + Z_U1 - VS1(3,5) = Z_X1 - VS2(3,1) = Z_DI2*DI2_S2 - VS2(3,2) = Z_HS2*HS2_T2 + Z_CF2*CF2_T2 + Z_DI2*DI2_T2 + Z_T2 - VS2(3,3) = Z_HS2*HS2_D2 + Z_CF2*CF2_D2 + Z_DI2*DI2_D2 - VS2(3,4) = Z_HS2*HS2_U2 + Z_CF2*CF2_U2 + Z_DI2*DI2_U2 + Z_U2 - VS2(3,5) = Z_X2 - VSM(3) = Z_HS1*HS1_MS + Z_CF1*CF1_MS + Z_DI1*DI1_MS - & + Z_HS2*HS2_MS + Z_CF2*CF2_MS + Z_DI2*DI2_MS - VSR(3) = Z_HS1*HS1_RE + Z_CF1*CF1_RE + Z_DI1*DI1_RE - & + Z_HS2*HS2_RE + Z_CF2*CF2_RE + Z_DI2*DI2_RE -C - VS1(3,2) = VS1(3,2) + 0.5*(Z_HCA*HC1_T1+Z_HA*H1_T1) + Z_UPW*UPW_T1 - VS1(3,3) = VS1(3,3) + 0.5*(Z_HCA*HC1_D1+Z_HA*H1_D1) + Z_UPW*UPW_D1 - VS1(3,4) = VS1(3,4) + 0.5*(Z_HCA*HC1_U1 ) + Z_UPW*UPW_U1 - VS2(3,2) = VS2(3,2) + 0.5*(Z_HCA*HC2_T2+Z_HA*H2_T2) + Z_UPW*UPW_T2 - VS2(3,3) = VS2(3,3) + 0.5*(Z_HCA*HC2_D2+Z_HA*H2_D2) + Z_UPW*UPW_D2 - VS2(3,4) = VS2(3,4) + 0.5*(Z_HCA*HC2_U2 ) + Z_UPW*UPW_U2 -C - VSM(3) = VSM(3) + 0.5*(Z_HCA*HC1_MS ) + Z_UPW*UPW_MS - & + 0.5*(Z_HCA*HC2_MS ) -C - VSX(3) = 0. - VSREZ(3) = -REZH -C - RETURN - END - - - - SUBROUTINE DAMPL( HK, TH, RT, AX, AX_HK, AX_TH, AX_RT ) -C============================================================== -C Amplification rate routine for envelope e^n method. -C Reference: -C Drela, M., Giles, M., -C "Viscous/Inviscid Analysis of Transonic and -C Low Reynolds Number Airfoils", -C AIAA Journal, Oct. 1987. -C -C NEW VERSION. March 1991 (latest bug fix July 93) -C - m(H) correlation made more accurate up to H=20 -C - for H > 5, non-similar profiles are used -C instead of Falkner-Skan profiles. These -C non-similar profiles have smaller reverse -C velocities, are more representative of typical -C separation bubble profiles. -C-------------------------------------------------------------- -C -C input : HK kinematic shape parameter -C TH momentum thickness -C RT momentum-thickness Reynolds number -C -C output: AX envelope spatial amplification rate -C AX_(.) sensitivity of AX to parameter (.) -C -C -C Usage: The log of the envelope amplitude N(x) is -C calculated by integrating AX (= dN/dx) with -C respect to the streamwise distance x. -C x -C / -C N(x) = | AX(H(x),Th(x),Rth(x)) dx -C / -C 0 -C The integration can be started from the leading -C edge since AX will be returned as zero when RT -C is below the critical Rtheta. Transition occurs -C when N(x) reaches Ncrit (Ncrit= 9 is "standard"). -C============================================================== - IMPLICIT REAL (A-H,M,O-Z) -ccc DATA DGR / 0.04 / - DATA DGR / 0.08 / -C - HMI = 1.0/(HK - 1.0) - HMI_HK = -HMI**2 -C -C---- log10(Critical Rth) - H correlation for Falkner-Skan profiles - AA = 2.492*HMI**0.43 - AA_HK = (AA/HMI)*0.43 * HMI_HK -C - BB = TANH(14.0*HMI - 9.24) - BB_HK = (1.0 - BB*BB) * 14.0 * HMI_HK -C - GRCRIT = AA + 0.7*(BB + 1.0) - GRC_HK = AA_HK + 0.7* BB_HK -C -C - GR = LOG10(RT) - GR_RT = 1.0 / (2.3025851*RT) -C - IF(GR .LT. GRCRIT-DGR) THEN -C -C----- no amplification for Rtheta < Rcrit - AX = 0. - AX_HK = 0. - AX_TH = 0. - AX_RT = 0. -C - ELSE -C -C----- Set steep cubic ramp used to turn on AX smoothly as Rtheta -C- exceeds Rcrit (previously, this was done discontinuously). -C- The ramp goes between -DGR < log10(Rtheta/Rcrit) < DGR -C - RNORM = (GR - (GRCRIT-DGR)) / (2.0*DGR) - RN_HK = - GRC_HK / (2.0*DGR) - RN_RT = GR_RT / (2.0*DGR) -C - IF(RNORM .GE. 1.0) THEN - RFAC = 1.0 - RFAC_HK = 0. - RFAC_RT = 0. - ELSE - RFAC = 3.0*RNORM**2 - 2.0*RNORM**3 - RFAC_RN = 6.0*RNORM - 6.0*RNORM**2 -C - RFAC_HK = RFAC_RN*RN_HK - RFAC_RT = RFAC_RN*RN_RT - ENDIF -C -C----- Amplification envelope slope correlation for Falkner-Skan - ARG = 3.87*HMI - 2.52 - ARG_HK = 3.87*HMI_HK -C - EX = EXP(-ARG**2) - EX_HK = EX * (-2.0*ARG*ARG_HK) -C - DADR = 0.028*(HK-1.0) - 0.0345*EX - DADR_HK = 0.028 - 0.0345*EX_HK -C -C----- new m(H) correlation 1 March 91 - AF = -0.05 + 2.7*HMI - 5.5*HMI**2 + 3.0*HMI**3 - AF_HMI = 2.7 - 11.0*HMI + 9.0*HMI**2 - AF_HK = AF_HMI*HMI_HK -C - AX = (AF *DADR/TH ) * RFAC - AX_HK = (AF_HK*DADR/TH + AF*DADR_HK/TH) * RFAC - & + (AF *DADR/TH ) * RFAC_HK - AX_TH = -AX/TH - AX_RT = (AF *DADR/TH ) * RFAC_RT -C - ENDIF -C - RETURN - END ! DAMPL - - - - SUBROUTINE HKIN( H, MSQ, HK, HK_H, HK_MSQ ) - REAL MSQ -C -C---- calculate kinematic shape parameter (assuming air) -C (from Whitfield ) - HK = (H - 0.29*MSQ)/(1.0 + 0.113*MSQ) - HK_H = 1.0 /(1.0 + 0.113*MSQ) - HK_MSQ = (-.29 - 0.113*HK)/(1.0 + 0.113*MSQ) -C - RETURN - END - - - - SUBROUTINE DIL( HK, RT, DI, DI_HK, DI_RT ) -C -C---- Laminar dissipation function ( 2 CD/H* ) (from Falkner-Skan) - IF(HK.LT.4.0) THEN - DI = ( 0.00205 * (4.0-HK)**5.5 + 0.207 ) / RT - DI_HK = ( -.00205*5.5*(4.0-HK)**4.5 ) / RT - ELSE - HKB = HK - 4.0 - DEN = 1.0 + 0.02*HKB**2 - DI = ( -.0016 * HKB**2 /DEN + 0.207 ) / RT - DI_HK = ( -.0016*2.0*HKB*(1.0/DEN - 0.02*HKB**2/DEN**2) ) / RT - ENDIF - DI_RT = -DI/RT -C - RETURN - END - - - SUBROUTINE DILW( HK, RT, DI, DI_HK, DI_RT ) - REAL MSQ -C - MSQ = 0. - CALL HSL( HK, RT, MSQ, HS, HS_HK, HS_RT, HS_MSQ ) -C -C---- Laminar wake dissipation function ( 2 CD/H* ) - RCD = 1.10 * (1.0 - 1.0/HK)**2 / HK - RCD_HK = -1.10 * (1.0 - 1.0/HK)*2.0 / HK**3 - & - RCD/HK -C - DI = 2.0*RCD /(HS*RT) - DI_HK = 2.0*RCD_HK/(HS*RT) - (DI/HS)*HS_HK - DI_RT = -DI/RT - (DI/HS)*HS_RT -C - RETURN - END - - - SUBROUTINE HSL( HK, RT, MSQ, HS, HS_HK, HS_RT, HS_MSQ ) - REAL MSQ -C -C---- Laminar HS correlation - IF(HK.LT.4.35) THEN - TMP = HK - 4.35 - HS = 0.0111*TMP**2/(HK+1.0) - & - 0.0278*TMP**3/(HK+1.0) + 1.528 - & - 0.0002*(TMP*HK)**2 - HS_HK = 0.0111*(2.0*TMP - TMP**2/(HK+1.0))/(HK+1.0) - & - 0.0278*(3.0*TMP**2 - TMP**3/(HK+1.0))/(HK+1.0) - & - 0.0002*2.0*TMP*HK * (TMP + HK) - ELSE - HS = 0.015* (HK-4.35)**2/HK + 1.528 - HS_HK = 0.015*2.0*(HK-4.35) /HK - & - 0.015* (HK-4.35)**2/HK**2 - ENDIF -C - HS_RT = 0. - HS_MSQ = 0. -C - RETURN - END - - - SUBROUTINE CFL( HK, RT, MSQ, CF, CF_HK, CF_RT, CF_MSQ ) - REAL MSQ -C -C---- Laminar skin friction function ( Cf ) ( from Falkner-Skan ) - IF(HK.LT.5.5) THEN - TMP = (5.5-HK)**3 / (HK+1.0) - CF = ( 0.0727*TMP - 0.07 )/RT - CF_HK = ( -.0727*TMP*3.0/(5.5-HK) - 0.0727*TMP/(HK+1.0))/RT - ELSE - TMP = 1.0 - 1.0/(HK-4.5) - CF = ( 0.015*TMP**2 - 0.07 ) / RT - CF_HK = ( 0.015*TMP*2.0/(HK-4.5)**2 ) / RT - ENDIF - CF_RT = -CF/RT - CF_MSQ = 0.0 -C - RETURN - END - - - - SUBROUTINE DIT( HS, US, CF, ST, DI, DI_HS, DI_US, DI_CF, DI_ST ) -C -C---- Turbulent dissipation function ( 2 CD/H* ) - DI = ( 0.5*CF*US + ST*ST*(1.0-US) ) * 2.0/HS - DI_HS = -( 0.5*CF*US + ST*ST*(1.0-US) ) * 2.0/HS**2 - DI_US = ( 0.5*CF - ST*ST ) * 2.0/HS - DI_CF = ( 0.5 *US ) * 2.0/HS - DI_ST = ( 2.0*ST*(1.0-US) ) * 2.0/HS -C - RETURN - END - - - SUBROUTINE HST( HK, RT, MSQ, HS, HS_HK, HS_RT, HS_MSQ ) - IMPLICIT REAL (A-H,M,O-Z) -C -C---- Turbulent HS correlation -C - DATA HSMIN, DHSINF / 1.500, 0.015 / -C -C---- ### 12/4/94 -C---- limited Rtheta dependence for Rtheta < 200 -C -C - IF(RT.GT.400.0) THEN - HO = 3.0 + 400.0/RT - HO_RT = - 400.0/RT**2 - ELSE - HO = 4.0 - HO_RT = 0. - ENDIF -C - IF(RT.GT.200.0) THEN - RTZ = RT - RTZ_RT = 1. - ELSE - RTZ = 200.0 - RTZ_RT = 0. - ENDIF -C - IF(HK.LT.HO) THEN -C----- attached branch -C======================================================= -C----- old correlation -C- (from Swafford profiles) -c SRT = SQRT(RT) -c HEX = (HO-HK)**1.6 -c RTMP = 0.165 - 1.6/SRT -c HS = HSMIN + 4.0/RT + RTMP*HEX/HK -c HS_HK = RTMP*HEX/HK*(-1.6/(HO-HK) - 1.0/HK) -c HS_RT = -4.0/RT**2 + HEX/HK*0.8/SRT/RT -c & + RTMP*HEX/HK*1.6/(HO-HK)*HO_RT -C======================================================= -C----- new correlation 29 Nov 91 -C- (from arctan(y+) + Schlichting profiles) - HR = ( HO - HK)/(HO-1.0) - HR_HK = - 1.0/(HO-1.0) - HR_RT = (1.0 - HR)/(HO-1.0) * HO_RT - HS = (2.0-HSMIN-4.0/RTZ)*HR**2 * 1.5/(HK+0.5) + HSMIN - & + 4.0/RTZ - HS_HK =-(2.0-HSMIN-4.0/RTZ)*HR**2 * 1.5/(HK+0.5)**2 - & + (2.0-HSMIN-4.0/RTZ)*HR*2.0 * 1.5/(HK+0.5) * HR_HK - HS_RT = (2.0-HSMIN-4.0/RTZ)*HR*2.0 * 1.5/(HK+0.5) * HR_RT - & + (HR**2 * 1.5/(HK+0.5) - 1.0)*4.0/RTZ**2 * RTZ_RT -C - ELSE -C -C----- separated branch - GRT = LOG(RTZ) - HDIF = HK - HO - RTMP = HK - HO + 4.0/GRT - HTMP = 0.007*GRT/RTMP**2 + DHSINF/HK - HTMP_HK = -.014*GRT/RTMP**3 - DHSINF/HK**2 - HTMP_RT = -.014*GRT/RTMP**3 * (-HO_RT - 4.0/GRT**2/RTZ * RTZ_RT) - & + 0.007 /RTMP**2 / RTZ * RTZ_RT - HS = HDIF**2 * HTMP + HSMIN + 4.0/RTZ - HS_HK = HDIF*2.0* HTMP - & + HDIF**2 * HTMP_HK - HS_RT = HDIF**2 * HTMP_RT - 4.0/RTZ**2 * RTZ_RT - & + HDIF*2.0* HTMP * (-HO_RT) -C - ENDIF -C -C---- fudge HS slightly to make sure HS -> 2 as HK -> 1 -C- (unnecessary with new correlation) -c HTF = 0.485/9.0 * (HK-4.0)**2/HK + 1.515 -c HTF_HK = 0.485/9.0 * (1.0-16.0/HK**2) -c ARG = MAX( 10.0*(1.0 - HK) , -15.0 ) -c HXX = EXP(ARG) -c HXX_HK = -10.0*HXX -cC -c HS_HK = (1.0-HXX)*HS_HK + HXX*HTF_HK -c & + ( -HS + HTF )*HXX_HK -c HS_RT = (1.0-HXX)*HS_RT -c HS = (1.0-HXX)*HS + HXX*HTF -C -C---- Whitfield's minor additional compressibility correction - FM = 1.0 + 0.014*MSQ - HS = ( HS + 0.028*MSQ ) / FM - HS_HK = ( HS_HK ) / FM - HS_RT = ( HS_RT ) / FM - HS_MSQ = 0.028/FM - 0.014*HS/FM -C - RETURN - END - - - - SUBROUTINE CFT( HK, RT, MSQ, CF, CF_HK, CF_RT, CF_MSQ ) - IMPLICIT REAL (A-H,M,O-Z) - DATA GAM /1.4/ -C -C---- Turbulent skin friction function ( Cf ) (Coles) - GM1 = GAM - 1.0 - FC = SQRT(1.0 + 0.5*GM1*MSQ) - GRT = LOG(RT/FC) - GRT = MAX(GRT,3.0) -C - GEX = -1.74 - 0.31*HK -C - ARG = -1.33*HK - ARG = MAX(-20.0, ARG ) -C - THK = TANH(4.0 - HK/0.875) -C - CFO = 0.3*EXP(ARG) * (GRT/2.3026)**GEX - CF = ( CFO + 1.1E-4*(THK-1.0) ) / FC - CF_HK = (-1.33*CFO - 0.31*LOG(GRT/2.3026)*CFO - & - 1.1E-4*(1.0-THK**2) / 0.875 ) / FC - CF_RT = GEX*CFO/(FC*GRT) / RT - CF_MSQ = GEX*CFO/(FC*GRT) * (-0.25*GM1/FC**2) - 0.25*GM1*CF/FC**2 -C - RETURN - END ! CFT - - - - SUBROUTINE HCT( HK, MSQ, HC, HC_HK, HC_MSQ ) - REAL MSQ -C -C---- density shape parameter (from Whitfield) - HC = MSQ * (0.064/(HK-0.8) + 0.251) - HC_HK = MSQ * (-.064/(HK-0.8)**2 ) - HC_MSQ = 0.064/(HK-0.8) + 0.251 -C - RETURN - END diff --git a/deps/src/xfoil/xdriver.f b/deps/src/xfoil/xdriver.f deleted file mode 100644 index 7d492d9..0000000 --- a/deps/src/xfoil/xdriver.f +++ /dev/null @@ -1,176 +0,0 @@ - subroutine xdriver(ncoor,x_coor,y_coor,ccl,ccd) - - PARAMETER (IQX=286, IWX=36, IPX=5, ISX=2) - PARAMETER (IBX=572) - PARAMETER (IZX=322) - PARAMETER (IVX=229) - PARAMETER (NAX=800,NPX=8,NFX=128) - CHARACTER*32 LABREF - CHARACTER*64 FNAME, PFNAME, PFNAMX, ONAME, PREFIX - CHARACTER*48 NAME, NAMEPOL, CODEPOL, NAMEREF - CHARACTER*80 ISPARS - LOGICAL OK,LIMAGE, - & LGAMU,LQINU,SHARP,LVISC,LALFA,LWAKE,LPACC, - & LBLINI,LIPAN,LQAIJ,LADIJ,LWDIJ,LCPXX,LQVDES,LQREFL, - & LQSPEC,LVCONV,LCPREF,LCLOCK,LPFILE,LPFILX,LPPSHO, - & LBFLAP,LFLAP,LEIW,LSCINI,LFOREF,LNORM,LGSAME, - & LPLCAM, LQSYM ,LGSYM , LQGRID, LGGRID, LGTICK, - & LQSLOP,LGSLOP, LCSLOP, LQSPPL, LGEOPL, LGPARM, - & LCPGRD,LBLGRD, LBLSYM, LCMINP, LHMOMP - LOGICAL LPLOT,LSYM,LIQSET,LCLIP,LVLAB,LCURS,LLAND - LOGICAL LPGRID, LPCDW, LPLIST, LPLEGN - LOGICAL TFORCE - REAL NX, NY, MASS, MINF1, MINF, MINF_CL, MVISC, MACHP1 - INTEGER RETYP, MATYP, AIJPIV - CHARACTER*1 VMXBL - - REAL W1(6*IQX),W2(6*IQX),W3(6*IQX),W4(6*IQX), - & W5(6*IQX),W6(6*IQX),W7(6*IQX),W8(6*IQX) - REAL BIJ(IQX,IZX), CIJ(IWX,IQX) - - COMMON/CR01/ VERSION - COMMON/CC01/ FNAME, - & NAME,ISPARS,ONAME,PREFIX, - & PFNAME(NPX),PFNAMX(NPX), - & NAMEPOL(NPX), CODEPOL(NPX), - & NAMEREF(NPX) - COMMON/QMAT/ Q(IQX,IQX),DQ(IQX), - & DZDG(IQX),DZDN(IQX),DZDM(IZX), - & DQDG(IQX),DQDM(IZX),QTAN1,QTAN2, - & Z_QINF,Z_ALFA,Z_QDOF0,Z_QDOF1,Z_QDOF2,Z_QDOF3 - COMMON/CR03/ AIJ(IQX,IQX),DIJ(IZX,IZX) - COMMON/CR04/ QINV(IZX),QVIS(IZX),CPI(IZX),CPV(IZX), - & QINVU(IZX,2), QINV_A(IZX) - COMMON/CR05/ X(IZX),Y(IZX),XP(IZX),YP(IZX),S(IZX), - & SLE,XLE,YLE,XTE,YTE,CHORD,YIMAGE, - & WGAP(IWX),WAKLEN - COMMON/CR06/ GAM(IQX),GAMU(IQX,2),GAM_A(IQX),SIG(IZX), - & NX(IZX),NY(IZX),APANEL(IZX), - & SST,SST_GO,SST_GP, - & GAMTE,GAMTE_A, - & SIGTE,SIGTE_A, - & DSTE,ANTE,ASTE - COMMON/CR07/ SSPLE, - & SSPEC(IBX),XSPOC(IBX),YSPOC(IBX), - & QGAMM(IBX), - & QSPEC(IBX,IPX),QSPECP(IBX,IPX), - & ALGAM,CLGAM,CMGAM, - & ALQSP(IPX),CLQSP(IPX),CMQSP(IPX), - & QF0(IQX),QF1(IQX),QF2(IQX),QF3(IQX), - & QDOF0,QDOF1,QDOF2,QDOF3,CLSPEC,FFILT - COMMON/CI01/ IQ1,IQ2,NSP,NQSP,KQTARG,IACQSP,NC1,NNAME,NPREFIX - COMMON/CR09/ ADEG,ALFA,AWAKE,MVISC,AVISC, - & XCMREF,YCMREF, - & CL,CM,CD,CDP,CDF,CL_ALF,CL_MSQ, - & PSIO,CIRC,COSA,SINA,QINF, - & GAMMA,GAMM1, - & MINF1,MINF,MINF_CL,TKLAM,TKL_MSQ,CPSTAR,QSTAR, - & CPMN,CPMNI,CPMNV,XCPMNI,XCPMNV - COMMON/CI03/ NCPREF, NAPOL(NPX), NPOL, IPACT, NLREF, - & ICOLP(NPX),ICOLR(NPX), - & IMATYP(NPX),IRETYP(NPX), NXYPOL(NPX), - & NPOLREF, NDREF(4,NPX) - COMMON/CR10/ XPREF(IQX),CPREF(IQX), VERSPOL(NPX), - & CPOLXY(IQX,2,NPX), - & MACHP1(NPX), - & REYNP1(NPX), - & ACRITP(NPX),XSTRIPP(ISX,NPX) - - COMMON/CC02/ LABREF - - COMMON/CR11/ PI,HOPI,QOPI,DTOR - COMMON/CR12/ CVPAR,CTERAT,CTRRAT,XSREF1,XSREF2,XPREF1,XPREF2 - COMMON/CI04/ N,NB,NW,NPAN,IST,KIMAGE, - & ITMAX,NSEQEX,RETYP,MATYP,AIJPIV(IQX), - & IDEV,IDEVRP,IPSLU,NCOLOR, - & ICOLS(ISX),NOVER, NCM,NTK - COMMON/CR13/ SIZE,SCRNFR,PLOTAR, PFAC,QFAC,VFAC, - & XWIND,YWIND, - & XPAGE,YPAGE,XMARG,YMARG, - & CH, CHG, CHQ, - & XOFAIR,YOFAIR,FACAIR, XOFA,YOFA,FACA,UPRWT, - & CPMIN,CPMAX,CPDEL, - & CPOLPLF(3,4), - & XCDWID,XALWID,XOCWID - COMMON/CL01/ OK,LIMAGE,SHARP, - & LGAMU,LQINU,LVISC,LALFA,LWAKE,LPACC, - & LBLINI,LIPAN,LQAIJ,LADIJ,LWDIJ,LCPXX,LQVDES,LQREFL, - & LQSPEC,LVCONV,LCPREF,LCLOCK,LPFILE,LPFILX,LPPSHO, - & LBFLAP,LFLAP,LEIW,LSCINI,LFOREF,LNORM,LGSAME, - & LPLCAM,LQSYM ,LGSYM, - & LQGRID,LGGRID,LGTICK, - & LQSLOP,LGSLOP,LCSLOP,LQSPPL,LGEOPL,LGPARM, - & LCPGRD,LBLGRD,LBLSYM, - & LPLOT,LSYM,LIQSET,LCLIP,LVLAB,LCURS,LLAND, - & LPGRID,LPCDW,LPLIST,LPLEGN, - & LCMINP, LHMOMP - COMMON/CR14/ XB(IBX),YB(IBX), - & XBP(IBX),YBP(IBX),SB(IBX),SNEW(4*IBX), - & XBF,YBF,XOF,YOF,HMOM,HFX,HFY, - & XBMIN,XBMAX,YBMIN,YBMAX, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB, - & XCM(2*IBX),YCM(2*IBX),SCM(2*IBX),XCMP(2*IBX),YCMP(2*IBX), - & XTK(2*IBX),YTK(2*IBX),STK(2*IBX),XTKP(2*IBX),YTKP(2*IBX) - - COMMON/CR15/ XSSI(IVX,ISX),UEDG(IVX,ISX),UINV(IVX,ISX), - & MASS(IVX,ISX),THET(IVX,ISX),DSTR(IVX,ISX), - & CTAU(IVX,ISX),DELT(IVX,ISX),USLP(IVX,ISX), - & GUXQ(IVX,ISX),GUXD(IVX,ISX), - & TAU(IVX,ISX),DIS(IVX,ISX),CTQ(IVX,ISX), - & VTI(IVX,ISX), - & REINF1,REINF,REINF_CL,ACRIT, - & XSTRIP(ISX),XOCTR(ISX),YOCTR(ISX),XSSITR(ISX), - & UINV_A(IVX,ISX) - COMMON/CI05/ IBLTE(ISX),NBL(ISX),IPAN(IVX,ISX),ISYS(IVX,ISX),NSYS, - & ITRAN(ISX) - COMMON/CL02/ TFORCE(ISX) - COMMON/CR17/ RMSBL,RMXBL,RLX,VACCEL - COMMON/CI06/ IMXBL,ISMXBL - COMMON/CC03/ VMXBL - COMMON/CR18/ XSF,YSF,XOFF,YOFF, - & XGMIN,XGMAX,YGMIN,YGMAX,DXYG, - & XCMIN,XCMAX,YCMIN,YCMAX,DXYC,DYOFFC, - & XPMIN,XPMAX,YPMIN,YPMAX,DXYP,DYOFFP, - & YSFP,GTICK - COMMON/VMAT/ VA(3,2,IZX),VB(3,2,IZX),VDEL(3,2,IZX), - & VM(3,IZX,IZX),VZ(3,2) - EQUIVALENCE (Q(1,1 ),W1(1)), (Q(1,7 ),W2(1)), - & (Q(1,13),W3(1)), (Q(1,19),W4(1)), - & (Q(1,25),W5(1)), (Q(1,31),W6(1)), - & (Q(1,37),W7(1)), (Q(1,43),W8(1)) - - EQUIVALENCE (VM(1,1,1),BIJ(1,1)), (VM(1,1,IZX/2),CIJ(1,1)) - - integer ncoor - real x_coor(ncoor),y_coor(ncoor) - real ccl,ccd - integer i -c Set the coorinates: - NB = ncoor - do 5 i=1,ncoor - xb(i) = x_coor(i) - yb(i) = y_coor(i) - 5 continue - -! Set alpha,Mach,RE: - refin1 = 1e6 - minf1 = 0.01 - adeg = 1.0 - -c Solve - call oper() - -c Copy cl,cd - ccl = cl - ccd = cd -c ccl = 0.0 -c ccd = 0.0 -c do 5 i=1,ncoor -c ccl = ccl + x_coor(i) -c ccd = ccd + y_coor(i) -c 5 continue - - end diff --git a/deps/src/xfoil/xfoil.f b/deps/src/xfoil/xfoil.f deleted file mode 100644 index dd04793..0000000 --- a/deps/src/xfoil/xfoil.f +++ /dev/null @@ -1,2057 +0,0 @@ -C*********************************************************************** -C Module: xfoil.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C -C*********************************************************************** -C UPDATED: Dan Berkenstock March 2006, Stanford ADL -C -C Functionality changed to command line driven for use in -C optimization. -C -C 030606: Updated as xfoil subroutine for wrapping in python -C 060806: Modified subroutine xfoil to subroutine initialize -C for greater clarity in python wrapping -C 060806: Stripped everything to do with plotting and gui -C*********************************************************************** -C - SUBROUTINE XFOIL() - - INCLUDE 'XFOIL.INC' - CHARACTER*4 COMAND - CHARACTER*128 COMARG - CHARACTER*1 ANS - CHARACTER*128 OUTFILE - - DIMENSION IINPUT(20) - DIMENSION RINPUT(20) - DIMENSION GRADIENT(150) - LOGICAL ERROR - -C---- max panel angle threshold for warning - DATA ANGTOL / 40.0 / - -c---- call initialization function - CALL INIT -c LU = 8 -c CALL GETDEF(LU,'xfoil.def', .TRUE.) - -c---- read file in variable 'FNAME' should be unlabelled airfoil file - LU = 9 -c CALL AREAD(LU,FNAME,IBX,XB,YB,NB,NAME,ISPARS,ITYPE,1) - - CALL ABCOPY(.TRUE.) - ITYPE = 1 - - RETURN - STOP - END ! XFOIL - -C--------------------------------------------------- - - SUBROUTINE setNACA(camber,position,thickness) - ! This function is wrapped - include 'XFOIL.INC' - real camber,position,thickness - real Xreturn(NB),Yreturn(NB) - call NACA(camber,position,thickness,XB,YB) - END - - SUBROUTINE NACA(camber,position,thickness,Xreturn,Yreturn) - INCLUDE 'XFOIL.INC' - real camber,position,thickness - real Xreturn(NB),Yreturn(NB) -C---- number of points per side - NSIDE = IQX/3 -C - IDES = IDES1 -C - ITYPE = 0 - IF(IDES.LE.25099) ITYPE = 5 - IF(IDES.LE.9999 ) ITYPE = 4 -C - IF(ITYPE.EQ.0) THEN - WRITE(*,*) 'This designation not implemented.' - RETURN - ENDIF -C -c IF(ITYPE.EQ.4) CALL NACA4(IDES,W1,W2,W3,NSIDE,XB,YB,NB,NAME) - camber = camber/100 - position = position/10 - thickness = thickness/100 -c print *, 'camber',camber -c print *, 'position',position -c print *, 'thickness',thickness - IF(ITYPE.EQ.4) CALL NACA4B(camber,position,thickness,W1,W2,W3, - * NSIDE,XB,YB,NB,NAME) - do i=1,NB - Xreturn(i) = XB(i) - Yreturn(i) = YB(i) - end do - CALL STRIP(NAME,NNAME) -C -C---- see if routines didn't recognize designator - - LCLOCK = .FALSE. -C - XBF = 0.0 - YBF = 0.0 - LBFLAP = .FALSE. -C - CALL SCALC(XB,YB,SB,NB) - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C - CALL GEOPAR(XB,XBP,YB,YBP,SB,NB, W1, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB ) -C -! WRITE(*,1200) NB -! 1200 FORMAT(/' Buffer airfoil set using', I4,' points') -C -C---- set paneling -! print *,'calling pangen' -! CALL PANGEN(.FALSE.) -! print *,'done pangen' -ccc CALL PANPLT -C - RETURN - END ! NACA - - SUBROUTINE INIT -C--------------------------------------------------- -C Variable initialization/default routine. -C See file XFOIL.INC for variable description. -C--------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - PI = 4.0*ATAN(1.0) - HOPI = 0.50/PI - QOPI = 0.25/PI - DTOR = PI/180.0 -C -C---- default Cp/Cv (air) - GAMMA = 1.4 - GAMM1 = GAMMA - 1.0 -C -C---- set unity freestream speed - QINF = 1.0 -C -C---- initialize freestream Mach number to zero - MATYP = 1 -C MINF1 = 0. -C - ALFA = 0.0 - COSA = 1.0 - SINA = 0.0 -C - DO 10 I=1, IQX - GAMU(I,1) = 0. - GAMU(I,2) = 0. - GAM(I) = 0. - GAM_A(I) = 0. - 10 CONTINUE - PSIO = 0. -C - CL = 0. - CM = 0. - CD = 0. -C - SIGTE = 0.0 - GAMTE = 0.0 - SIGTE_A = 0. - GAMTE_A = 0. -C - DO 20 I=1, IZX - SIG(I) = 0. - 20 CONTINUE -C - NQSP = 0 - DO 30 K=1, IPX - ALQSP(K) = 0. - CLQSP(K) = 0. - CMQSP(K) = 0. - DO 302 I=1, IBX - QSPEC(I,K) = 0. - 302 CONTINUE - 30 CONTINUE -C - AWAKE = 0.0 - AVISC = 0.0 -C - KIMAGE = 1 - YIMAGE = -10.0 - LIMAGE = .FALSE. -C - LGAMU = .FALSE. - LQINU = .FALSE. - LVISC = .FALSE. - LWAKE = .FALSE. - LPACC = .FALSE. - LBLINI = .FALSE. - LIPAN = .FALSE. - LQAIJ = .FALSE. - LADIJ = .FALSE. - LWDIJ = .FALSE. - LCPXX = .FALSE. - LQVDES = .FALSE. - LQSPEC = .FALSE. - LQREFL = .FALSE. - LVCONV = .FALSE. - LCPREF = .FALSE. - LFOREF = .FALSE. - LPFILE = .FALSE. - LPFILX = .FALSE. - LPPSHO = .FALSE. - LBFLAP = .FALSE. - LFLAP = .FALSE. - LEIW = .FALSE. - LSCINI = .FALSE. - LPLOT = .FALSE. - LCLIP = .FALSE. - LVLAB = .TRUE. - LCMINP = .FALSE. - LHMOMP = .FALSE. -C - LCURS = .TRUE. - LLAND = .TRUE. - LGSAME = .FALSE. -C - LGPARM = .TRUE. - LPLCAM = .FALSE. -C -C---- input airfoil will not be normalized - LNORM = .FALSE. -C -C---- airfoil will not be forced symmetric - LQSYM = .FALSE. - LGSYM = .FALSE. -C -C---- endpoint slopes will be matched - LQSLOP = .TRUE. - LGSLOP = .TRUE. - LCSLOP = .TRUE. -C -C---- grids on Qspec(s) and buffer airfoil geometry plots will be plotted - LQGRID = .TRUE. - LGGRID = .TRUE. - LGTICK = .TRUE. -C -C---- no grid on Cp plots - LCPGRD = .FALSE. -C -C---- grid and no symbols are to be used on BL variable plots - LBLGRD = .TRUE. - LBLSYM = .FALSE. -C -C---- buffer and current airfoil flap hinge coordinates - XBF = 0.0 - YBF = 0.0 - XOF = 0.0 - YOF = 0.0 -C - NCPREF = 0 -C n -C---- circle plane array size (largest 2 + 1 that will fit array size) - ANN = LOG(FLOAT((2*IQX)-1))/LOG(2.0) - NN = INT( ANN + 0.00001 ) - NC1 = 2**NN + 1 - IF(NC1 .GT. 257) NC1 = 2**(NN-1) + 1 -C -C---- default paneling parameters - NPAN = 140 - CVPAR = 1.0 - CTERAT = 0.15 - CTRRAT = 0.2 -C -C---- default paneling refinement zone x/c endpoints - XSREF1 = 1.0 - XSREF2 = 1.0 - XPREF1 = 1.0 - XPREF2 = 1.0 -C -C---- no polars present to begin with - NPOL = 0 - IPACT = 0 - DO IP = 1, NPX - PFNAME(IP) = ' ' - PFNAMX(IP) = ' ' - ENDDO -C -C---- no reference polars - NPOLREF = 0 -C -C---- plot aspect ratio, character size - PLOTAR = 0.55 - CH = 0.015 -C -C---- airfoil node tick-mark size (as fraction of arc length) - GTICK = 0.0005 -C -C---- Cp limits in Cp vs x plot -c CPMAX = 1.0 -c CPMIN = -2.0 -c CPDEL = -0.5 -c PFAC = PLOTAR/(CPMAX-CPMIN) -C -C---- DCp limits in CAMB loading plot -c YPMIN = -0.2 -c YPMAX = 0.4 -C -C---- scaling factor for Cp vector plot -c VFAC = 0.25 -C -C---- offsets and scale factor for airfoil in Cp vs x plot -c XOFAIR = 0.09 -c YOFAIR = -.01 -c FACAIR = 0.70 -C -C---- u/Qinf scale factor for profile plotting -c UPRWT = 0.02 -C -C---- polar plot options, grid, list, legend, no CDW -c LPGRID = .TRUE. -c LPCDW = .FALSE. -c LPLIST = .TRUE. -c LPLEGN = .TRUE. -C -C---- axis limits and annotation deltas for polar plot -c CPOLPLF(1,ICD) = 0.0 -c CPOLPLF(2,ICD) = 0.04 -c CPOLPLF(3,ICD) = 0.01 -C -c CPOLPLF(1,ICL) = 0. -c CPOLPLF(2,ICL) = 1.5 -c CPOLPLF(3,ICL) = 0.5 -C -c CPOLPLF(1,ICM) = -0.25 -c CPOLPLF(2,ICM) = 0.0 -c CPOLPLF(3,ICM) = 0.05 -C -c CPOLPLF(1,IAL) = -4.0 -c CPOLPLF(2,IAL) = 10.0 -c CPOLPLF(3,IAL) = 2.0 -C -C---- widths of plot boxes in polar plot page -c XCDWID = 0.45 -c XALWID = 0.25 -c XOCWID = 0.20 -C -C---- color index for each polar -c DO IP=1, NPX -c ICOLP(IP) = 3 + MOD(IP-1,8) -c ENDDO -C -C---- default Cm reference location - XCMREF = 0.25 - YCMREF = 0. -C -C---- default viscous parameters - RETYP = 1 -C REINF1 = 0. - ACRIT = 9.0 - XSTRIP(1) = 1.0 - XSTRIP(2) = 1.0 - XOCTR(1) = 1.0 - XOCTR(2) = 1.0 - YOCTR(1) = 0. - YOCTR(2) = 0. - WAKLEN = 1.0 -C -C---- Newton iteration limit -C ITMAX = 10 -C -C---- max number of unconverged sequence points for early exit - NSEQEX = 4 -C -C---- drop tolerance for BL system solver - VACCEL = 0.01 -C -C---- inverse-mapping auto-filter level - FFILT = 0.0 -C -C---- default overlay airfoil filename - ONAME = ' ' -C -C---- default filename prefix - PREFIX = ' ' -C -C---- Plotting flag -c IDEV = 1 ! X11 window only -c IDEV = 2 ! B&W PostScript output file only (no color) -c IDEV = 3 ! both X11 and B&W PostScript file -c IDEV = 4 ! Color PostScript output file only -c IDEV = 5 ! both X11 and Color PostScript file -C -C---- Re-plotting flag (for hardcopy) - IDEVRP = 2 ! B&W PostScript -c IDEVRP = 4 ! Color PostScript -C -C---- PostScript output logical unit and file specification - IPSLU = 0 ! output to file plot.ps on LU 4 (default case) -c IPSLU = ? ! output to file plot?.ps on LU 10+? -C -C---- screen fraction taken up by plot window upon opening - SCRNFR = 0.80 -C -C---- Default plot size in inches -C- (Default plot window is 11.0 x 8.5) -C- (Must be smaller than XPAGE if objects are to fit on paper page) - SIZE = 10.0 - -C---- plot-window dimensions in inches for plot blowup calculations -C- currently, 11.0 x 8.5 default window is hard-wired in libPlt -c XPAGE = 11.0 -c YPAGE = 8.5 -C -C---- page margins in inches -c XMARG = 0.0 -c YMARG = 0.0 -C -C---- set top and bottom-side colors -c ICOLS(1) = 5 -c ICOLS(2) = 7 -C -C 3 red -C 4 orange -C 5 yellow -C 6 green -C 7 cyan -C 8 blue -C 9 violet -C 10 magenta -C -C -c CALL PLINITIALIZE -C -C---- set up color spectrum -c NCOLOR = 64 -c CALL COLORSPECTRUMHUES(NCOLOR,'RYGCBM') -C -C -c NNAME = 32 -C NAME = ' ' -CCC 12345678901234567890123456789012 -C -C---- MSES domain parameters (not used in XFOIL) - ISPARS = ' -2.0 3.0 -2.5 3.5' -C -C---- set MINF, REINF, based on current CL-dependence - CALL MRCL(1.0,MINF_CL,REINF_CL) -C -C---- set various compressibility parameters from MINF - CALL COMSET -C - RETURN - END ! INIT - - - SUBROUTINE MRCL(CLS,M_CLS,R_CLS) -C------------------------------------------- -C Sets actual Mach, Reynolds numbers -C from unit-CL values and specified CLS -C depending on MATYP,RETYP flags. -C------------------------------------------- - INCLUDE 'XFOIL.INC' - REAL M_CLS -C - CLA = MAX( CLS , 0.000001 ) -C - IF(RETYP.LT.1 .OR. RETYP.GT.3) THEN - WRITE(*,*) 'MRCL: Illegal Re(CL) dependence trigger.' - WRITE(*,*) ' Setting fixed Re.' - RETYP = 1 - ENDIF - IF(MATYP.LT.1 .OR. MATYP.GT.3) THEN - WRITE(*,*) 'MRCL: Illegal Mach(CL) dependence trigger.' - WRITE(*,*) ' Setting fixed Mach.' - MATYP = 1 - ENDIF -C -C - IF(MATYP.EQ.1) THEN -C - MINF = MINF1 - M_CLS = 0. -C - ELSE IF(MATYP.EQ.2) THEN -C - MINF = MINF1/SQRT(CLA) - M_CLS = -0.5*MINF/CLA -C - ELSE IF(MATYP.EQ.3) THEN -C - MINF = MINF1 - M_CLS = 0. -C - ENDIF -C -C - IF(RETYP.EQ.1) THEN -C - REINF = REINF1 - R_CLS = 0. -C - ELSE IF(RETYP.EQ.2) THEN -C - REINF = REINF1/SQRT(CLA) - R_CLS = -0.5*REINF/CLA -C - ELSE IF(RETYP.EQ.3) THEN -C - REINF = REINF1/CLA - R_CLS = -REINF /CLA -C - ENDIF -C -C - IF(MINF .GE. 0.99) THEN - WRITE(*,*) - WRITE(*,*) 'MRCL: CL too low for chosen Mach(CL) dependence' - WRITE(*,*) ' Aritificially limiting Mach to 0.99' - MINF = 0.99 - M_CLS = 0. - ENDIF -C - RRAT = 1.0 - IF(REINF1 .GT. 0.0) RRAT = REINF/REINF1 -C - IF(RRAT .GT. 100.0) THEN - WRITE(*,*) - WRITE(*,*) 'MRCL: CL too low for chosen Re(CL) dependence' - WRITE(*,*) ' Aritificially limiting Re to ',REINF1*100.0 - REINF = REINF1*100.0 - R_CLS = 0. - ENDIF -C - RETURN - END ! MRCL - -C***************************************************************** -C -C READS PARAM FILE -C -C***************************************************************** - - SUBROUTINE GETDEF(LU,FILNAM,LASK) - CHARACTER*(*) FILNAM - LOGICAL LASK -C----------------------------------------------------- -C Reads in default parameters from file xfoil.def -C If LASK=t, ask user if file is to be read. -C----------------------------------------------------- - INCLUDE 'XFOIL.INC' - LOGICAL LCOLOR - CHARACTER*1 ANS -C - 1000 FORMAT(A) -C - OPEN(LU,FILE=FILNAM,STATUS='OLD',ERR=90) - IF(LASK) THEN - WRITE(*,1050) FILNAM - 1050 FORMAT(/' Read settings from file ', A, ' ? Y') - READ(*,1000) ANS - IF(INDEX('Nn',ANS).NE.0) THEN - CLOSE(LU) - RETURN - ENDIF - ENDIF -C - CLMIN = CPOLPLF(1,ICL) - CLMAX = CPOLPLF(2,ICL) - CLDEL = CPOLPLF(3,ICL) -C - CDMIN = CPOLPLF(1,ICD) - CDMAX = CPOLPLF(2,ICD) - CDDEL = CPOLPLF(3,ICD) -C - ALMIN = CPOLPLF(1,IAL) - ALMAX = CPOLPLF(2,IAL) - ALDEL = CPOLPLF(3,IAL) -C - CMMIN = CPOLPLF(1,ICM) - CMMAX = CPOLPLF(2,ICM) - CMDEL = CPOLPLF(3,ICM) -C -C---- default paneling parameters (viscous) - READ(LU,*,ERR=80) NPAN, CVPAR, CTERAT, CTRRAT - READ(LU,*,ERR=80) XSREF1, XSREF2, XPREF1, XPREF2 -C -C---- plotting parameters - READ(LU,*,ERR=80) SIZE, PLOTAR, CH, SCRNFR -C -C---- plot sizes - READ(LU,*,ERR=80) XPAGE, YPAGE, XMARG, YMARG -C -C---- plot flags - READ(LU,*,ERR=80) LCOLOR, LCURS -C -C---- Cp limits in Cp vs x plot - READ(LU,*,ERR=80) CPMAX, CPMIN, CPDEL - PFAC = PLOTAR/(CPMAX-CPMIN) -C -C---- airfoil x-offset and scale factor in Cp vs x plot, BL profile weight - READ(LU,*,ERR=80) XOFAIR, FACAIR, UPRWT -C -C---- polar plot CL,CD,alpha,CM min,max,delta - READ(LU,*,ERR=80) (CPOLPLF(K,ICL), K=1, 3) - READ(LU,*,ERR=80) (CPOLPLF(K,ICD), K=1, 3) - READ(LU,*,ERR=80) (CPOLPLF(K,IAL), K=1, 3) - READ(LU,*,ERR=80) (CPOLPLF(K,ICM), K=1, 3) -C -C---- default Mach and viscous parameters - READ(LU,*,ERR=80) MATYP, MINF1, VACCEL - READ(LU,*,ERR=80) RETYP, RMILL, ACRIT - READ(LU,*,ERR=80) XSTRIP(1), XSTRIP(2) -C - IF( LCOLOR) IDEVRP = 4 - IF(.NOT.LCOLOR) IDEVRP = 2 -C - REINF1 = RMILL * 1.0E6 -C -C---- set MINF, REINF - CALL MRCL(1.0,MINF_CL,REINF_CL) -C -C---- set various compressibility parameters from new MINF - CALL COMSET -C - CLOSE(LU) -C WRITE(*,1600) FILNAM - 1600 FORMAT(/' Default parameters read in from file ', A,':' /) - CALL WRTDEF(6) - RETURN -C - 80 CONTINUE - CLOSE(LU) -C WRITE(*,1800) FILNAM - 1800 FORMAT(/' File ', A,' read error' - & /' Settings may have been changed') - RETURN -C - 90 CONTINUE -C WRITE(*,1900) FILNAM - 1900 FORMAT(/' File ', A,' not found') - RETURN -C - END ! GETDEF - - - - SUBROUTINE WRTDEF(LU) -C------------------------------------------ -C Writes default parameters to unit LU -C------------------------------------------ - INCLUDE 'XFOIL.INC' - LOGICAL LCOLOR -C - LCOLOR = IDEVRP.EQ.4 -C -C---- default paneling parameters (viscous) - WRITE(LU,1010) NPAN , CVPAR , CTERAT, CTRRAT - WRITE(LU,1020) XSREF1, XSREF2, XPREF1, XPREF2 -C -C---- plotting parameters - WRITE(LU,1030) SIZE, PLOTAR, CH, SCRNFR -C -C---- plot sizes - WRITE(LU,1032) XPAGE, YPAGE, XMARG, YMARG -C -C---- plot flags - WRITE(LU,1034) LCOLOR, LCURS -C -C---- Cp limits in Cp vs x plot - WRITE(LU,1040) CPMAX, CPMIN, CPDEL -C -C---- x-offset and scale factor for airfoil on Cp vs x plot - WRITE(LU,1050) XOFAIR, FACAIR, UPRWT -C -C---- polar plot CL,CD,alpha,CM min,max,delta - WRITE(LU,1061) (CPOLPLF(K,ICL), K=1, 3) - WRITE(LU,1062) (CPOLPLF(K,ICD), K=1, 3) - WRITE(LU,1063) (CPOLPLF(K,IAL), K=1, 3) - WRITE(LU,1064) (CPOLPLF(K,ICM), K=1, 3) -C -C---- default viscous parameters - WRITE(LU,1071) MATYP , MINF1 , VACCEL - WRITE(LU,1072) RETYP , REINF1/1.0E6 , ACRIT - WRITE(LU,1080) XSTRIP(1), XSTRIP(2) -C - RETURN -C............................................... - 1010 FORMAT(1X,I5,4X,F9.4,F9.4,F9.4,' | Npan PPanel TErat REFrat') - 1020 FORMAT(1X,F9.4 ,F9.4,F9.4,F9.4,' | XrefS1 XrefS2 XrefP1 XrefP2') - 1030 FORMAT(1X,F9.4 ,F9.4,F9.4,F9.4,' | Size plotAR CHsize ScrnFr') - 1032 FORMAT(1X,F9.4 ,F9.4,F9.4,F9.4,' | Xpage Ypage Xmargn Ymargn') - 1034 FORMAT(1X,L2,7X,L2,7X,9X , 9X ,' | Lcolor Lcursor' ) - 1040 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CPmax CPmin CPdel' ) - 1050 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | XoffAir ScalAir BLUwt' ) - 1061 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CLmin CLmax CLdel' ) - 1062 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CDmin CDmax CDdel' ) - 1063 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | ALmin ALmax ALdel' ) - 1064 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CMmin CMmax CMdel' ) - 1071 FORMAT(1X,I3,6X,F9.4,F9.4, 9X ,' | MAtype Mach Vaccel' ) - 1072 FORMAT(1X,I3,6X,F9.4,F9.4, 9X ,' | REtype Re/10^6 Ncrit' ) - 1080 FORMAT(1X,F9.4 ,F9.4, 9X , 9X ,' | XtripT XtripB' ) - END ! WRTDEF - - - SUBROUTINE COMSET - INCLUDE 'XFOIL.INC' -C -C---- set Karman-Tsien parameter TKLAM - BETA = SQRT(1.0 - MINF**2) - BETA_MSQ = -0.5/BETA -C - TKLAM = MINF**2 / (1.0 + BETA)**2 - TKL_MSQ = 1.0 / (1.0 + BETA)**2 - & - 2.0*TKLAM/ (1.0 + BETA) * BETA_MSQ -C -C---- set sonic Pressure coefficient and speed - IF(MINF.EQ.0.0) THEN - CPSTAR = -999.0 - QSTAR = 999.0 - ELSE - CPSTAR = 2.0 / (GAMMA*MINF**2) - & * (( (1.0 + 0.5*GAMM1*MINF**2) - & /(1.0 + 0.5*GAMM1 ))**(GAMMA/GAMM1) - 1.0) - QSTAR = QINF/MINF - & * SQRT( (1.0 + 0.5*GAMM1*MINF**2) - & /(1.0 + 0.5*GAMM1 ) ) - ENDIF -C - RETURN - END ! COMSET - - - SUBROUTINE CPCALC(N,Q,QINF,MINF,CP) -C--------------------------------------------- -C Sets compressible Cp from speed. -C--------------------------------------------- - DIMENSION Q(N),CP(N) - REAL MINF -C - LOGICAL DENNEG -C - BETA = SQRT(1.0 - MINF**2) - BFAC = 0.5*MINF**2 / (1.0 + BETA) -C - DENNEG = .FALSE. -C - DO 20 I=1, N - CPINC = 1.0 - (Q(I)/QINF)**2 - DEN = BETA + BFAC*CPINC - CP(I) = CPINC / DEN - IF(DEN .LE. 0.0) DENNEG = .TRUE. - 20 CONTINUE -C - IF(DENNEG) THEN - WRITE(*,*) - WRITE(*,*) 'CPCALC: Local speed too large. ', - & 'Compressibility corrections invalid.' - ENDIF -C - RETURN - END ! CPCALC - -C*********************************************************** -C -C CL CALCULATION ROUTINE -C -C*********************************************************** - - SUBROUTINE CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, - & XREF,YREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) -C----------------------------------------------------------- -C Integrates surface pressures to get CL and CM. -C Integrates skin friction to get CDF. -C Calculates dCL/dAlpha for prescribed-CL routines. -C----------------------------------------------------------- - DIMENSION X(N),Y(N), GAM(N), GAM_A(N) - REAL MINF -C -C---- moment-reference coordinates -ccc XREF = 0.25 -ccc YREF = 0. -C -C - SA = SIN(ALFA) - CA = COS(ALFA) -C - BETA = SQRT(1.0 - MINF**2) - BETA_MSQ = -0.5/BETA -C - BFAC = 0.5*MINF**2 / (1.0 + BETA) - BFAC_MSQ = 0.5 / (1.0 + BETA) - & - BFAC / (1.0 + BETA) * BETA_MSQ -C - CL = 0.0 - CM = 0.0 - - CDP = 0.0 -C - CL_ALF = 0. - CL_MSQ = 0. -C - I = 1 - CGINC = 1.0 - (GAM(I)/QINF)**2 - CPG1 = CGINC/(BETA + BFAC*CGINC) - CPG1_MSQ = -CPG1/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_GAM = -2.0*GAM(I)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG1)/ (BETA + BFAC*CGINC) - CPG1_ALF = CPC_CPI*CPI_GAM*GAM_A(I) -C - DO 10 I=1, N - IP = I+1 - IF(I.EQ.N) IP = 1 -C - CGINC = 1.0 - (GAM(IP)/QINF)**2 - CPG2 = CGINC/(BETA + BFAC*CGINC) - CPG2_MSQ = -CPG2/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_GAM = -2.0*GAM(IP)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG2)/ (BETA + BFAC*CGINC) - CPG2_ALF = CPC_CPI*CPI_GAM*GAM_A(IP) -C - DX = (X(IP) - X(I))*CA + (Y(IP) - Y(I))*SA - DY = (Y(IP) - Y(I))*CA - (X(IP) - X(I))*SA - DG = CPG2 - CPG1 -C - AX = (0.5*(X(IP)+X(I))-XREF)*CA + (0.5*(Y(IP)+Y(I))-YREF)*SA - AY = (0.5*(Y(IP)+Y(I))-YREF)*CA - (0.5*(X(IP)+X(I))-XREF)*SA - AG = 0.5*(CPG2 + CPG1) -C - DX_ALF = -(X(IP) - X(I))*SA + (Y(IP) - Y(I))*CA - AG_ALF = 0.5*(CPG2_ALF + CPG1_ALF) - AG_MSQ = 0.5*(CPG2_MSQ + CPG1_MSQ) -C - CL = CL + DX* AG - CDP = CDP - DY* AG - CM = CM - DX*(AG*AX + DG*DX/12.0) - & - DY*(AG*AY + DG*DY/12.0) -C - CL_ALF = CL_ALF + DX*AG_ALF + AG*DX_ALF - CL_MSQ = CL_MSQ + DX*AG_MSQ -C - CPG1 = CPG2 - CPG1_ALF = CPG2_ALF - CPG1_MSQ = CPG2_MSQ - 10 CONTINUE -C - RETURN - END ! CLCALC - -C************************************************************************ - - SUBROUTINE CDCALC - INCLUDE 'XFOIL.INC' -C - SA = SIN(ALFA) - CA = COS(ALFA) -C - IF(LVISC .AND. LBLINI) THEN -C -C----- set variables at the end of the wake - THWAKE = THET(NBL(2),2) - URAT = UEDG(NBL(2),2)/QINF - UEWAKE = UEDG(NBL(2),2) * (1.0-TKLAM) / (1.0 - TKLAM*URAT**2) - SHWAKE = DSTR(NBL(2),2)/THET(NBL(2),2) -C -C----- extrapolate wake to downstream infinity using Squire-Young relation -C (reduces errors of the wake not being long enough) - CD = 2.0*THWAKE * (UEWAKE/QINF)**(0.5*(5.0+SHWAKE)) -C - ELSE -C - CD = 0.0 -C - ENDIF -C -C---- calculate friction drag coefficient - CDF = 0.0 - DO 20 IS=1, 2 - DO 205 IBL=3, IBLTE(IS) - I = IPAN(IBL ,IS) - IM = IPAN(IBL-1,IS) - DX = (X(I) - X(IM))*CA + (Y(I) - Y(IM))*SA - CDF = CDF + 0.5*(TAU(IBL,IS)+TAU(IBL-1,IS))*DX * 2.0/QINF**2 - 205 CONTINUE - 20 CONTINUE -C - RETURN - END ! CDCALC - - -C############################################################# -C READS IN AIRFOIL COORDS -C -C############################################################# - SUBROUTINE LOAD(FILNAM,ITYPE) -C------------------------------------------------------ -C Reads airfoil file into buffer airfoil -C and does various initial processesing on it. -C------------------------------------------------------ - INCLUDE 'XFOIL.INC' - CHARACTER*(*) FILNAM -C - FNAME = FILNAM -C -c IF(FNAME(1:1).EQ.' ') FNAME = 'INPUTAIRFOIL' - LU = 9 - - - IF(ITYPE.EQ.0) RETURN -C -C IF(ITYPE.EQ.1) CALL ASKS('Enter airfoil name^',NAME) - NAME = 'INPUTAIRFOIL' - CALL STRIP(NAME,NNAME) -C -C---- set default prefix for other filenames - KDOT = INDEX(FNAME,'.') - IF(KDOT.EQ.0) THEN - PREFIX = FNAME - ELSE - PREFIX = FNAME(1:KDOT-1) - ENDIF - CALL STRIP(PREFIX,NPREFIX) -C -C---- calculate airfoil area assuming counterclockwise ordering - AREA = 0.0 - DO 50 I=1, NB - IP = I+1 - IF(I.EQ.NB) IP = 1 - AREA = AREA + 0.5*(YB(I)+YB(IP))*(XB(I)-XB(IP)) - 50 CONTINUE -C - IF(AREA.GE.0.0) THEN - LCLOCK = .FALSE. -C WRITE(*,1010) NB - ELSE -C----- if area is negative (clockwise order), reverse coordinate order - LCLOCK = .TRUE. -C WRITE(*,1011) NB - DO 55 I=1, NB/2 - XTMP = XB(NB-I+1) - YTMP = YB(NB-I+1) - XB(NB-I+1) = XB(I) - YB(NB-I+1) = YB(I) - XB(I) = XTMP - YB(I) = YTMP - 55 CONTINUE - ENDIF -C - IF(LNORM) THEN - CALL NORM(XB,XBP,YB,YBP,SB,NB) -C WRITE(*,1020) - ENDIF -C - CALL SCALC(XB,YB,SB,NB) - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C - CALL GEOPAR(XB,XBP,YB,YBP,SB,NB, W1, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB ) -C - XBLE = SEVAL(SBLE,XB,XBP,SB,NB) - YBLE = SEVAL(SBLE,YB,YBP,SB,NB) - XBTE = 0.5*(XB(1) + XB(NB)) - YBTE = 0.5*(YB(1) + YB(NB)) -C -C WRITE(*,1050) XBLE,YBLE, CHORDB, -C & XBTE,YBTE -C -C---- set reasonable MSES domain parameters for non-MSES coordinate file - IF(ITYPE.LE.2) THEN - XBLE = SEVAL(SBLE,XB,XBP,SB,NB) - YBLE = SEVAL(SBLE,YB,YBP,SB,NB) - XINL = XBLE - 2.0*CHORDB - XOUT = XBLE + 3.0*CHORDB - YBOT = YBLE - 2.5*CHORDB - YTOP = YBLE + 3.5*CHORDB - XINL = AINT(20.0*ABS(XINL/CHORDB)+0.5)/20.0 * SIGN(CHORDB,XINL) - XOUT = AINT(20.0*ABS(XOUT/CHORDB)+0.5)/20.0 * SIGN(CHORDB,XOUT) - YBOT = AINT(20.0*ABS(YBOT/CHORDB)+0.5)/20.0 * SIGN(CHORDB,YBOT) - YTOP = AINT(20.0*ABS(YTOP/CHORDB)+0.5)/20.0 * SIGN(CHORDB,YTOP) -C WRITE(ISPARS,1005) XINL, XOUT, YBOT, YTOP - 1005 FORMAT(1X, 4F8.2 ) - ENDIF -C -C---- wipe out old flap hinge location - XBF = 0.0 - YBF = 0.0 - LBFLAP = .FALSE. -C -C---- wipe out off-design alphas, CLs -cc NALOFF = 0 -cc NCLOFF = 0 -C - RETURN -C............................................................... - 1010 FORMAT(/' Number of input coordinate points:', I4 - & /' Counterclockwise ordering') - 1011 FORMAT(/' Number of input coordinate points:', I4 - & /' Clockwise ordering') - 1020 FORMAT(/' Airfoil has been normalized') - 1050 FORMAT(/' LE x,y =', 2F10.5,' | Chord =',F10.5 - & /' TE x,y =', 2F10.5,' |' ) - END ! LOAD - - - - SUBROUTINE SAVE(IFTYP,FNAME1) -C-------------------------------- -C Writes out current airfoil -C-------------------------------- - INCLUDE 'XFOIL.INC' - CHARACTER*(*) FNAME1 -C - CHARACTER*1 ANS -C - LU = 2 -C -C---- get output filename if it was not supplied - IF(FNAME1(1:1) .NE. ' ') THEN - FNAME = FNAME1 - ELSE - CALL ASKS('Enter output filename^',FNAME) - ENDIF -C - OPEN(LU,FILE=FNAME,STATUS='OLD',ERR=5) - WRITE(*,*) - WRITE(*,*) 'Output file exists. Overwrite? Y' - READ(*,1000) ANS - IF(INDEX('Nn',ANS).EQ.0) GO TO 6 -C - CLOSE(LU) - WRITE(*,*) 'Current airfoil not saved.' - RETURN -C - 5 OPEN(LU,FILE=FNAME,STATUS='NEW',ERR=90) - 6 REWIND(LU) -C - IF(IFTYP.GE.1) THEN -C----- write name to first line - WRITE(LU,1000) NAME(1:NNAME) - ENDIF -C - IF(IFTYP.GE.2) THEN -C----- write MSES domain parameters to second line - DO K=80, 1, -1 - IF(INDEX(ISPARS(K:K),' ') .NE. 1) GO TO 11 - ENDDO - 11 CONTINUE -C - WRITE(LU,1000) ISPARS(1:K) - ENDIF -C - IF(LCLOCK) THEN -C----- write out in clockwise order (reversed from internal XFOIL order) - IBEG = N - IEND = 1 - INCR = -1 - ELSE -C----- write out in counterclockwise order (same as internal XFOIL order) - IBEG = 1 - IEND = N - INCR = 1 - ENDIF -C - IF(IFTYP.EQ.-1) THEN - DO I=IBEG, IEND, INCR - WRITE(LU,1400) INT(X(I)+SIGN(0.5,X(I))), - & INT(Y(I)+SIGN(0.5,Y(I))) - ENDDO - ELSE - DO I=IBEG, IEND, INCR - WRITE(LU,1100) X(I),Y(I) - ENDDO - ENDIF -C - CLOSE(LU) - RETURN -C - 90 WRITE(*,*) 'Bad filename.' - WRITE(*,*) 'Current airfoil not saved.' - RETURN -C - 1000 FORMAT(A) - 1100 FORMAT(1X,2F12.6) - 1400 FORMAT(1X,2I12 ) - END ! SAVE - - - - SUBROUTINE MSAVE(FNAME1) -C------------------------------------------ -C Writes out current airfoil as one -C element in a multielement MSES file. -C------------------------------------------ - INCLUDE 'XFOIL.INC' - CHARACTER*(*) FNAME1 -C - CHARACTER*80 NAME1, ISPARS1 -C - PARAMETER (NEX=5) - DIMENSION NTMP(NEX) - DIMENSION XTMP(2*IQX,NEX), YTMP(2*IQX,NEX) - EQUIVALENCE (Q(1,1),XTMP(1,1)), (Q(1,IQX/2),YTMP(1,1)) -C - LU = 2 -C -C---- get output filename if it was not supplied - IF(FNAME1(1:1) .NE. ' ') THEN - FNAME = FNAME1 - ELSE - CALL ASKS('Enter output filename for element replacement^',FNAME) - ENDIF -C - OPEN(LU,FILE=FNAME,STATUS='OLD',ERR=9005) -C - READ(LU,1000,ERR=9010) NAME1 - READ(LU,1000,ERR=9010) ISPARS1 -C - DO NN1=80, 2, -1 - IF(NAME1(NN1:NN1) .NE. ' ') GO TO 10 - ENDDO - 10 CONTINUE -C - DO NI1=80, 2, -1 - IF(ISPARS1(NI1:NI1) .NE. ' ') GO TO 20 - ENDDO - 20 CONTINUE -C -C---- read in existing airfoil coordinates - 40 DO 55 IEL=1, NEX - DO 50 I=1, 2*IQX+1 - READ(LU,*,END=56) XTMP(I,IEL), YTMP(I,IEL) - IF(XTMP(I,IEL).EQ.999.0) THEN - NTMP(IEL) = I-1 - GO TO 55 - ENDIF - 50 CONTINUE - STOP 'LOAD: Array overflow' - 55 CONTINUE - NEL = NEX -C - 56 IF(I.EQ.1) THEN -C----- coordinate file has "999.0 999.0" at the end ... - NEL = IEL-1 - ELSE -C----- coordinate file has no ending line - NEL = IEL - NTMP(IEL) = I-1 - ENDIF -C -C -C WRITE(*,3010) NEL -C CALL ASKI('Enter element to be replaced by current airfoil^',IEL) -C - IF(IEL.LT.1 .OR. IEL.GT.NEL+1) THEN - WRITE(*,*) 'Element number inappropriate. Airfoil not written.' - CLOSE(LU) - RETURN - ELSE IF(IEL.EQ.NEL+1) THEN - NEL = NEL+1 - ENDIF -C -C - NTMP(IEL) = N - DO 70 I = 1, NTMP(IEL) - IF(LCLOCK) THEN -C------- write out in clockwise order (reversed from internal XFOIL order) - IDIR = NTMP(IEL) - I + 1 - ELSE -C------- write out in counterclockwise order (same as internal XFOIL order) - IDIR = I - ENDIF - XTMP(I,IEL) = X(IDIR) - YTMP(I,IEL) = Y(IDIR) - 70 CONTINUE -C -C - REWIND(LU) -C -C---- write first 2 lines of MSES format coordinate file - WRITE(LU,1000) NAME1(1:NN1) - WRITE(LU,1000) ISPARS1(1:NI1) -C - DO 80 IEL=1, NEL - DO 805 I=1, NTMP(IEL) - WRITE(LU,1100) XTMP(I,IEL),YTMP(I,IEL) - 805 CONTINUE - IF(IEL.LT.NEL) WRITE(LU,*) ' 999.0 999.0' - 80 CONTINUE -C - CLOSE(LU) - RETURN -C - 9005 WRITE(*,*) 'Old file OPEN error. Airfoil not saved.' - RETURN -C - 9010 WRITE(*,*) 'Old file READ error. Airfoil not saved.' - CLOSE(LU) - RETURN -C - 1000 FORMAT(A) - 1100 FORMAT(1X,5F12.6) - 3010 FORMAT(/' Specified multielement airfoil has',I2,' elements.') - END ! MSAVE - - - - SUBROUTINE ROTATE(X,Y,N,ALFA) - DIMENSION X(N), Y(N) -C - SA = SIN(ALFA) - CA = COS(ALFA) -CCC XOFF = 0.25*(1.0-CA) -CCC YOFF = 0.25*SA - XOFF = 0. - YOFF = 0. - DO 8 I=1, N - XT = X(I) - YT = Y(I) - X(I) = CA*XT + SA*YT + XOFF - Y(I) = CA*YT - SA*XT + YOFF - 8 CONTINUE -C - RETURN - END - - - SUBROUTINE PANGEN() -C--------------------------------------------------- -C Set paneling distribution from buffer airfoil -C geometry, thus creating current airfoil. -C -C If REFINE=True, bunch points at x=XSREF on -C top side and at x=XPREF on bottom side -C by setting a fictitious local curvature of -C CTRRAT*(LE curvature) there. -C--------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - IF(NB.LT.2) THEN -C WRITE(*,*) 'PANGEN: Buffer airfoil not available.' - N = 0 - RETURN - ENDIF -C -C---- Number of temporary nodes for panel distribution calculation -C exceeds the specified panel number by factor of IPFAC. - IPFAC = 3 -C -C---- number of airfoil panel points - N = NPAN -C -cC---- number of wake points -c NW = NPAN/8 + 2 -c IF(NW.GT.IWX) THEN -c WRITE(*,*) -c & 'Array size (IWX) too small. Last wake point index reduced.' -c NW = IWX -c ENDIF -C -C---- set arc length spline parameter - CALL SCALC(XB,YB,SB,NB) -C -C---- spline raw airfoil coordinates - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C -C---- normalizing length (~ chord) - SBREF = 0.5*(SB(NB)-SB(1)) -C -C---- set up curvature array - DO I = 1, NB - W5(I) = ABS( CURV(SB(I),XB,XBP,YB,YBP,SB,NB) ) * SBREF - ENDDO -C -C---- locate LE point arc length value and the normalized curvature there - CALL LEFIND(SBLE,XB,XBP,YB,YBP,SB,NB) - CVLE = ABS( CURV(SBLE,XB,XBP,YB,YBP,SB,NB) ) * SBREF -C -C---- check for doubled point (sharp corner) at LE - IBLE = 0 - DO I = 1, NB-1 - IF(SBLE.EQ.SB(I) .AND. SBLE.EQ.SB(I+1)) THEN - IBLE = I -C WRITE(*,*) -C WRITE(*,*) 'Sharp leading edge' - GO TO 21 - ENDIF - ENDDO - 21 CONTINUE -C -C---- set LE, TE points - XBLE = SEVAL(SBLE,XB,XBP,SB,NB) - YBLE = SEVAL(SBLE,YB,YBP,SB,NB) - XBTE = 0.5*(XB(1)+XB(NB)) - YBTE = 0.5*(YB(1)+YB(NB)) - CHBSQ = (XBTE-XBLE)**2 + (YBTE-YBLE)**2 -C -C---- set average curvature over 2*NK+1 points within Rcurv of LE point - NK = 3 - CVSUM = 0. - DO K = -NK, NK - FRAC = FLOAT(K)/FLOAT(NK) - SBK = SBLE + FRAC*SBREF/MAX(CVLE,20.0) - CVK = ABS( CURV(SBK,XB,XBP,YB,YBP,SB,NB) ) * SBREF - CVSUM = CVSUM + CVK - ENDDO - CVAVG = CVSUM/FLOAT(2*NK+1) -C -C---- dummy curvature for sharp LE - IF(IBLE.NE.0) CVAVG = 10.0 -C -C---- set curvature attraction coefficient actually used - CC = 6.0 * CVPAR -C -C---- set artificial curvature at TE to bunch panels there - CVTE = CVAVG * CTERAT - W5(1) = CVTE - W5(NB) = CVTE -C -C -C**** smooth curvature array for smoother panel size distribution **** -C -CCC CALL ASKR('Enter curvature smoothing length/c^',SMOOL) -CCC SMOOL = 0.010 -C -C---- set smoothing length = 1 / averaged LE curvature, but -C- no more than 5% of chord and no less than 1/4 average panel spacing - SMOOL = MAX( 1.0/MAX(CVAVG,20.0) , 0.25 /FLOAT(NPAN/2) ) -C - SMOOSQ = (SMOOL*SBREF) ** 2 -C -C---- set up tri-diagonal system for smoothed curvatures - W2(1) = 1.0 - W3(1) = 0.0 - DO I=2, NB-1 - DSM = SB(I) - SB(I-1) - DSP = SB(I+1) - SB(I) - DSO = 0.5*(SB(I+1) - SB(I-1)) -C - IF(DSM.EQ.0.0 .OR. DSP.EQ.0.0) THEN -C------- leave curvature at corner point unchanged - W1(I) = 0.0 - W2(I) = 1.0 - W3(I) = 0.0 - ELSE - W1(I) = SMOOSQ * ( - 1.0/DSM) / DSO - W2(I) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - W3(I) = SMOOSQ * (-1.0/DSP ) / DSO - ENDIF - ENDDO -C - W1(NB) = 0.0 - W2(NB) = 1.0 -C -C---- fix curvature at LE point by modifying equations adjacent to LE - DO I=2, NB-1 - IF(SB(I).EQ.SBLE .OR. I.EQ.IBLE .OR. I.EQ.IBLE+1) THEN -C------- if node falls right on LE point, fix curvature there - W1(I) = 0. - W2(I) = 1.0 - W3(I) = 0. - W5(I) = CVLE - ELSE IF(SB(I-1).LT.SBLE .AND. SB(I).GT.SBLE) THEN -C------- modify equation at node just before LE point - DSM = SB(I-1) - SB(I-2) - DSP = SBLE - SB(I-1) - DSO = 0.5*(SBLE - SB(I-2)) -C - W1(I-1) = SMOOSQ * ( - 1.0/DSM) / DSO - W2(I-1) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - W3(I-1) = 0. - W5(I-1) = W5(I-1) + SMOOSQ*CVLE/(DSP*DSO) -C -C------- modify equation at node just after LE point - DSM = SB(I) - SBLE - DSP = SB(I+1) - SB(I) - DSO = 0.5*(SB(I+1) - SBLE) - W1(I) = 0. - W2(I) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - W3(I) = SMOOSQ * (-1.0/DSP ) / DSO - W5(I) = W5(I) + SMOOSQ*CVLE/(DSM*DSO) -C - GO TO 51 - ENDIF - ENDDO - 51 CONTINUE -C -C---- set artificial curvature at bunching points and fix it there - DO I=2, NB-1 -C------ chord-based x/c coordinate - XOC = ( (XB(I)-XBLE)*(XBTE-XBLE) - & + (YB(I)-YBLE)*(YBTE-YBLE) ) / CHBSQ -C - IF(SB(I).LT.SBLE) THEN -C------- check if top side point is in refinement area - IF(XOC.GT.XSREF1 .AND. XOC.LT.XSREF2) THEN - W1(I) = 0. - W2(I) = 1.0 - W3(I) = 0. - W5(I) = CVLE*CTRRAT - ENDIF - ELSE -C------- check if bottom side point is in refinement area - IF(XOC.GT.XPREF1 .AND. XOC.LT.XPREF2) THEN - W1(I) = 0. - W2(I) = 1.0 - W3(I) = 0. - W5(I) = CVLE*CTRRAT - ENDIF - ENDIF - ENDDO -C -C---- solve for smoothed curvature array W5 - IF(IBLE.EQ.0) THEN - CALL TRISOL(W2,W1,W3,W5,NB) - ELSE - I = 1 - CALL TRISOL(W2(I),W1(I),W3(I),W5(I),IBLE) - I = IBLE+1 - CALL TRISOL(W2(I),W1(I),W3(I),W5(I),NB-IBLE) - ENDIF -C -C---- find max curvature - CVMAX = 0. - DO I=1, NB - CVMAX = MAX( CVMAX , ABS(W5(I)) ) - ENDDO -C -C---- normalize curvature array - DO I=1, NB - W5(I) = W5(I) / CVMAX - ENDDO -C -C---- spline curvature array - CALL SEGSPL(W5,W6,SB,NB) -C -C---- Set initial guess for node positions uniform in s. -C More nodes than specified (by factor of IPFAC) are -C temporarily used for more reliable convergence. - NN = IPFAC*(N-1)+1 -C -C---- ratio of lengths of panel at TE to one away from the TE - RDSTE = 0.667 - RTF = (RDSTE-1.0)*FLOAT(IPFAC) + 1.0 -C - IF(IBLE.EQ.0) THEN -C - DSAVG = (SB(NB)-SB(1))/(FLOAT(NN-3) + 2.0*RTF) - SNEW(1) = SB(1) - DO I=2, NN-1 - SNEW(I) = SB(1) + DSAVG * (FLOAT(I-2) + RTF) - ENDDO - SNEW(NN) = SB(NB) -C - ELSE -C - NFRAC1 = (N * IBLE) / NB -C - NN1 = IPFAC*(NFRAC1-1)+1 - DSAVG1 = (SBLE-SB(1))/(FLOAT(NN1-2) + RTF) - SNEW(1) = SB(1) - DO I=2, NN1 - SNEW(I) = SB(1) + DSAVG1 * (FLOAT(I-2) + RTF) - ENDDO -C - NN2 = NN - NN1 + 1 - DSAVG2 = (SB(NB)-SBLE)/(FLOAT(NN2-2) + RTF) - DO I=2, NN2-1 - SNEW(I-1+NN1) = SBLE + DSAVG2 * (FLOAT(I-2) + RTF) - ENDDO - SNEW(NN) = SB(NB) -C - ENDIF -C -C---- Newton iteration loop for new node positions - DO 10 ITER=1, 20 -C -C------ set up tri-diagonal system for node position deltas - CV1 = SEVAL(SNEW(1),W5,W6,SB,NB) - CV2 = SEVAL(SNEW(2),W5,W6,SB,NB) - CVS1 = DEVAL(SNEW(1),W5,W6,SB,NB) - CVS2 = DEVAL(SNEW(2),W5,W6,SB,NB) -C - CAVM = SQRT(CV1**2 + CV2**2) - IF(CAVM .EQ. 0.0) THEN - CAVM_S1 = 0. - CAVM_S2 = 0. - ELSE - CAVM_S1 = CVS1 * CV1/CAVM - CAVM_S2 = CVS2 * CV2/CAVM - ENDIF -C - DO 110 I=2, NN-1 - DSM = SNEW(I) - SNEW(I-1) - DSP = SNEW(I) - SNEW(I+1) - CV3 = SEVAL(SNEW(I+1),W5,W6,SB,NB) - CVS3 = DEVAL(SNEW(I+1),W5,W6,SB,NB) -C - CAVP = SQRT(CV3**2 + CV2**2) - IF(CAVP .EQ. 0.0) THEN - CAVP_S2 = 0. - CAVP_S3 = 0. - ELSE - CAVP_S2 = CVS2 * CV2/CAVP - CAVP_S3 = CVS3 * CV3/CAVP - ENDIF -C - FM = CC*CAVM + 1.0 - FP = CC*CAVP + 1.0 -C - REZ = DSP*FP + DSM*FM -C -C-------- lower, main, and upper diagonals - W1(I) = -FM + CC* DSM*CAVM_S1 - W2(I) = FP + FM + CC*(DSP*CAVP_S2 + DSM*CAVM_S2) - W3(I) = -FP + CC* DSP*CAVP_S3 -C -C-------- residual, requiring that -C (1 + C*curv)*deltaS is equal on both sides of node i - W4(I) = -REZ -C - CV1 = CV2 - CV2 = CV3 - CVS1 = CVS2 - CVS2 = CVS3 - CAVM = CAVP - CAVM_S1 = CAVP_S2 - CAVM_S2 = CAVP_S3 - 110 CONTINUE -C -C------ fix endpoints (at TE) - W2(1) = 1.0 - W3(1) = 0.0 - W4(1) = 0.0 - W1(NN) = 0.0 - W2(NN) = 1.0 - W4(NN) = 0.0 -C - IF(RTF .NE. 1.0) THEN -C------- fudge equations adjacent to TE to get TE panel length ratio RTF -C - I = 2 - W4(I) = -((SNEW(I) - SNEW(I-1)) + RTF*(SNEW(I) - SNEW(I+1))) - W1(I) = -1.0 - W2(I) = 1.0 + RTF - W3(I) = - RTF -C - I = NN-1 - W4(I) = -((SNEW(I) - SNEW(I+1)) + RTF*(SNEW(I) - SNEW(I-1))) - W3(I) = -1.0 - W2(I) = 1.0 + RTF - W1(I) = - RTF - ENDIF -C -C -C------ fix sharp LE point - IF(IBLE.NE.0) THEN - I = NN1 - W1(I) = 0.0 - W2(I) = 1.0 - W3(I) = 0.0 - W4(I) = SBLE - SNEW(I) - ENDIF -C -C------ solve for changes W4 in node position arc length values - CALL TRISOL(W2,W1,W3,W4,NN) -C -C------ find under-relaxation factor to keep nodes from changing order - RLX = 1.0 - DMAX = 0.0 - DO I=1, NN-1 - DS = SNEW(I+1) - SNEW(I) - DDS = W4(I+1) - W4(I) - DSRAT = 1.0 + RLX*DDS/DS - IF(DSRAT.GT.4.0) RLX = (4.0-1.0)*DS/DDS - IF(DSRAT.LT.0.2) RLX = (0.2-1.0)*DS/DDS - DMAX = MAX(ABS(W4(I)),DMAX) - ENDDO -C -C------ update node position - DO I=2, NN-1 - SNEW(I) = SNEW(I) + RLX*W4(I) - ENDDO -C -CCC IF(RLX.EQ.1.0) WRITE(*,*) DMAX -CCC IF(RLX.NE.1.0) WRITE(*,*) DMAX,' RLX =',RLX - IF(ABS(DMAX).LT.1.E-3) GO TO 11 - 10 CONTINUE - WRITE(*,*) 'Paneling convergence failed. Continuing anyway...' -C - 11 CONTINUE -C -C---- set new panel node coordinates - DO I=1, N - IND = IPFAC*(I-1) + 1 - S(I) = SNEW(IND) - X(I) = SEVAL(SNEW(IND),XB,XBP,SB,NB) - Y(I) = SEVAL(SNEW(IND),YB,YBP,SB,NB) - ENDDO -C -C -C---- go over buffer airfoil again, checking for corners (double points) - NCORN = 0 - DO 25 IB=1, NB-1 - IF(SB(IB) .EQ. SB(IB+1)) THEN -C------- found one ! -C - NCORN = NCORN+1 - XBCORN = XB(IB) - YBCORN = YB(IB) - SBCORN = SB(IB) -C -C------- find current-airfoil panel which contains corner - DO 252 I=1, N -C -C--------- keep stepping until first node past corner - IF(S(I) .LE. SBCORN) GO TO 252 -C -C---------- move remainder of panel nodes to make room for additional node - DO 2522 J=N, I, -1 - X(J+1) = X(J) - Y(J+1) = Y(J) - S(J+1) = S(J) - 2522 CONTINUE - N = N+1 -C - IF(N .GT. IQX-1) - & STOP 'PANEL: Too many panels. Increase IQX in XFOIL.INC' -C - X(I) = XBCORN - Y(I) = YBCORN - S(I) = SBCORN -C -C---------- shift nodes adjacent to corner to keep panel sizes comparable - IF(I-2 .GE. 1) THEN - S(I-1) = 0.5*(S(I) + S(I-2)) - X(I-1) = SEVAL(S(I-1),XB,XBP,SB,NB) - Y(I-1) = SEVAL(S(I-1),YB,YBP,SB,NB) - ENDIF -C - IF(I+2 .LE. N) THEN - S(I+1) = 0.5*(S(I) + S(I+2)) - X(I+1) = SEVAL(S(I+1),XB,XBP,SB,NB) - Y(I+1) = SEVAL(S(I+1),YB,YBP,SB,NB) - ENDIF -C -C---------- go on to next input geometry point to check for corner - GO TO 25 -C - 252 CONTINUE - ENDIF - 25 CONTINUE -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) - CALL LEFIND(SLE,X,XP,Y,YP,S,N) -C - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT( (XTE-XLE)**2 + (YTE-YLE)**2 ) -C -C---- calculate panel size ratios (user info) - DSMIN = 1000.0 - DSMAX = -1000.0 - DO 40 I=1, N-1 - DS = S(I+1)-S(I) - IF(DS .EQ. 0.0) GO TO 40 - DSMIN = MIN(DSMIN,DS) - DSMAX = MAX(DSMAX,DS) - 40 CONTINUE -C - DSMIN = DSMIN*FLOAT(N-1)/S(N) - DSMAX = DSMAX*FLOAT(N-1)/S(N) -ccc WRITE(*,*) 'DSmin/DSavg = ',DSMIN,' DSmax/DSavg = ',DSMAX -C -C---- set various flags for new airfoil - LGAMU = .FALSE. - LQINU = .FALSE. - LWAKE = .FALSE. - LQAIJ = .FALSE. - LADIJ = .FALSE. - LWDIJ = .FALSE. - LIPAN = .FALSE. - LBLINI = .FALSE. - LVCONV = .FALSE. - LSCINI = .FALSE. - LQSPEC = .FALSE. - LGSAME = .FALSE. -C - IF(LBFLAP) THEN - XOF = XBF - YOF = YBF - LFLAP = .TRUE. - ENDIF -C -C---- determine if TE is blunt or sharp, calculate TE geometry parameters - CALL TECALC -C -C---- calculate normal vectors - CALL NCALC(X,Y,S,N,NX,NY) -C -C---- calculate panel angles for panel routines - CALL APCALC -C - IF(SHARP) THEN -C WRITE(*,1090) 'Sharp trailing edge' - ELSE - GAP = SQRT((X(1)-X(N))**2 + (Y(1)-Y(N))**2) -C WRITE(*,1090) 'Blunt trailing edge. Gap =', GAP - ENDIF -C - RETURN - END ! PANGEN - - - -c SUBROUTINE GETPAN -c INCLUDE 'XFOIL.INC' -c LOGICAL LCHANGE -c CHARACTER*4 VAR -c CHARACTER*128 COMARG -C -c DIMENSION IINPUT(20) -c DIMENSION RINPUT(20) -c LOGICAL ERROR -C -c IF(NB.LE.1) THEN -c WRITE(*,*) 'GETPAN: Buffer airfoil not available.' -c RETURN -c ENDIF -C -c 5 CONTINUE -c IF(N.LE.1) THEN -c WRITE(*,*) 'No current airfoil to plot' -c ELSE -c CALL PANPLT -c ENDIF -c LCHANGE = .FALSE. -cC -c 10 WRITE(*,1000) NPAN, CVPAR, CTERAT, CTRRAT, -c & XSREF1, XSREF2, XPREF1, XPREF2 -c 1000 FORMAT( -c & /' Present paneling parameters...' -c & /' N i Number of panel nodes ' , I4 -c & /' P r Panel bunching parameter ' , F6.3 -c & /' T r TE/LE panel density ratio ' , F6.3 -c & /' R r Refined area/LE panel density ratio ' , F6.3 -c & /' XT rr Top side refined area x/c limits ' , 2F6.3 -c & /' XB rr Bottom side refined area x/c limits ' , 2F6.3 -c & /' Z oom' -c & /' U nzoom' ) -cC -c 12 CALL ASKC('Change what ? ( if nothing else)^',VAR,COMARG) -cC -c IF(VAR.EQ.'Z ') THEN -c CALL USETZOOM(.TRUE.,.TRUE.) -c CALL REPLOT(IDEV) -c GO TO 12 -c ENDIF -cC -c IF(VAR.EQ.'U ') THEN -c CALL CLRZOOM -c CALL REPLOT(IDEV) -c GO TO 12 -c ENDIF -cC -cC -c DO I=1, 20 -c IINPUT(I) = 0 -c RINPUT(I) = 0.0 -c ENDDO -c NINPUT = 0 -c CALL GETINT(COMARG,IINPUT,NINPUT,ERROR) -c NINPUT = 0 -c CALL GETFLT(COMARG,RINPUT,NINPUT,ERROR) -cC -c IF (VAR.EQ.' ') THEN -cC -c IF(LCHANGE) THEN -cC -cC-------- set new panel distribution, and display max panel corner angle -c CALL PANGEN(.FALSE.) -c IF(N.GT.0) CALL CANG(X,Y,N,1,IMAX,AMAX) -cC -cC-------- go back to paneling menu -c GO TO 5 -c ENDIF -cC -c CALL CLRZOOM -c RETURN -cC -c ELSE IF(VAR.EQ.'N ' .OR. VAR.EQ.'n ') THEN -cC -c IF(NINPUT.GE.1) THEN -c NPAN = IINPUT(1) -c ELSE -c CALL ASKI('Enter number of panel nodes^',NPAN) -c ENDIF -c IF(NPAN .GT. IQX-6) THEN -c NPAN = IQX - 6 -c WRITE(*,1200) NPAN -c 1200 FORMAT(1X,' Number of panel nodes reduced to array limit:',I4) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'P ' .OR. VAR.EQ.'p ') THEN -cC -c IF(NINPUT.GE.1) THEN -c CVPAR = RINPUT(1) -c ELSE -c CALL ASKR('Enter panel bunching parameter (0 to ~1)^',CVPAR) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'T ' .OR. VAR.EQ.'t ') THEN -cC -c IF(NINPUT.GE.1) THEN -c CTERAT = RINPUT(1) -c ELSE -c CALL ASKR('Enter TE/LE panel density ratio^',CTERAT) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'R ' .OR. VAR.EQ.'r ') THEN -cC -c IF(NINPUT.GE.1) THEN -c CTRRAT = RINPUT(1) -c ELSE -c CALL ASKR('Enter refined-area panel density ratio^',CTRRAT) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'XT ' .OR. VAR.EQ.'xt ') THEN -cC -c IF(NINPUT.GE.2) THEN -c XSREF1 = RINPUT(1) -c XSREF2 = RINPUT(2) -c ELSE -c CALL ASKR('Enter left top side refinement limit^',XSREF1) -c CALL ASKR('Enter right top side refinement limit^',XSREF2) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'XB ' .OR. VAR.EQ.'xb ') THEN -cC -c IF(NINPUT.GE.2) THEN -c XPREF1 = RINPUT(1) -c XPREF2 = RINPUT(2) -c ELSE -c CALL ASKR('Enter left bottom side refinement limit^',XPREF1) -c CALL ASKR('Enter right bottom side refinement limit^',XPREF2) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE -cC -c WRITE(*,*) -c WRITE(*,*) '*** Input not recognized ***' -c GO TO 10 -cC -c ENDIF -cC -c GO TO 12 -cC -c END ! GETPAN - - - SUBROUTINE TECALC -C------------------------------------------- -C Calculates total and projected TE gap -C areas and TE panel strengths. -C------------------------------------------- - INCLUDE 'XFOIL.INC' -C -C---- set TE base vector and TE bisector components - DXTE = X(1) - X(N) - DYTE = Y(1) - Y(N) - DXS = 0.5*(-XP(1) + XP(N)) - DYS = 0.5*(-YP(1) + YP(N)) -C -C---- normal and streamwise projected TE gap areas - ANTE = DXS*DYTE - DYS*DXTE - ASTE = DXS*DXTE + DYS*DYTE -C -C---- total TE gap area - DSTE = SQRT(DXTE**2 + DYTE**2) -C - SHARP = DSTE .LT. 0.0001*CHORD -C - IF(SHARP) THEN - SCS = 1.0 - SDS = 0.0 - ELSE - SCS = ANTE/DSTE - SDS = ASTE/DSTE - ENDIF -C -C---- TE panel source and vorticity strengths - SIGTE = 0.5*(GAM(1) - GAM(N))*SCS - GAMTE = -.5*(GAM(1) - GAM(N))*SDS -C - SIGTE_A = 0.5*(GAM_A(1) - GAM_A(N))*SCS - GAMTE_A = -.5*(GAM_A(1) - GAM_A(N))*SDS -C - RETURN - END ! TECALC - - - - SUBROUTINE INTE -C----------------------------------------------------------- -C Interpolates two airfoils into an intermediate shape. -C Extrapolation is also possible to a reasonable extent. -C----------------------------------------------------------- - INCLUDE 'XFOIL.INC' - CHARACTER*2 CAIR - INTEGER NINT(2) - REAL SINT(IBX,2), - & XINT(IBX,2), XPINT(IBX,2), - & YINT(IBX,2), YPINT(IBX,2), - & SLEINT(2) - CHARACTER*20 PROMPTN - CHARACTER*48 NAMEINT(2) - CHARACTER*80 ISPARST -C - LU = 21 -C - 1000 FORMAT(A) -C - WRITE(*,1100) NAME - DO IP=1, NPOL - IF(NXYPOL(IP).GT.0) THEN - WRITE(*,1200) IP, NAMEPOL(IP) - ENDIF - ENDDO - IF (NPOL.EQ.0) THEN - PROMPTN = '" ( F C ): ' - NPR = 12 - ELSEIF(NPOL.EQ.1) THEN - PROMPTN = '" ( F C 1 ): ' - NPR = 14 - ELSEIF(NPOL.EQ.2) THEN - PROMPTN = '" ( F C 1 2 ): ' - NPR = 16 - ELSE - PROMPTN = '" ( F C 1 2.. ): ' - NPR = 18 - ENDIF -C - 1100 FORMAT(/ ' F disk file' - & / ' C current airfoil ', A) - 1200 FORMAT( 1X,I2,' polar airfoil ', A) -C - 2100 FORMAT(/' Select source of airfoil "',I1, A, $) -C - DO 40 K = 1, 2 - IAIR = K - 1 - 20 WRITE(*,2100) IAIR, PROMPTN(1:NPR) - READ(*,1000) CAIR -C - IF (INDEX('Ff',CAIR(1:1)).NE.0) THEN - CALL ASKS('Enter filename^',FNAME) - CALL AREAD(LU,FNAME,IBX, - & XINT(1,K),YINT(1,K),NINT(K), - & NAMEINT(K),ISPARST,ITYPE,0) - IF(ITYPE.EQ.0) RETURN -C - ELSEIF(INDEX('Cc',CAIR(1:1)).NE.0) THEN - IF(N.LE.1) THEN - WRITE(*,*) 'No current airfoil available' - GO TO 20 - ENDIF -C - NINT(K) = N - DO I = 1, N - XINT(I,K) = X(I) - YINT(I,K) = Y(I) - ENDDO - NAMEINT(K) = NAME -C - ELSE - READ(CAIR,*,ERR=90) IP - IF(IP.LT.1 .OR. IP.GT.NPOL) THEN - GO TO 90 - ELSEIF(NXYPOL(IP).LE.0) THEN - GO TO 90 - ELSE - NINT(K) = NXYPOL(IP) - DO I = 1, N - XINT(I,K) = CPOLXY(I,1,IP) - YINT(I,K) = CPOLXY(I,2,IP) - ENDDO - ENDIF - NAMEINT(K) = NAMEPOL(IP) -C - ENDIF -C - CALL SCALC(XINT(1,K),YINT(1,K),SINT(1,K),NINT(K)) - CALL SEGSPLD(XINT(1,K),XPINT(1,K),SINT(1,K),NINT(K),-999.,-999.) - CALL SEGSPLD(YINT(1,K),YPINT(1,K),SINT(1,K),NINT(K),-999.,-999.) - CALL LEFIND(SLEINT(K), - & XINT(1,K),XPINT(1,K), - & YINT(1,K),YPINT(1,K),SINT(1,K),NINT(K)) - 40 CONTINUE -C - WRITE(*,*) - WRITE(*,*) 'airfoil "0": ', NAMEINT(1) - WRITE(*,*) 'airfoil "1": ', NAMEINT(2) - FRAC = 0.5 -C CALL ASKR('Specify interpolating fraction 0...1^',FRAC) -C - CALL INTER(XINT(1,1),XPINT(1,1), - & YINT(1,1),YPINT(1,1),SINT(1,1),NINT(1),SLEINT(1), - & XINT(1,2),XPINT(1,2), - & YINT(1,2),YPINT(1,2),SINT(1,2),NINT(2),SLEINT(2), - & XB,YB,NB,FRAC) -C - CALL SCALC(XB,YB,SB,NB) - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C - CALL GEOPAR(XB,XBP,YB,YBP,SB,NB, W1, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB ) -C - CALL ASKS('Enter new airfoil name^',NAME) - WRITE(*,*) - WRITE(*,*) 'Result has been placed in buffer airfoil' - WRITE(*,*) 'Execute PCOP or PANE to set new current airfoil' - RETURN -C - 90 CONTINUE - WRITE(*,*) - WRITE(*,*) 'Invalid response' - RETURN - END ! INTE diff --git a/deps/src/xfoil/xgdes.f b/deps/src/xfoil/xgdes.f deleted file mode 100644 index 76b2a56..0000000 --- a/deps/src/xfoil/xgdes.f +++ /dev/null @@ -1,123 +0,0 @@ -C*********************************************************************** -C Module: xgdes.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE ABCOPY(LCONF) - INCLUDE 'XFOIL.INC' - LOGICAL LCONF -C - IF(NB.LE.1) THEN - WRITE(*,*) 'ABCOPY: Buffer airfoil not available.' - RETURN - ELSEIF(NB.GT.IQX-5) THEN - WRITE(*,*) 'Maximum number of panel nodes : ',IQX-5 - WRITE(*,*) 'Number of buffer airfoil points: ',NB - WRITE(*,*) 'Current airfoil cannot be set.' - WRITE(*,*) 'Try executing PANE at Top Level instead.' - RETURN - ENDIF - IF(N.NE.NB) LBLINI = .FALSE. -C - N = NB - DO 101 I=1, N - X(I) = XB(I) - Y(I) = YB(I) - 101 CONTINUE - LGSAME = .TRUE. -C - IF(LBFLAP) THEN - XOF = XBF - YOF = YBF - LFLAP = .TRUE. - ENDIF -C -C---- strip out doubled points - I = 1 - 102 CONTINUE - I = I+1 - IF(X(I-1).EQ.X(I) .AND. Y(I-1).EQ.Y(I)) THEN - DO 104 J=I, N-1 - X(J) = X(J+1) - Y(J) = Y(J+1) - 104 CONTINUE - N = N-1 - ENDIF - IF(I.LT.N) GO TO 102 -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) - CALL NCALC(X,Y,S,N,NX,NY) - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT( (XTE-XLE)**2 + (YTE-YLE)**2 ) - CALL TECALC - CALL APCALC -C - LGAMU = .FALSE. - LQINU = .FALSE. - LWAKE = .FALSE. - LQAIJ = .FALSE. - LADIJ = .FALSE. - LWDIJ = .FALSE. - LIPAN = .FALSE. - LVCONV = .FALSE. - LSCINI = .FALSE. -CCC LBLINI = .FALSE. -C -C IF(LCONF) WRITE(*,1200) N -C 1200 FORMAT(/' Current airfoil nodes set from buffer airfoil nodes (', -C & I4,' )') -C - RETURN - END ! ABCOPY - - - SUBROUTINE GETXYF(X,XP,Y,YP,S,N, TOPS,BOTS,XF,YF) - DIMENSION X(N),XP(N),Y(N),YP(N),S(N) -C - IF(XF .EQ. -999.0) - & CALL ASKR('Enter flap hinge x location^',XF) -C -C---- find top and bottom y at hinge x location - TOPS = S(1) + (X(1) - XF) - BOTS = S(N) - (X(N) - XF) - CALL SINVRT(TOPS,XF,X,XP,S,N) - CALL SINVRT(BOTS,XF,X,XP,S,N) - TOPY = SEVAL(TOPS,Y,YP,S,N) - BOTY = SEVAL(BOTS,Y,YP,S,N) -C - WRITE(*,1000) TOPY, BOTY - 1000 FORMAT(/' Top surface: y =', F8.4,' y/t = 1.0' - & /' Bottom surface: y =', F8.4,' y/t = 0.0') -C - IF(YF .EQ. -999.0) - & CALL ASKR( - & 'Enter flap hinge y location (or 999 to specify y/t)^',YF) -C - IF(YF .EQ. 999.0) THEN - CALL ASKR('Enter flap hinge relative y/t location^',YREL) - YF = TOPY*YREL + BOTY*(1.0-YREL) - ENDIF -C - RETURN - END ! GETXYF diff --git a/deps/src/xfoil/xgeom.f b/deps/src/xfoil/xgeom.f deleted file mode 100644 index fd372c0..0000000 --- a/deps/src/xfoil/xgeom.f +++ /dev/null @@ -1,1412 +0,0 @@ -C*********************************************************************** -C Module: xgeom.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE LEFIND(SLE,X,XP,Y,YP,S,N) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C------------------------------------------------------ -C Locates leading edge spline-parameter value SLE -C -C The defining condition is -C -C (X-XTE,Y-YTE) . (X',Y') = 0 at S = SLE -C -C i.e. the surface tangent is normal to the chord -C line connecting X(SLE),Y(SLE) and the TE point. -C------------------------------------------------------ -C -C---- convergence tolerance - DSEPS = (S(N)-S(1)) * 1.0E-5 -C -C---- set trailing edge point coordinates - XTE = 0.5*(X(1) + X(N)) - YTE = 0.5*(Y(1) + Y(N)) -C -C---- get first guess for SLE - DO 10 I=3, N-2 - DXTE = X(I) - XTE - DYTE = Y(I) - YTE - DX = X(I+1) - X(I) - DY = Y(I+1) - Y(I) - DOTP = DXTE*DX + DYTE*DY - IF(DOTP .LT. 0.0) GO TO 11 - 10 CONTINUE -C - 11 SLE = S(I) -C -C---- check for sharp LE case - IF(S(I) .EQ. S(I-1)) THEN -ccc WRITE(*,*) 'Sharp LE found at ',I,SLE - RETURN - ENDIF -C -C---- Newton iteration to get exact SLE value - DO 20 ITER=1, 50 - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - DXDS = DEVAL(SLE,X,XP,S,N) - DYDS = DEVAL(SLE,Y,YP,S,N) - DXDD = D2VAL(SLE,X,XP,S,N) - DYDD = D2VAL(SLE,Y,YP,S,N) -C - XCHORD = XLE - XTE - YCHORD = YLE - YTE -C -C------ drive dot product between chord line and LE tangent to zero - RES = XCHORD*DXDS + YCHORD*DYDS - RESS = DXDS *DXDS + DYDS *DYDS - & + XCHORD*DXDD + YCHORD*DYDD -C -C------ Newton delta for SLE - DSLE = -RES/RESS -C - DSLE = MAX( DSLE , -0.02*ABS(XCHORD+YCHORD) ) - DSLE = MIN( DSLE , 0.02*ABS(XCHORD+YCHORD) ) - SLE = SLE + DSLE - IF(ABS(DSLE) .LT. DSEPS) RETURN - 20 CONTINUE - WRITE(*,*) 'LEFIND: LE point not found. Continuing...' - SLE = S(I) - RETURN - END - - - - SUBROUTINE XLFIND(SLE,X,XP,Y,YP,S,N) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C------------------------------------------------------ -C Locates leftmost (minimum x) point location SLE -C -C The defining condition is -C -C X' = 0 at S = SLE -C -C i.e. the surface tangent is vertical -C------------------------------------------------------ -C - DSLEN = S(N) - S(1) -C -C---- convergence tolerance - DSEPS = (S(N)-S(1)) * 1.0E-5 -C -C---- get first guess for SLE - DO 10 I=3, N-2 - DX = X(I+1) - X(I) - IF(DX .GT. 0.0) GO TO 11 - 10 CONTINUE -C - 11 SLE = S(I) -C -C---- check for sharp LE case - IF(S(I) .EQ. S(I-1)) THEN -ccc WRITE(*,*) 'Sharp LE found at ',I,SLE - RETURN - ENDIF -C -C---- Newton iteration to get exact SLE value - DO 20 ITER=1, 50 - DXDS = DEVAL(SLE,X,XP,S,N) - DXDD = D2VAL(SLE,X,XP,S,N) -C -C------ drive DXDS to zero - RES = DXDS - RESS = DXDD -C -C------ Newton delta for SLE - DSLE = -RES/RESS -C - DSLE = MAX( DSLE , -0.01*ABS(DSLEN) ) - DSLE = MIN( DSLE , 0.01*ABS(DSLEN) ) - SLE = SLE + DSLE - IF(ABS(DSLE) .LT. DSEPS) RETURN - 20 CONTINUE - WRITE(*,*) 'XLFIND: Left point not found. Continuing...' - SLE = S(I) - RETURN - END ! XLFIND - - - - SUBROUTINE NSFIND(SLE,X,XP,Y,YP,S,N) - REAL X(*),Y(*),S(*),XP(*),YP(*) -C---------------------------------------------------------- -C Finds "nose" of airfoil where curvature is a maximum -C---------------------------------------------------------- -C - PARAMETER (NMAX=500) - DIMENSION A(NMAX), B(NMAX), C(NMAX), CV(NMAX) -C - IF(N.GT.NMAX) STOP 'NSFIND: Local array overflow. Increase NMAX.' -C -C---- set up curvature array - DO 3 I=1, N - CV(I) = CURV(S(I),X,XP,Y,YP,S,N) - 3 CONTINUE -C -C---- curvature smoothing length - SMOOL = 0.006*(S(N)-S(1)) -C -C---- set up tri-diagonal system for smoothed curvatures - SMOOSQ = SMOOL**2 - A(1) = 1.0 - C(1) = 0.0 - DO 4 I=2, N-1 - DSM = S(I) - S(I-1) - DSP = S(I+1) - S(I) - DSO = 0.5*(S(I+1) - S(I-1)) -C - IF(DSM.EQ.0.0 .OR. DSP.EQ.0.0) THEN -C------- leave curvature at corner point unchanged - B(I) = 0.0 - A(I) = 1.0 - C(I) = 0.0 - ELSE - B(I) = SMOOSQ * ( - 1.0/DSM) / DSO - A(I) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - C(I) = SMOOSQ * (-1.0/DSP ) / DSO - ENDIF - 4 CONTINUE - B(N) = 0.0 - A(N) = 1.0 -C - CALL TRISOL(A,B,C,CV,N) -C -C---- find max curvature index - CVMAX = 0. - IVMAX = 0 - DO 71 I=2, N-1 - IF(ABS(CV(I)) .GT. CVMAX) THEN - CVMAX = ABS(CV(I)) - IVMAX = I - ENDIF - 71 CONTINUE -C -C---- fit a parabola to the curvature at the three points near maximum - I = IVMAX -C - IP = I+1 - IM = I-1 - IF(S(I) .EQ. S(IP)) IP = I+2 - IF(S(I) .EQ. S(IM)) IM = I-2 - - DSM = S(I) - S(IM) - DSP = S(IP) - S(I) -C - CVSM = (CV(I)-CV(IM))/DSM - CVSP = (CV(IP)-CV(I))/DSP -C -C---- 1st and 2nd derivatives at i=IVMAX - CVS = (CVSM*DSP + CVSP*DSM)/(DSP+DSM) - CVSS = 2.0*(CVSP-CVSM)/(DSP+DSM) -C -C---- set location of arc length at maximum of parabola - DS = -CVS/CVSS - SLE = S(I) + DS -C - RETURN - END - - - SUBROUTINE SOPPS(SOPP, SI, X,XP,Y,YP,S,N, SLE) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C-------------------------------------------------- -C Calculates arc length SOPP of point -C which is opposite of point SI, on the -C other side of the airfoil baseline -C-------------------------------------------------- -C -C---- reference length for testing convergence - SLEN = S(N) - S(1) -C -C---This fails miserably with sharp LE foils, tsk,tsk,tsk HHY 4/24/01 -C---- set baseline vector normal to surface at LE point -c DXC = -DEVAL(SLE,Y,YP,S,N) -c DYC = DEVAL(SLE,X,XP,S,N) -c DSC = SQRT(DXC**2 + DYC**2) -c DXC = DXC/DSC -c DYC = DYC/DSC -C -C---Rational alternative 4/24/01 HHY - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT((XTE-XLE)**2 + (YTE-YLE)**2) -C---- set unit chord-line vector - DXC = (XTE-XLE) / CHORD - DYC = (YTE-YLE) / CHORD -C -C - IF(SI.LT.SLE) THEN - IN = 1 - INOPP = N - ELSE - IN = N - INOPP = 1 - ENDIF - SFRAC = (SI-SLE)/(S(IN)-SLE) - SOPP = SLE + SFRAC*(S(INOPP)-SLE) -C - - IF(ABS(SFRAC) .LE. 1.0E-5) THEN - SOPP = SLE - RETURN - ENDIF -C -C---- XBAR = x coordinate in chord-line axes - XI = SEVAL(SI , X,XP,S,N) - YI = SEVAL(SI , Y,YP,S,N) - XLE = SEVAL(SLE, X,XP,S,N) - YLE = SEVAL(SLE, Y,YP,S,N) - XBAR = (XI-XLE)*DXC + (YI-YLE)*DYC -C -C---- converge on exact opposite point with same XBAR value - DO 300 ITER=1, 12 - XOPP = SEVAL(SOPP,X,XP,S,N) - YOPP = SEVAL(SOPP,Y,YP,S,N) - XOPPD = DEVAL(SOPP,X,XP,S,N) - YOPPD = DEVAL(SOPP,Y,YP,S,N) -C - RES = (XOPP -XLE)*DXC + (YOPP -YLE)*DYC - XBAR - RESD = XOPPD *DXC + YOPPD *DYC -C - IF(ABS(RES)/SLEN .LT. 1.0E-5) GO TO 305 - IF(RESD .EQ. 0.0) GO TO 303 -C - DSOPP = -RES/RESD - SOPP = SOPP + DSOPP -C -c write(*,*) abs(SFRAC)/slen - - IF(ABS(DSOPP)/SLEN .LT. 1.0E-5) GO TO 305 - 300 CONTINUE - 303 WRITE(*,*) - & 'SOPPS: Opposite-point location failed. Continuing...' - SOPP = SLE + SFRAC*(S(INOPP)-SLE) -C - 305 CONTINUE - RETURN - END ! SOPPS - - - - SUBROUTINE NORM(X,XP,Y,YP,S,N) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C----------------------------------------------- -C Scales coordinates to get unit chord -C----------------------------------------------- -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) -C - CALL LEFIND(SLE,X,XP,Y,YP,S,N) -C - XMAX = 0.5*(X(1) + X(N)) - XMIN = SEVAL(SLE,X,XP,S,N) - YMIN = SEVAL(SLE,Y,YP,S,N) -C - FUDGE = 1.0/(XMAX-XMIN) - DO 40 I=1, N - X(I) = (X(I)-XMIN)*FUDGE - Y(I) = (Y(I)-YMIN)*FUDGE - S(I) = S(I)*FUDGE - 40 CONTINUE -C - RETURN - END - - -C*************************************************************************** -C -C GEOPAR -> Feeds into NACA Subroutine in xfoil.f -C -C*************************************************************************** - SUBROUTINE GEOPAR(X,XP,Y,YP,S,N, T, - & SLE,CHORD,AREA,RADLE,ANGTE, - & EI11A,EI22A,APX1A,APX2A, - & EI11T,EI22T,APX1T,APX2T, - & THICK,CAMBR) - DIMENSION X(*), XP(*), Y(*), YP(*), S(*), T(*) -C - PARAMETER (IBX=600) - DIMENSION - & XCAM(2*IBX), YCAM(2*IBX), YCAMP(2*IBX), - & XTHK(2*IBX), YTHK(2*IBX), YTHKP(2*IBX) -C------------------------------------------------------ -C Sets geometric parameters for airfoil shape -C------------------------------------------------------ - CALL LEFIND(SLE,X,XP,Y,YP,S,N) -C - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) -C - CHSQ = (XTE-XLE)**2 + (YTE-YLE)**2 - CHORD = SQRT(CHSQ) -C - CURVLE = CURV(SLE,X,XP,Y,YP,S,N) -C - RADLE = 0.0 - IF(ABS(CURVLE) .GT. 0.001*(S(N)-S(1))) RADLE = 1.0 / CURVLE -C - ANG1 = ATAN2( -YP(1) , -XP(1) ) - ANG2 = ATANC( YP(N) , XP(N) , ANG1 ) - ANGTE = ANG2 - ANG1 -C - - DO I=1, N - T(I) = 1.0 - ENDDO -C - CALL AECALC(N,X,Y,T, 1, - & AREA,XCENA,YCENA,EI11A,EI22A,APX1A,APX2A) -C - CALL AECALC(N,X,Y,T, 2, - & SLEN,XCENT,YCENT,EI11T,EI22T,APX1T,APX2T) -C -C--- Old, approximate thickness,camber routine (on discrete points only) - CALL TCCALC(X,XP,Y,YP,S,N, THICK,XTHICK, CAMBR,XCAMBR ) -C -C--- More accurate thickness and camber estimates -cc CALL GETCAM(XCAM,YCAM,NCAM,XTHK,YTHK,NTHK, -cc & X,XP,Y,YP,S,N ) -cc CALL GETMAX(XCAM,YCAM,YCAMP,NCAM,XCAMBR,CAMBR) -cc CALL GETMAX(XTHK,YTHK,YTHKP,NTHK,XTHICK,THICK) -cc THICK = 2.0*THICK -C -C WRITE(*,1000) THICK,XTHICK,CAMBR,XCAMBR -C 1000 FORMAT( ' Max thickness = ',F12.6,' at x = ',F7.3, -C & /' Max camber = ',F12.6,' at x = ',F7.3) - - -C - RETURN - END ! GEOPAR -C -C********************************************************************* - - SUBROUTINE AECALC(N,X,Y,T, ITYPE, - & AREA,XCEN,YCEN,EI11,EI22,APX1,APX2) - DIMENSION X(*),Y(*),T(*) -C--------------------------------------------------------------- -C Calculates geometric properties of shape X,Y -C -C Input: -C N number of points -C X(.) shape coordinate point arrays -C Y(.) -C T(.) skin-thickness array, used only if ITYPE = 2 -C ITYPE = 1 ... integration is over whole area dx dy -C = 2 ... integration is over skin area t ds -C -C Output: -C XCEN,YCEN centroid location -C EI11,EI22 principal moments of inertia -C APX1,APX2 principal-axis angles -C--------------------------------------------------------------- - DATA PI / 3.141592653589793238 / -C - SINT = 0.0 - AINT = 0.0 - XINT = 0.0 - YINT = 0.0 - XXINT = 0.0 - XYINT = 0.0 - YYINT = 0.0 -C - DO 10 IO = 1, N - IF(IO.EQ.N) THEN - IP = 1 - ELSE - IP = IO + 1 - ENDIF -C - DX = X(IO) - X(IP) - DY = Y(IO) - Y(IP) - XA = (X(IO) + X(IP))*0.50 - YA = (Y(IO) + Y(IP))*0.50 - TA = (T(IO) + T(IP))*0.50 -C - DS = SQRT(DX*DX + DY*DY) - SINT = SINT + DS - - IF(ITYPE.EQ.1) THEN -C-------- integrate over airfoil cross-section - DA = YA*DX - AINT = AINT + DA - XINT = XINT + XA *DA - YINT = YINT + YA *DA/2.0 - XXINT = XXINT + XA*XA*DA - XYINT = XYINT + XA*YA*DA/2.0 - YYINT = YYINT + YA*YA*DA/3.0 - ELSE -C-------- integrate over skin thickness - DA = TA*DS - AINT = AINT + DA - XINT = XINT + XA *DA - YINT = YINT + YA *DA - XXINT = XXINT + XA*XA*DA - XYINT = XYINT + XA*YA*DA - YYINT = YYINT + YA*YA*DA - ENDIF -C - 10 CONTINUE -C - AREA = AINT -C - IF(AINT .EQ. 0.0) THEN - XCEN = 0.0 - YCEN = 0.0 - EI11 = 0.0 - EI22 = 0.0 - APX1 = 0.0 - APX2 = ATAN2(1.0,0.0) - RETURN - ENDIF -C -C -C---- calculate centroid location - XCEN = XINT/AINT - YCEN = YINT/AINT -C -C---- calculate inertias - EIXX = YYINT - YCEN*YCEN*AINT - EIXY = XYINT - XCEN*YCEN*AINT - EIYY = XXINT - XCEN*XCEN*AINT -C -C---- set principal-axis inertias, EI11 is closest to "up-down" bending inertia - EISQ = 0.25*(EIXX - EIYY)**2 + EIXY**2 - SGN = SIGN( 1.0 , EIYY-EIXX ) - EI11 = 0.5*(EIXX + EIYY) - SGN*SQRT(EISQ) - EI22 = 0.5*(EIXX + EIYY) + SGN*SQRT(EISQ) -C - IF(EI11.EQ.0.0 .OR. EI22.EQ.0.0) THEN -C----- vanishing section stiffness - APX1 = 0.0 - APX2 = ATAN2(1.0,0.0) -C - ELSEIF(EISQ/(EI11*EI22) .LT. (0.001*SINT)**4) THEN -C----- rotationally-invariant section (circle, square, etc.) - APX1 = 0.0 - APX2 = ATAN2(1.0,0.0) -C - ELSE -C----- normal airfoil section - C1 = EIXY - S1 = EIXX-EI11 -C - C2 = EIXY - S2 = EIXX-EI22 -C - IF(ABS(S1).GT.ABS(S2)) THEN - APX1 = ATAN2(S1,C1) - APX2 = APX1 + 0.5*PI - ELSE - APX2 = ATAN2(S2,C2) - APX1 = APX2 - 0.5*PI - ENDIF - - IF(APX1.LT.-0.5*PI) APX1 = APX1 + PI - IF(APX1.GT.+0.5*PI) APX1 = APX1 - PI - IF(APX2.LT.-0.5*PI) APX2 = APX2 + PI - IF(APX2.GT.+0.5*PI) APX2 = APX2 - PI -C - ENDIF -C - RETURN - END ! AECALC - - - - SUBROUTINE TCCALC(X,XP,Y,YP,S,N, - & THICK,XTHICK, CAMBR,XCAMBR ) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C--------------------------------------------------------------- -C Calculates max thickness and camber at airfoil points -C -C Note: this routine does not find the maximum camber or -C thickness exactly as it only looks at discrete points -C -C Input: -C N number of points -C X(.) shape coordinate point arrays -C Y(.) -C -C Output: -C THICK max thickness -C CAMBR max camber -C--------------------------------------------------------------- - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT((XTE-XLE)**2 + (YTE-YLE)**2) -C -C---- set unit chord-line vector - DXC = (XTE-XLE) / CHORD - DYC = (YTE-YLE) / CHORD -C - THICK = 0. - XTHICK = 0. - CAMBR = 0. - XCAMBR = 0. -C -C---- go over each point, finding the y-thickness and camber - DO 30 I=1, N - XBAR = (X(I)-XLE)*DXC + (Y(I)-YLE)*DYC - YBAR = (Y(I)-YLE)*DXC - (X(I)-XLE)*DYC -C -C------ set point on the opposite side with the same chord x value - CALL SOPPS(SOPP, S(I), X,XP,Y,YP,S,N, SLE) -cc write(*,*) 'SOPP = ', SOPP - XOPP = SEVAL(SOPP,X,XP,S,N) - YOPP = SEVAL(SOPP,Y,YP,S,N) -C - YBAROP = (YOPP-YLE)*DXC - (XOPP-XLE)*DYC -C - YC = 0.5*(YBAR+YBAROP) - YT = ABS(YBAR-YBAROP) -C - IF(ABS(YC) .GT. ABS(CAMBR)) THEN - CAMBR = YC - XCAMBR = XOPP - ENDIF - IF(ABS(YT) .GT. ABS(THICK)) THEN - THICK = YT - XTHICK = XOPP - ENDIF - 30 CONTINUE -C - RETURN - END ! TCCALC - - - - SUBROUTINE YSYM(X,XP,Y,YP,S,NX,N,ISIDE, XNEW,YNEW) -C--------------------------------------------------------- -C Makes passed-in airfoil symmetric about chord line. -C--------------------------------------------------------- - - DIMENSION X(NX),XP(NX),Y(NX),YP(NX),S(NX) - DIMENSION XNEW(NX), YNEW(NX) -C - SREF = S(N) - S(1) -C - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHSQ = (XTE-XLE)**2 + (YTE-YLE)**2 -C -C---- set unit chord-line vector - DXC = (XTE-XLE) / SQRT(CHSQ) - DYC = (YTE-YLE) / SQRT(CHSQ) -C -C---- find index of node ILE which is just before leading edge point - DO 5 I=2, N - DS = S(I) - S(I-1) - IF(S(I)-SLE .GE. -0.01*DS) GO TO 6 - 5 CONTINUE - 6 CONTINUE - ILE = I-1 -C - DS = S(ILE+1) - S(ILE) - IF(SLE-S(ILE-1) .LT. 0.1*DS) THEN -C------ point is just before LE, we will move it ahead to LE - ILE1 = ILE - 1 - ILE2 = ILE + 1 - ELSE IF(S(ILE+1)-SLE .LT. 0.1*DS) THEN -C------ point is just after LE, we will move it back to LE - ILE1 = ILE - ILE2 = ILE + 2 - ELSE -C------ no point is near LE ... we will add new point - ILE1 = ILE - ILE2 = ILE + 1 - ENDIF -C -C---- set index limits of side which will set symmetric geometry - IF(ISIDE.EQ.1) THEN - IG1 = 1 - IG2 = ILE1 - IGDIR = +1 - ELSE - IG1 = N - IG2 = ILE2 - IGDIR = -1 - ENDIF -C -C---- set new number of points, including LE point - NNEW = 2*(IABS(IG2-IG1) + 1) + 1 - IF(NNEW.GT.NX) STOP 'YSYM: Array overflow on passed arrays.' -C -C---- set symmetric geometry - DO 10 I=IG1, IG2, IGDIR -C -C------ coordinates in chord-line axes - XBAR = (X(I)-XLE)*DXC + (Y(I)-YLE)*DYC - YBAR = (Y(I)-YLE)*DXC - (X(I)-XLE)*DYC -C - I1 = 1 + (I - IG1)*IGDIR - I2 = NNEW - (I - IG1)*IGDIR -C - XNEW(I1) = XLE + XBAR*DXC - YBAR*DYC - XNEW(I2) = XLE + XBAR*DXC + YBAR*DYC -C - YNEW(I1) = YLE + YBAR*DXC + XBAR*DYC - YNEW(I2) = YLE - YBAR*DXC + XBAR*DYC - 10 CONTINUE -C -C---- set new LE point - XNEW(NNEW/2+1) = XLE - YNEW(NNEW/2+1) = YLE -C -C---- set geometry for returning - N = NNEW - DO 20 IG = 1, N - IF(IGDIR.EQ.+1) THEN - I = IG - ELSE - I = N - IG + 1 - ENDIF - X(I) = XNEW(IG) - Y(I) = YNEW(IG) - 20 CONTINUE -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) -C - RETURN - END ! YSYM - - - - SUBROUTINE LERSCL(X,XP,Y,YP,S,N, DOC,RFAC, XNEW,YNEW) -C--------------------------------------------------------- -C Adjusts airfoil to scale LE radius by factor RFAC. -C Blending of new shape is done with decay length DOC. -C--------------------------------------------------------- - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) - DIMENSION XNEW(*), YNEW(*) -C - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT((XTE-XLE)**2 + (YTE-YLE)**2) -C -C---- set unit chord-line vector - DXC = (XTE-XLE) / CHORD - DYC = (YTE-YLE) / CHORD -C - SRFAC = SQRT(ABS(RFAC)) -C -C---- go over each point, changing the y-thickness appropriately - DO 30 I=1, N - XBAR = (X(I)-XLE)*DXC + (Y(I)-YLE)*DYC - YBAR = (Y(I)-YLE)*DXC - (X(I)-XLE)*DYC -C -C------ set point on the opposite side with the same chord x value - CALL SOPPS(SOPP, S(I), X,XP,Y,YP,S,N, SLE) -cc write(*,*) 'SOPP = ', SOPP - - XOPP = SEVAL(SOPP,X,XP,S,N) - YOPP = SEVAL(SOPP,Y,YP,S,N) -C - YBAROP = (YOPP-YLE)*DXC - (XOPP-XLE)*DYC -C -C------ thickness factor tails off exponentially towards trailing edge - XOC = XBAR/CHORD - ARG = MIN( XOC/DOC , 15.0 ) - TFAC = 1.0 - (1.0-SRFAC)*EXP(-ARG) -C -C------ set new chord x,y coordinates by changing thickness locally - YBARCT = 0.5*(YBAR+YBAROP) + TFAC*0.5*(YBAR-YBAROP) -C - XNEW(I) = XLE + XBAR *DXC - YBARCT*DYC - YNEW(I) = YLE + YBARCT*DXC + XBAR *DYC - 30 CONTINUE -C - RETURN - END - - - - SUBROUTINE SSS(SS,S1,S2,DEL,XBF,YBF,X,XP,Y,YP,S,N,ISIDE) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C---------------------------------------------------------------- -C Returns arc length points S1,S2 at flap surface break -C locations. S1 is on fixed airfoil part, S2 is on flap. -C The points are defined according to two cases: -C -C -C If DEL > 0: Surface will be eliminated in S1 < s < S2 -C -C Returns the arc length values S1,S2 of the endpoints -C of the airfoil surface segment which "disappears" as a -C result of the flap deflection. The line segments between -C these enpoints and the flap hinge point (XBF,YBF) have -C an included angle of DEL. DEL is therefore the flap -C deflection which will join up the points at S1,S2. -C SS is an approximate arc length value near S1 and S2. -C It is used as an initial guess for the Newton loop -C for S1 and S2. -C -C -C If DEL = 0: Surface will be created at s = S1 = S2 -C -C If DEL=0, then S1,S2 will cooincide, and will be located -C on the airfoil surface where the segment joining the -C point at S1,S2 and the hinge point is perpendicular to -C the airfoil surface. This will be the point where the -C airfoil surface must be broken to permit a gap to open -C as a result of the flap deflection. -C---------------------------------------------------------------- -C -C---- convergence epsilon - DATA EPS / 1.0E-5 / -C - STOT = ABS( S(N) - S(1) ) -C - SIND = SIN(0.5*ABS(DEL)) -C - SSGN = 1.0 - IF(ISIDE.EQ.1) SSGN = -1.0 -C -C---- initial guesses for S1, S2 - RSQ = (SEVAL(SS,X,XP,S,N)-XBF)**2 + (SEVAL(SS,Y,YP,S,N)-YBF)**2 - S1 = SS - (SIND*SQRT(RSQ) + EPS*STOT)*SSGN - S2 = SS + (SIND*SQRT(RSQ) + EPS*STOT)*SSGN -C -C---- Newton iteration loop - DO 10 ITER=1, 10 - X1 = SEVAL(S1,X,XP,S,N) - X1P = DEVAL(S1,X,XP,S,N) - Y1 = SEVAL(S1,Y,YP,S,N) - Y1P = DEVAL(S1,Y,YP,S,N) -C - X2 = SEVAL(S2,X,XP,S,N) - X2P = DEVAL(S2,X,XP,S,N) - Y2 = SEVAL(S2,Y,YP,S,N) - Y2P = DEVAL(S2,Y,YP,S,N) -C - R1SQ = (X1-XBF)**2 + (Y1-YBF)**2 - R2SQ = (X2-XBF)**2 + (Y2-YBF)**2 - R1 = SQRT(R1SQ) - R2 = SQRT(R2SQ) -C - RRSQ = (X1-X2)**2 + (Y1-Y2)**2 - RR = SQRT(RRSQ) -C - IF(R1.LE.EPS*STOT .OR. R2.LE.EPS*STOT) THEN - S1 = SS - S2 = SS - RETURN - ENDIF -C - R1_S1 = (X1P*(X1-XBF) + Y1P*(Y1-YBF))/R1 - R2_S2 = (X2P*(X2-XBF) + Y2P*(Y2-YBF))/R2 -C - IF(SIND.GT.0.01) THEN -C - IF(RR.EQ.0.0) RETURN -C - RR_S1 = (X1P*(X1-X2) + Y1P*(Y1-Y2))/RR - RR_S2 = -(X2P*(X1-X2) + Y2P*(Y1-Y2))/RR -C -C------- Residual 1: set included angle via dot product - RS1 = ((XBF-X1)*(X2-X1) + (YBF-Y1)*(Y2-Y1))/RR - SIND*R1 - A11 = ((XBF-X1)*( -X1P) + (YBF-Y1)*( -Y1P))/RR - & + (( -X1P)*(X2-X1) + ( -Y1P)*(Y2-Y1))/RR - & - ((XBF-X1)*(X2-X1) + (YBF-Y1)*(Y2-Y1))*RR_S1/RRSQ - & - SIND*R1_S1 - A12 = ((XBF-X1)*(X2P ) + (YBF-Y1)*(Y2P ))/RR - & - ((XBF-X1)*(X2-X1) + (YBF-Y1)*(Y2-Y1))*RR_S2/RRSQ -C -C------- Residual 2: set equal length segments - RS2 = R1 - R2 - A21 = R1_S1 - A22 = - R2_S2 -C - ELSE -C -C------- Residual 1: set included angle via small angle approximation - RS1 = (R1+R2)*SIND + (S1 - S2)*SSGN - A11 = R1_S1 *SIND + SSGN - A12 = R2_S2 *SIND - SSGN -C -C------- Residual 2: set vector sum of line segments beteen the -C- endpoints and flap hinge to be perpendicular to airfoil surface. - X1PP = D2VAL(S1,X,XP,S,N) - Y1PP = D2VAL(S1,Y,YP,S,N) - X2PP = D2VAL(S2,X,XP,S,N) - Y2PP = D2VAL(S2,Y,YP,S,N) -C - XTOT = X1+X2 - 2.0*XBF - YTOT = Y1+Y2 - 2.0*YBF -C - RS2 = XTOT*(X1P+X2P) + YTOT*(Y1P+Y2P) - A21 = X1P*(X1P+X2P) + Y1P*(Y1P+Y2P) + XTOT*X1PP + YTOT*Y1PP - A22 = X2P*(X1P+X2P) + Y2P*(Y1P+Y2P) + XTOT*X2PP + YTOT*Y2PP -C - ENDIF -C - DET = A11*A22 - A12*A21 - DS1 = -(RS1*A22 - A12*RS2) / DET - DS2 = -(A11*RS2 - RS1*A21) / DET -C - DS1 = MIN( DS1 , 0.01*STOT ) - DS1 = MAX( DS1 , -.01*STOT ) - DS2 = MIN( DS2 , 0.01*STOT ) - DS2 = MAX( DS2 , -.01*STOT ) -C - S1 = S1 + DS1 - S2 = S2 + DS2 - IF(ABS(DS1)+ABS(DS2) .LT. EPS*STOT ) GO TO 11 - 10 CONTINUE - WRITE(*,*) 'SSS: failed to converge subtending angle points' - S1 = SS - S2 = SS -C - 11 CONTINUE -C -C---- make sure points are identical if included angle is zero. - IF(DEL.EQ.0.0) THEN - S1 = 0.5*(S1+S2) - S2 = S1 - ENDIF -C - RETURN - END - - - SUBROUTINE CLIS(X,XP,Y,YP,S,N) - DIMENSION X(*), XP(*), Y(*), YP(*), S(*) -C------------------------------------------------------------------- -C Displays curvatures at panel nodes. -C------------------------------------------------------------------- - PI = 4.0*ATAN(1.0) -C - CMAX = 0.0 - IMAX = 1 -C -C---- go over each point, calculating curvature - WRITE(*,1050) - DO 30 I=1, N - IF(I.EQ.1) THEN - ARAD = ATAN2(-YP(I),-XP(I)) - ELSE - ARAD = ATANC(-YP(I),-XP(I),ARAD) - ENDIF - ADEG = ARAD * 180.0/PI - CV = CURV(S(I),X,XP,Y,YP,S,N) - WRITE(*,1100) I, X(I), Y(I), S(I), ADEG, CV - IF(ABS(CV) .GT. ABS(CMAX)) THEN - CMAX = CV - IMAX = I - ENDIF - 30 CONTINUE -C - WRITE(*,1200) CMAX, IMAX, X(IMAX), Y(IMAX), S(IMAX) -C - RETURN -C - 1050 FORMAT(/' i x y s theta curv') -CCC 120 0.2134 -0.0234 -0.0234 180.024 2025.322 - 1100 FORMAT(1X,I3, 3F9.4, F11.3, F12.3) - 1200 FORMAT(/' Maximum curvature =', F14.3, - & ' at i,x,y,s = ', I3, 3F9.4 ) - END ! CLIS - - - - - - - SUBROUTINE CANG(X,Y,N,IPRINT, IMAX,AMAX) - DIMENSION X(*), Y(*) -C------------------------------------------------------------------- -C IPRINT=2: Displays all panel node corner angles -C IPRINT=1: Displays max panel node corner angle -C IPRINT=0: No display... just returns values -C------------------------------------------------------------------- -C - AMAX = 0.0 - IMAX = 1 -C -C---- go over each point, calculating corner angle - IF(IPRINT.EQ.2) WRITE(*,1050) - DO 30 I=2, N-1 - DX1 = X(I) - X(I-1) - DY1 = Y(I) - Y(I-1) - DX2 = X(I) - X(I+1) - DY2 = Y(I) - Y(I+1) -C -C------ allow for doubled points - IF(DX1.EQ.0.0 .AND. DY1.EQ.0.0) THEN - DX1 = X(I) - X(I-2) - DY1 = Y(I) - Y(I-2) - ENDIF - IF(DX2.EQ.0.0 .AND. DY2.EQ.0.0) THEN - DX2 = X(I) - X(I+2) - DY2 = Y(I) - Y(I+2) - ENDIF -C - CROSSP = (DX2*DY1 - DY2*DX1) - & / SQRT((DX1**2 + DY1**2) * (DX2**2 + DY2**2)) - ANGL = ASIN(CROSSP)*(180.0/3.1415926) - IF(IPRINT.EQ.2) WRITE(*,1100) I, X(I), Y(I), ANGL - IF(ABS(ANGL) .GT. ABS(AMAX)) THEN - AMAX = ANGL - IMAX = I - ENDIF - 30 CONTINUE -C - IF(IPRINT.GE.1) WRITE(*,1200) AMAX, IMAX, X(IMAX), Y(IMAX) -C - RETURN -C - 1050 FORMAT(/' i x y angle') -CCC 120 0.2134 -0.0234 25.322 - 1100 FORMAT(1X,I3, 2F9.4, F9.3) - 1200 FORMAT(/' Maximum panel corner angle =', F7.3, - & ' at i,x,y = ', I3, 2F9.4 ) - END ! CANG - - - - SUBROUTINE INTER(X0,XP0,Y0,YP0,S0,N0,SLE0, - & X1,XP1,Y1,YP1,S1,N1,SLE1, - & X,Y,N,FRAC) -C ..................................................................... -C -C Interpolates two source airfoil shapes into an "intermediate" shape. -C -C Procedure: -C The interpolated x coordinate at a given normalized spline -C parameter value is a weighted average of the two source -C x coordinates at the same normalized spline parameter value. -C Ditto for the y coordinates. The normalized spline parameter -C runs from 0 at the leading edge to 1 at the trailing edge on -C each surface. -C ..................................................................... -C - REAL X0(N0),Y0(N0),XP0(N0),YP0(N0),S0(N0) - REAL X1(N1),Y1(N1),XP1(N1),YP1(N1),S1(N1) - REAL X(N),Y(N) -C -C---- number of points in interpolated airfoil is the same as in airfoil 0 - N = N0 -C -C---- interpolation weighting fractions - F0 = 1.0 - FRAC - F1 = FRAC -C -C---- top side spline parameter increments - TOPS0 = S0(1) - SLE0 - TOPS1 = S1(1) - SLE1 -C -C---- bottom side spline parameter increments - BOTS0 = S0(N0) - SLE0 - BOTS1 = S1(N1) - SLE1 -C - DO 50 I=1, N -C -C------ normalized spline parameter is taken from airfoil 0 value - IF(S0(I).LT.SLE0) SN = (S0(I) - SLE0) / TOPS0 ! top side - IF(S0(I).GE.SLE0) SN = (S0(I) - SLE0) / BOTS0 ! bottom side -C -C------ set actual spline parameters - ST0 = S0(I) - IF(ST0.LT.SLE0) ST1 = SLE1 + TOPS1 * SN - IF(ST0.GE.SLE0) ST1 = SLE1 + BOTS1 * SN -C -C------ set interpolated x,y coordinates - X(I) = F0*SEVAL(ST0,X0,XP0,S0,N0) + F1*SEVAL(ST1,X1,XP1,S1,N1) - Y(I) = F0*SEVAL(ST0,Y0,YP0,S0,N0) + F1*SEVAL(ST1,Y1,YP1,S1,N1) -C - 50 CONTINUE -C - RETURN - END ! INTER - - - - SUBROUTINE IJSECT(N,X,Y, PEX, - & AREA, SLEN, - & XC, XMIN, XMAX, XEXINT, - & YC, YMIN, YMAX, YEXINT, - & AIXX, AIXXT, - & AIYY, AIYYT, - & AJ , AJT ) - DIMENSION X(*), Y(*) -C - XMIN = X(1) - XMAX = X(1) - YMIN = Y(1) - YMAX = Y(1) -C - DX = X(1) - X(N) - DY = Y(1) - Y(N) - DS = SQRT(DX*DX + DY*DY) - XAVG = 0.5*(X(1) + X(N)) - YAVG = 0.5*(Y(1) + Y(N)) -C - X_DY = DY * XAVG - XX_DY = DY * XAVG**2 - XXX_DY = DY * XAVG**3 - X_DS = DS * XAVG - XX_DS = DS * XAVG**2 -C - Y_DX = DX * YAVG - YY_DX = DX * YAVG**2 - YYY_DX = DX * YAVG**3 - Y_DS = DS * YAVG - YY_DS = DS * YAVG**2 -C - C_DS = DS -C - DO 10 I = 2, N - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) - DS = SQRT(DX*DX + DY*DY) - XAVG = 0.5*(X(I) + X(I-1)) - YAVG = 0.5*(Y(I) + Y(I-1)) -C - X_DY = X_DY + DY * XAVG - XX_DY = XX_DY + DY * XAVG**2 - XXX_DY = XXX_DY + DY * XAVG**3 - X_DS = X_DS + DS * XAVG - XX_DS = XX_DS + DS * XAVG**2 -C - Y_DX = Y_DX + DX * YAVG - YY_DX = YY_DX + DX * YAVG**2 - YYY_DX = YYY_DX + DX * YAVG**3 - Y_DS = Y_DS + DS * YAVG - YY_DS = YY_DS + DS * YAVG**2 -C - C_DS = C_DS + DS -C - XMIN = MIN(XMIN,X(I)) - XMAX = MAX(XMAX,X(I)) - YMIN = MIN(YMIN,Y(I)) - YMAX = MAX(YMAX,Y(I)) - 10 CONTINUE -C - AREA = -Y_DX - SLEN = C_DS -C - IF(AREA.EQ.0.0) RETURN -C - XC = XX_DY / (2.0*X_DY) - AIYY = XXX_DY/3.0 - XX_DY*XC + X_DY*XC**2 - AIYYT = XX_DS - X_DS*XC*2.0 + C_DS*XC**2 -C - YC = YY_DX / (2.0*Y_DX) - AIXX = -YYY_DX/3.0 + YY_DX*YC - Y_DX*YC**2 - AIXXT = YY_DS - Y_DS*YC*2.0 + C_DS*YC**2 -C -C - SINT = 0. - XINT = 0. - YINT = 0. -C - DO 20 I=2, N - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) - DS = SQRT(DX*DX + DY*DY) - XAVG = 0.5*(X(I) + X(I-1)) - XC - YAVG = 0.5*(Y(I) + Y(I-1)) - YC -C - SINT = SINT + DS -cc XINT = XINT + DS * ABS(XAVG)**PEX -cc YINT = YINT + DS * ABS(YAVG)**PEX - 20 CONTINUE -C - DO I=1, N-1 - IF(X(I+1) .GE. X(I)) GO TO 30 - ENDDO - IMID = N/2 - 30 IMID = I -C - AJ = 0.0 - DO I = 2, IMID - XAVG = 0.5*(X(I) + X(I-1)) - YAVG = 0.5*(Y(I) + Y(I-1)) - DX = X(I-1) - X(I) -C - IF(XAVG.GT.X(N)) THEN - YOPP = Y(N) - GO TO 41 - ENDIF - IF(XAVG.LE.X(IMID)) THEN - YOPP = Y(IMID) - GO TO 41 - ENDIF -C - DO J = N, IMID, -1 - IF(XAVG.GT.X(J-1) .AND. XAVG.LE.X(J)) THEN - FRAC = (XAVG - X(J-1)) - & / (X(J) - X(J-1)) - YOPP = Y(J-1) + (Y(J)-Y(J-1))*FRAC - GO TO 41 - ENDIF - ENDDO - 41 CONTINUE -C - AJ = AJ + ABS(YAVG-YOPP)**3 * DX / 3.0 - ENDDO -C - AJT = 4.0*AREA**2/SLEN -C -cc XEXINT = (XINT/SINT)**(1.0/PEX) -cc YEXINT = (YINT/SINT)**(1.0/PEX) -C - RETURN - END ! IJSECT - - - SUBROUTINE AREFINE(X,Y,S,XS,YS,N, ATOL, - & NDIM,NNEW,XNEW,YNEW,X1,X2) -C------------------------------------------------------------- -C Adds points to a x,y spline contour wherever -C the angle between adjacent segments at a node -C exceeds a specified threshold. The points are -C added 1/3 of a segment before and after the -C offending node. -C -C The point adding is done only within X1..X2. -C -C Intended for doubling the number of points -C of Eppler and Selig airfoils so that they are -C suitable for clean interpolation using Xfoil's -C arc-length spline routines. -C------------------------------------------------------ - REAL X(*), Y(*), S(*), XS(*), YS(*) - REAL XNEW(NDIM), YNEW(NDIM) - LOGICAL LREF -C - ATOLR = ATOL * 3.14159/180.0 -C - K = 1 - XNEW(K) = X(1) - YNEW(K) = Y(1) -C - DO 10 I = 2, N-1 - IM = I-1 - IP = I+1 -C - DXM = X(I) - X(I-1) - DYM = Y(I) - Y(I-1) - DXP = X(I+1) - X(I) - DYP = Y(I+1) - Y(I) -C - CRSP = DXM*DYP - DYM*DXP - DOTP = DXM*DXP + DYM*DYP - IF(CRSP.EQ.0.0 .AND. DOTP.EQ.0.0) THEN - ASEG = 0.0 - ELSE - ASEG = ATAN2( CRSP , DOTP ) - ENDIF -C - LREF = ABS(ASEG) .GT. ATOLR -C - IF(LREF) THEN -C------- add extra point just before this node - SMID = S(I) - 0.3333*(S(I)-S(I-1)) - XK = SEVAL(SMID,X,XS,S,N) - YK = SEVAL(SMID,Y,YS,S,N) - IF(XK.GE.X1 .AND. XK.LE.X2) THEN - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = XK - YNEW(K) = YK - ENDIF - ENDIF -C -C------ add the node itself - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = X(I) - YNEW(K) = Y(I) -C - IF(LREF) THEN -C------- add extra point just after this node - SMID = S(I) + 0.3333*(S(I+1)-S(I)) - XK = SEVAL(SMID,X,XS,S,N) - YK = SEVAL(SMID,Y,YS,S,N) - IF(XK.GE.X1 .AND. XK.LE.X2) THEN - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = XK - YNEW(K) = YK - ENDIF - ENDIF - 10 CONTINUE -C - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = X(N) - YNEW(K) = Y(N) -C - NNEW = K - RETURN -C - 90 CONTINUE - WRITE(*,*) 'SDOUBLE: Arrays will overflow. No action taken.' - NNEW = 0 - RETURN -C - END ! AREFINE - - - SUBROUTINE SCHECK(X,Y,N, STOL, LCHANGE) -C------------------------------------------------------------- -C Removes points from an x,y spline contour wherever -C the size of a segment between nodes falls below a -C a specified threshold of the adjacent segments. -C The two node points defining the short segment are -C replaced with a single node at their midpoint. -C Note that the number of nodes may be altered by -C this routine. -C -C Intended for eliminating odd "micro" panels -C that occur when blending a flap to a foil. -C If LCHANGE is set on return the airfoil definition -C has been changed and resplining should be done. -C -C The recommended value for STOL is 0.05 (meaning -C segments less than 5% of the length of either adjoining -C segment are removed). 4/24/01 HHY -C------------------------------------------------------ - REAL X(*), Y(*) - LOGICAL LCHANGE -C - LCHANGE = .FALSE. -C--- Check STOL for sanity - IF(STOL.GT.0.3) THEN - WRITE(*,*) 'SCHECK: Bad value for small panels (STOL > 0.3)' - RETURN - ENDIF -C - 10 DO 20 I = 2, N-2 - IM1 = I-1 - IP1 = I+1 - IP2 = I+2 -C - DXM1 = X(I) - X(I-1) - DYM1 = Y(I) - Y(I-1) - DSM1 = SQRT(DXM1*DXM1 + DYM1*DYM1) -C - DXP1 = X(I+1) - X(I) - DYP1 = Y(I+1) - Y(I) - DSP1 = SQRT(DXP1*DXP1 + DYP1*DYP1) -C - DXP2 = X(I+2) - X(I+1) - DYP2 = Y(I+2) - Y(I+1) - DSP2 = SQRT(DXP2*DXP2 + DYP2*DYP2) -C -C------- Don't mess with doubled points (slope breaks) - IF(DSP1.EQ.0.0) GO TO 20 -C - IF(DSP1.LT.STOL*DSM1 .OR. DSP1.LT.STOL*DSP2) THEN -C------- Replace node I with average of I and I+1 - X(I) = 0.5*(X(I)+X(I+1)) - Y(I) = 0.5*(Y(I)+Y(I+1)) -C------- Remove node I+1 - DO L = I+1, N - X(L) = X(L+1) - Y(L) = Y(L+1) - END DO - N = N - 1 - LCHANGE = .TRUE. - WRITE(*,*) 'SCHECK segment removed at ',I - GO TO 10 - ENDIF -C - 20 CONTINUE -C - RETURN - END ! SCHECK - - - - - - SUBROUTINE BENDUMP -c REAL X(*), Y(*) - INCLUDE 'XFOIL.INC' -C - PEX = 16.0 - CALL IJSECT(N,X,Y, PEX, - & AREA, SLEN, - & XC, XMIN, XMAX, XEXINT, - & YC, YMIN, YMAX, YEXINT, - & AIXX, AIXXT, - & AIYY, AIYYT, - & AJ , AJT ) -C -c WRITE(*,*) -c WRITE(*,1200) 'Area =', AREA -c WRITE(*,1200) 'Slen =', SLEN -c WRITE(*,*) -c WRITE(*,1200) 'X-bending parameters:' -c WRITE(*,1200) ' centroid Xc =', XC -c WRITE(*,1200) ' max X-Xc =', XMAX-XC -c WRITE(*,1200) ' min X-Xc =', XMIN-XC -c WRITE(*,1200) ' solid Iyy =', AIYY -c WRITE(*,1200) ' skin Iyy/t =', AIYYT - XBAR = MAX( ABS(XMAX-XC) , ABS(XMIN-XC) ) -c WRITE(*,1200) ' solid Iyy/(X-Xc)=', AIYY /XBAR -c WRITE(*,1200) ' skin Iyy/t(X-Xc)=', AIYYT/XBAR -C -c WRITE(*,*) -c WRITE(*,1200) 'Y-bending parameters:' -c WRITE(*,1200) ' centroid Yc =', YC -c WRITE(*,1200) ' max Y-Yc =', YMAX-YC -c WRITE(*,1200) ' min Y-Yc =', YMIN-YC -c WRITE(*,1200) ' solid Ixx =', AIXX -c WRITE(*,1200) ' skin Ixx/t =', AIXXT - YBAR = MAX( ABS(YMAX-YC) , ABS(YMIN-YC) ) -c WRITE(*,1200) ' solid Ixx/(Y-Yc)=', AIXX /YBAR -c WRITE(*,1200) ' skin Ixx/t(Y-Yc)=', AIXXT/YBAR -C -c WRITE(*,*) -c WRITE(*,1200) ' power-avg X-Xc =', XEXINT -c WRITE(*,1200) ' power-avg Y-Yc =', YEXINT -C -c WRITE(*,*) -c WRITE(*,1200) ' solid J =', AJ -c WRITE(*,1200) ' skin J/t =', AJT - RETURN -C -c 1200 FORMAT(1X,A,G14.6) - END ! BENDUMP - - - - - - diff --git a/deps/src/xfoil/xoper.f b/deps/src/xfoil/xoper.f deleted file mode 100644 index 5b89559..0000000 --- a/deps/src/xfoil/xoper.f +++ /dev/null @@ -1,978 +0,0 @@ -C*********************************************************************** -C Module: xoper.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C -C - SUBROUTINE OPER() - INCLUDE 'XFOIL.INC' - CHARACTER*1 ANS - CHARACTER*4 COMAND, COMOLD - LOGICAL LRECALC, LCPX, LCONV -C - CHARACTER*128 COMARG, ARGOLD, LINE -C - PARAMETER (NPRX = 101) - DIMENSION XPR(NPRX), YPR(NPRX) -C - DIMENSION NBLP(NPX) - DIMENSION IPPAI(NPX), NAPOLT(NPX) -C - DIMENSION IINPUT(20) - DIMENSION RINPUT(20) - LOGICAL ERROR -C -C---- retain last-command info if OPER is exited and then re-entered - SAVE COMOLD, ARGOLD -C -C---- logical units for polar save file, polar dump file - LUPLR = 9 - LUPLX = 11 -C - COMAND = '****' - COMARG = ' ' - LRECALC = .FALSE. - LCPX = .FALSE. - LPLOT = .FALSE. -C - IF(N.EQ.0) THEN - WRITE(*,*) - WRITE(*,*) '*** No airfoil available ***' - RETURN - ENDIF -C - IF(IPACT.NE.0) THEN - WRITE(*,5000) IPACT - 5000 FORMAT(/' Polar', I3,' is active') - ENDIF -C -ccc 500 CONTINUE - COMOLD = COMAND - ARGOLD = COMARG -C -C==================================================== -C****************************************************** -C START OF DB COMMAND STRUCTURE -C -C Main purpose is to calculate Cl/Cd either -C through inviscid or viscous calculation. -C -c LVISC = .NOT. LVISC - LVISC = .TRUE. -C -c IF(LVISC) THEN -C IF(NINPUT.GE.1) THEN -C REINF1 = RINPUT(1) -C ELSE IF(REINF1 .EQ. 0.0) THEN -C CALL ASKR('Enter Reynolds number^',REINF1) -C ENDIF -C -C****************************************************** -C REINF1 = 100000 -C WRITE(*,*) REINF1 -C STOP - -C*****CHANGE REYNOLDS NUMBER*************************** -C ITMAX = 75 -C CALL MRSHOW(.TRUE.,.TRUE.) -c ENDIF - LCONV = .FALSE. - IF(.NOT.LRECALC) THEN -C------- set inviscid solution only if point is not being recalculated -C IF(NINPUT.GE.1) THEN -C ADEG = RINPUT(1) -C ELSE -C ADEG = ALFA/DTOR -C CALL ASKR('Enter angle of attack (deg)^',ADEG) -C ENDIF - -C ADEG = 0.0 SET IN XFOIL.F NOW - LALFA = .TRUE. - ALFA = DTOR*ADEG - QINF = 1.0 - - CALL SPECAL - - IF(ABS(ALFA-AWAKE) .GT. 1.0E-5) LWAKE = .FALSE. - IF(ABS(ALFA-AVISC) .GT. 1.0E-5) LVCONV = .FALSE. - IF(ABS(MINF-MVISC) .GT. 1.0E-5) LVCONV = .FALSE. - ENDIF -C - IF(LVISC) CALL VISCAL(ITMAX) -C CALL CPX - CALL FCPMIN - -C -C IF(LVISC .AND. LPACC .AND. LVCONV) THEN -C CALL PLRADD(LUPLR,IPACT) -C CALL PLXADD(LUPLX,IPACT) -C ENDIF -C -C IF(LVISC .AND. .NOT.LPACC .AND. .NOT.LVCONV) THEN -C WRITE(*,*) 'Type "!" to continue iterating' -C ENDIF - - -C call cpcalc(N+NW,QVIS,QINF,MINF,CPV) - call cdcalc -C CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF,XCMREF,YCMREF, -C & CL,CM,CDP, CL_ALF,CL_MSQ) - - RETURN -C - END ! OPER - - SUBROUTINE FCPMIN -C------------------------------------------------ -C Finds minimum Cp on dist for cavitation work -C------------------------------------------------ - INCLUDE 'XFOIL.INC' -C - XCPMNI = X(1) - XCPMNV = X(1) - CPMNI = CPI(1) - CPMNV = CPV(1) -C - DO I = 2, N + NW - IF(CPI(I) .LT. CPMNI) THEN - XCPMNI = X(I) - CPMNI = CPI(I) - ENDIF - IF(CPV(I) .LT. CPMNV) THEN - XCPMNV = X(I) - CPMNV = CPV(I) - ENDIF - ENDDO -C - - IF(LVISC)THEN - CPMN = CPMNV - ELSE - CPMN = CPMNI -C - CPMNV = CPMNI - XCPMNV = XCPMNI - ENDIF -C - RETURN - END ! FCPMIN - - - - SUBROUTINE MRSHOW(LM,LR) - INCLUDE 'XFOIL.INC' - LOGICAL LM, LR -C - IF(LM .OR. LR) WRITE(*,*) -C - IF(LM) THEN - IF(MATYP.EQ.1) WRITE(*,1100) MINF1 - IF(MATYP.EQ.2) WRITE(*,1100) MINF1, ' / sqrt(CL)' - IF(MATYP.EQ.3) WRITE(*,1100) MINF1, ' / CL' - ENDIF -C - IF(LR) THEN - IF(RETYP.EQ.1) WRITE(*,1200) INT(REINF1) - IF(RETYP.EQ.2) WRITE(*,1200) INT(REINF1), ' / sqrt(CL)' - IF(RETYP.EQ.3) WRITE(*,1200) INT(REINF1), ' / CL' - ENDIF -C - RETURN -C - 1100 FORMAT(1X,'M =' , F10.4, A) - 1200 FORMAT(1X,'Re =' , I10 , A) - END ! MRSHOW - - - - SUBROUTINE NAMMOD(NAME,KDEL,KMOD0) - CHARACTER*(*) NAME -C------------------------------------------- -C Requests new modified NAME with -C version number in brackets, e.g. -C NACA 0012 [5] -C -C If bracketed index exists in NAME, -C it is incremented by KDEL. -C If no bracketed index exists, it -C is added with initial value KMOD0, -C unless KMOD0 is negative in which -C case nothing is added. -C------------------------------------------- - CHARACTER*48 NAMDEF -C - CALL STRIP(NAME,NNAME) - KBRACK1 = INDEX(NAME,'[') - KBRACK2 = INDEX(NAME,']') -C - NAMDEF = NAME(1:NNAME) -C - IF(KBRACK1.NE.0 .AND. - & KBRACK2.NE.0 .AND. KBRACK2-KBRACK1.GT.1) THEN -C----- brackets exist... get number, (go get user's input on READ error) - READ(NAME(KBRACK1+1:KBRACK2-1),*,ERR=40) KMOD - KMOD = IABS(KMOD) - KMODP = MOD( KMOD+KDEL , 100 ) - IF(KBRACK1.GE.2) THEN - NAME = NAME(1:KBRACK1-1) - ELSE - NAME = ' ' - ENDIF - CALL STRIP(NAME,NNAME) - ELSEIF(KMOD0.GT.0) THEN - KMODP = MOD( KMOD0 , 100 ) - ELSE - KMODP = 0 - ENDIF -C - IF (KMODP.GE.10) THEN - NAMDEF = NAME(1:NNAME) // ' [ ]' - WRITE(NAMDEF(NNAME+3:NNAME+4),1020) KMODP - 1020 FORMAT(I2) - ELSEIF(KMODP.GE. 1) THEN - NAMDEF = NAME(1:NNAME) // ' [ ]' - WRITE(NAMDEF(NNAME+3:NNAME+3),1025) KMODP - 1025 FORMAT(I1) - ENDIF -C - 40 WRITE(*,1040) NAMDEF - 1040 FORMAT(/' Enter airfoil name or for default: ',A) - READ(*,1000) NAME - 1000 FORMAT(A) - IF(NAME .EQ. ' ') NAME = NAMDEF -C - RETURN - END ! NAMMOD - - - - SUBROUTINE BLDUMP(DIMOUT,SOUT,XOUT,YOUT, - & UEOUT,DSOUT,THOUT,CFOUT) - INCLUDE 'XFOIL.INC' - INTEGER, INTENT(OUT) :: DIMOUT - REAL, DIMENSION(IZX), INTENT(OUT) :: SOUT - REAL, DIMENSION(IZX), INTENT(OUT) :: XOUT - REAL, DIMENSION(IZX), INTENT(OUT) :: YOUT - REAL, DIMENSION(IZX), INTENT(OUT) :: UEOUT - REAL, DIMENSION(IZX), INTENT(OUT) :: DSOUT - REAL, DIMENSION(IZX), INTENT(OUT) :: THOUT - REAL, DIMENSION(IZX), INTENT(OUT) :: CFOUT -C - CALL COMSET - DO 10 I=1, N - IS = 1 - IF(GAM(I) .LT. 0.0) IS = 2 -C - IF(LIPAN .AND. LVISC) THEN - IF(IS.EQ.1) THEN - IBL = IBLTE(IS) - I + 1 - ELSE - IBL = IBLTE(IS) + I - N - ENDIF - DS = DSTR(IBL,IS) - TH = THET(IBL,IS) - CF = TAU(IBL,IS)/(0.5*QINF**2) - ELSE - DS = 0. - TH = 0. - CF = 0. - ENDIF - UE = (GAM(I)/QINF)*(1.0-TKLAM) / (1.0 - TKLAM*(GAM(I)/QINF)**2) -C - SOUT(I) = S(I) - XOUT(I) = X(I) - YOUT(I) = Y(I) - UEOUT(I) = UE - DSOUT(I) = DS - THOUT(I) = TH - CFOUT(I) = CF - 10 CONTINUE -C - IF(LWAKE) THEN - IS = 2 - DO 20 I=N+1, N+NW - IBL = IBLTE(IS) + I - N - DS = DSTR(IBL,IS) - TH = THET(IBL,IS) - CF = 0. - UI = UEDG(IBL,IS) - UE = (UI/QINF)*(1.0-TKLAM) / (1.0 - TKLAM*(UI/QINF)**2) -C - SOUT(I) = S(I) - XOUT(I) = X(I) - YOUT(I) = Y(I) - UEOUT(I) = UE - DSOUT(I) = DS - THOUT(I) = TH - CFOUT(I) = CF - 20 CONTINUE - ENDIF -C - DIMOUT = N+NW -C - RETURN - END ! BLDUMP - - - - SUBROUTINE CPDUMP(FNAME1) - INCLUDE 'XFOIL.INC' - CHARACTER*(*) FNAME1 -C - CHARACTER*80 FILDEF -C - 1000 FORMAT(A) -C - IF(FNAME1(1:1).NE.' ') THEN - FNAME = FNAME1 - ELSE -C----- no argument... get it somehow - IF(NPREFIX.GT.0) THEN -C------ offer default using existing prefix - FILDEF = PREFIX(1:NPREFIX) // '.cp' - WRITE(*,1100) FILDEF - 1100 FORMAT(/' Enter filename: ', A) - READ(*,1000) FNAME - CALL STRIP(FNAME,NFN) - IF(NFN.EQ.0) FNAME = FILDEF - ELSE -C------ nothing available... just ask for filename - CALL ASKS('Enter filename^',FNAME) - ENDIF - ENDIF -C -C - LU = 19 - OPEN(LU,FILE=FNAME,STATUS='UNKNOWN') - REWIND(LU) -C - WRITE(LU,1000) - & '# x Cp ' -C 0.23451 0.23451 -C - CALL COMSET -C - BETA = SQRT(1.0 - MINF**2) - BFAC = 0.5*MINF**2 / (1.0 + BETA) -C - DO 10 I=1, N - CPINC = 1.0 - (GAM(I)/QINF)**2 - DEN = BETA + BFAC*CPINC - CPCOM = CPINC / DEN -C - WRITE(LU,8500) X(I), CPCOM - 8500 FORMAT(1X,2F9.5) - 10 CONTINUE -C - CLOSE(LU) - RETURN - END ! CPDUMP - - - - SUBROUTINE MHINGE -C---------------------------------------------------- -C Calculates the hinge moment of the flap about -C (XOF,YOF) by integrating surface pressures. -C---------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - IF(.NOT.LFLAP) THEN -C - CALL GETXYF(X,XP,Y,YP,S,N, TOPS,BOTS,XOF,YOF) - LFLAP = .TRUE. -C - ELSE -C -C------ find top and bottom y at hinge x location - TOPS = XOF - BOTS = S(N) - XOF - CALL SINVRT(TOPS,XOF,X,XP,S,N) - CALL SINVRT(BOTS,XOF,X,XP,S,N) -C - ENDIF -C - TOPX = SEVAL(TOPS,X,XP,S,N) - TOPY = SEVAL(TOPS,Y,YP,S,N) - BOTX = SEVAL(BOTS,X,XP,S,N) - BOTY = SEVAL(BOTS,Y,YP,S,N) -C -C - HMOM = 0. - HFX = 0. - HFY = 0. -C -C---- integrate pressures on top and bottom sides of flap - DO 20 I=2, N - IF(S(I-1).GE.TOPS .AND. S(I).LE.BOTS) GO TO 20 -C - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) - XMID = 0.5*(X(I)+X(I-1)) - XOF - YMID = 0.5*(Y(I)+Y(I-1)) - YOF - IF(LVISC) THEN - PMID = 0.5*(CPV(I) + CPV(I-1)) - ELSE - PMID = 0.5*(CPI(I) + CPI(I-1)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX - 20 CONTINUE -C -C---- find S(I)..S(I-1) interval containing s=TOPS - DO I=2, N - IF(S(I).GT.TOPS) GO TO 31 - ENDDO -C - 31 CONTINUE -C---- add on top surface chunk TOPS..S(I-1), missed in the DO 20 loop. - DX = TOPX - X(I-1) - DY = TOPY - Y(I-1) - XMID = 0.5*(TOPX+X(I-1)) - XOF - YMID = 0.5*(TOPY+Y(I-1)) - YOF - IF(S(I) .NE. S(I-1)) THEN - FRAC = (TOPS-S(I-1))/(S(I)-S(I-1)) - ELSE - FRAC = 0. - ENDIF - IF(LVISC) THEN - TOPP = CPV(I)*FRAC + CPV(I-1)*(1.0-FRAC) - PMID = 0.5*(TOPP+CPV(I-1)) - ELSE - TOPP = CPI(I)*FRAC + CPI(I-1)*(1.0-FRAC) - PMID = 0.5*(TOPP+CPI(I-1)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- add on inside flap surface contribution from hinge to top surface - DX = XOF - TOPX - DY = YOF - TOPY - XMID = 0.5*(TOPX+XOF) - XOF - YMID = 0.5*(TOPY+YOF) - YOF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- find S(I)..S(I-1) interval containing s=BOTS - DO I=N, 2, -1 - IF(S(I-1).LT.BOTS) GO TO 41 - ENDDO -C - 41 CONTINUE -C---- add on bottom surface chunk BOTS..S(I), missed in the DO 20 loop. - DX = X(I) - BOTX - DY = Y(I) - BOTY - XMID = 0.5*(BOTX+X(I)) - XOF - YMID = 0.5*(BOTY+Y(I)) - YOF - IF(S(I) .NE. S(I-1)) THEN - FRAC = (BOTS-S(I-1))/(S(I)-S(I-1)) - ELSE - FRAC = 0. - ENDIF - IF(LVISC) THEN - BOTP = CPV(I)*FRAC + CPV(I-1)*(1.0-FRAC) - PMID = 0.5*(BOTP+CPV(I)) - ELSE - BOTP = CPI(I)*FRAC + CPI(I-1)*(1.0-FRAC) - PMID = 0.5*(BOTP+CPI(I)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- add on inside flap surface contribution from hinge to bottom surface - DX = BOTX - XOF - DY = BOTY - YOF - XMID = 0.5*(BOTX+XOF) - XOF - YMID = 0.5*(BOTY+YOF) - YOF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- add on TE base thickness contribution - DX = X(1) - X(N) - DY = Y(1) - Y(N) - XMID = 0.5*(X(1)+X(N)) - XOF - YMID = 0.5*(Y(1)+Y(N)) - YOF - IF(LVISC) THEN - PMID = 0.5*(CPV(1)+CPV(N)) - ELSE - PMID = 0.5*(CPI(1)+CPI(N)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C - RETURN - END ! MHINGE - - - SUBROUTINE VPAR -C--------------------------------------------- -C Viscous parameter change menu routine. -C--------------------------------------------- - INCLUDE 'XFOIL.INC' - CHARACTER*4 COMAND - CHARACTER*128 COMARG -C - DIMENSION IINPUT(20) - DIMENSION RINPUT(20) - LOGICAL ERROR -C -C - TURB = 100.0 * EXP( -(ACRIT + 8.43)/2.4 ) - WRITE(*,1200) XSTRIP(1), XSTRIP(2), ACRIT, TURB, VACCEL -C - 500 CONTINUE - CALL ASKC('..VPAR^',COMAND,COMARG) -C - DO I=1, 20 - IINPUT(I) = 0 - RINPUT(I) = 0.0 - ENDDO - NINPUT = 20 - CALL GETINT(COMARG,IINPUT,NINPUT,ERROR) - NINPUT = 20 - CALL GETFLT(COMARG,RINPUT,NINPUT,ERROR) -C - IF(COMAND.EQ.' ') RETURN - IF(COMAND.EQ.'? ') GO TO 5 - IF(COMAND.EQ.'SHOW') GO TO 10 - IF(COMAND.EQ.'XTR ') GO TO 40 - IF(COMAND.EQ.'N ') GO TO 50 - IF(COMAND.EQ.'VACC') GO TO 70 - IF(COMAND.EQ.'INIT') GO TO 80 -C - WRITE(*,1000) COMAND - GO TO 500 -C - 5 WRITE(*,1050) - GO TO 500 -C - 10 TURB = 100.0 * EXP( -(ACRIT + 8.43)/2.4 ) - WRITE(*,1200) XSTRIP(1), XSTRIP(2), ACRIT, TURB, VACCEL - GO TO 500 -C - 40 IF(NINPUT.GE.2) THEN - XSTRIP(1) = RINPUT(1) - XSTRIP(2) = RINPUT(2) - ELSE - CALL ASKR('Enter top side Xtrip/c^',XSTRIP(1)) - CALL ASKR('Enter bottom side Xtrip/c^',XSTRIP(2)) - ENDIF - LVCONV = .FALSE. - GO TO 500 -C - 50 IF(NINPUT.GE.1) THEN - ACRIT = RINPUT(1) - ELSE - CALL ASKR('Enter critical amplification ratio^',ACRIT) - ENDIF - LVCONV = .FALSE. - GO TO 500 -C - 70 IF(NINPUT.GE.1) THEN - VACCEL = RINPUT(1) - ELSE - CALL ASKR('Enter viscous acceleration parameter^',VACCEL) - ENDIF - GO TO 500 -C - 80 LBLINI = .NOT.LBLINI - IF(.NOT.LBLINI) WRITE(*,*) 'BLs will be initialized on next point' - IF( LBLINI) WRITE(*,*) 'BLs are assumed to be initialized' - IF(.NOT.LBLINI) LIPAN = .FALSE. - GO TO 500 -C -C................................................................... -C - 1000 FORMAT(1X,A4,' command not recognized. Type a "?" for list') - 1050 FORMAT( - & /' Return to OPER menu' - & /' SHOW Display viscous parameters' - & /' XTR rr Change trip positions Xtr/c' - & /' N r Change critical amplification exponent Ncrit' - & /' VACC r Change Newton solution acceleration parameter' - & /' INIT BL initialization flag toggle') - 1200 FORMAT(/' Xtr/c =', F8.4, ' top side' - & /' Xtr/c =', F8.4, ' bottom side' - & /' Ncrit =', F8.2, ' (', F6.3, ' % turb. level )' - & /' Vacc =', F8.4 ) - END ! VPAR - - - - - SUBROUTINE SPECAL -C----------------------------------- -C Converges to specified alpha. -C----------------------------------- - INCLUDE 'XFOIL.INC' - REAL MINF_CLM, MSQ_CLM -C -C---- calculate surface vorticity distributions for alpha = 0, 90 degrees - IF(.NOT.LGAMU .OR. .NOT.LQAIJ) CALL GGCALC -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C -C---- superimpose suitably weighted alpha = 0, 90 distributions - DO 50 I=1, N - GAM(I) = COSA*GAMU(I,1) + SINA*GAMU(I,2) - GAM_A(I) = -SINA*GAMU(I,1) + COSA*GAMU(I,2) - 50 CONTINUE - PSIO = COSA*GAMU(N+1,1) + SINA*GAMU(N+1,2) -C - CALL TECALC - CALL QISET -C -C---- set initial guess for the Newton variable CLM - CLM = 1.0 -C -C---- set corresponding M(CLM), Re(CLM) - CALL MRCL(CLM,MINF_CLM,REINF_CLM) - CALL COMSET -C -C---- set corresponding CL(M) - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) -C -C---- iterate on CLM - DO 100 ITCL=1, 20 -C - MSQ_CLM = 2.0*MINF*MINF_CLM - DCLM = (CL - CLM)/(1.0 - CL_MSQ*MSQ_CLM) -C - CLM1 = CLM - RLX = 1.0 -C -C------ under-relaxation loop to avoid driving M(CL) above 1 - DO 90 IRLX=1, 12 -C - CLM = CLM1 + RLX*DCLM -C -C-------- set new freestream Mach M(CLM) - CALL MRCL(CLM,MINF_CLM,REINF_CLM) -C -C-------- if Mach is OK, go do next Newton iteration - IF(MATYP.EQ.1 .OR. MINF.EQ.0.0 .OR. MINF_CLM.NE.0.0) GO TO 91 -C - RLX = 0.5*RLX - 90 CONTINUE - 91 CONTINUE -C -C------ set new CL(M) - CALL COMSET - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP,CL_ALF,CL_MSQ) -C - IF(ABS(DCLM).LE.1.0E-6) GO TO 110 -C - 100 CONTINUE - WRITE(*,*) 'SPECAL: Minf convergence failed' - 110 CONTINUE -C -C---- set final Mach, CL, Cp distributions, and hinge moment - CALL MRCL(CL,MINF_CL,REINF_CL) - CALL COMSET - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) - CALL CPCALC(N,QINV,QINF,MINF,CPI) - IF(LVISC) THEN - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - ELSE - CALL CPCALC(N,QINV,QINF,MINF,CPI) - ENDIF - IF(LFLAP) CALL MHINGE -C - RETURN - END ! SPECAL - - - SUBROUTINE SPECCL -C----------------------------------------- -C Converges to specified inviscid CL. -C----------------------------------------- - INCLUDE 'XFOIL.INC' -C -C---- calculate surface vorticity distributions for alpha = 0, 90 degrees - IF(.NOT.LGAMU .OR. .NOT.LQAIJ) CALL GGCALC -C -C---- set freestream Mach from specified CL -- Mach will be held fixed - CALL MRCL(CLSPEC,MINF_CL,REINF_CL) - CALL COMSET -C -C---- current alpha is the initial guess for Newton variable ALFA - COSA = COS(ALFA) - SINA = SIN(ALFA) - DO 10 I=1, N - GAM(I) = COSA*GAMU(I,1) + SINA*GAMU(I,2) - GAM_A(I) = -SINA*GAMU(I,1) + COSA*GAMU(I,2) - 10 CONTINUE - PSIO = COSA*GAMU(N+1,1) + SINA*GAMU(N+1,2) -C -C---- get corresponding CL, CL_alpha, CL_Mach - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) -C -C---- Newton loop for alpha to get specified inviscid CL - DO 100 ITAL=1, 20 -C - DALFA = (CLSPEC - CL) / CL_ALF - RLX = 1.0 -C - ALFA = ALFA + RLX*DALFA -C -C------ set new surface speed distribution - COSA = COS(ALFA) - SINA = SIN(ALFA) - DO 40 I=1, N - GAM(I) = COSA*GAMU(I,1) + SINA*GAMU(I,2) - GAM_A(I) = -SINA*GAMU(I,1) + COSA*GAMU(I,2) - 40 CONTINUE - PSIO = COSA*GAMU(N+1,1) + SINA*GAMU(N+1,2) -C -C------ set new CL(alpha) - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP,CL_ALF,CL_MSQ) -C - IF(ABS(DALFA).LE.1.0E-6) GO TO 110 - 100 CONTINUE - WRITE(*,*) 'SPECCL: CL convergence failed' - 110 CONTINUE -C -C---- set final surface speed and Cp distributions - CALL TECALC - CALL QISET - IF(LVISC) THEN - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - ELSE - CALL CPCALC(N,QINV,QINF,MINF,CPI) - ENDIF - IF(LFLAP) CALL MHINGE -C - RETURN - END ! SPECCL - - - SUBROUTINE VISCAL(NITER1) -C---------------------------------------- -C Converges viscous operating point -C---------------------------------------- - INCLUDE 'XFOIL.INC' -C -C---- convergence tolerance - DATA EPS1 / 1.0E-10 / -C - NITER = NITER1 -C -C---- calculate wake trajectory from current inviscid solution if necessary - IF(.NOT.LWAKE) THEN - CALL XYWAKE - ENDIF -C -C---- set velocities on wake from airfoil vorticity for alpha=0, 90 - CALL QWCALC -C -C---- set velocities on airfoil and wake for initial alpha - CALL QISET -C - IF(.NOT.LIPAN) THEN -C - IF(LBLINI) CALL GAMQV -C -C----- locate stagnation point arc length position and panel index - CALL STFIND -C -C----- set BL position -> panel position pointers - CALL IBLPAN -C -C----- calculate surface arc length array for current stagnation point location - CALL XICALC -C -C----- set BL position -> system line pointers - CALL IBLSYS -C - ENDIF -C -C---- set inviscid BL edge velocity UINV from QINV - CALL UICALC -C - IF(.NOT.LBLINI) THEN -C -C----- set initial Ue from inviscid Ue - DO IBL=1, NBL(1) - UEDG(IBL,1) = UINV(IBL,1) - ENDDO -C - DO IBL=1, NBL(2) - UEDG(IBL,2) = UINV(IBL,2) - ENDDO -C - ENDIF -C - IF(LVCONV) THEN -C----- set correct CL if converged point exists - CALL QVFUE - IF(LVISC) THEN - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - ELSE - CALL CPCALC(N,QINV,QINF,MINF,CPI) - ENDIF - CALL GAMQV - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) - CALL CDCALC - ENDIF -C -C---- set up source influence matrix if it doesn't exist - IF(.NOT.LWDIJ .OR. .NOT.LADIJ) CALL QDCALC -C -C---- Newton iteration for entire BL solution - IF(NITER.EQ.0) CALL ASKI('Enter number of iterations^',NITER) -C WRITE(*,*) -C WRITE(*,*) 'Solving BL system ...' - DO 1000 ITER=1, NITER -C -C------ fill Newton system for BL variables -c WRITE (*,*) 'Calling SETBL...' - CALL SETBL - -C -C------ solve Newton system with custom solver -c WRITE(*,*) 'CALLING BLSOLV...' - CALL BLSOLV -C -C------ update BL variables - CALL UPDATE -C - IF(LALFA) THEN -C------- set new freestream Mach, Re from new CL - CALL MRCL(CL,MINF_CL,REINF_CL) - CALL COMSET - ELSE -C------- set new inviscid speeds QINV and UINV for new alpha - CALL QISET - CALL UICALC - ENDIF -C -C------ calculate edge velocities QVIS(.) from UEDG(..) - CALL QVFUE -C -C------ set GAM distribution from QVIS - CALL GAMQV -C -C------ relocate stagnation point - CALL STMOVE -C -C------ set updated CL,CD - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP,CL_ALF,CL_MSQ) - CALL CDCALC -C -C------ display changes and test for convergence -c IF(RLX.LT.1.0) -c & WRITE(*,2000) ITER, RMSBL, RMXBL, VMXBL,IMXBL,ISMXBL,RLX -c IF(RLX.EQ.1.0) -c & WRITE(*,2010) ITER, RMSBL, RMXBL, VMXBL,IMXBL,ISMXBL -c CDP = CD - CDF -c WRITE(*,2020) ALFA/DTOR, CL, CM, CD, CDF, CDP -C - IF(RMSBL .LT. EPS1) THEN - LVCONV = .TRUE. - AVISC = ALFA - MVISC = MINF - GO TO 90 - ENDIF -C - 1000 CONTINUE -C WRITE(*,*) 'VISCAL: Convergence failed' -C - 90 CONTINUE - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - IF(LFLAP) CALL MHINGE - RETURN -C.................................................................... - 2000 FORMAT - & (/1X,I3,' rms: ',E10.4,' max: ',E10.4,3X,A1,' at ',I4,I3, - & ' RLX:',F6.3) - 2010 FORMAT - & (/1X,I3,' rms: ',E10.4,' max: ',E10.4,3X,A1,' at ',I4,I3) - 2020 FORMAT - & ( 1X,3X,' a =', F7.3,' CL =',F8.4 / - & 1X,3X,' Cm =', F8.4, ' CD =',F9.5, - & ' => CDf =',F9.5,' CDp =',F9.5) - END ! VISCAL - - - subroutine dcpout - include 'XFOIL.INC' -c -c Computes and writes upper and lower-surface -c Cp values at two specified x locations -c -c - x1 = 0.05 - x2 = 0.15 -c - lu = 60 - open(lu,file='dcp.out',status='old',access='append',err=10) - go to 20 -c - 10 continue - open(lu,file='dcp.out',status='new') - write(lu,*) '# ', name - write(lu,*) '# alpha CL ', - & ' Cpl05 Cpu05 dCp05 ', - & ' Cpl15 Cpu15 dCp15 ' - 20 continue -c - call spline(cpv,w1,s,n) -c - su1 = sle + x1*(s(1)-sle) - sl1 = sle + x1*(s(n)-sle) - su2 = sle + x2*(s(1)-sle) - sl2 = sle + x2*(s(n)-sle) -c - call sinvrt(sl1,x1,x,xp,s,n) - call sinvrt(su1,x1,x,xp,s,n) - call sinvrt(sl2,x2,x,xp,s,n) - call sinvrt(su2,x2,x,xp,s,n) -c - cpl1 = seval(sl1,cpv,w1,s,n) - cpu1 = seval(su1,cpv,w1,s,n) - cpl2 = seval(sl2,cpv,w1,s,n) - cpu2 = seval(su2,cpv,w1,s,n) -c - write(lu,1200) alfa/dtor, cl, - & cpl1, cpu1, cpl1-cpu1, - & cpl2, cpu2, cpl2-cpu2 - - 1200 format(1x, f7.3, f9.4, 8f10.5) -c - close(lu) -c - return - end diff --git a/deps/src/xfoil/xpanel.f b/deps/src/xfoil/xpanel.f deleted file mode 100644 index 21833f8..0000000 --- a/deps/src/xfoil/xpanel.f +++ /dev/null @@ -1,1745 +0,0 @@ -C*********************************************************************** -C Module: xpanel.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - - SUBROUTINE APCALC - INCLUDE 'XFOIL.INC' -C -C---- set angles of airfoil panels - DO 10 I=1, N-1 - SX = X(I+1) - X(I) - SY = Y(I+1) - Y(I) - IF(SX.EQ.0.0 .AND. SY.EQ.0.0) THEN - APANEL(I) = ATAN2( -NY(I) , -NX(I) ) - ELSE - APANEL(I) = ATAN2( SX , -SY ) - ENDIF - 10 CONTINUE -C -C---- TE panel - I = N - IP = 1 - IF(SHARP) THEN - APANEL(I) = PI - ELSE - SX = X(IP) - X(I) - SY = Y(IP) - Y(I) - APANEL(I) = ATAN2( -SX , SY ) + PI - ENDIF -C - RETURN - END - - - SUBROUTINE NCALC(X,Y,S,N,XN,YN) -C--------------------------------------- -C Calculates normal unit vector -C components at airfoil panel nodes -C--------------------------------------- - DIMENSION X(N), Y(N), S(N), XN(N), YN(N) -C - IF(N.LE.1) RETURN -C - CALL SEGSPL(X,XN,S,N) - CALL SEGSPL(Y,YN,S,N) - DO 10 I=1, N - SX = YN(I) - SY = -XN(I) - SMOD = SQRT(SX*SX + SY*SY) - XN(I) = SX/SMOD - YN(I) = SY/SMOD - 10 CONTINUE -C -C---- average normal vectors at corner points - DO 20 I=1, N-1 - IF(S(I) .EQ. S(I+1)) THEN - SX = 0.5*(XN(I) + XN(I+1)) - SY = 0.5*(YN(I) + YN(I+1)) - SMOD = SQRT(SX*SX + SY*SY) - XN(I) = SX/SMOD - YN(I) = SY/SMOD - XN(I+1) = SX/SMOD - YN(I+1) = SY/SMOD - ENDIF - 20 CONTINUE -C - RETURN - END - - - SUBROUTINE PSILIN(I,XI,YI,NXI,NYI,PSI,PSI_NI,GEOLIN,SIGLIN) -C----------------------------------------------------------------------- -C Calculates current streamfunction Psi at panel node or wake node -C I due to freestream and all bound vorticity Gam on the airfoil. -C Sensitivities of Psi with respect to alpha (Z_ALFA) and inverse -C Qspec DOFs (Z_QDOF0,Z_QDOF1) which influence Gam in inverse cases. -C Also calculates the sensitivity vector dPsi/dGam (DZDG). -C -C If SIGLIN=True, then Psi includes the effects of the viscous -C source distribution Sig and the sensitivity vector dPsi/dSig -C (DZDM) is calculated. -C -C If GEOLIN=True, then the geometric sensitivity vector dPsi/dn -C is calculated, where n is the normal motion of the jth node. -C -C Airfoil: 1 < I < N -C Wake: N+1 < I < N+NW -C----------------------------------------------------------------------- - INCLUDE 'XFOIL.INC' - REAL NXO, NYO, NXP, NYP, NXI, NYI - LOGICAL GEOLIN,SIGLIN -C -C---- distance tolerance for determining if two points are the same - SEPS = (S(N)-S(1)) * 1.0E-5 -C - IO = I -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C - DO 3 JO=1, N - DZDG(JO) = 0.0 - DZDN(JO) = 0.0 - DQDG(JO) = 0.0 - 3 CONTINUE -C - DO 4 JO=1, N - DZDM(JO) = 0.0 - DQDM(JO) = 0.0 - 4 CONTINUE -C - Z_QINF = 0. - Z_ALFA = 0. - Z_QDOF0 = 0. - Z_QDOF1 = 0. - Z_QDOF2 = 0. - Z_QDOF3 = 0. -C - PSI = 0. - PSI_NI = 0. -C - QTAN1 = 0. - QTAN2 = 0. - QTANM = 0. -C - IF(SHARP) THEN - SCS = 1.0 - SDS = 0.0 - ELSE - SCS = ANTE/DSTE - SDS = ASTE/DSTE - ENDIF -C - DO 10 JO=1, N - JP = JO+1 -C - JM = JO-1 - JQ = JP+1 -C - IF(JO.EQ.1) THEN - JM = JO - ELSE IF(JO.EQ.N-1) THEN - JQ = JP - ELSE IF(JO.EQ.N) THEN - JP = 1 - IF((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2 .LT. SEPS**2) GO TO 12 - ENDIF -C - DSO = SQRT((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2) -C -C------ skip null panel - IF(DSO .EQ. 0.0) GO TO 10 -C - DSIO = 1.0 / DSO -C - APAN = APANEL(JO) -C - RX1 = XI - X(JO) - RY1 = YI - Y(JO) - RX2 = XI - X(JP) - RY2 = YI - Y(JP) -C - SX = (X(JP) - X(JO)) * DSIO - SY = (Y(JP) - Y(JO)) * DSIO -C - X1 = SX*RX1 + SY*RY1 - X2 = SX*RX2 + SY*RY2 - YY = SX*RY1 - SY*RX1 -C - RS1 = RX1*RX1 + RY1*RY1 - RS2 = RX2*RX2 + RY2*RY2 -C -C------ set reflection flag SGN to avoid branch problems with arctan - IF(IO.GE.1 .AND. IO.LE.N) THEN -C------- no problem on airfoil surface - SGN = 1.0 - ELSE -C------- make sure arctan falls between -/+ Pi/2 - SGN = SIGN(1.0,YY) - ENDIF -C -C------ set log(r^2) and arctan(x/y), correcting for reflection if any - IF(IO.NE.JO .AND. RS1.GT.0.0) THEN - G1 = LOG(RS1) - T1 = ATAN2(SGN*X1,SGN*YY) + (0.5 - 0.5*SGN)*PI - ELSE - G1 = 0.0 - T1 = 0.0 - ENDIF -C - IF(IO.NE.JP .AND. RS2.GT.0.0) THEN - G2 = LOG(RS2) - T2 = ATAN2(SGN*X2,SGN*YY) + (0.5 - 0.5*SGN)*PI - ELSE - G2 = 0.0 - T2 = 0.0 - ENDIF -C - X1I = SX*NXI + SY*NYI - X2I = SX*NXI + SY*NYI - YYI = SX*NYI - SY*NXI -C - IF(GEOLIN) THEN - NXO = NX(JO) - NYO = NY(JO) - NXP = NX(JP) - NYP = NY(JP) -C - X1O =-((RX1-X1*SX)*NXO + (RY1-X1*SY)*NYO)*DSIO-(SX*NXO+SY*NYO) - X1P = ((RX1-X1*SX)*NXP + (RY1-X1*SY)*NYP)*DSIO - X2O =-((RX2-X2*SX)*NXO + (RY2-X2*SY)*NYO)*DSIO - X2P = ((RX2-X2*SX)*NXP + (RY2-X2*SY)*NYP)*DSIO-(SX*NXP+SY*NYP) - YYO = ((RX1+X1*SY)*NYO - (RY1-X1*SX)*NXO)*DSIO-(SX*NYO-SY*NXO) - YYP =-((RX1-X1*SY)*NYP - (RY1+X1*SX)*NXP)*DSIO - ENDIF -C - IF(JO.EQ.N) GO TO 11 -C - IF(SIGLIN) THEN -C -C------- set up midpoint quantities - X0 = 0.5*(X1+X2) - RS0 = X0*X0 + YY*YY - G0 = LOG(RS0) - T0 = ATAN2(SGN*X0,SGN*YY) + (0.5 - 0.5*SGN)*PI -C -C------- calculate source contribution to Psi for 1-0 half-panel - DXINV = 1.0/(X1-X0) - PSUM = X0*(T0-APAN) - X1*(T1-APAN) + 0.5*YY*(G1-G0) - PDIF = ((X1+X0)*PSUM + RS1*(T1-APAN) - RS0*(T0-APAN) - & + (X0-X1)*YY) * DXINV -C - PSX1 = -(T1-APAN) - PSX0 = T0-APAN - PSYY = 0.5*(G1-G0) -C - PDX1 = ((X1+X0)*PSX1 + PSUM + 2.0*X1*(T1-APAN) - PDIF) * DXINV - PDX0 = ((X1+X0)*PSX0 + PSUM - 2.0*X0*(T0-APAN) + PDIF) * DXINV - PDYY = ((X1+X0)*PSYY + 2.0*(X0-X1 + YY*(T1-T0)) ) * DXINV -C - DSM = SQRT((X(JP)-X(JM))**2 + (Y(JP)-Y(JM))**2) - DSIM = 1.0/DSM -C -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SIG1 = (SIG(JP) - SIG(JM))*DSIM -CCC SSUM = SIG0 + SIG1 -CCC SDIF = SIG0 - SIG1 -C - SSUM = (SIG(JP) - SIG(JO))*DSIO + (SIG(JP) - SIG(JM))*DSIM - SDIF = (SIG(JP) - SIG(JO))*DSIO - (SIG(JP) - SIG(JM))*DSIM -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JM) = DZDM(JM) + QOPI*(-PSUM*DSIM + PDIF*DSIM) - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*DSIO - PDIF*DSIO) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*(DSIO+DSIM) - & + PDIF*(DSIO-DSIM)) -C -C------- dPsi/dni - PSNI = PSX1*X1I + PSX0*(X1I+X2I)*0.5 + PSYY*YYI - PDNI = PDX1*X1I + PDX0*(X1I+X2I)*0.5 + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JM) = DQDM(JM) + QOPI*(-PSNI*DSIM + PDNI*DSIM) - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*DSIO - PDNI*DSIO) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*(DSIO+DSIM) - & + PDNI*(DSIO-DSIM)) -C -C -C------- calculate source contribution to Psi for 0-2 half-panel - DXINV = 1.0/(X0-X2) - PSUM = X2*(T2-APAN) - X0*(T0-APAN) + 0.5*YY*(G0-G2) - PDIF = ((X0+X2)*PSUM + RS0*(T0-APAN) - RS2*(T2-APAN) - & + (X2-X0)*YY) * DXINV -C - PSX0 = -(T0-APAN) - PSX2 = T2-APAN - PSYY = 0.5*(G0-G2) -C - PDX0 = ((X0+X2)*PSX0 + PSUM + 2.0*X0*(T0-APAN) - PDIF) * DXINV - PDX2 = ((X0+X2)*PSX2 + PSUM - 2.0*X2*(T2-APAN) + PDIF) * DXINV - PDYY = ((X0+X2)*PSYY + 2.0*(X2-X0 + YY*(T0-T2)) ) * DXINV -C - DSP = SQRT((X(JQ)-X(JO))**2 + (Y(JQ)-Y(JO))**2) - DSIP = 1.0/DSP -C -CCC SIG2 = (SIG(JQ) - SIG(JO))*DSIP -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SSUM = SIG2 + SIG0 -CCC SDIF = SIG2 - SIG0 -C - SSUM = (SIG(JQ) - SIG(JO))*DSIP + (SIG(JP) - SIG(JO))*DSIO - SDIF = (SIG(JQ) - SIG(JO))*DSIP - (SIG(JP) - SIG(JO))*DSIO -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*(DSIP+DSIO) - & - PDIF*(DSIP-DSIO)) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*DSIO - PDIF*DSIO) - DZDM(JQ) = DZDM(JQ) + QOPI*( PSUM*DSIP + PDIF*DSIP) -C -C------- dPsi/dni - PSNI = PSX0*(X1I+X2I)*0.5 + PSX2*X2I + PSYY*YYI - PDNI = PDX0*(X1I+X2I)*0.5 + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*(DSIP+DSIO) - & - PDNI*(DSIP-DSIO)) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*DSIO - PDNI*DSIO) - DQDM(JQ) = DQDM(JQ) + QOPI*( PSNI*DSIP + PDNI*DSIP) -C - ENDIF -C -C------ calculate vortex panel contribution to Psi - DXINV = 1.0/(X1-X2) - PSIS = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) - PSID = ((X1+X2)*PSIS + 0.5*(RS2*G2-RS1*G1 + X1*X1-X2*X2))*DXINV -C - PSX1 = 0.5*G1 - PSX2 = -.5*G2 - PSYY = T1-T2 -C - PDX1 = ((X1+X2)*PSX1 + PSIS - X1*G1 - PSID)*DXINV - PDX2 = ((X1+X2)*PSX2 + PSIS + X2*G2 + PSID)*DXINV - PDYY = ((X1+X2)*PSYY - YY*(G1-G2) )*DXINV -C - GSUM1 = GAMU(JP,1) + GAMU(JO,1) - GSUM2 = GAMU(JP,2) + GAMU(JO,2) - GDIF1 = GAMU(JP,1) - GAMU(JO,1) - GDIF2 = GAMU(JP,2) - GAMU(JO,2) -C - GSUM = GAM(JP) + GAM(JO) - GDIF = GAM(JP) - GAM(JO) -C - PSI = PSI + QOPI*(PSIS*GSUM + PSID*GDIF) -C -C------ dPsi/dGam - DZDG(JO) = DZDG(JO) + QOPI*(PSIS-PSID) - DZDG(JP) = DZDG(JP) + QOPI*(PSIS+PSID) -C -C------ dPsi/dni - PSNI = PSX1*X1I + PSX2*X2I + PSYY*YYI - PDNI = PDX1*X1I + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(GSUM*PSNI + GDIF*PDNI) -C - QTAN1 = QTAN1 + QOPI*(GSUM1*PSNI + GDIF1*PDNI) - QTAN2 = QTAN2 + QOPI*(GSUM2*PSNI + GDIF2*PDNI) -C - DQDG(JO) = DQDG(JO) + QOPI*(PSNI - PDNI) - DQDG(JP) = DQDG(JP) + QOPI*(PSNI + PDNI) -C - IF(GEOLIN) THEN -C -C------- dPsi/dn - DZDN(JO) = DZDN(JO)+ QOPI*GSUM*(PSX1*X1O + PSX2*X2O + PSYY*YYO) - & + QOPI*GDIF*(PDX1*X1O + PDX2*X2O + PDYY*YYO) - DZDN(JP) = DZDN(JP)+ QOPI*GSUM*(PSX1*X1P + PSX2*X2P + PSYY*YYP) - & + QOPI*GDIF*(PDX1*X1P + PDX2*X2P + PDYY*YYP) -C------- dPsi/dP - Z_QDOF0 = Z_QDOF0 - & + QOPI*((PSIS-PSID)*QF0(JO) + (PSIS+PSID)*QF0(JP)) - Z_QDOF1 = Z_QDOF1 - & + QOPI*((PSIS-PSID)*QF1(JO) + (PSIS+PSID)*QF1(JP)) - Z_QDOF2 = Z_QDOF2 - & + QOPI*((PSIS-PSID)*QF2(JO) + (PSIS+PSID)*QF2(JP)) - Z_QDOF3 = Z_QDOF3 - & + QOPI*((PSIS-PSID)*QF3(JO) + (PSIS+PSID)*QF3(JP)) - ENDIF -C -C - 10 CONTINUE -C - 11 CONTINUE - PSIG = 0.5*YY*(G1-G2) + X2*(T2-APAN) - X1*(T1-APAN) - PGAM = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) -C - PSIGX1 = -(T1-APAN) - PSIGX2 = T2-APAN - PSIGYY = 0.5*(G1-G2) - PGAMX1 = 0.5*G1 - PGAMX2 = -.5*G2 - PGAMYY = T1-T2 -C - PSIGNI = PSIGX1*X1I + PSIGX2*X2I + PSIGYY*YYI - PGAMNI = PGAMX1*X1I + PGAMX2*X2I + PGAMYY*YYI -C -C---- TE panel source and vortex strengths - SIGTE1 = 0.5*SCS*(GAMU(JP,1) - GAMU(JO,1)) - SIGTE2 = 0.5*SCS*(GAMU(JP,2) - GAMU(JO,2)) - GAMTE1 = -.5*SDS*(GAMU(JP,1) - GAMU(JO,1)) - GAMTE2 = -.5*SDS*(GAMU(JP,2) - GAMU(JO,2)) -C - SIGTE = 0.5*SCS*(GAM(JP) - GAM(JO)) - GAMTE = -.5*SDS*(GAM(JP) - GAM(JO)) -C -C---- TE panel contribution to Psi - PSI = PSI + HOPI*(PSIG*SIGTE + PGAM*GAMTE) -C -C---- dPsi/dGam - DZDG(JO) = DZDG(JO) - HOPI*PSIG*SCS*0.5 - DZDG(JP) = DZDG(JP) + HOPI*PSIG*SCS*0.5 -C - DZDG(JO) = DZDG(JO) + HOPI*PGAM*SDS*0.5 - DZDG(JP) = DZDG(JP) - HOPI*PGAM*SDS*0.5 -C -C---- dPsi/dni - PSI_NI = PSI_NI + HOPI*(PSIGNI*SIGTE + PGAMNI*GAMTE) -C - QTAN1 = QTAN1 + HOPI*(PSIGNI*SIGTE1 + PGAMNI*GAMTE1) - QTAN2 = QTAN2 + HOPI*(PSIGNI*SIGTE2 + PGAMNI*GAMTE2) -C - DQDG(JO) = DQDG(JO) - HOPI*(PSIGNI*0.5*SCS - PGAMNI*0.5*SDS) - DQDG(JP) = DQDG(JP) + HOPI*(PSIGNI*0.5*SCS - PGAMNI*0.5*SDS) -C - IF(GEOLIN) THEN -C -C----- dPsi/dn - DZDN(JO) = DZDN(JO) - & + HOPI*(PSIGX1*X1O + PSIGX2*X2O + PSIGYY*YYO)*SIGTE - & + HOPI*(PGAMX1*X1O + PGAMX2*X2O + PGAMYY*YYO)*GAMTE - DZDN(JP) = DZDN(JP) - & + HOPI*(PSIGX1*X1P + PSIGX2*X2P + PSIGYY*YYP)*SIGTE - & + HOPI*(PGAMX1*X1P + PGAMX2*X2P + PGAMYY*YYP)*GAMTE -C -C----- dPsi/dP - Z_QDOF0 = Z_QDOF0 + HOPI*PSIG*0.5*(QF0(JP)-QF0(JO))*SCS - & - HOPI*PGAM*0.5*(QF0(JP)-QF0(JO))*SDS - Z_QDOF1 = Z_QDOF1 + HOPI*PSIG*0.5*(QF1(JP)-QF1(JO))*SCS - & - HOPI*PGAM*0.5*(QF1(JP)-QF1(JO))*SDS - Z_QDOF2 = Z_QDOF2 + HOPI*PSIG*0.5*(QF2(JP)-QF2(JO))*SCS - & - HOPI*PGAM*0.5*(QF2(JP)-QF2(JO))*SDS - Z_QDOF3 = Z_QDOF3 + HOPI*PSIG*0.5*(QF3(JP)-QF3(JO))*SCS - & - HOPI*PGAM*0.5*(QF3(JP)-QF3(JO))*SDS -C - ENDIF -C - 12 CONTINUE -C -C**** Freestream terms - PSI = PSI + QINF*(COSA*YI - SINA*XI) -C -C---- dPsi/dn - PSI_NI = PSI_NI + QINF*(COSA*NYI - SINA*NXI) -C - QTAN1 = QTAN1 + QINF*NYI - QTAN2 = QTAN2 - QINF*NXI -C -C---- dPsi/dQinf - Z_QINF = Z_QINF + (COSA*YI - SINA*XI) -C -C---- dPsi/dalfa - Z_ALFA = Z_ALFA - QINF*(SINA*YI + COSA*XI) -C - IF(.NOT.LIMAGE) RETURN -C -C -C - DO 20 JO=1, N - JP = JO+1 -C - JM = JO-1 - JQ = JP+1 -C - IF(JO.EQ.1) THEN - JM = JO - ELSE IF(JO.EQ.N-1) THEN - JQ = JP - ELSE IF(JO.EQ.N) THEN - JP = 1 - IF((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2 .LT. SEPS**2) GO TO 22 - ENDIF -C - DSO = SQRT((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2) -C -C------ skip null panel - IF(DSO .EQ. 0.0) GO TO 20 -C - DSIO = 1.0 / DSO -C -ccc APAN = APANEL(JO) - APAN = PI - APANEL(JO) + 2.0*ALFA -C - XJO = X(JO) + 2.0*(YIMAGE+Y(JO))*SINA - YJO = Y(JO) - 2.0*(YIMAGE+Y(JO))*COSA - XJP = X(JP) + 2.0*(YIMAGE+Y(JP))*SINA - YJP = Y(JP) - 2.0*(YIMAGE+Y(JP))*COSA -C - RX1 = XI - XJO - RY1 = YI - YJO - RX2 = XI - XJP - RY2 = YI - YJP -C - SX = (XJP - XJO) * DSIO - SY = (YJP - YJO) * DSIO -C - X1 = SX*RX1 + SY*RY1 - X2 = SX*RX2 + SY*RY2 - YY = SX*RY1 - SY*RX1 -C - RS1 = RX1*RX1 + RY1*RY1 - RS2 = RX2*RX2 + RY2*RY2 -C -C------ set reflection flag SGN to avoid branch problems with arctan - IF(IO.GE.1 .AND. IO.LE.N) THEN -C------- no problem on airfoil surface - SGN = 1.0 - ELSE -C------- make sure arctan falls between -/+ Pi/2 - SGN = SIGN(1.0,YY) - ENDIF -C -C------ set log(r^2) and arctan(x/y), correcting for reflection if any - G1 = LOG(RS1) - T1 = ATAN2(SGN*X1,SGN*YY) + (0.5 - 0.5*SGN)*PI -C - G2 = LOG(RS2) - T2 = ATAN2(SGN*X2,SGN*YY) + (0.5 - 0.5*SGN)*PI -C - X1I = SX*NXI + SY*NYI - X2I = SX*NXI + SY*NYI - YYI = SX*NYI - SY*NXI -C - IF(GEOLIN) THEN - NXO = NX(JO) - NYO = NY(JO) - NXP = NX(JP) - NYP = NY(JP) -C - X1O =-((RX1-X1*SX)*NXO + (RY1-X1*SY)*NYO)*DSIO-(SX*NXO+SY*NYO) - X1P = ((RX1-X1*SX)*NXP + (RY1-X1*SY)*NYP)*DSIO - X2O =-((RX2-X2*SX)*NXO + (RY2-X2*SY)*NYO)*DSIO - X2P = ((RX2-X2*SX)*NXP + (RY2-X2*SY)*NYP)*DSIO-(SX*NXP+SY*NYP) - YYO = ((RX1+X1*SY)*NYO - (RY1-X1*SX)*NXO)*DSIO-(SX*NYO-SY*NXO) - YYP =-((RX1-X1*SY)*NYP - (RY1+X1*SX)*NXP)*DSIO - ENDIF -C - IF(JO.EQ.N) GO TO 21 -C - IF(SIGLIN) THEN -C -C------- set up midpoint quantities - X0 = 0.5*(X1+X2) - RS0 = X0*X0 + YY*YY - G0 = LOG(RS0) - T0 = ATAN2(SGN*X0,SGN*YY) + (0.5 - 0.5*SGN)*PI -C -C------- calculate source contribution to Psi for 1-0 half-panel - DXINV = 1.0/(X1-X0) - PSUM = X0*(T0-APAN) - X1*(T1-APAN) + 0.5*YY*(G1-G0) - PDIF = ((X1+X0)*PSUM + RS1*(T1-APAN) - RS0*(T0-APAN) - & + (X0-X1)*YY) * DXINV -C - PSX1 = -(T1-APAN) - PSX0 = T0-APAN - PSYY = 0.5*(G1-G0) -C - PDX1 = ((X1+X0)*PSX1 + PSUM + 2.0*X1*(T1-APAN) - PDIF) * DXINV - PDX0 = ((X1+X0)*PSX0 + PSUM - 2.0*X0*(T0-APAN) + PDIF) * DXINV - PDYY = ((X1+X0)*PSYY + 2.0*(X0-X1 + YY*(T1-T0)) ) * DXINV -C - DSM = SQRT((X(JP)-X(JM))**2 + (Y(JP)-Y(JM))**2) - DSIM = 1.0/DSM -C -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SIG1 = (SIG(JP) - SIG(JM))*DSIM -CCC SSUM = SIG0 + SIG1 -CCC SDIF = SIG0 - SIG1 -C - SSUM = (SIG(JP) - SIG(JO))*DSIO + (SIG(JP) - SIG(JM))*DSIM - SDIF = (SIG(JP) - SIG(JO))*DSIO - (SIG(JP) - SIG(JM))*DSIM -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JM) = DZDM(JM) + QOPI*(-PSUM*DSIM + PDIF*DSIM) - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*DSIO - PDIF*DSIO) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*(DSIO+DSIM) - & + PDIF*(DSIO-DSIM)) -C -C------- dPsi/dni - PSNI = PSX1*X1I + PSX0*(X1I+X2I)*0.5 + PSYY*YYI - PDNI = PDX1*X1I + PDX0*(X1I+X2I)*0.5 + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JM) = DQDM(JM) + QOPI*(-PSNI*DSIM + PDNI*DSIM) - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*DSIO - PDNI*DSIO) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*(DSIO+DSIM) - & + PDNI*(DSIO-DSIM)) -C -C -C------- calculate source contribution to Psi for 0-2 half-panel - DXINV = 1.0/(X0-X2) - PSUM = X2*(T2-APAN) - X0*(T0-APAN) + 0.5*YY*(G0-G2) - PDIF = ((X0+X2)*PSUM + RS0*(T0-APAN) - RS2*(T2-APAN) - & + (X2-X0)*YY) * DXINV -C - PSX0 = -(T0-APAN) - PSX2 = T2-APAN - PSYY = 0.5*(G0-G2) -C - PDX0 = ((X0+X2)*PSX0 + PSUM + 2.0*X0*(T0-APAN) - PDIF) * DXINV - PDX2 = ((X0+X2)*PSX2 + PSUM - 2.0*X2*(T2-APAN) + PDIF) * DXINV - PDYY = ((X0+X2)*PSYY + 2.0*(X2-X0 + YY*(T0-T2)) ) * DXINV -C - DSP = SQRT((X(JQ)-X(JO))**2 + (Y(JQ)-Y(JO))**2) - DSIP = 1.0/DSP -C -CCC SIG2 = (SIG(JQ) - SIG(JO))*DSIP -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SSUM = SIG2 + SIG0 -CCC SDIF = SIG2 - SIG0 -C - SSUM = (SIG(JQ) - SIG(JO))*DSIP + (SIG(JP) - SIG(JO))*DSIO - SDIF = (SIG(JQ) - SIG(JO))*DSIP - (SIG(JP) - SIG(JO))*DSIO -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*(DSIP+DSIO) - & - PDIF*(DSIP-DSIO)) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*DSIO - PDIF*DSIO) - DZDM(JQ) = DZDM(JQ) + QOPI*( PSUM*DSIP + PDIF*DSIP) -C -C------- dPsi/dni - PSNI = PSX0*(X1I+X2I)*0.5 + PSX2*X2I + PSYY*YYI - PDNI = PDX0*(X1I+X2I)*0.5 + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*(DSIP+DSIO) - & - PDNI*(DSIP-DSIO)) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*DSIO - PDNI*DSIO) - DQDM(JQ) = DQDM(JQ) + QOPI*( PSNI*DSIP + PDNI*DSIP) -C - ENDIF -C -C------ calculate vortex panel contribution to Psi - DXINV = 1.0/(X1-X2) - PSIS = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) - PSID = ((X1+X2)*PSIS + 0.5*(RS2*G2-RS1*G1 + X1*X1-X2*X2))*DXINV -C - PSX1 = 0.5*G1 - PSX2 = -.5*G2 - PSYY = T1-T2 -C - PDX1 = ((X1+X2)*PSX1 + PSIS - X1*G1 - PSID)*DXINV - PDX2 = ((X1+X2)*PSX2 + PSIS + X2*G2 + PSID)*DXINV - PDYY = ((X1+X2)*PSYY - YY*(G1-G2) )*DXINV -C - GSUM1 = GAMU(JP,1) + GAMU(JO,1) - GSUM2 = GAMU(JP,2) + GAMU(JO,2) - GDIF1 = GAMU(JP,1) - GAMU(JO,1) - GDIF2 = GAMU(JP,2) - GAMU(JO,2) -C - GSUM = GAM(JP) + GAM(JO) - GDIF = GAM(JP) - GAM(JO) -C - PSI = PSI - QOPI*(PSIS*GSUM + PSID*GDIF) -C -C------ dPsi/dGam - DZDG(JO) = DZDG(JO) - QOPI*(PSIS-PSID) - DZDG(JP) = DZDG(JP) - QOPI*(PSIS+PSID) -C -C------ dPsi/dni - PSNI = PSX1*X1I + PSX2*X2I + PSYY*YYI - PDNI = PDX1*X1I + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI - QOPI*(GSUM*PSNI + GDIF*PDNI) -C - QTAN1 = QTAN1 - QOPI*(GSUM1*PSNI + GDIF1*PDNI) - QTAN2 = QTAN2 - QOPI*(GSUM2*PSNI + GDIF2*PDNI) -C - DQDG(JO) = DQDG(JO) - QOPI*(PSNI - PDNI) - DQDG(JP) = DQDG(JP) - QOPI*(PSNI + PDNI) -C - IF(GEOLIN) THEN -C -C------- dPsi/dn - DZDN(JO) = DZDN(JO)- QOPI*GSUM*(PSX1*X1O + PSX2*X2O + PSYY*YYO) - & - QOPI*GDIF*(PDX1*X1O + PDX2*X2O + PDYY*YYO) - DZDN(JP) = DZDN(JP)- QOPI*GSUM*(PSX1*X1P + PSX2*X2P + PSYY*YYP) - & - QOPI*GDIF*(PDX1*X1P + PDX2*X2P + PDYY*YYP) -C------- dPsi/dP - Z_QDOF0 = Z_QDOF0 - & - QOPI*((PSIS-PSID)*QF0(JO) + (PSIS+PSID)*QF0(JP)) - Z_QDOF1 = Z_QDOF1 - & - QOPI*((PSIS-PSID)*QF1(JO) + (PSIS+PSID)*QF1(JP)) - Z_QDOF2 = Z_QDOF2 - & - QOPI*((PSIS-PSID)*QF2(JO) + (PSIS+PSID)*QF2(JP)) - Z_QDOF3 = Z_QDOF3 - & - QOPI*((PSIS-PSID)*QF3(JO) + (PSIS+PSID)*QF3(JP)) - ENDIF -C -C - 20 CONTINUE -C - 21 CONTINUE - PSIG = 0.5*YY*(G1-G2) + X2*(T2-APAN) - X1*(T1-APAN) - PGAM = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) -C - PSIGX1 = -(T1-APAN) - PSIGX2 = T2-APAN - PSIGYY = 0.5*(G1-G2) - PGAMX1 = 0.5*G1 - PGAMX2 = -.5*G2 - PGAMYY = T1-T2 -C - PSIGNI = PSIGX1*X1I + PSIGX2*X2I + PSIGYY*YYI - PGAMNI = PGAMX1*X1I + PGAMX2*X2I + PGAMYY*YYI -C -C---- TE panel source and vortex strengths - SIGTE1 = 0.5*SCS*(GAMU(JP,1) - GAMU(JO,1)) - SIGTE2 = 0.5*SCS*(GAMU(JP,2) - GAMU(JO,2)) - GAMTE1 = -.5*SDS*(GAMU(JP,1) - GAMU(JO,1)) - GAMTE2 = -.5*SDS*(GAMU(JP,2) - GAMU(JO,2)) -C - SIGTE = 0.5*SCS*(GAM(JP) - GAM(JO)) - GAMTE = -.5*SDS*(GAM(JP) - GAM(JO)) -C -C---- TE panel contribution to Psi - PSI = PSI + HOPI*(PSIG*SIGTE - PGAM*GAMTE) -C -C---- dPsi/dGam - DZDG(JO) = DZDG(JO) - HOPI*PSIG*SCS*0.5 - DZDG(JP) = DZDG(JP) + HOPI*PSIG*SCS*0.5 -C - DZDG(JO) = DZDG(JO) - HOPI*PGAM*SDS*0.5 - DZDG(JP) = DZDG(JP) + HOPI*PGAM*SDS*0.5 -C -C---- dPsi/dni - PSI_NI = PSI_NI + HOPI*(PSIGNI*SIGTE - PGAMNI*GAMTE) -C - QTAN1 = QTAN1 + HOPI*(PSIGNI*SIGTE1 - PGAMNI*GAMTE1) - QTAN2 = QTAN2 + HOPI*(PSIGNI*SIGTE2 - PGAMNI*GAMTE2) -C - DQDG(JO) = DQDG(JO) - HOPI*(PSIGNI*0.5*SCS + PGAMNI*0.5*SDS) - DQDG(JP) = DQDG(JP) + HOPI*(PSIGNI*0.5*SCS + PGAMNI*0.5*SDS) -C - IF(GEOLIN) THEN -C -C----- dPsi/dn - DZDN(JO) = DZDN(JO) - & + HOPI*(PSIGX1*X1O + PSIGX2*X2O + PSIGYY*YYO)*SIGTE - & - HOPI*(PGAMX1*X1O + PGAMX2*X2O + PGAMYY*YYO)*GAMTE - DZDN(JP) = DZDN(JP) - & + HOPI*(PSIGX1*X1P + PSIGX2*X2P + PSIGYY*YYP)*SIGTE - & - HOPI*(PGAMX1*X1P + PGAMX2*X2P + PGAMYY*YYP)*GAMTE -C -C----- dPsi/dP - Z_QDOF0 = Z_QDOF0 + HOPI*PSIG*0.5*(QF0(JP)-QF0(JO))*SCS - & + HOPI*PGAM*0.5*(QF0(JP)-QF0(JO))*SDS - Z_QDOF1 = Z_QDOF1 + HOPI*PSIG*0.5*(QF1(JP)-QF1(JO))*SCS - & + HOPI*PGAM*0.5*(QF1(JP)-QF1(JO))*SDS - Z_QDOF2 = Z_QDOF2 + HOPI*PSIG*0.5*(QF2(JP)-QF2(JO))*SCS - & + HOPI*PGAM*0.5*(QF2(JP)-QF2(JO))*SDS - Z_QDOF3 = Z_QDOF3 + HOPI*PSIG*0.5*(QF3(JP)-QF3(JO))*SCS - & + HOPI*PGAM*0.5*(QF3(JP)-QF3(JO))*SDS -C - ENDIF -C - 22 CONTINUE -C - RETURN - END - - - SUBROUTINE PSWLIN(I,XI,YI,NXI,NYI,PSI,PSI_NI) -C-------------------------------------------------------------------- -C Calculates current streamfunction Psi and tangential velocity -C Qtan at panel node or wake node I due to freestream and wake -C sources Sig. Also calculates sensitivity vectors dPsi/dSig -C (DZDM) and dQtan/dSig (DQDM). -C -C Airfoil: 1 < I < N -C Wake: N+1 < I < N+NW -C-------------------------------------------------------------------- - INCLUDE 'XFOIL.INC' - REAL NXI, NYI -C - IO = I -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C - DO 4 JO=N+1, N+NW - DZDM(JO) = 0.0 - DQDM(JO) = 0.0 - 4 CONTINUE -C - PSI = 0. - PSI_NI = 0. -C - DO 20 JO=N+1, N+NW-1 -C - JP = JO+1 -C - JM = JO-1 - JQ = JP+1 - IF(JO.EQ.N+1) THEN - JM = JO - ELSE IF(JO.EQ.N+NW-1) THEN - JQ = JP - ENDIF -C - DSO = SQRT((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2) - DSIO = 1.0 / DSO -C - APAN = APANEL(JO) -C - RX1 = XI - X(JO) - RY1 = YI - Y(JO) - RX2 = XI - X(JP) - RY2 = YI - Y(JP) -C - SX = (X(JP) - X(JO)) * DSIO - SY = (Y(JP) - Y(JO)) * DSIO -C - X1 = SX*RX1 + SY*RY1 - X2 = SX*RX2 + SY*RY2 - YY = SX*RY1 - SY*RX1 -C - RS1 = RX1*RX1 + RY1*RY1 - RS2 = RX2*RX2 + RY2*RY2 -C - IF(IO.GE.N+1 .AND. IO.LE.N+NW) THEN - SGN = 1.0 - ELSE - SGN = SIGN(1.0,YY) - ENDIF -C - IF(IO.NE.JO .AND. RS1.GT.0.0) THEN - G1 = LOG(RS1) - T1 = ATAN2(SGN*X1,SGN*YY) - (0.5 - 0.5*SGN)*PI - ELSE - G1 = 0.0 - T1 = 0.0 - ENDIF -C - IF(IO.NE.JP .AND. RS2.GT.0.0) THEN - G2 = LOG(RS2) - T2 = ATAN2(SGN*X2,SGN*YY) - (0.5 - 0.5*SGN)*PI - ELSE - G2 = 0.0 - T2 = 0.0 - ENDIF -C - X1I = SX*NXI + SY*NYI - X2I = SX*NXI + SY*NYI - YYI = SX*NYI - SY*NXI -C -C------- set up midpoint quantities - X0 = 0.5*(X1+X2) - RS0 = X0*X0 + YY*YY - G0 = LOG(RS0) - T0 = ATAN2(SGN*X0,SGN*YY) - (0.5 - 0.5*SGN)*PI -C -C------- calculate source contribution to Psi for 1-0 half-panel - DXINV = 1.0/(X1-X0) - PSUM = X0*(T0-APAN) - X1*(T1-APAN) + 0.5*YY*(G1-G0) - PDIF = ((X1+X0)*PSUM + RS1*(T1-APAN) - RS0*(T0-APAN) - & + (X0-X1)*YY) * DXINV -C - PSX1 = -(T1-APAN) - PSX0 = T0-APAN - PSYY = 0.5*(G1-G0) -C - PDX1 = ((X1+X0)*PSX1 + PSUM + 2.0*X1*(T1-APAN) - PDIF) * DXINV - PDX0 = ((X1+X0)*PSX0 + PSUM - 2.0*X0*(T0-APAN) + PDIF) * DXINV - PDYY = ((X1+X0)*PSYY + 2.0*(X0-X1 + YY*(T1-T0)) ) * DXINV -C - DSM = SQRT((X(JP)-X(JM))**2 + (Y(JP)-Y(JM))**2) - DSIM = 1.0/DSM -C -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SIG1 = (SIG(JP) - SIG(JM))*DSIM -CCC SSUM = SIG0 + SIG1 -CCC SDIF = SIG0 - SIG1 -C - SSUM = (SIG(JP) - SIG(JO))*DSIO + (SIG(JP) - SIG(JM))*DSIM - SDIF = (SIG(JP) - SIG(JO))*DSIO - (SIG(JP) - SIG(JM))*DSIM -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JM) = DZDM(JM) + QOPI*(-PSUM*DSIM + PDIF*DSIM) - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*DSIO - PDIF*DSIO) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*(DSIO+DSIM) - & + PDIF*(DSIO-DSIM)) -C -C------- dPsi/dni - PSNI = PSX1*X1I + PSX0*(X1I+X2I)*0.5 + PSYY*YYI - PDNI = PDX1*X1I + PDX0*(X1I+X2I)*0.5 + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JM) = DQDM(JM) + QOPI*(-PSNI*DSIM + PDNI*DSIM) - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*DSIO - PDNI*DSIO) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*(DSIO+DSIM) - & + PDNI*(DSIO-DSIM)) -C -C -C------- calculate source contribution to Psi for 0-2 half-panel - DXINV = 1.0/(X0-X2) - PSUM = X2*(T2-APAN) - X0*(T0-APAN) + 0.5*YY*(G0-G2) - PDIF = ((X0+X2)*PSUM + RS0*(T0-APAN) - RS2*(T2-APAN) - & + (X2-X0)*YY) * DXINV -C - PSX0 = -(T0-APAN) - PSX2 = T2-APAN - PSYY = 0.5*(G0-G2) -C - PDX0 = ((X0+X2)*PSX0 + PSUM + 2.0*X0*(T0-APAN) - PDIF) * DXINV - PDX2 = ((X0+X2)*PSX2 + PSUM - 2.0*X2*(T2-APAN) + PDIF) * DXINV - PDYY = ((X0+X2)*PSYY + 2.0*(X2-X0 + YY*(T0-T2)) ) * DXINV -C - DSP = SQRT((X(JQ)-X(JO))**2 + (Y(JQ)-Y(JO))**2) - DSIP = 1.0/DSP -C -CCC SIG2 = (SIG(JQ) - SIG(JO))*DSIP -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SSUM = SIG2 + SIG0 -CCC SDIF = SIG2 - SIG0 -C - SSUM = (SIG(JQ) - SIG(JO))*DSIP + (SIG(JP) - SIG(JO))*DSIO - SDIF = (SIG(JQ) - SIG(JO))*DSIP - (SIG(JP) - SIG(JO))*DSIO -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*(DSIP+DSIO) - & - PDIF*(DSIP-DSIO)) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*DSIO - PDIF*DSIO) - DZDM(JQ) = DZDM(JQ) + QOPI*( PSUM*DSIP + PDIF*DSIP) -C -C------- dPsi/dni - PSNI = PSX0*(X1I+X2I)*0.5 + PSX2*X2I + PSYY*YYI - PDNI = PDX0*(X1I+X2I)*0.5 + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*(DSIP+DSIO) - & - PDNI*(DSIP-DSIO)) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*DSIO - PDNI*DSIO) - DQDM(JQ) = DQDM(JQ) + QOPI*( PSNI*DSIP + PDNI*DSIP) -C - 20 CONTINUE -C - RETURN - END - - - -C************************************************** -C -C CALLED FROM SPECAL/SPECCL -C -C************************************************** - SUBROUTINE GGCALC -C-------------------------------------------------------------- -C Calculates two surface vorticity (gamma) distributions -C for alpha = 0, 90 degrees. These are superimposed -C in SPECAL or SPECCL for specified alpha or CL. -C-------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C -C---- distance of internal control point ahead of sharp TE -C- (fraction of smaller panel length adjacent to TE) - BWT = 0.1 -C -C WRITE(*,*) 'Calculating unit vorticity distributions ...' -C - DO 10 I=1, N - GAM(I) = 0. - GAMU(I,1) = 0. - GAMU(I,2) = 0. - 10 CONTINUE - PSIO = 0. -C -C---- Set up matrix system for Psi = Psio on airfoil surface. -C- The unknowns are (dGamma)i and dPsio. - DO 20 I=1, N -C -C------ calculate Psi and dPsi/dGamma array for current node - CALL PSILIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N,.FALSE.,.TRUE.) -C - PSIINF = QINF*(COS(ALFA)*Y(I) - SIN(ALFA)*X(I)) -C -C------ RES1 = PSI( 0) - PSIO -C------ RES2 = PSI(90) - PSIO - RES1 = QINF*Y(I) - RES2 = -QINF*X(I) -C -C------ dRes/dGamma - DO 201 J=1, N - AIJ(I,J) = DZDG(J) - 201 CONTINUE -C - DO 202 J=1, N - BIJ(I,J) = -DZDM(J) - 202 CONTINUE -C -C------ dRes/dPsio - AIJ(I,N+1) = -1.0 -C - GAMU(I,1) = -RES1 - GAMU(I,2) = -RES2 -C - 20 CONTINUE -C -C---- set Kutta condition -C- RES = GAM(1) + GAM(N) - RES = 0. -C - DO 30 J=1, N+1 - AIJ(N+1,J) = 0.0 - 30 CONTINUE -C - AIJ(N+1,1) = 1.0 - AIJ(N+1,N) = 1.0 -C - GAMU(N+1,1) = -RES - GAMU(N+1,2) = -RES -C -C---- set up Kutta condition (no direct source influence) - DO 32 J=1, N - BIJ(N+1,J) = 0. - 32 CONTINUE -C - IF(SHARP) THEN -C----- set zero internal velocity in TE corner -C -C----- set TE bisector angle - AG1 = ATAN2(-YP(1),-XP(1) ) - AG2 = ATANC( YP(N), XP(N),AG1) - ABIS = 0.5*(AG1+AG2) - CBIS = COS(ABIS) - SBIS = SIN(ABIS) -C -C----- minimum panel length adjacent to TE - DS1 = SQRT( (X(1)-X(2) )**2 + (Y(1)-Y(2) )**2 ) - DS2 = SQRT( (X(N)-X(N-1))**2 + (Y(N)-Y(N-1))**2 ) - DSMIN = MIN( DS1 , DS2 ) -C -C----- control point on bisector just ahead of TE point - XBIS = XTE - BWT*DSMIN*CBIS - YBIS = YTE - BWT*DSMIN*SBIS -ccc write(*,*) xbis, ybis -C -C----- set velocity component along bisector line - CALL PSILIN(0,XBIS,YBIS,-SBIS,CBIS,PSI,QBIS,.FALSE.,.TRUE.) -C -CCC--- RES = DQDGj*Gammaj + DQDMj*Massj + QINF*(COSA*CBIS + SINA*SBIS) - RES = QBIS -C -C----- dRes/dGamma - DO J=1, N - AIJ(N,J) = DQDG(J) - ENDDO -C -C----- -dRes/dMass - DO J=1, N - BIJ(N,J) = -DQDM(J) - ENDDO -C -C----- dRes/dPsio - AIJ(N,N+1) = 0. -C -C----- -dRes/dUinf - GAMU(N,1) = -CBIS -C -C----- -dRes/dVinf - GAMU(N,2) = -SBIS -C - ENDIF -C -C---- LU-factor coefficient matrix AIJ - CALL LUDCMP(IQX,N+1,AIJ,AIJPIV) - LQAIJ = .TRUE. -C -C---- solve system for the two vorticity distributions - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,GAMU(1,1)) - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,GAMU(1,2)) -C -C---- set inviscid alpha=0,90 surface speeds for this geometry - DO 50 I=1, N - QINVU(I,1) = GAMU(I,1) - QINVU(I,2) = GAMU(I,2) - 50 CONTINUE -C - LGAMU = .TRUE. -C - RETURN - END - - - - SUBROUTINE QWCALC -C--------------------------------------------------------------- -C Sets inviscid tangential velocity for alpha = 0, 90 -C on wake due to freestream and airfoil surface vorticity. -C--------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C -C---- first wake point (same as TE) - QINVU(N+1,1) = QINVU(N,1) - QINVU(N+1,2) = QINVU(N,2) -C -C---- rest of wake - DO 10 I=N+2, N+NW - CALL PSILIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_NI,.FALSE.,.FALSE.) - QINVU(I,1) = QTAN1 - QINVU(I,2) = QTAN2 - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE QDCALC -C----------------------------------------------------- -C Calculates source panel influence coefficient -C matrix for current airfoil and wake geometry. -C----------------------------------------------------- - INCLUDE 'XFOIL.INC' -C -C WRITE(*,*) 'Calculating source influence matrix ...' -C - IF(.NOT.LADIJ) THEN -C -C----- calculate source influence matrix for airfoil surface if it doesn't exist - DO 10 J=1, N -C -C------- multiply each dPsi/Sig vector by inverse of factored dPsi/dGam matrix - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,BIJ(1,J)) -C -C------- store resulting dGam/dSig = dQtan/dSig vector - DO 105 I=1, N - DIJ(I,J) = BIJ(I,J) - 105 CONTINUE -C - 10 CONTINUE - LADIJ = .TRUE. -C - ENDIF -C -C---- set up coefficient matrix of dPsi/dm on airfoil surface - DO 20 I=1, N - CALL PSWLIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N) - DO 202 J=N+1, N+NW - BIJ(I,J) = -DZDM(J) - 202 CONTINUE - 20 CONTINUE -C -C---- set up Kutta condition (no direct source influence) - DO 32 J=N+1, N+NW - BIJ(N+1,J) = 0. - 32 CONTINUE -C -C---- sharp TE gamma extrapolation also has no source influence - IF(SHARP) THEN - DO 34 J=N+1, N+NW - BIJ(N,J) = 0. - 34 CONTINUE - ENDIF -C -C---- multiply by inverse of factored dPsi/dGam matrix - DO 40 J=N+1, N+NW - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,BIJ(1,J)) - 40 CONTINUE -C -C---- set the source influence matrix for the wake sources - DO 50 I=1, N - DO 510 J=N+1, N+NW - DIJ(I,J) = BIJ(I,J) - 510 CONTINUE - 50 CONTINUE -C -C**** Now we need to calculate the influence of sources on the wake velocities -C -C---- calculcate dQtan/dGam and dQtan/dSig at the wake points - DO 70 I=N+1, N+NW -C - IW = I-N -C -C------ airfoil contribution at wake panel node - CALL PSILIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N,.FALSE.,.TRUE.) -C - DO 710 J=1, N - CIJ(IW,J) = DQDG(J) - 710 CONTINUE -C - DO 720 J=1, N - DIJ(I,J) = DQDM(J) - 720 CONTINUE -C -C------ wake contribution - CALL PSWLIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N) -C - DO 730 J=N+1, N+NW - DIJ(I,J) = DQDM(J) - 730 CONTINUE -C - 70 CONTINUE -C -C---- add on effect of all sources on airfoil vorticity which effects wake Qtan - DO 80 I=N+1, N+NW - IW = I-N -C -C------ airfoil surface source contribution first - DO 810 J=1, N - SUM = 0. - DO 8100 K=1, N - SUM = SUM + CIJ(IW,K)*DIJ(K,J) - 8100 CONTINUE - DIJ(I,J) = DIJ(I,J) + SUM - 810 CONTINUE -C -C------ wake source contribution next - DO 820 J=N+1, N+NW - SUM = 0. - DO 8200 K=1, N - SUM = SUM + CIJ(IW,K)*BIJ(K,J) - 8200 CONTINUE - DIJ(I,J) = DIJ(I,J) + SUM - 820 CONTINUE -C - 80 CONTINUE -C -C---- make sure first wake point has same velocity as trailing edge - DO 90 J=1, N+NW - DIJ(N+1,J) = DIJ(N,J) - 90 CONTINUE -C - LWDIJ = .TRUE. -C - RETURN - END - - - SUBROUTINE XYWAKE -C----------------------------------------------------- -C Sets wake coordinate array for current surface -C vorticity and/or mass source distributions. -C----------------------------------------------------- - INCLUDE 'XFOIL.INC' -C -C WRITE(*,*) 'Calculating wake trajectory ...' -C -C---- number of wake points - NW = N/8 + 2 - IF(NW.GT.IWX) THEN -C WRITE(*,*) -C & 'Array size (IWX) too small. Last wake point index reduced.' - NW = IWX - ENDIF -C - DS1 = 0.5*(S(2) - S(1) + S(N) - S(N-1)) - CALL SETEXP(SNEW(N+1),DS1,WAKLEN*CHORD,NW) -C - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) -C -C---- set first wake point a tiny distance behind TE - I = N+1 - SX = 0.5*(YP(N) - YP(1)) - SY = 0.5*(XP(1) - XP(N)) - SMOD = SQRT(SX**2 + SY**2) - NX(I) = SX / SMOD - NY(I) = SY / SMOD - X(I) = XTE - 0.0001*NY(I) - Y(I) = YTE + 0.0001*NX(I) - S(I) = S(N) -C -C---- calculate streamfunction gradient components at first point - CALL PSILIN(I,X(I),Y(I),1.0,0.0,PSI,PSI_X,.FALSE.,.FALSE.) - CALL PSILIN(I,X(I),Y(I),0.0,1.0,PSI,PSI_Y,.FALSE.,.FALSE.) -C -C---- set unit vector normal to wake at first point - NX(I+1) = -PSI_X / SQRT(PSI_X**2 + PSI_Y**2) - NY(I+1) = -PSI_Y / SQRT(PSI_X**2 + PSI_Y**2) -C -C---- set angle of wake panel normal - APANEL(I) = ATAN2( PSI_Y , PSI_X ) -C -C---- set rest of wake points - DO 10 I=N+2, N+NW - DS = SNEW(I) - SNEW(I-1) -C -C------ set new point DS downstream of last point - X(I) = X(I-1) - DS*NY(I) - Y(I) = Y(I-1) + DS*NX(I) - S(I) = S(I-1) + DS -C - IF(I.EQ.N+NW) GO TO 10 -C -C------- calculate normal vector for next point - CALL PSILIN(I,X(I),Y(I),1.0,0.0,PSI,PSI_X,.FALSE.,.FALSE.) - CALL PSILIN(I,X(I),Y(I),0.0,1.0,PSI,PSI_Y,.FALSE.,.FALSE.) -C - NX(I+1) = -PSI_X / SQRT(PSI_X**2 + PSI_Y**2) - NY(I+1) = -PSI_Y / SQRT(PSI_X**2 + PSI_Y**2) -C -C------- set angle of wake panel normal - APANEL(I) = ATAN2( PSI_Y , PSI_X ) -C - 10 CONTINUE -C -C---- set wake presence flag and corresponding alpha - LWAKE = .TRUE. - AWAKE = ALFA -C -C---- old source influence matrix is invalid for the new wake geometry - LWDIJ = .FALSE. -C - RETURN - END - - - - SUBROUTINE STFIND -C----------------------------------------- -C Locates stagnation point arc length -C location SST and panel index IST. -C----------------------------------------- - INCLUDE 'XFOIL.INC' -C - DO 10 I=1, N-1 - IF(GAM(I).GE.0.0 .AND. GAM(I+1).LT.0.0) GO TO 11 - 10 CONTINUE -C -C WRITE(*,*) 'STFIND: Stagnation point not found. Continuing ...' - I = N/2 -C - 11 CONTINUE -C - IST = I - DGAM = GAM(I+1) - GAM(I) - DS = S(I+1) - S(I) -C -C---- evaluate so as to minimize roundoff for very small GAM(I) or GAM(I+1) - IF(GAM(I) .LT. -GAM(I+1)) THEN - SST = S(I) - DS*(GAM(I) /DGAM) - ELSE - SST = S(I+1) - DS*(GAM(I+1)/DGAM) - ENDIF -C -C---- tweak stagnation point if it falls right on a node (very unlikely) - IF(SST .LE. S(I) ) SST = S(I) + 1.0E-7 - IF(SST .GE. S(I+1)) SST = S(I+1) - 1.0E-7 -C - SST_GO = (SST - S(I+1))/DGAM - SST_GP = (S(I) - SST )/DGAM -C - RETURN - END - - - SUBROUTINE IBLPAN -C------------------------------------------------------------- -C Sets BL location -> panel location pointer array IPAN -C------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C -C---- top surface first - IS = 1 -C - IBL = 1 - DO 10 I=IST, 1, -1 - IBL = IBL+1 - IPAN(IBL,IS) = I - VTI(IBL,IS) = 1.0 - 10 CONTINUE -C - IBLTE(IS) = IBL - NBL(IS) = IBL -C -C---- bottom surface next - IS = 2 -C - IBL = 1 - DO 20 I=IST+1, N - IBL = IBL+1 - IPAN(IBL,IS) = I - VTI(IBL,IS) = -1.0 - 20 CONTINUE -C -C---- wake - IBLTE(IS) = IBL -C - DO 25 IW=1, NW - I = N+IW - IBL = IBLTE(IS)+IW - IPAN(IBL,IS) = I - VTI(IBL,IS) = -1.0 - 25 CONTINUE -C - NBL(IS) = IBLTE(IS) + NW -C -C---- upper wake pointers (for plotting only) - DO 35 IW=1, NW - IPAN(IBLTE(1)+IW,1) = IPAN(IBLTE(2)+IW,2) - VTI(IBLTE(1)+IW,1) = 1.0 - 35 CONTINUE -C -C - IBLMAX = MAX(IBLTE(1),IBLTE(2)) + NW - IF(IBLMAX.GT.IVX) THEN -C WRITE(*,*) ' *** BL array overflow.' -C WRITE(*,*) ' *** Increase IVX to at least', IBLMAX - STOP - ENDIF -C - LIPAN = .TRUE. - RETURN - END - - - SUBROUTINE XICALC -C------------------------------------------------------------- -C Sets BL arc length array on each airfoil side and wake -C------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - IS = 1 -C - XSSI(1,IS) = 0. -C - DO 10 IBL=2, IBLTE(IS) - I = IPAN(IBL,IS) - XSSI(IBL,IS) = SST - S(I) - 10 CONTINUE -C -C - IS = 2 -C - XSSI(1,IS) = 0. -C - DO 20 IBL=2, IBLTE(IS) - I = IPAN(IBL,IS) - XSSI(IBL,IS) = S(I) - SST - 20 CONTINUE -C - IBL = IBLTE(IS) + 1 - XSSI(IBL,IS) = XSSI(IBL-1,IS) -C - DO 25 IBL=IBLTE(IS)+2, NBL(IS) - I = IPAN(IBL,IS) - XSSI(IBL,IS) = XSSI(IBL-1,IS) - & + SQRT((X(I)-X(I-1))**2 + (Y(I)-Y(I-1))**2) - 25 CONTINUE -C -C---- trailing edge flap length to TE gap ratio - TELRAT = 2.50 -C -C---- set up parameters for TE flap cubics -C -ccc DWDXTE = YP(1)/XP(1) + YP(N)/XP(N) !!! BUG 2/2/95 -C - CROSP = (XP(1)*YP(N) - YP(1)*XP(N)) - & / SQRT( (XP(1)**2 + YP(1)**2) - & *(XP(N)**2 + YP(N)**2) ) - DWDXTE = CROSP / SQRT(1.0 - CROSP**2) -C -C---- limit cubic to avoid absurd TE gap widths - DWDXTE = MAX(DWDXTE,-3.0/TELRAT) - DWDXTE = MIN(DWDXTE, 3.0/TELRAT) -C - AA = 3.0 + TELRAT*DWDXTE - BB = -2.0 - TELRAT*DWDXTE -C - IF(SHARP) THEN - DO 30 IW=1, NW - WGAP(IW) = 0. - 30 CONTINUE - ELSE -C----- set TE flap (wake gap) array - IS = 2 - DO 35 IW=1, NW - IBL = IBLTE(IS) + IW - ZN = 1.0 - (XSSI(IBL,IS)-XSSI(IBLTE(IS),IS)) / (TELRAT*ANTE) - WGAP(IW) = 0. - IF(ZN.GE.0.0) WGAP(IW) = ANTE * (AA + BB*ZN)*ZN**2 - 35 CONTINUE - ENDIF -C - RETURN - END - - - SUBROUTINE UICALC -C-------------------------------------------------------------- -C Sets inviscid Ue from panel inviscid tangential velocity -C-------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - DO 10 IS=1, 2 - UINV (1,IS) = 0. - UINV_A(1,IS) = 0. - DO 110 IBL=2, NBL(IS) - I = IPAN(IBL,IS) - UINV (IBL,IS) = VTI(IBL,IS)*QINV (I) - UINV_A(IBL,IS) = VTI(IBL,IS)*QINV_A(I) - 110 CONTINUE - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE UECALC -C-------------------------------------------------------------- -C Sets viscous Ue from panel viscous tangential velocity -C-------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - DO 10 IS=1, 2 - UEDG(1,IS) = 0. - DO 110 IBL=2, NBL(IS) - I = IPAN(IBL,IS) - UEDG(IBL,IS) = VTI(IBL,IS)*QVIS(I) - 110 CONTINUE - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE QVFUE -C-------------------------------------------------------------- -C Sets panel viscous tangential velocity from viscous Ue -C-------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - I = IPAN(IBL,IS) - QVIS(I) = VTI(IBL,IS)*UEDG(IBL,IS) - 10 CONTINUE - 1 CONTINUE -C - RETURN - END - - - SUBROUTINE QISET -C------------------------------------------------------- -C Sets inviscid panel tangential velocity for -C current alpha. -C------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C - DO 5 I=1, N+NW - QINV (I) = COSA*QINVU(I,1) + SINA*QINVU(I,2) - QINV_A(I) = -SINA*QINVU(I,1) + COSA*QINVU(I,2) - 5 CONTINUE -C - RETURN - END - - - SUBROUTINE GAMQV - INCLUDE 'XFOIL.INC' -C - DO 10 I=1, N - GAM(I) = QVIS(I) - GAM_A(I) = QINV_A(I) - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE STMOVE -C--------------------------------------------------- -C Moves stagnation point location to new panel. -C--------------------------------------------------- - INCLUDE 'XFOIL.INC' -C -C---- locate new stagnation point arc length SST from GAM distribution - ISTOLD = IST - CALL STFIND -C - IF(ISTOLD.EQ.IST) THEN -C -C----- recalculate new arc length array - CALL XICALC -C - ELSE -C -CCC WRITE(*,*) 'STMOVE: Resetting stagnation point' -C -C----- set new BL position -> panel position pointers - CALL IBLPAN -C -C----- set new inviscid BL edge velocity UINV from QINV - CALL UICALC -C -C----- recalculate new arc length array - CALL XICALC -C -C----- set BL position -> system line pointers - CALL IBLSYS -C - IF(IST.GT.ISTOLD) THEN -C------ increase in number of points on top side (IS=1) - IDIF = IST-ISTOLD -C - ITRAN(1) = ITRAN(1) + IDIF - ITRAN(2) = ITRAN(2) - IDIF -C -C------ move top side BL variables downstream - DO 110 IBL=NBL(1), IDIF+2, -1 - CTAU(IBL,1) = CTAU(IBL-IDIF,1) - THET(IBL,1) = THET(IBL-IDIF,1) - DSTR(IBL,1) = DSTR(IBL-IDIF,1) - UEDG(IBL,1) = UEDG(IBL-IDIF,1) - 110 CONTINUE -C -C------ set BL variables between old and new stagnation point - DUDX = UEDG(IDIF+2,1)/XSSI(IDIF+2,1) - DO 115 IBL=IDIF+1, 2, -1 - CTAU(IBL,1) = CTAU(IDIF+2,1) - THET(IBL,1) = THET(IDIF+2,1) - DSTR(IBL,1) = DSTR(IDIF+2,1) - UEDG(IBL,1) = DUDX * XSSI(IBL,1) - 115 CONTINUE -C -C------ move bottom side BL variables upstream - DO 120 IBL=2, NBL(2) - CTAU(IBL,2) = CTAU(IBL+IDIF,2) - THET(IBL,2) = THET(IBL+IDIF,2) - DSTR(IBL,2) = DSTR(IBL+IDIF,2) - UEDG(IBL,2) = UEDG(IBL+IDIF,2) - 120 CONTINUE -C - ELSE -C------ increase in number of points on bottom side (IS=2) - IDIF = ISTOLD-IST -C - ITRAN(1) = ITRAN(1) - IDIF - ITRAN(2) = ITRAN(2) + IDIF -C -C------ move bottom side BL variables downstream - DO 210 IBL=NBL(2), IDIF+2, -1 - CTAU(IBL,2) = CTAU(IBL-IDIF,2) - THET(IBL,2) = THET(IBL-IDIF,2) - DSTR(IBL,2) = DSTR(IBL-IDIF,2) - UEDG(IBL,2) = UEDG(IBL-IDIF,2) - 210 CONTINUE -C -C------ set BL variables between old and new stagnation point - DUDX = UEDG(IDIF+2,2)/XSSI(IDIF+2,2) - DO 215 IBL=IDIF+1, 2, -1 - CTAU(IBL,2) = CTAU(IDIF+2,2) - THET(IBL,2) = THET(IDIF+2,2) - DSTR(IBL,2) = DSTR(IDIF+2,2) - UEDG(IBL,2) = DUDX * XSSI(IBL,2) - 215 CONTINUE -C -C------ move top side BL variables upstream - DO 220 IBL=2, NBL(1) - CTAU(IBL,1) = CTAU(IBL+IDIF,1) - THET(IBL,1) = THET(IBL+IDIF,1) - DSTR(IBL,1) = DSTR(IBL+IDIF,1) - UEDG(IBL,1) = UEDG(IBL+IDIF,1) - 220 CONTINUE - ENDIF -C - ENDIF -C -C---- set new mass array since Ue has been tweaked - DO 50 IS=1, 2 - DO 510 IBL=2, NBL(IS) - MASS(IBL,IS) = DSTR(IBL,IS)*UEDG(IBL,IS) - 510 CONTINUE - 50 CONTINUE -C - RETURN - END - - - SUBROUTINE UESET -C--------------------------------------------------------- -C Sets Ue from inviscid Ue plus all source influence -C--------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - I = IPAN(IBL,IS) -C - DUI = 0. - DO 100 JS=1, 2 - DO 1000 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - UE_M = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - DUI = DUI + UE_M*MASS(JBL,JS) - 1000 CONTINUE - 100 CONTINUE -C - UEDG(IBL,IS) = UINV(IBL,IS) + DUI -C - 10 CONTINUE - 1 CONTINUE -C - RETURN - END - - - SUBROUTINE DSSET - INCLUDE 'XFOIL.INC' -C - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - DSTR(IBL,IS) = MASS(IBL,IS) / UEDG(IBL,IS) - 10 CONTINUE - 1 CONTINUE -C - RETURN - END diff --git a/deps/src/xfoil/xsolve.f b/deps/src/xfoil/xsolve.f deleted file mode 100644 index baf2ce5..0000000 --- a/deps/src/xfoil/xsolve.f +++ /dev/null @@ -1,484 +0,0 @@ -C*********************************************************************** -C Module: xsolve.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - - SUBROUTINE GAUSS(NSIZ,NN,Z,R,NRHS) -C ******************************************************* -C * * -C * Solves general NxN system in NN unknowns * -C * with arbitrary number (NRHS) of righthand sides. * -C * Assumes system is invertible... * -C * ...if it isn't, a divide by zero will result. * -C * * -C * Z is the coefficient matrix... * -C * ...destroyed during solution process. * -C * R is the righthand side(s)... * -C * ...replaced by the solution vector(s). * -C * * -C * Mark Drela 1984 * -C ******************************************************* -C - DIMENSION Z(NSIZ,NSIZ), R(NSIZ,NRHS) -C - DO 1 NP=1, NN-1 - NP1 = NP+1 -C -C------ find max pivot index NX - NX = NP - DO 11 N=NP1, NN - IF(ABS(Z(N,NP))-ABS(Z(NX,NP))) 11,11,111 - 111 NX = N - 11 CONTINUE -C - PIVOT = 1.0/Z(NX,NP) -C -C------ switch pivots - Z(NX,NP) = Z(NP,NP) -C -C------ switch rows & normalize pivot row - DO 12 L=NP1, NN - TEMP = Z(NX,L)*PIVOT - Z(NX,L) = Z(NP,L) - Z(NP,L) = TEMP - 12 CONTINUE -C - DO 13 L=1, NRHS - TEMP = R(NX,L)*PIVOT - R(NX,L) = R(NP,L) - R(NP,L) = TEMP - 13 CONTINUE -C -C------ forward eliminate everything - DO 15 K=NP1, NN - ZTMP = Z(K,NP) -C -C IF(ZTMP.EQ.0.0) GO TO 15 -C - DO 151 L=NP1, NN - Z(K,L) = Z(K,L) - ZTMP*Z(NP,L) - 151 CONTINUE - DO 152 L=1, NRHS - R(K,L) = R(K,L) - ZTMP*R(NP,L) - 152 CONTINUE - 15 CONTINUE -C - 1 CONTINUE -C -C---- solve for last row - DO 2 L=1, NRHS - R(NN,L) = R(NN,L)/Z(NN,NN) - 2 CONTINUE -C -C---- back substitute everything - DO 3 NP=NN-1, 1, -1 - NP1 = NP+1 - DO 31 L=1, NRHS - DO 310 K=NP1, NN - R(NP,L) = R(NP,L) - Z(NP,K)*R(K,L) - 310 CONTINUE - 31 CONTINUE - 3 CONTINUE -C - RETURN - END ! GAUSS - - - SUBROUTINE CGAUSS(NSIZ,NN,Z,R,NRHS) -C******************************************** -C Solves general complex linear systems. -C******************************************** - COMPLEX Z(NSIZ,NSIZ), R(NSIZ,NRHS) - COMPLEX PIVOT, TEMP, ZTMP -C - DO 1 NP=1, NN-1 - NP1 = NP+1 -C -C------ find max pivot index NX - NX = NP - DO 11 N=NP1, NN - IF(ABS(Z(N,NP))-ABS(Z(NX,NP))) 11,11,111 - 111 NX = N - 11 CONTINUE -C - PIVOT = (1.0,0.0)/Z(NX,NP) -C -C------ switch pivots - Z(NX,NP) = Z(NP,NP) -C -C------ switch rows & normalize pivot row - DO 12 L=NP1, NN - TEMP = Z(NX,L)*PIVOT - Z(NX,L) = Z(NP,L) - Z(NP,L) = TEMP - 12 CONTINUE -C - DO 13 L=1, NRHS - TEMP = R(NX,L)*PIVOT - R(NX,L) = R(NP,L) - R(NP,L) = TEMP - 13 CONTINUE -C -C------ forward eliminate everything - DO 15 K=NP1, NN - ZTMP = Z(K,NP) -C -C IF(ZTMP.EQ.0.0) GO TO 15 -C - DO 151 L=NP1, NN - Z(K,L) = Z(K,L) - ZTMP*Z(NP,L) - 151 CONTINUE - DO 152 L=1, NRHS - R(K,L) = R(K,L) - ZTMP*R(NP,L) - 152 CONTINUE - 15 CONTINUE -C - 1 CONTINUE -C -C---- solve for last row - DO 2 L=1, NRHS - R(NN,L) = R(NN,L)/Z(NN,NN) - 2 CONTINUE -C -C---- back substitute everything - DO 3 NP=NN-1, 1, -1 - NP1 = NP+1 - DO 31 L=1, NRHS - DO 310 K=NP1, NN - R(NP,L) = R(NP,L) - Z(NP,K)*R(K,L) - 310 CONTINUE - 31 CONTINUE - 3 CONTINUE -C - RETURN - END ! CGAUSS - - - - SUBROUTINE LUDCMP(NSIZ,N,A,INDX) -C ******************************************************* -C * * -C * Factors a full NxN matrix into an LU form. * -C * Subr. BAKSUB can back-substitute it with some RHS.* -C * Assumes matrix is non-singular... * -C * ...if it isn't, a divide by zero will result. * -C * * -C * A is the matrix... * -C * ...replaced with its LU factors. * -C * * -C * Mark Drela 1988 * -C ******************************************************* -C - DIMENSION A(NSIZ,NSIZ), INDX(NSIZ) -C - PARAMETER (NVX=500) - DIMENSION VV(NVX) -C - IF(N.GT.NVX) STOP 'LUDCMP: Array overflow. Increase NVX.' -C - DO 12 I=1, N - AAMAX = 0. - DO 11 J=1, N - AAMAX = MAX( ABS(A(I,J)) , AAMAX ) - 11 CONTINUE - VV(I) = 1.0/AAMAX - 12 CONTINUE -C - DO 19 J=1, N - DO 14 I=1, J-1 - SUM = A(I,J) - DO 13 K=1, I-1 - SUM = SUM - A(I,K)*A(K,J) - 13 CONTINUE - A(I,J) = SUM - 14 CONTINUE -C - AAMAX = 0. - DO 16 I=J, N - SUM = A(I,J) - DO 15 K=1, J-1 - SUM = SUM - A(I,K)*A(K,J) - 15 CONTINUE - A(I,J) = SUM -C - DUM = VV(I)*ABS(SUM) - IF(DUM.GE.AAMAX) THEN - IMAX = I - AAMAX = DUM - ENDIF - 16 CONTINUE -C - IF(J.NE.IMAX) THEN - DO 17 K=1, N - DUM = A(IMAX,K) - A(IMAX,K) = A(J,K) - A(J,K) = DUM - 17 CONTINUE - VV(IMAX) = VV(J) - ENDIF -C - INDX(J) = IMAX - IF(J.NE.N) THEN - DUM = 1.0/A(J,J) - DO 18 I=J+1, N - A(I,J) = A(I,J)*DUM - 18 CONTINUE - ENDIF -C - 19 CONTINUE -C - RETURN - END ! LUDCMP - - - SUBROUTINE BAKSUB(NSIZ,N,A,INDX,B) - DIMENSION A(NSIZ,NSIZ), B(NSIZ), INDX(NSIZ) -C - II = 0 - DO 12 I=1, N - LL = INDX(I) - SUM = B(LL) - B(LL) = B(I) - IF(II.NE.0) THEN - DO 11 J=II, I-1 - SUM = SUM - A(I,J)*B(J) - 11 CONTINUE - ELSE IF(SUM.NE.0.0) THEN - II = I - ENDIF - B(I) = SUM - 12 CONTINUE -C - DO 14 I=N, 1, -1 - SUM = B(I) - IF(I.LT.N) THEN - DO 13 J=I+1, N - SUM = SUM - A(I,J)*B(J) - 13 CONTINUE - ENDIF - B(I) = SUM/A(I,I) - 14 CONTINUE -C - RETURN - END ! BAKSUB - - - - SUBROUTINE BLSOLV -C----------------------------------------------------------------- -C Custom solver for coupled viscous-inviscid Newton system: -C -C A | | . | | . | d R S -C B A | . | | . | d R S -C | B A . | | . | d R S -C . . . . | | . | d = R - dRe S -C | | | B A | . | d R S -C | Z | | B A . | d R S -C . . . . . . . | d R S -C | | | | | | B A d R S -C -C A, B, Z 3x3 blocks containing linearized BL equation coefficients -C | 3x1 vectors containing mass defect influence -C coefficients on Ue -C d 3x1 unknown vectors (Newton deltas for Ctau, Theta, m) -C R 3x1 residual vectors -C S 3x1 Re influence vectors -C----------------------------------------------------------------- - INCLUDE 'XFOIL.INC' -C - IVTE1 = ISYS(IBLTE(1),1) -C - DO 1000 IV=1, NSYS -C - IVP = IV + 1 -C -C====== Invert VA(IV) block -C -C------ normalize first row - PIVOT = 1.0 / VA(1,1,IV) - VA(1,2,IV) = VA(1,2,IV) * PIVOT - DO 10 L=IV, NSYS - VM(1,L,IV) = VM(1,L,IV)*PIVOT - 10 CONTINUE - VDEL(1,1,IV) = VDEL(1,1,IV)*PIVOT - VDEL(1,2,IV) = VDEL(1,2,IV)*PIVOT -C -C------ eliminate lower first column in VA block - DO 15 K=2, 3 - VTMP = VA(K,1,IV) - VA(K,2,IV) = VA(K,2,IV) - VTMP*VA(1,2,IV) - DO 150 L=IV, NSYS - VM(K,L,IV) = VM(K,L,IV) - VTMP*VM(1,L,IV) - 150 CONTINUE - VDEL(K,1,IV) = VDEL(K,1,IV) - VTMP*VDEL(1,1,IV) - VDEL(K,2,IV) = VDEL(K,2,IV) - VTMP*VDEL(1,2,IV) - 15 CONTINUE -C -C -C------ normalize second row - PIVOT = 1.0 / VA(2,2,IV) - DO 20 L=IV, NSYS - VM(2,L,IV) = VM(2,L,IV)*PIVOT - 20 CONTINUE - VDEL(2,1,IV) = VDEL(2,1,IV)*PIVOT - VDEL(2,2,IV) = VDEL(2,2,IV)*PIVOT -C -C------ eliminate lower second column in VA block - K = 3 - VTMP = VA(K,2,IV) - DO 250 L=IV, NSYS - VM(K,L,IV) = VM(K,L,IV) - VTMP*VM(2,L,IV) - 250 CONTINUE - VDEL(K,1,IV) = VDEL(K,1,IV) - VTMP*VDEL(2,1,IV) - VDEL(K,2,IV) = VDEL(K,2,IV) - VTMP*VDEL(2,2,IV) -C -C -C------ normalize third row - PIVOT = 1.0/VM(3,IV,IV) - DO 350 L=IVP, NSYS - VM(3,L,IV) = VM(3,L,IV)*PIVOT - 350 CONTINUE - VDEL(3,1,IV) = VDEL(3,1,IV)*PIVOT - VDEL(3,2,IV) = VDEL(3,2,IV)*PIVOT -C -C -C------ eliminate upper third column in VA block - VTMP1 = VM(1,IV,IV) - VTMP2 = VM(2,IV,IV) - DO 450 L=IVP, NSYS - VM(1,L,IV) = VM(1,L,IV) - VTMP1*VM(3,L,IV) - VM(2,L,IV) = VM(2,L,IV) - VTMP2*VM(3,L,IV) - 450 CONTINUE - VDEL(1,1,IV) = VDEL(1,1,IV) - VTMP1*VDEL(3,1,IV) - VDEL(2,1,IV) = VDEL(2,1,IV) - VTMP2*VDEL(3,1,IV) - VDEL(1,2,IV) = VDEL(1,2,IV) - VTMP1*VDEL(3,2,IV) - VDEL(2,2,IV) = VDEL(2,2,IV) - VTMP2*VDEL(3,2,IV) -C -C------ eliminate upper second column in VA block - VTMP = VA(1,2,IV) - DO 460 L=IVP, NSYS - VM(1,L,IV) = VM(1,L,IV) - VTMP*VM(2,L,IV) - 460 CONTINUE - VDEL(1,1,IV) = VDEL(1,1,IV) - VTMP*VDEL(2,1,IV) - VDEL(1,2,IV) = VDEL(1,2,IV) - VTMP*VDEL(2,2,IV) -C -C - IF(IV.EQ.NSYS) GO TO 1000 -C -C====== Eliminate VB(IV+1) block, rows 1 -> 3 - DO 50 K=1, 3 - VTMP1 = VB(K, 1,IVP) - VTMP2 = VB(K, 2,IVP) - VTMP3 = VM(K,IV,IVP) - DO 510 L=IVP, NSYS - VM(K,L,IVP) = VM(K,L,IVP) - & - ( VTMP1*VM(1,L,IV) - & + VTMP2*VM(2,L,IV) - & + VTMP3*VM(3,L,IV) ) - 510 CONTINUE - VDEL(K,1,IVP) = VDEL(K,1,IVP) - & - ( VTMP1*VDEL(1,1,IV) - & + VTMP2*VDEL(2,1,IV) - & + VTMP3*VDEL(3,1,IV) ) - VDEL(K,2,IVP) = VDEL(K,2,IVP) - & - ( VTMP1*VDEL(1,2,IV) - & + VTMP2*VDEL(2,2,IV) - & + VTMP3*VDEL(3,2,IV) ) - 50 CONTINUE -C - IF(IV.EQ.IVTE1) THEN -C------- eliminate VZ block - IVZ = ISYS(IBLTE(2)+1,2) -C - DO 55 K=1, 3 - VTMP1 = VZ(K,1) - VTMP2 = VZ(K,2) - DO 515 L=IVP, NSYS - VM(K,L,IVZ) = VM(K,L,IVZ) - & - ( VTMP1*VM(1,L,IV) - & + VTMP2*VM(2,L,IV) ) - 515 CONTINUE - VDEL(K,1,IVZ) = VDEL(K,1,IVZ) - & - ( VTMP1*VDEL(1,1,IV) - & + VTMP2*VDEL(2,1,IV) ) - VDEL(K,2,IVZ) = VDEL(K,2,IVZ) - & - ( VTMP1*VDEL(1,2,IV) - & + VTMP2*VDEL(2,2,IV) ) - 55 CONTINUE - ENDIF -C - IF(IVP.EQ.NSYS) GO TO 1000 -C -C====== Eliminate lower VM column - DO 60 KV=IV+2, NSYS - VTMP1 = VM(1,IV,KV) - VTMP2 = VM(2,IV,KV) - VTMP3 = VM(3,IV,KV) -C - IF(ABS(VTMP1).GT.VACCEL) THEN - DO 610 L=IVP, NSYS - VM(1,L,KV) = VM(1,L,KV) - VTMP1*VM(3,L,IV) - 610 CONTINUE - VDEL(1,1,KV) = VDEL(1,1,KV) - VTMP1*VDEL(3,1,IV) - VDEL(1,2,KV) = VDEL(1,2,KV) - VTMP1*VDEL(3,2,IV) - ENDIF -C - IF(ABS(VTMP2).GT.VACCEL) THEN - DO 620 L=IVP, NSYS - VM(2,L,KV) = VM(2,L,KV) - VTMP2*VM(3,L,IV) - 620 CONTINUE - VDEL(2,1,KV) = VDEL(2,1,KV) - VTMP2*VDEL(3,1,IV) - VDEL(2,2,KV) = VDEL(2,2,KV) - VTMP2*VDEL(3,2,IV) - ENDIF -C - IF(ABS(VTMP3).GT.VACCEL) THEN - DO 630 L=IVP, NSYS - VM(3,L,KV) = VM(3,L,KV) - VTMP3*VM(3,L,IV) - 630 CONTINUE - VDEL(3,1,KV) = VDEL(3,1,KV) - VTMP3*VDEL(3,1,IV) - VDEL(3,2,KV) = VDEL(3,2,KV) - VTMP3*VDEL(3,2,IV) - ENDIF -C - 60 CONTINUE -C - 1000 CONTINUE -C -C -C - DO 2000 IV=NSYS, 2, -1 -C -C------ eliminate upper VM columns - VTMP = VDEL(3,1,IV) - DO 81 KV=IV-1, 1, -1 - VDEL(1,1,KV) = VDEL(1,1,KV) - VM(1,IV,KV)*VTMP - VDEL(2,1,KV) = VDEL(2,1,KV) - VM(2,IV,KV)*VTMP - VDEL(3,1,KV) = VDEL(3,1,KV) - VM(3,IV,KV)*VTMP - 81 CONTINUE -C - VTMP = VDEL(3,2,IV) - DO 82 KV=IV-1, 1, -1 - VDEL(1,2,KV) = VDEL(1,2,KV) - VM(1,IV,KV)*VTMP - VDEL(2,2,KV) = VDEL(2,2,KV) - VM(2,IV,KV)*VTMP - VDEL(3,2,KV) = VDEL(3,2,KV) - VM(3,IV,KV)*VTMP - 82 CONTINUE -C - 2000 CONTINUE -C - RETURN - END diff --git a/deps/src/xfoil/xutils.f b/deps/src/xfoil/xutils.f deleted file mode 100644 index e1734c5..0000000 --- a/deps/src/xfoil/xutils.f +++ /dev/null @@ -1,113 +0,0 @@ - - - - SUBROUTINE SETEXP(S,DS1,SMAX,NN) -C........................................................ -C Sets geometrically stretched array S: -C -C S(i+1) - S(i) = r * [S(i) - S(i-1)] -C -C S (output) array to be set -C DS1 (input) first S increment: S(2) - S(1) -C SMAX (input) final S value: S(NN) -C NN (input) number of points -C........................................................ - REAL S(NN) -C - SIGMA = SMAX/DS1 - NEX = NN-1 - RNEX = FLOAT(NEX) - RNI = 1.0/RNEX -C -C---- solve quadratic for initial geometric ratio guess - AAA = RNEX*(RNEX-1.0)*(RNEX-2.0) / 6.0 - BBB = RNEX*(RNEX-1.0) / 2.0 - CCC = RNEX - SIGMA -C - DISC = BBB**2 - 4.0*AAA*CCC - DISC = MAX( 0.0 , DISC ) -C - IF(NEX.LE.1) THEN - STOP 'SETEXP: Cannot fill array. N too small.' - ELSE IF(NEX.EQ.2) THEN - RATIO = -CCC/BBB + 1.0 - ELSE - RATIO = (-BBB + SQRT(DISC))/(2.0*AAA) + 1.0 - ENDIF -C - IF(RATIO.EQ.1.0) GO TO 11 -C -C---- Newton iteration for actual geometric ratio - DO 1 ITER=1, 100 - SIGMAN = (RATIO**NEX - 1.0) / (RATIO - 1.0) - RES = SIGMAN**RNI - SIGMA**RNI - DRESDR = RNI*SIGMAN**RNI - & * (RNEX*RATIO**(NEX-1) - SIGMAN) / (RATIO**NEX - 1.0) -C - DRATIO = -RES/DRESDR - RATIO = RATIO + DRATIO -C - IF(ABS(DRATIO) .LT. 1.0E-5) GO TO 11 -C - 1 CONTINUE -c WRITE(*,*) 'SETEXP: Convergence failed. Continuing anyway ...' -C -C---- set up stretched array using converged geometric ratio - 11 S(1) = 0.0 - DS = DS1 - DO 2 N=2, NN - S(N) = S(N-1) + DS - DS = DS*RATIO - 2 CONTINUE -C - RETURN - END - - - - FUNCTION ATANC(Y,X,THOLD) - IMPLICIT REAL (A-H,M,O-Z) -C--------------------------------------------------------------- -C ATAN2 function with branch cut checking. -C -C Increments position angle of point X,Y from some previous -C value THOLD due to a change in position, ensuring that the -C position change does not cross the ATAN2 branch cut -C (which is in the -x direction). For example: -C -C ATANC( -1.0 , -1.0 , 0.75*pi ) returns 1.25*pi , whereas -C ATAN2( -1.0 , -1.0 ) returns -.75*pi . -C -C Typically, ATANC is used to fill an array of angles: -C -C THETA(1) = ATAN2( Y(1) , X(1) ) -C DO i=2, N -C THETA(i) = ATANC( Y(i) , X(i) , THETA(i-1) ) -C END DO -C -C This will prevent the angle array THETA(i) from jumping by -C +/- 2 pi when the path X(i),Y(i) crosses the negative x axis. -C -C Input: -C X,Y point position coordinates -C THOLD position angle of nearby point -C -C Output: -C ATANC position angle of X,Y -C--------------------------------------------------------------- - DATA PI /3.1415926535897932384/ - DATA TPI /6.2831853071795864769/ -C -C---- set new position angle, ignoring branch cut in ATAN2 function for now - THNEW = ATAN2( Y , X ) - DTHET = THNEW - THOLD -C -C---- angle change cannot exceed +/- pi, so get rid of any multiples of 2 pi - DTCORR = DTHET - TPI*INT( (DTHET + SIGN(PI,DTHET))/TPI ) -C -C---- set correct new angle - ATANC = THOLD + DTCORR -C - RETURN - END ! ATANC - diff --git a/deps/src/xfoil_cs/LICENSE b/deps/src/xfoil_cs/LICENSE deleted file mode 100644 index 3912109..0000000 --- a/deps/src/xfoil_cs/LICENSE +++ /dev/null @@ -1,340 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 2, June 1991 - - Copyright (C) 1989, 1991 Free Software Foundation, Inc. - 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -License is intended to guarantee your freedom to share and change free -software--to make sure the software is free for all its users. This -General Public License applies to most of the Free Software -Foundation's software and to any other program whose authors commit to -using it. (Some other Free Software Foundation software is covered by -the GNU Library General Public License instead.) You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -this service if you wish), that you receive source code or can get it -if you want it, that you can change the software or use pieces of it -in new free programs; and that you know you can do these things. - - To protect your rights, we need to make restrictions that forbid -anyone to deny you these rights or to ask you to surrender the rights. -These restrictions translate to certain responsibilities for you if you -distribute copies of the software, or if you modify it. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must give the recipients all the rights that -you have. You must make sure that they, too, receive or can get the -source code. And you must show them these terms so they know their -rights. - - We protect your rights with two steps: (1) copyright the software, and -(2) offer you this license which gives you legal permission to copy, -distribute and/or modify the software. - - Also, for each author's protection and ours, we want to make certain -that everyone understands that there is no warranty for this free -software. If the software is modified by someone else and passed on, we -want its recipients to know that what they have is not the original, so -that any problems introduced by others will not reflect on the original -authors' reputations. - - Finally, any free program is threatened constantly by software -patents. We wish to avoid the danger that redistributors of a free -program will individually obtain patent licenses, in effect making the -program proprietary. To prevent this, we have made it clear that any -patent must be licensed for everyone's free use or not licensed at all. - - The precise terms and conditions for copying, distribution and -modification follow. - - GNU GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License applies to any program or other work which contains -a notice placed by the copyright holder saying it may be distributed -under the terms of this General Public License. The "Program", below, -refers to any such program or work, and a "work based on the Program" -means either the Program or any derivative work under copyright law: -that is to say, a work containing the Program or a portion of it, -either verbatim or with modifications and/or translated into another -language. (Hereinafter, translation is included without limitation in -the term "modification".) Each licensee is addressed as "you". - -Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running the Program is not restricted, and the output from the Program -is covered only if its contents constitute a work based on the -Program (independent of having been made by running the Program). -Whether that is true depends on what the Program does. - - 1. You may copy and distribute verbatim copies of the Program's -source code as you receive it, in any medium, provided that you -conspicuously and appropriately publish on each copy an appropriate -copyright notice and disclaimer of warranty; keep intact all the -notices that refer to this License and to the absence of any warranty; -and give any other recipients of the Program a copy of this License -along with the Program. - -You may charge a fee for the physical act of transferring a copy, and -you may at your option offer warranty protection in exchange for a fee. - - 2. You may modify your copy or copies of the Program or any portion -of it, thus forming a work based on the Program, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) You must cause the modified files to carry prominent notices - stating that you changed the files and the date of any change. - - b) You must cause any work that you distribute or publish, that in - whole or in part contains or is derived from the Program or any - part thereof, to be licensed as a whole at no charge to all third - parties under the terms of this License. - - c) If the modified program normally reads commands interactively - when run, you must cause it, when started running for such - interactive use in the most ordinary way, to print or display an - announcement including an appropriate copyright notice and a - notice that there is no warranty (or else, saying that you provide - a warranty) and that users may redistribute the program under - these conditions, and telling the user how to view a copy of this - License. (Exception: if the Program itself is interactive but - does not normally print such an announcement, your work based on - the Program is not required to print an announcement.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Program, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Program, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Program. - -In addition, mere aggregation of another work not based on the Program -with the Program (or with a work based on the Program) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may copy and distribute the Program (or a work based on it, -under Section 2) in object code or executable form under the terms of -Sections 1 and 2 above provided that you also do one of the following: - - a) Accompany it with the complete corresponding machine-readable - source code, which must be distributed under the terms of Sections - 1 and 2 above on a medium customarily used for software interchange; or, - - b) Accompany it with a written offer, valid for at least three - years, to give any third party, for a charge no more than your - cost of physically performing source distribution, a complete - machine-readable copy of the corresponding source code, to be - distributed under the terms of Sections 1 and 2 above on a medium - customarily used for software interchange; or, - - c) Accompany it with the information you received as to the offer - to distribute corresponding source code. (This alternative is - allowed only for noncommercial distribution and only if you - received the program in object code or executable form with such - an offer, in accord with Subsection b above.) - -The source code for a work means the preferred form of the work for -making modifications to it. For an executable work, complete source -code means all the source code for all modules it contains, plus any -associated interface definition files, plus the scripts used to -control compilation and installation of the executable. However, as a -special exception, the source code distributed need not include -anything that is normally distributed (in either source or binary -form) with the major components (compiler, kernel, and so on) of the -operating system on which the executable runs, unless that component -itself accompanies the executable. - -If distribution of executable or object code is made by offering -access to copy from a designated place, then offering equivalent -access to copy the source code from the same place counts as -distribution of the source code, even though third parties are not -compelled to copy the source along with the object code. - - 4. You may not copy, modify, sublicense, or distribute the Program -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense or distribute the Program is -void, and will automatically terminate your rights under this License. -However, parties who have received copies, or rights, from you under -this License will not have their licenses terminated so long as such -parties remain in full compliance. - - 5. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Program or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Program (or any work based on the -Program), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Program or works based on it. - - 6. Each time you redistribute the Program (or any work based on the -Program), the recipient automatically receives a license from the -original licensor to copy, distribute or modify the Program subject to -these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties to -this License. - - 7. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Program at all. For example, if a patent -license would not permit royalty-free redistribution of the Program by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Program. - -If any portion of this section is held invalid or unenforceable under -any particular circumstance, the balance of the section is intended to -apply and the section as a whole is intended to apply in other -circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system, which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 8. If the distribution and/or use of the Program is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Program under this License -may add an explicit geographical distribution limitation excluding -those countries, so that distribution is permitted only in or among -countries not thus excluded. In such case, this License incorporates -the limitation as if written in the body of this License. - - 9. The Free Software Foundation may publish revised and/or new versions -of the General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies a version number of this License which applies to it and "any -later version", you have the option of following the terms and conditions -either of that version or of any later version published by the Free -Software Foundation. If the Program does not specify a version number of -this License, you may choose any version ever published by the Free Software -Foundation. - - 10. If you wish to incorporate parts of the Program into other free -programs whose distribution conditions are different, write to the author -to ask for permission. For software which is copyrighted by the Free -Software Foundation, write to the Free Software Foundation; we sometimes -make exceptions for this. Our decision will be guided by the two goals -of preserving the free status of all derivatives of our free software and -of promoting the sharing and reuse of software generally. - - NO WARRANTY - - 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY -FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN -OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES -PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED -OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS -TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE -PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, -REPAIR OR CORRECTION. - - 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR -REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING -OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED -TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY -YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER -PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE -POSSIBILITY OF SUCH DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - - -Also add information on how to contact you by electronic and paper mail. - -If the program is interactive, make it output a short notice like this -when it starts in an interactive mode: - - Gnomovision version 69, Copyright (C) year name of author - Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, the commands you use may -be called something other than `show w' and `show c'; they could even be -mouse-clicks or menu items--whatever suits your program. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the program - `Gnomovision' (which makes passes at compilers) written by James Hacker. - - , 1 April 1989 - Ty Coon, President of Vice - -This General Public License does not permit incorporating your program into -proprietary programs. If your program is a subroutine library, you may -consider it more useful to permit linking proprietary applications with the -library. If this is what you want to do, use the GNU Library General -Public License instead of this License. diff --git a/deps/src/xfoil_cs/Makefile b/deps/src/xfoil_cs/Makefile deleted file mode 100644 index 59e1c16..0000000 --- a/deps/src/xfoil_cs/Makefile +++ /dev/null @@ -1,48 +0,0 @@ -#********************************************************* -# Makefile for XFOIL V6.93 programs -# H.Youngren 4/24/01 -# M.Drela -#********************************************************* -RM = /bin/rm -rf -FC = gfortran -FFLAGS = -O3 -fdefault-real-8 -fPIC -shared -LIB = libxfoil_cs -SUFFIX = so - -OBJ = complexify.o\ - c_xfoil.o\ - c_xpanel.o\ - c_xoper.o\ - c_xsolve.o\ - c_xgdes.o\ - c_xbl.o\ - c_xblsys.o\ - c_xgeom.o\ - c_xutils.o\ - c_aread.o\ - c_userio.o\ - c_spline.o\ - c_naca.o - -default: libxfoil_cs - -clean: - $(RM) *.o $(LIB).$(SUFFIX) - -libxfoil_cs: $(OBJ) - $(FC) -O3 -shared -fPIC -o $(LIB).$(SUFFIX) $(OBJ) - -%.o : %.f - $(FC) $(FFLAGS) -c $< -o $*.o - @echo - @echo " --- Compiled $*.f successfully ---" - @echo - -%.o : %.f90 - $(FC) $(FFLAGS) -c $< -o $*.o - @echo - @echo " --- Compiled $*.f90 successfully ---" - @echo - -install: - install $(LIB).$(SUFFIX) $(INSTALL_DIR) diff --git a/deps/src/xfoil_cs/c_XBL.INC b/deps/src/xfoil_cs/c_XBL.INC deleted file mode 100644 index 2e33537..0000000 --- a/deps/src/xfoil_cs/c_XBL.INC +++ /dev/null @@ -1,79 +0,0 @@ -C -c use complexify -c implicit complex(a-h, o-z) - PARAMETER (NCOM=73) - complex COM1(NCOM), COM2(NCOM) - complex M1, M1_U1, M1_MS, M2, M2_U2, M2_MS - LOGICAL SIMI,TRAN,TURB,WAKE - LOGICAL TRFORC,TRFREE -C -C- SCCON = shear coefficient lag constant -C- GACON = G-beta locus constants... -C- GBCON = G = GACON * sqrt(1.0 + GBCON*beta) -C- GCCON = + GCCON / [H*Rtheta*sqrt(Cf/2)] <-- wall term -C- DLCON = wall/wake dissipation length ratio Lo/L -C- CTCON = Ctau weighting coefficient (implied by G-beta constants) -C - PARAMETER (SCCON = 5.6 , - & GACON = 6.70 , - & GBCON = 0.75 , - & GBC0 = 0.60, - & GBC1 = 0.40, - & GCCON = 18.0 , - & DLCON = 0.9 ) - PARAMETER (CTCON = 0.5/(GACON**2 * GBCON)) -C - COMMON/VAR1/ X1, U1, T1, D1, S1, AMPL1, U1_UEI, U1_MS, DW1 - & , H1, H1_T1, H1_D1 - & , M1, M1_U1, M1_MS - & , R1, R1_U1, R1_MS - & , V1, V1_U1, V1_MS, V1_RE - & , HK1, HK1_U1, HK1_T1, HK1_D1, HK1_MS - & , HS1, HS1_U1, HS1_T1, HS1_D1, HS1_MS, HS1_RE - & , HC1, HC1_U1, HC1_T1, HC1_D1, HC1_MS - & , RT1, RT1_U1, RT1_T1, RT1_MS, RT1_RE - & , CF1, CF1_U1, CF1_T1, CF1_D1, CF1_MS, CF1_RE - & , DI1, DI1_U1, DI1_T1, DI1_D1, DI1_S1, DI1_MS, DI1_RE - & , US1, US1_U1, US1_T1, US1_D1, US1_MS, US1_RE - & , CQ1, CQ1_U1, CQ1_T1, CQ1_D1, CQ1_MS, CQ1_RE - & , DE1, DE1_U1, DE1_T1, DE1_D1, DE1_MS - COMMON/VAR2/ X2, U2, T2, D2, S2, AMPL2, U2_UEI, U2_MS, DW2 - & , H2, H2_T2, H2_D2 - & , M2, M2_U2, M2_MS - & , R2, R2_U2, R2_MS - & , V2, V2_U2, V2_MS, V2_RE - & , HK2, HK2_U2, HK2_T2, HK2_D2, HK2_MS - & , HS2, HS2_U2, HS2_T2, HS2_D2, HS2_MS, HS2_RE - & , HC2, HC2_U2, HC2_T2, HC2_D2, HC2_MS - & , RT2, RT2_U2, RT2_T2, RT2_MS, RT2_RE - & , CF2, CF2_U2, CF2_T2, CF2_D2, CF2_MS, CF2_RE - & , DI2, DI2_U2, DI2_T2, DI2_D2, DI2_S2, DI2_MS, DI2_RE - & , US2, US2_U2, US2_T2, US2_D2, US2_MS, US2_RE - & , CQ2, CQ2_U2, CQ2_T2, CQ2_D2, CQ2_MS, CQ2_RE - & , DE2, DE2_U2, DE2_T2, DE2_D2, DE2_MS - EQUIVALENCE (X1,COM1(1)), (X2,COM2(1)) -C - COMMON/VARA/ CFM, CFM_MS, CFM_RE - & , CFM_U1, CFM_T1, CFM_D1 - & , CFM_U2, CFM_T2, CFM_D2 - & , XT, XT_A1, XT_MS, XT_RE, XT_XF - & , XT_X1, XT_T1, XT_D1, XT_U1 - & , XT_X2, XT_T2, XT_D2, XT_U2 -C -C - COMMON/SAV/ C1SAV(NCOM), C2SAV(NCOM) -C - COMMON/VAR/ DWTE - & , QINFBL - & , TKBL , TKBL_MS - & , RSTBL , RSTBL_MS - & , HSTINV, HSTINV_MS - & , REYBL , REYBL_MS, REYBL_RE - & , GAMBL, GM1BL, HVRAT - & , BULE, XIFORC, AMCRIT - & , SIMI,TRAN,TURB,WAKE - & , TRFORC,TRFREE -C - COMMON/SYS/ VS1(4,5), VS2(4,5), VSREZ(4), VSR(4), VSM(4), VSX(4) -C - diff --git a/deps/src/xfoil_cs/c_XFOIL.INC b/deps/src/xfoil_cs/c_XFOIL.INC deleted file mode 100644 index d377979..0000000 --- a/deps/src/xfoil_cs/c_XFOIL.INC +++ /dev/null @@ -1,571 +0,0 @@ -C -C==== XFOIL code global INCLUDE file ===== -C -C------ Primary dimensioning limit parameters -C IQX number of surface panel nodes + 6 -C IWX number of wake panel nodes -C IPX number of Qspec(s) distributions -C ISX number of airfoil sides -C -C------ Derived dimensioning limit parameters -C IBX number of buffer airfoil nodes -C IMX number of complex mapping coefficients Cn -C IZX number of panel nodes (airfoil + wake) -C IVX number of nodes along BL on one side of airfoil and wake -C NAX number of points in stored polar -C NPX number of polars and reference polars -C NFX number of points in one reference polar -C -C---- include polar variable indexing parameters -C INCLUDE 'PINDEX.INC' -C -c use complexify -c implicit complex(a-h, o-z) - PARAMETER (IQX=286, IWX=36, IPX=5, ISX=2) -C PARAMETER (IBX=2*IQX) - PARAMETER (IBX=572) -C PARAMETER (IZX=IQX+IWX) - PARAMETER (IZX=322) -C PARAMETER (IVX=IQX/2 + IWX + 50) - PARAMETER (IVX=229) - PARAMETER (NAX=800,NPX=8,NFX=128) - CHARACTER*32 LABREF - CHARACTER*64 FNAME, PFNAME, PFNAMX, ONAME, PREFIX - CHARACTER*48 NAME, NAMEPOL, CODEPOL, NAMEREF - CHARACTER*80 ISPARS - LOGICAL OK,LIMAGE, - & LGAMU,LQINU,SHARP,LVISC,LALFA,LWAKE,LPACC, - & LBLINI,LIPAN,LQAIJ,LADIJ,LWDIJ,LCPXX,LQVDES,LQREFL, - & LQSPEC,LVCONV,LCPREF,LCLOCK,LPFILE,LPFILX,LPPSHO, - & LBFLAP,LFLAP,LEIW,LSCINI,LFOREF,LNORM,LGSAME, - & LPLCAM, LQSYM ,LGSYM , LQGRID, LGGRID, LGTICK, - & LQSLOP,LGSLOP, LCSLOP, LQSPPL, LGEOPL, LGPARM, - & LCPGRD,LBLGRD, LBLSYM, LCMINP, LHMOMP - LOGICAL LPLOT,LSYM,LIQSET,LCLIP,LVLAB,LCURS,LLAND - LOGICAL LPGRID, LPCDW, LPLIST, LPLEGN - LOGICAL TFORCE - complex NX, NY, MASS, MINF1, MINF, MINF_CL, MVISC, MACHP1 - INTEGER RETYP, MATYP, AIJPIV - CHARACTER*1 VMXBL -C -C---- dimension temporary work and storage arrays (EQUIVALENCED below) - complex W1(6*IQX),W2(6*IQX),W3(6*IQX),W4(6*IQX), - & W5(6*IQX),W6(6*IQX),W7(6*IQX),W8(6*IQX) - complex BIJ(IQX,IZX), CIJ(IWX,IQX) -C - COMMON/CR01/ VERSION - COMMON/CC01/ FNAME, - & NAME,ISPARS,ONAME,PREFIX, - & PFNAME(NPX),PFNAMX(NPX), - & NAMEPOL(NPX), CODEPOL(NPX), - & NAMEREF(NPX) - COMMON/QMAT/ Q(IQX,IQX),DQ(IQX), - & DZDG(IQX),DZDN(IQX),DZDM(IZX), - & DQDG(IQX),DQDM(IZX),QTAN1,QTAN2, - & Z_QINF,Z_ALFA,Z_QDOF0,Z_QDOF1,Z_QDOF2,Z_QDOF3 - COMMON/CR03/ AIJ(IQX,IQX),DIJ(IZX,IZX) - COMMON/CR04/ QINV(IZX),QVIS(IZX),CPI(IZX),CPV(IZX), - & QINVU(IZX,2), QINV_A(IZX) - COMMON/CR05/ X(IZX),Y(IZX),XP(IZX),YP(IZX),S(IZX), - & SLE,XLE,YLE,XTE,YTE,CHORD,YIMAGE, - & WGAP(IWX),WAKLEN - COMMON/CR06/ GAM(IQX),GAMU(IQX,2),GAM_A(IQX),SIG(IZX), - & NX(IZX),NY(IZX),APANEL(IZX), - & SST,SST_GO,SST_GP, - & GAMTE,GAMTE_A, - & SIGTE,SIGTE_A, - & DSTE,ANTE,ASTE - COMMON/CR07/ SSPLE, - & SSPEC(IBX),XSPOC(IBX),YSPOC(IBX), - & QGAMM(IBX), - & QSPEC(IBX,IPX),QSPECP(IBX,IPX), - & ALGAM,CLGAM,CMGAM, - & ALQSP(IPX),CLQSP(IPX),CMQSP(IPX), - & QF0(IQX),QF1(IQX),QF2(IQX),QF3(IQX), - & QDOF0,QDOF1,QDOF2,QDOF3,CLSPEC,FFILT - COMMON/CI01/ IQ1,IQ2,NSP,NQSP,KQTARG,IACQSP,NC1,NNAME,NPREFIX - COMMON/CR09/ ADEG,ALFA,AWAKE,MVISC,AVISC, - & XCMREF,YCMREF, - & CL,CM,CD,CDP,CDF,CL_ALF,CL_MSQ, - & PSIO,CIRC,COSA,SINA,QINF, - & GAMMA,GAMM1, - & MINF1,MINF,MINF_CL,TKLAM,TKL_MSQ,CPSTAR,QSTAR, - & CPMN,CPMNI,CPMNV,XCPMNI,XCPMNV - COMMON/CI03/ NCPREF, NAPOL(NPX), NPOL, IPACT, NLREF, - & ICOLP(NPX),ICOLR(NPX), - & IMATYP(NPX),IRETYP(NPX), NXYPOL(NPX), - & NPOLREF, NDREF(4,NPX) - COMMON/CR10/ XPREF(IQX),CPREF(IQX), VERSPOL(NPX), - & CPOLXY(IQX,2,NPX), - & MACHP1(NPX), - & REYNP1(NPX), - & ACRITP(NPX),XSTRIPP(ISX,NPX) - -c modified db -c COMMON/CR10/ XPREF(IQX),CPREF(IQX), VERSPOL(NPX), -c & CPOL(NAX,IPTOT,NPX), -c & CPOLSD(NAX,ISX,JPTOT,NPX), -c & CPOLXY(IQX,2,NPX), -c & MACHP1(NPX), -c & REYNP1(NPX), -c & ACRITP(NPX),XSTRIPP(ISX,NPX), -c & CPOLREF(NFX,2,4,NPX) - - - COMMON/CC02/ LABREF -C - COMMON/CR11/ PI,HOPI,QOPI,DTOR - COMMON/CR12/ CVPAR,CTERAT,CTRRAT,XSREF1,XSREF2,XPREF1,XPREF2 - COMMON/CI04/ N,NB,NW,NPAN,IST,KIMAGE, - & ITMAX,NSEQEX,RETYP,MATYP,AIJPIV(IQX), - & IDEV,IDEVRP,IPSLU,NCOLOR, - & ICOLS(ISX),NOVER, NCM,NTK - COMMON/CR13/ SIZE,SCRNFR,PLOTAR, PFAC,QFAC,VFAC, - & XWIND,YWIND, - & XPAGE,YPAGE,XMARG,YMARG, - & CH, CHG, CHQ, - & XOFAIR,YOFAIR,FACAIR, XOFA,YOFA,FACA,UPRWT, - & CPMIN,CPMAX,CPDEL, - & CPOLPLF(3,4), - & XCDWID,XALWID,XOCWID - COMMON/CL01/ OK,LIMAGE,SHARP, - & LGAMU,LQINU,LVISC,LALFA,LWAKE,LPACC, - & LBLINI,LIPAN,LQAIJ,LADIJ,LWDIJ,LCPXX,LQVDES,LQREFL, - & LQSPEC,LVCONV,LCPREF,LCLOCK,LPFILE,LPFILX,LPPSHO, - & LBFLAP,LFLAP,LEIW,LSCINI,LFOREF,LNORM,LGSAME, - & LPLCAM,LQSYM ,LGSYM, - & LQGRID,LGGRID,LGTICK, - & LQSLOP,LGSLOP,LCSLOP,LQSPPL,LGEOPL,LGPARM, - & LCPGRD,LBLGRD,LBLSYM, - & LPLOT,LSYM,LIQSET,LCLIP,LVLAB,LCURS,LLAND, - & LPGRID,LPCDW,LPLIST,LPLEGN, - & LCMINP, LHMOMP - COMMON/CR14/ XB(IBX),YB(IBX), - & XBP(IBX),YBP(IBX),SB(IBX),SNEW(4*IBX), - & XBF,YBF,XOF,YOF,HMOM,HFX,HFY, - & XBMIN,XBMAX,YBMIN,YBMAX, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB, - & XCM(2*IBX),YCM(2*IBX),SCM(2*IBX),XCMP(2*IBX),YCMP(2*IBX), - & XTK(2*IBX),YTK(2*IBX),STK(2*IBX),XTKP(2*IBX),YTKP(2*IBX) -C - COMMON/CR15/ XSSI(IVX,ISX),UEDG(IVX,ISX),UINV(IVX,ISX), - & MASS(IVX,ISX),THET(IVX,ISX),DSTR(IVX,ISX), - & CTAU(IVX,ISX),DELT(IVX,ISX),USLP(IVX,ISX), - & GUXQ(IVX,ISX),GUXD(IVX,ISX), - & TAU(IVX,ISX),DIS(IVX,ISX),CTQ(IVX,ISX), - & VTI(IVX,ISX), - & REINF1,REINF,REINF_CL,ACRIT, - & XSTRIP(ISX),XOCTR(ISX),YOCTR(ISX),XSSITR(ISX), - & UINV_A(IVX,ISX) - COMMON/CI05/ IBLTE(ISX),NBL(ISX),IPAN(IVX,ISX),ISYS(IVX,ISX),NSYS, - & ITRAN(ISX) - COMMON/CL02/ TFORCE(ISX) - COMMON/CR17/ RMSBL,RMXBL,RLX,VACCEL - COMMON/CI06/ IMXBL,ISMXBL - COMMON/CC03/ VMXBL - COMMON/CR18/ XSF,YSF,XOFF,YOFF, - & XGMIN,XGMAX,YGMIN,YGMAX,DXYG, - & XCMIN,XCMAX,YCMIN,YCMAX,DXYC,DYOFFC, - & XPMIN,XPMAX,YPMIN,YPMAX,DXYP,DYOFFP, - & YSFP,GTICK -C - COMMON/VMAT/ VA(3,2,IZX),VB(3,2,IZX),VDEL(3,2,IZX), - & VM(3,IZX,IZX),VZ(3,2) -C -C -C---- save storage space - EQUIVALENCE (Q(1,1 ),W1(1)), (Q(1,7 ),W2(1)), - & (Q(1,13),W3(1)), (Q(1,19),W4(1)), - & (Q(1,25),W5(1)), (Q(1,31),W6(1)), - & (Q(1,37),W7(1)), (Q(1,43),W8(1)) - EQUIVALENCE (VM(1,1,1),BIJ(1,1)), (VM(1,1,IZX/2),CIJ(1,1)) -C -C -C VERSION version number of this XFOIL implementation -C -C FNAME airfoil data filename -C PFNAME(.) polar append filename -C PFNAMX(.) polar append x/c dump filename -C ONAME default overlay airfoil filename -C PREFIX default filename prefix -C NAME airfoil name -C -C ISPARS ISES domain parameters (not used in XFOIL) -C -C Q(..) generic coefficient matrix -C DQ(.) generic matrix righthand side -C -C DZDG(.) dPsi/dGam -C DZDN(.) dPsi/dn -C DZDM(.) dPsi/dSig -C -C DQDG(.) dQtan/dGam -C DQDM(.) dQtan/dSig -C QTAN1 Qtan at alpha = 0 deg. -C QTAN2 Qtan at alpha = 90 deg. -C -C Z_QINF dPsi/dQinf -C Z_ALFA dPsi/dalfa -C Z_QDOF0 dPsi/dQdof0 -C Z_QDOF1 dPsi/dQdof1 -C Z_QDOF2 dPsi/dQdof2 -C Z_QDOF3 dPsi/dQdof3 -C -C AIJ(..) dPsi/dGam influence coefficient matrix (factored if LQAIJ=t) -C BIJ(..) dGam/dSig influence coefficient matrix -C CIJ(..) dQtan/dGam influence coefficient matrix -C DIJ(..) dQtan/dSig influence coefficient matrix -C QINV(.) tangential velocity due to surface vorticity -C QVIS(.) tangential velocity due to surface vorticity & mass sources -C QINVU(..) QINV for alpha = 0, 90 deg. -C QINV_A(.) dQINV/dalpha -C -C X(.),Y(.) airfoil (1panel pointers IPAN have been calculated -C LQAIJ .TRUE. if dPsi/dGam matrix has been computed and factored -C LADIJ .TRUE. if dQ/dSig matrix for the airfoil has been computed -C LWDIJ .TRUE. if dQ/dSig matrix for the wake has been computed -C LQVDES .TRUE. if viscous Ue is to be plotted in QDES routines -C LQSPEC .TRUE. if Qspec has been initialized -C LQREFL .TRUE. if reflected Qspec is to be plotted in QDES routines -C LVCONV .TRUE. if converged BL solution exists -C LCPREF .TRUE. if reference data is to be plotted on Cp vs x/c plots -C LCLOCK .TRUE. if source airfoil coordinates are clockwise -C LPFILE .TRUE. if polar file is ready to be appended to -C LPFILX .TRUE. if polar dump file is ready to be appended to -C LPPSHO .TRUE. if CL-CD polar is plotted during point sequence -C LBFLAP .TRUE. if buffer airfoil flap parameters are defined -C LFLAP .TRUE. if current airfoil flap parameters are defined -C LEIW .TRUE. if unit circle complex number array is initialized -C LSCINI .TRUE. if old-airfoil circle-plane arc length s(w) exists -C LFOREF .TRUE. if CL,CD... data is to be plotted on Cp vs x/c plots -C LNORM .TRUE. if input buffer airfoil is to be normalized -C LGSAME .TRUE. if current and buffer airfoils are identical -C -C LPLCAM .TRUE. if thickness and camber are to be plotted -C LQSYM .TRUE. if symmetric Qspec will be enforced -C LGSYM .TRUE. if symmetric geometry will be enforced -C LQGRID .TRUE. if grid is to overlaid on Qspec(s) plot -C LGGRID .TRUE. if grid is to overlaid on buffer airfoil geometry plot -C LGTICK .TRUE. if node tick marks are to be plotted on buffer airfoil -C LQSLOP .TRUE. if modified Qspec(s) segment is to match slopes -C LGSLOP .TRUE. if modified geometry segment is to match slopes -C LCSLOP .TRUE. if modified camber line segment is to match slopes -C LQSPPL .TRUE. if current Qspec(s) in in plot -C LGEOPL .TRUE. if current geometry in in plot -C LCPGRD .TRUE. if grid is to be plotted on Cp plots -C LBLGRD .TRUE. if grid is to be plotted on BL variable plots -C LBLSYM .TRUE. if symbols are to be plotted on BL variable plots -C LCMINP .TRUE. if min Cp is to be written to polar file for cavitation -C LHMOMP .TRUE. if hinge moment is to be written to polar file -C -C LPGRID .TRUE. if polar grid overlay is enabled -C LPCDW .TRUE. if polar CDwave is plotted -C LPLIST .TRUE. if polar listing lines (at top of plot) are enabled -C LPLEGN .TRUE. if polar legend is enabled -C -C LPLOT .TRUE. if plot page is open -C LSYM .TRUE. if symbols are to be plotted in QDES routines -C LIQSET .TRUE. if inverse target segment is marked off in QDES -C LCLIP .TRUE. if line-plot clipping is to be performed -C LVLAB .TRUE. if label is to be plotted on viscous-variable plots -C LCURS .TRUE. if cursor input is to be used for blowups, etc. -C LLAND .TRUE. if Landscape orientation for PostScript is used -C -C -C XB(.),YB(.) buffer airfoil coordinate arrays -C XBP(.) dXB/dSB -C YBP(.) dYB/dSB -C SB(.) spline parameter for buffer airfoil -C SNEW(.) new panel endpoint arc length array -C -C XBF,YBF buffer airfoil flap hinge coordinates -C XOF,YOF current airfoil flap hinge coordinates -C HMOM moment of flap about hinge point -C HFX x-force of flap on hinge point -C HFY y-force of flap on hinge point -C -C~~~~~~~~~~~~~~ properties of current buffer airfoil -C -C XBMIN,XBMAX limits of XB array -C YBMIN,YBMAX limits of YB array -C SBLE LE tangency-point SB location -C CHORDB chord -C AREAB area -C RADBLE LE radius -C ANGBTE TE angle (rad) -C -C EI11BA bending inertia about axis 1 x^2 dx dy -C EI22BA bending inertia about axis 2 y^2 dx dy -C APX1BA principal axis 1 angle -C APX2BA principal axis 2 angle -C -C EI11BT bending inertia about axis 1 x^2 t ds -C EI22BT bending inertia about axis 2 y^2 t ds -C APX1BT principal axis 1 angle -C APX2BT principal axis 2 angle -C -C THICKB max thickness -C CAMBRB max camber -C -C~~~~~~~~~~~~~~ -C -C XSSI(..) BL arc length coordinate array on each surface -C UEDG(..) BL edge velocity array -C UINV(..) BL edge velocity array without mass defect influence -C MASS(..) BL mass defect array ( = UEDG*DSTR ) -C THET(..) BL momentum thickness array -C DSTR(..) BL displacement thickness array -C CTAU(..) sqrt(max shear coefficient) array -C (in laminar regions, log of amplification ratio) -C -C TAU(..) wall shear stress array (for plotting only) -C DIS(..) dissipation array (for plotting only) -C CTQ(..) sqrt(equilibrium max shear coefficient) array ( " ) -C VTI(..) +/-1 conversion factor between panel and BL variables -C UINV_A(..) dUINV/dalfa array -C -C REINF1 Reynolds number Vinf c / ve for CL=1 -C REINF Reynolds number for current CL -C REINF_CL dREINF/dCL -C -C ACRIT log (critical amplification ratio) -C XSTRIP(.) transition trip x/c locations (if XTRIP > 0), -C transition trip -s/s_side locations (if XTRIP < 0), -C XOCTR(.) actual transition x/c locations -C YOCTR(.) actual transition y/c locations -C XSSITR(.) actual transition xi locations -C -C IBLTE(.) BL array index at trailing edge -C NBL(.) max BL array index -C IPAN(..) panel index corresponding to BL location -C ISYS(..) BL Newton system line number corresponding to BL location -C NSYS total number of lines in BL Newton system -C ITRAN(.) BL array index of transition interval -C TFORCE(.) .TRUE. if transition is forced due to transition strip -C -C VA,VB(...) diagonal and off-diagonal blocks in BL Newton system -C VZ(..) way-off-diagonal block at TE station line -C VM(...) mass-influence coefficient vectors in BL Newton system -C VDEL(..) residual and solution vectors in BL Newton system -C -C RMSBL rms change from BL Newton system solution -C RMXBL max change from BL Newton system solution -C IMXBL location of max change -C ISMXBL index of BL side containing max change -C VMXBL character identifying variable with max change -C RLX underrelaxation factor for Newton update -C VACCEL parameter for accelerating BL Newton system solution -C (any off-diagonal element < VACCEL is not eliminated, -C which speeds up each iteration, but MAY increase -C iteration count) -C Can be set to zero for unadulterated Newton method -C -C XOFF,YOFF x and y offsets for windowing in QDES,GDES routines -C XSF ,YSF x and y scaling factors for windowing in QDES,GDES routines -C -C XGMIN airfoil grid plot limits -C XGMAX -C YGMIN -C YGMAX -C DXYG airfoil grid-plot annotation increment -C GTICK airfoil-plot tick marks size (as fraction of arc length) diff --git a/deps/src/xfoil_cs/c_aread.f b/deps/src/xfoil_cs/c_aread.f deleted file mode 100644 index 6998594..0000000 --- a/deps/src/xfoil_cs/c_aread.f +++ /dev/null @@ -1,155 +0,0 @@ - - SUBROUTINE AREAD(LU,FNAME,NMAX,X,Y,N,NAME,ISPARS,ITYPE,INFO) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(NMAX), Y(NMAX) - CHARACTER*(*) FNAME - CHARACTER*(*) NAME - CHARACTER*(*) ISPARS -C-------------------------------------------------------- -C Reads in several types of airfoil coordinate file. -C -C Input: -C LU logical unit to use for reading -C FNAME name of coordinate file to be read, -C if FNAME(1:1).eq.' ', unit LU is assumed -C to be already open -C INFO 0 keep quiet -C 1 print info on airfoil -C Output: -C X,Y coordinates -C N number of X,Y coordinates -C NAME character name string (if ITYPE > 1) -C ISPARS ISES/MSES domain-size string (if ITYPE > 2) -C ITYPE returns type of file: -C 0 None. Read error occurred. -C 1 Generic. -C 2 Labeled generic. -C 3 MSES single element. -C 4 MSES multi-element. -C-------------------------------------------------------- -C***************************************************************** -CModified 2.24.06 by D. Berkenstock to suppress text output -C***************************************************************** -C - CHARACTER*80 LINE1,LINE2,LINE - LOGICAL LOPEN, ERROR - DIMENSION A(10) -C - IEL = 0 - NEL = 0 -C -C---- assume read error will occur - ITYPE = 0 -C - LOPEN = FNAME(1:1) .cne. ' ' - IF(LOPEN) OPEN(LU,FILE=FNAME,STATUS='OLD',ERR=98) -C - 11 READ(LU,1000,END=99,ERR=98) LINE1 - IF(INDEX('#!',LINE1(1:1)) .cne. 0) GO TO 11 -C - 12 READ(LU,1000,END=99) LINE2 - IF(INDEX('#!',LINE2(1:1)) .cne. 0) GO TO 12 -C - I = 1 -C -C---- try to read numbers from first line - NA = 10 - CALL GETFLT(LINE1,A,NA,ERROR) - IF(ERROR .OR. NA.LT.2) THEN - NAME = LINE1 - ELSE - IF(INFO.GT.0) THEN -C WRITE(*,*) -C WRITE(*,*) 'Plain airfoil file' - ENDIF - ITYPE = 1 - REWIND(LU) - GO TO 50 - ENDIF -C -C---- try to read numbers from second line - NA = 10 - CALL GETFLT(LINE2,A,NA,ERROR) - IF(ERROR .OR. NA.GE.4) THEN - ISPARS = LINE2 - ELSE - NAME = LINE1 - IF(INFO.GT.0) THEN -C WRITE(*,*) -C WRITE(*,*) 'Labeled airfoil file. Name: ', NAME - ENDIF - ITYPE = 2 - REWIND(LU) - READ(LU,1000,END=99) LINE1 - GO TO 50 - ENDIF -C - IF(INFO.GT.0) THEN -C WRITE(*,*) -C WRITE(*,*) 'MSES airfoil file. Name: ', NAME - ENDIF - ITYPE = 3 -C -C---- read each element until 999.0 or end of file is encountered - 50 NEL = NEL + 1 - DO 55 I=1, NMAX - 51 READ(LU,1000,END=60) LINE -C -C------ skip comment line - IF(INDEX('#!',LINE(1:1)) .cne. 0) GO TO 51 -C - NA = 2 - CALL GETFLT(LINE,A,NA,ERROR) - IF(ERROR) GO TO 99 -C -C------ skip line without at least two numbers - IF(NA.LT.2) GO TO 51 -C - X(I) = A(1) - Y(I) = A(2) -C - IF (X(I) .ceq. 999.0) THEN -C-------- if this is the element we want, just exit - IF(IEL .ceq. NEL) GO TO 60 -C - IF(IEL.ceq.0) THEN - CALL ASKI('Enter element number^',IEL) - ITYPE = 4 - ENDIF -C -C-------- if this is the specified element, exit. - IF(IEL .ceq. NEL) GO TO 60 - GO TO 50 - ENDIF - 55 CONTINUE -C WRITE(*,5030) NMAX -C WRITE(*,5900) - IF(LOPEN) CLOSE(LU) - ITYPE = 0 - RETURN -C - 60 N = I-1 - IF(LOPEN) CLOSE(LU) - RETURN -C - 98 CONTINUE -C WRITE(*,5050) -C WRITE(*,5900) - ITYPE = 0 - RETURN -C - 99 CONTINUE - IF(LOPEN) CLOSE(LU) -C WRITE(*,5100) -C WRITE(*,5900) - ITYPE = 0 - RETURN -C............................................................... - 1000 FORMAT(A) - 5030 FORMAT(/' Buffer array size exceeded' - & /' Maximum number of points: ', I4 ) - 5050 FORMAT(/' File OPEN error. Nonexistent file') - 5100 FORMAT(/' File READ error. Unrecognizable file format') - 5900 FORMAT( ' *** LOAD NOT COMPLETED ***' ) - END ! AREAD diff --git a/deps/src/xfoil_cs/c_naca.f b/deps/src/xfoil_cs/c_naca.f deleted file mode 100644 index 7e3302c..0000000 --- a/deps/src/xfoil_cs/c_naca.f +++ /dev/null @@ -1,249 +0,0 @@ -C*********************************************************************** -C Module: naca.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE NACA4(IDES,XX,YT,YC,NSIDE,XB,YB,NB,NAME) - use complexify - implicit complex(a-h, o-z) - complex XX(NSIDE), YT(NSIDE), YC(NSIDE) - complex XB(2*NSIDE), YB(2*NSIDE) - complex M - CHARACTER*(*) NAME -C - CHARACTER*10 DIGITS - DATA DIGITS / '0123456789' / -C -C---- TE point bunching parameter - DATA AN / 1.5 / -C - N4 = IDES / 1000 - N3 = (IDES - N4*1000 ) / 100 - N2 = (IDES - N4*1000 - N3*100 ) / 10 - N1 = (IDES - N4*1000 - N3*100 - N2*10) -C - M = FLOAT(N4) / 100.0 - P = FLOAT(N3) / 10.0 - T = FLOAT(N2*10 + N1) / 100.0 -C - ANP = AN + 1.0 - DO 10 I=1, NSIDE - FRAC = FLOAT(I-1)/FLOAT(NSIDE-1) - IF(I.ceq.NSIDE) THEN - XX(I) = 1.0 - ELSE - XX(I) = 1.0 - ANP*FRAC*(1.0-FRAC)**AN - (1.0-FRAC)**ANP - ENDIF - YT(I) = ( 0.29690*SQRT(XX(I)) - & - 0.12600*XX(I) - & - 0.35160*XX(I)**2 - & + 0.28430*XX(I)**3 - & - 0.10150*XX(I)**4) * T / 0.20 - IF(XX(I).LT.P) THEN - YC(I) = M/P**2 * (2.0*P*XX(I) - XX(I)**2) - ELSE - YC(I) = M/(1.0-P)**2 * ((1.0-2.0*P) + 2.0*P*XX(I)-XX(I)**2) - ENDIF - 10 CONTINUE -C - IB = 0 - DO 20 I=NSIDE, 1, -1 - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) + YT(I) - 20 CONTINUE - DO 30 I=2, NSIDE - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) - YT(I) - 30 CONTINUE - NB = IB -C - NAME = 'NACA' - NAME(6:9) = DIGITS(N4+1:N4+1) - & // DIGITS(N3+1:N3+1) - & // DIGITS(N2+1:N2+1) - & // DIGITS(N1+1:N1+1) -C - RETURN - END - - - SUBROUTINE NACA4B(M,P,T,XX,YT,YC,NSIDE,XB,YB,NB,NAME) - use complexify - implicit complex(a-h, o-z) - complex XX(NSIDE), YT(NSIDE), YC(NSIDE) - complex XB(2*NSIDE), YB(2*NSIDE) - complex M - CHARACTER*(*) NAME -C - CHARACTER*10 DIGITS - DATA DIGITS / '0123456789' / -C -C---- TE point bunching parameter - DATA AN / 1.5 / -C -c N4 = IDES / 1000 -c N3 = (IDES - N4*1000 ) / 100 -c N2 = (IDES - N4*1000 - N3*100 ) / 10 -c N1 = (IDES - N4*1000 - N3*100 - N2*10) -C -c M = FLOAT(N4) / 100.0 -c P = FLOAT(N3) / 10.0 -c T = FLOAT(N2*10 + N1) / 100.0 -C - ANP = AN + 1.0 - DO 10 I=1, NSIDE - FRAC = FLOAT(I-1)/FLOAT(NSIDE-1) - IF(I.ceq.NSIDE) THEN - XX(I) = 1.0 - ELSE - XX(I) = 1.0 - ANP*FRAC*(1.0-FRAC)**AN - (1.0-FRAC)**ANP - ENDIF - YT(I) = ( 0.29690*SQRT(XX(I)) - & - 0.12600*XX(I) - & - 0.35160*XX(I)**2 - & + 0.28430*XX(I)**3 - & - 0.10150*XX(I)**4) * T / 0.20 - IF(XX(I).LT.P) THEN - YC(I) = M/P**2 * (2.0*P*XX(I) - XX(I)**2) - ELSE - YC(I) = M/(1.0-P)**2 * ((1.0-2.0*P) + 2.0*P*XX(I)-XX(I)**2) - ENDIF - 10 CONTINUE -C - IB = 0 - DO 20 I=NSIDE, 1, -1 - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) + YT(I) - 20 CONTINUE - DO 30 I=2, NSIDE - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) - YT(I) - 30 CONTINUE - NB = IB -C - NAME = 'NACA' - NAME(6:9) = DIGITS(N4+1:N4+1) - & // DIGITS(N3+1:N3+1) - & // DIGITS(N2+1:N2+1) - & // DIGITS(N1+1:N1+1) -C - RETURN - END - - - SUBROUTINE NACA5(IDES,XX,YT,YC,NSIDE,XB,YB,NB,NAME) - use complexify - implicit complex(a-h, o-z) - complex XX(NSIDE), YT(NSIDE), YC(NSIDE) - complex XB(2*NSIDE), YB(2*NSIDE) - complex M -C - CHARACTER*(*) NAME -C - CHARACTER*10 DIGITS - DATA DIGITS / '0123456789' / -C -C---- TE point bunching parameter - DATA AN / 1.5 / -C - N5 = IDES / 10000 - N4 = (IDES - N5*10000 ) / 1000 - N3 = (IDES - N5*10000 - N4*1000 ) / 100 - N2 = (IDES - N5*10000 - N4*1000 - N3*100 ) / 10 - N1 = (IDES - N5*10000 - N4*1000 - N3*100 - N2*10) -C - N543 = 100*N5 + 10*N4 + N3 -C - IF (N543 .ceq. 210) THEN -cc P = 0.05 - M = 0.0580 - C = 361.4 - ELSE IF (N543 .ceq. 220) THEN -cc P = 0.10 - M = 0.1260 - C = 51.64 - ELSE IF (N543 .ceq. 230) THEN -cc P = 0.15 - M = 0.2025 - C = 15.957 - ELSE IF (N543 .ceq. 240) THEN -cc P = 0.20 - M = 0.2900 - C = 6.643 - ELSE IF (N543 .ceq. 250) THEN -cc P = 0.25 - M = 0.3910 - C = 3.230 - ELSE - WRITE(*,*) 'Illegal 5-digit designation' - WRITE(*,*) 'First three digits must be 210, 220, ... 250' - IDES = 0 - RETURN - ENDIF -C -C - T = FLOAT(N2*10 + N1) / 100.0 -C - ANP = AN + 1.0 - DO 10 I=1, NSIDE - FRAC = FLOAT(I-1)/FLOAT(NSIDE-1) - IF(I.ceq.NSIDE) THEN - XX(I) = 1.0 - ELSE - XX(I) = 1.0 - ANP*FRAC*(1.0-FRAC)**AN - (1.0-FRAC)**ANP - ENDIF -C - YT(I) = ( 0.29690*SQRT(XX(I)) - & - 0.12600*XX(I) - & - 0.35160*XX(I)**2 - & + 0.28430*XX(I)**3 - & - 0.10150*XX(I)**4) * T / 0.20 - IF(XX(I).LT.M) THEN - YC(I) = (C/6.0) * (XX(I)**3 - 3.0*M*XX(I)**2 - & + M*M*(3.0-M)*XX(I)) - ELSE - YC(I) = (C/6.0) * M**3 * (1.0 - XX(I)) - ENDIF - 10 CONTINUE -C - IB = 0 - DO 20 I=NSIDE, 1, -1 - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) + YT(I) - 20 CONTINUE - DO 30 I=2, NSIDE - IB = IB + 1 - XB(IB) = XX(I) - YB(IB) = YC(I) - YT(I) - 30 CONTINUE - NB = IB -C - NAME = 'NACA' - NAME(6:10) = DIGITS(N5+1:N5+1) - & // DIGITS(N4+1:N4+1) - & // DIGITS(N3+1:N3+1) - & // DIGITS(N2+1:N2+1) - & // DIGITS(N1+1:N1+1) -C - RETURN - END diff --git a/deps/src/xfoil_cs/c_spline.f b/deps/src/xfoil_cs/c_spline.f deleted file mode 100644 index f74f285..0000000 --- a/deps/src/xfoil_cs/c_spline.f +++ /dev/null @@ -1,616 +0,0 @@ -C*********************************************************************** -C Module: spline.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE SPLINE(X,XS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N),XS(N),S(N) - PARAMETER (NMAX=600) - DIMENSION A(NMAX),B(NMAX),C(NMAX) -C------------------------------------------------------- -C Calculates spline coefficients for X(S). | -C Zero 2nd derivative end conditions are used. | -C To evaluate the spline at some value of S, | -C use SEVAL and/or DEVAL. | -C | -C S independent variable array (input) | -C X dependent variable array (input) | -C XS dX/dS array (calculated) | -C N number of points (input) | -C | -C------------------------------------------------------- - IF(N.GT.NMAX) STOP 'SPLINE: array overflow, increase NMAX' -C - DO 1 I=2, N-1 - DSM = S(I) - S(I-1) - DSP = S(I+1) - S(I) - B(I) = DSP - A(I) = 2.0*(DSM+DSP) - C(I) = DSM - XS(I) = 3.0*((X(I+1)-X(I))*DSM/DSP + (X(I)-X(I-1))*DSP/DSM) - 1 CONTINUE -C -C---- set zero second derivative end conditions - A(1) = 2.0 - C(1) = 1.0 - XS(1) = 3.0*(X(2)-X(1)) / (S(2)-S(1)) - B(N) = 1.0 - A(N) = 2.0 - XS(N) = 3.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) -C -C---- solve for derivative array XS - CALL TRISOL(A,B,C,XS,N) -C - RETURN - END ! SPLINE - - - SUBROUTINE SPLIND(X,XS,S,N,XS1,XS2) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N),XS(N),S(N) - PARAMETER (NMAX=600) - DIMENSION A(NMAX),B(NMAX),C(NMAX) -C------------------------------------------------------- -C Calculates spline coefficients for X(S). | -C Specified 1st derivative and/or usual zero 2nd | -C derivative end conditions are used. | -C To evaluate the spline at some value of S, | -C use SEVAL and/or DEVAL. | -C | -C S independent variable array (input) | -C X dependent variable array (input) | -C XS dX/dS array (calculated) | -C N number of points (input) | -C XS1,XS2 endpoint derivatives (input) | -C If = 999.0, then usual zero second | -C derivative end condition(s) are used | -C If = -999.0, then zero third | -C derivative end condition(s) are used | -C | -C------------------------------------------------------- - IF(N.GT.NMAX) STOP 'SPLIND: array overflow, increase NMAX' -C - DO 1 I=2, N-1 - DSM = S(I) - S(I-1) - DSP = S(I+1) - S(I) - B(I) = DSP - A(I) = 2.0*(DSM+DSP) - C(I) = DSM - XS(I) = 3.0*((X(I+1)-X(I))*DSM/DSP + (X(I)-X(I-1))*DSP/DSM) - 1 CONTINUE -C - IF(XS1.ceq.999.0) THEN -C----- set zero second derivative end condition - A(1) = 2.0 - C(1) = 1.0 - XS(1) = 3.0*(X(2)-X(1)) / (S(2)-S(1)) - ELSE IF(XS1.ceq.-999.0) THEN -C----- set zero third derivative end condition - A(1) = 1.0 - C(1) = 1.0 - XS(1) = 2.0*(X(2)-X(1)) / (S(2)-S(1)) - ELSE -C----- set specified first derivative end condition - A(1) = 1.0 - C(1) = 0. - XS(1) = XS1 - ENDIF -C - IF(XS2.ceq.999.0) THEN - B(N) = 1.0 - A(N) = 2.0 - XS(N) = 3.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) - ELSE IF(XS2.ceq.-999.0) THEN - B(N) = 1.0 - A(N) = 1.0 - XS(N) = 2.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) - ELSE - A(N) = 1.0 - B(N) = 0. - XS(N) = XS2 - ENDIF -C - IF((N.ceq.2) .AND. (XS1.ceq.-999.0) .AND. (XS2.ceq.-999.0)) THEN - B(N) = 1.0 - A(N) = 2.0 - XS(N) = 3.0*(X(N)-X(N-1)) / (S(N)-S(N-1)) - ENDIF -C -C---- solve for derivative array XS - CALL TRISOL(A,B,C,XS,N) -C - RETURN - END ! SPLIND - - - - SUBROUTINE SPLINA(X,XS,S,N) - use complexify - IMPLICIT complex (A-H,O-Z) - DIMENSION X(N),XS(N),S(N) - LOGICAL LEND -C------------------------------------------------------- -C Calculates spline coefficients for X(S). | -C A simple averaging of adjacent segment slopes | -C is used to achieve non-oscillatory curve | -C End conditions are set by end segment slope | -C To evaluate the spline at some value of S, | -C use SEVAL and/or DEVAL. | -C | -C S independent variable array (input) | -C X dependent variable array (input) | -C XS dX/dS array (calculated) | -C N number of points (input) | -C | -C------------------------------------------------------- -C - LEND = .TRUE. - DO 1 I=1, N-1 - DS = S(I+1)-S(I) - IF (DS.ceq.0.) THEN - XS(I) = XS1 - LEND = .TRUE. - ELSE - DX = X(I+1)-X(I) - XS2 = DX / DS - IF (LEND) THEN - XS(I) = XS2 - LEND = .FALSE. - ELSE - XS(I) = 0.5*(XS1 + XS2) - ENDIF - ENDIF - XS1 = XS2 - 1 CONTINUE - XS(N) = XS1 -C - RETURN - END ! SPLINA - - - - SUBROUTINE TRISOL(A,B,C,D,KK) - use complexify - implicit complex(a-h, o-z) - DIMENSION A(KK),B(KK),C(KK),D(KK) -C----------------------------------------- -C Solves KK long, tri-diagonal system | -C | -C A C D | -C B A C D | -C B A . . | -C . . C . | -C B A D | -C | -C The righthand side D is replaced by | -C the solution. A, C are destroyed. | -C----------------------------------------- -C - DO 1 K=2, KK - KM = K-1 - C(KM) = C(KM) / A(KM) - D(KM) = D(KM) / A(KM) - A(K) = A(K) - B(K)*C(KM) - D(K) = D(K) - B(K)*D(KM) - 1 CONTINUE -C - D(KK) = D(KK)/A(KK) -C - DO 2 K=KK-1, 1, -1 - D(K) = D(K) - C(K)*D(K+1) - 2 CONTINUE -C - RETURN - END ! TRISOL - - - FUNCTION SEVAL(SS,X,XS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), S(N) -C-------------------------------------------------- -C Calculates X(SS) | -C XS array must have been calculated by SPLINE | -C-------------------------------------------------- - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - SEVAL = T*X(I) + (1.0-T)*X(I-1) + (T-T*T)*((1.0-T)*CX1 - T*CX2) - RETURN - END ! SEVAL - - FUNCTION DEVAL(SS,X,XS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), S(N) -C-------------------------------------------------- -C Calculates dX/dS(SS) | -C XS array must have been calculated by SPLINE | -C-------------------------------------------------- - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - DEVAL = X(I) - X(I-1) + (1.-4.0*T+3.0*T*T)*CX1 + T*(3.0*T-2.)*CX2 - DEVAL = DEVAL/DS - RETURN - END ! DEVAL - - FUNCTION D2VAL(SS,X,XS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), S(N) -C-------------------------------------------------- -C Calculates d2X/dS2(SS) | -C XS array must have been calculated by SPLINE | -C-------------------------------------------------- - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - D2VAL = (6.*T-4.)*CX1 + (6.*T-2.0)*CX2 - D2VAL = D2VAL/DS**2 - RETURN - END ! D2VAL - - - FUNCTION CURV(SS,X,XS,Y,YS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), Y(N), YS(N), S(N) -C----------------------------------------------- -C Calculates curvature of splined 2-D curve | -C at S = SS | -C | -C S arc length array of curve | -C X, Y coordinate arrays of curve | -C XS,YS derivative arrays | -C (calculated earlier by SPLINE) | -C----------------------------------------------- -C - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS -C - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - XD = X(I) - X(I-1) + (1.0-4.0*T+3.0*T*T)*CX1 + T*(3.0*T-2.0)*CX2 - XDD = (6.0*T-4.0)*CX1 + (6.0*T-2.0)*CX2 -C - CY1 = DS*YS(I-1) - Y(I) + Y(I-1) - CY2 = DS*YS(I) - Y(I) + Y(I-1) - YD = Y(I) - Y(I-1) + (1.0-4.0*T+3.0*T*T)*CY1 + T*(3.0*T-2.0)*CY2 - YDD = (6.0*T-4.0)*CY1 + (6.0*T-2.0)*CY2 -C - SD = SQRT(XD*XD + YD*YD) - SD = MAX(SD,0.001*DS) -C - CURV = (XD*YDD - YD*XDD) / SD**3 -C - RETURN - END ! CURV - - - FUNCTION CURVS(SS,X,XS,Y,YS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), Y(N), YS(N), S(N) -C----------------------------------------------- -C Calculates curvature derivative of | -C splined 2-D curve at S = SS | -C | -C S arc length array of curve | -C X, Y coordinate arrays of curve | -C XS,YS derivative arrays | -C (calculated earlier by SPLINE) | -C----------------------------------------------- -C - ILOW = 1 - I = N -C - 10 IF(I-ILOW .LE. 1) GO TO 11 -C - IMID = (I+ILOW)/2 - IF(SS .LT. S(IMID)) THEN - I = IMID - ELSE - ILOW = IMID - ENDIF - GO TO 10 -C - 11 DS = S(I) - S(I-1) - T = (SS - S(I-1)) / DS -C - CX1 = DS*XS(I-1) - X(I) + X(I-1) - CX2 = DS*XS(I) - X(I) + X(I-1) - XD = X(I) - X(I-1) + (1.0-4.0*T+3.0*T*T)*CX1 + T*(3.0*T-2.0)*CX2 - XDD = (6.0*T-4.0)*CX1 + (6.0*T-2.0)*CX2 - XDDD = 6.0*CX1 + 6.0*CX2 -C - CY1 = DS*YS(I-1) - Y(I) + Y(I-1) - CY2 = DS*YS(I) - Y(I) + Y(I-1) - YD = Y(I) - Y(I-1) + (1.0-4.0*T+3.0*T*T)*CY1 + T*(3.0*T-2.0)*CY2 - YDD = (6.0*T-4.0)*CY1 + (6.0*T-2.0)*CY2 - YDDD = 6.0*CY1 + 6.0*CY2 -C - SD = SQRT(XD*XD + YD*YD) - SD = MAX(SD,0.001*DS) -C - BOT = SD**3 - DBOTDT = 3.0*SD*(XD*XDD + YD*YDD) -C - TOP = XD*YDD - YD*XDD - DTOPDT = XD*YDDD - YD*XDDD -C - CURVS = (DTOPDT*BOT - DBOTDT*TOP) / BOT**2 -C - RETURN - END ! CURVS - - - SUBROUTINE SINVRT(SI,XI,X,XS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), S(N) -C------------------------------------------------------- -C Calculates the "inverse" spline function S(X). | -C Since S(X) can be multi-valued or not defined, | -C this is not a "black-box" routine. The calling | -C program must pass via SI a sufficiently good | -C initial guess for S(XI). | -C | -C XI specified X value (input) | -C SI calculated S(XI) value (input,output) | -C X,XS,S usual spline arrays (input) | -C | -C------------------------------------------------------- -C - SISAV = SI -C - DO 10 ITER=1, 10 - RES = SEVAL(SI,X,XS,S,N) - XI - RESP = DEVAL(SI,X,XS,S,N) - DS = -RES/RESP - SI = SI + DS - IF(ABS(DS/(S(N)-S(1))) .LT. 1.0E-5) RETURN - 10 CONTINUE - WRITE(*,*) - & 'SINVRT: spline inversion failed. Input value returned.' - SI = SISAV -C - RETURN - END ! SINVRT - - - SUBROUTINE SCALC(X,Y,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), Y(N), S(N) -C---------------------------------------- -C Calculates the arc length array S | -C for a 2-D array of points (X,Y). | -C---------------------------------------- -C - S(1) = 0. - DO 10 I=2, N - S(I) = S(I-1) + SQRT((X(I)-X(I-1))**2 + (Y(I)-Y(I-1))**2) - 10 CONTINUE -C - RETURN - END ! SCALC - - - SUBROUTINE SPLNXY(X,XS,Y,YS,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), Y(N), YS(N), S(N) -C----------------------------------------- -C Splines 2-D shape X(S), Y(S), along | -C with true arc length parameter S. | -C----------------------------------------- - PARAMETER (KMAX=32) - DIMENSION XT(0:KMAX), YT(0:KMAX) -C - KK = KMAX - NPASS = 10 -C -C---- set first estimate of arc length parameter - CALL SCALC(X,Y,S,N) -C -C---- spline X(S) and Y(S) - CALL SEGSPL(X,XS,S,N) - CALL SEGSPL(Y,YS,S,N) -C -C---- re-integrate true arc length - DO 100 IPASS=1, NPASS -C - SERR = 0. -C - DS = S(2) - S(1) - DO I = 2, N - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) -C - CX1 = DS*XS(I-1) - DX - CX2 = DS*XS(I ) - DX - CY1 = DS*YS(I-1) - DY - CY2 = DS*YS(I ) - DY -C - XT(0) = 0. - YT(0) = 0. - DO K=1, KK-1 - T = FLOAT(K) / FLOAT(KK) - XT(K) = T*DX + (T-T*T)*((1.0-T)*CX1 - T*CX2) - YT(K) = T*DY + (T-T*T)*((1.0-T)*CY1 - T*CY2) - ENDDO - XT(KK) = DX - YT(KK) = DY -C - SINT1 = 0. - DO K=1, KK - SINT1 = SINT1 - & + SQRT((XT(K)-XT(K-1))**2 + (YT(K)-YT(K-1))**2) - ENDDO -C - SINT2 = 0. - DO K=2, KK, 2 - SINT2 = SINT2 - & + SQRT((XT(K)-XT(K-2))**2 + (YT(K)-YT(K-2))**2) - ENDDO -C - SINT = (4.0*SINT1 - SINT2) / 3.0 -C - IF(ABS(SINT-DS) .GT. ABS(SERR)) SERR = SINT - DS -C - IF(I.LT.N) DS = S(I+1) - S(I) -C - S(I) = S(I-1) + SQRT(SINT) - ENDDO -C - SERR = SERR / (S(N) - S(1)) - WRITE(*,*) IPASS, SERR -C -C------ re-spline X(S) and Y(S) - CALL SEGSPL(X,XS,S,N) - CALL SEGSPL(Y,YS,S,N) -C - IF(ABS(SERR) .LT. 1.0E-7) RETURN -C - 100 CONTINUE -C - RETURN - END ! SPLNXY - - - - SUBROUTINE SEGSPL(X,XS,S,N) -C----------------------------------------------- -C Splines X(S) array just like SPLINE, | -C but allows derivative discontinuities | -C at segment joints. Segment joints are | -C defined by identical successive S values. | -C----------------------------------------------- - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), S(N) -C - IF(S(1).ceq.S(2) ) STOP 'SEGSPL: First input point duplicated' - IF(S(N).ceq.S(N-1)) STOP 'SEGSPL: Last input point duplicated' -C - ISEG0 = 1 - DO 10 ISEG=2, N-2 - IF(S(ISEG).ceq.S(ISEG+1)) THEN - NSEG = ISEG - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,(-999.0,0.0), - & (-999.0,0.0)) - ISEG0 = ISEG+1 - ENDIF - 10 CONTINUE -C - NSEG = N - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,(-999.0,0.0), - & (-999.0,0.0)) -C - RETURN - END ! SEGSPL - - - - SUBROUTINE SEGSPLD(X,XS,S,N,XS1,XS2) -C----------------------------------------------- -C Splines X(S) array just like SPLIND, | -C but allows derivative discontinuities | -C at segment joints. Segment joints are | -C defined by identical successive S values. | -C----------------------------------------------- - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), XS(N), S(N) -C - IF(S(1).ceq.S(2) ) STOP 'SEGSPL: First input point duplicated' - IF(S(N).ceq.S(N-1)) STOP 'SEGSPL: Last input point duplicated' -C - ISEG0 = 1 - DO 10 ISEG=2, N-2 - IF(S(ISEG).ceq.S(ISEG+1)) THEN - NSEG = ISEG - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,XS1,XS2) - ISEG0 = ISEG+1 - ENDIF - 10 CONTINUE -C - NSEG = N - ISEG0 + 1 - CALL SPLIND(X(ISEG0),XS(ISEG0),S(ISEG0),NSEG,XS1,XS2) -C - RETURN - END ! SEGSPL diff --git a/deps/src/xfoil_cs/c_userio.f b/deps/src/xfoil_cs/c_userio.f deleted file mode 100644 index 50b2de5..0000000 --- a/deps/src/xfoil_cs/c_userio.f +++ /dev/null @@ -1,471 +0,0 @@ -C*********************************************************************** -C Module: userio.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C -C -C==== user input routines with prompting and error trapping -C -C - SUBROUTINE ASKI(PROMPT,IINPUT) -C -C---- integer input -C - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) PROMPT - INTEGER IINPUT - CHARACTER LINE*80 -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.ceq.0) NP = LEN(PROMPT) -C - 10 WRITE(*,1000) PROMPT(1:NP) -C - READ (*,1001,ERR=10) LINE - IF(LINE.cne.' ') THEN - READ (LINE,*,ERR=10) IINPUT - ENDIF - RETURN -C - 1000 FORMAT(/A,' i> ',$) - 1001 FORMAT(A) - END ! ASKI - - - SUBROUTINE ASKR(PROMPT,RINPUT) -C -C---- real input -C - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) PROMPT - complex RINPUT - CHARACTER LINE*80 -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.ceq.0) NP = LEN(PROMPT) -C - 10 WRITE(*,1000) PROMPT(1:NP) -C - READ (*,1001,ERR=10) LINE - IF(LINE.cne.' ') THEN - READ (LINE,*,ERR=10) RINPUT - ENDIF - RETURN -C - 1000 FORMAT(/A,' r> ',$) - 1001 FORMAT(A) - END ! ASKR - - - SUBROUTINE ASKL(PROMPT,LINPUT) -C -C---- logical input -C - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) PROMPT - LOGICAL LINPUT - CHARACTER*1 CHAR -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.ceq.0) NP = LEN(PROMPT) -C - 10 WRITE(*,1000) PROMPT(1:NP) - READ (*,1010) CHAR - IF(CHAR.ceq.'y') CHAR = 'Y' - IF(CHAR.ceq.'n') CHAR = 'N' - IF((CHAR.cne.'Y') .AND. (CHAR.cne.'N')) GO TO 10 -C - LINPUT = CHAR .ceq. 'Y' - RETURN -C - 1000 FORMAT(/A,' y/n> ',$) - 1010 FORMAT(A) - END ! ASKL - - - SUBROUTINE ASKS(PROMPT,INPUT) -C -C---- string of arbitrary length input -C - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) PROMPT - CHARACTER*(*) INPUT -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.ceq.0) NP = LEN(PROMPT) -C - WRITE(*,1000) PROMPT(1:NP) - READ (*,1010) INPUT -C - RETURN -C - 1000 FORMAT(/A,' s> ',$) - 1010 FORMAT(A) - END ! ASKS - - - SUBROUTINE ASKC(PROMPT,COMAND,CARGS) -C -C---- returns 4-byte character string input converted to uppercase -C---- also returns rest of input characters in CARGS string -C - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) PROMPT - CHARACTER*(*) COMAND, CARGS -C - CHARACTER*128 LINE - LOGICAL ERROR -C - IZERO = ICHAR('0') -C - NP = INDEX(PROMPT,'^') - 1 - IF(NP.ceq.0) NP = LEN(PROMPT) -C - WRITE(*,1000) PROMPT(1:NP) - READ (*,1020) LINE -C -C---- strip off leading blanks - DO K=1, 128 - IF(LINE(1:1) .ceq. ' ') THEN - LINE = LINE(2:128) - ELSE - GO TO 5 - ENDIF - ENDDO - 5 CONTINUE -C -C---- find position of first blank, "+", "-", ".", ",", or numeral - K = INDEX(LINE,' ') - KI = INDEX(LINE,'-') - IF(KI.cne.0) K = MIN(K,KI) - KI = INDEX(LINE,'+') - IF(KI.cne.0) K = MIN(K,KI) - KI = INDEX(LINE,'.') - IF(KI.cne.0) K = MIN(K,KI) - KI = INDEX(LINE,',') - IF(KI.cne.0) K = MIN(K,KI) - DO I=0, 9 - KI = INDEX(LINE,CHAR(IZERO+I)) - IF(KI.cne.0) K = MIN(K,KI) - ENDDO -C -C---- there is no blank between command and argument... use first 4 characters - IF(K.LE.0) K = 5 -C - IF(K.ceq.1) THEN -C------ the "command" is a number... set entire COMAND string with it - COMAND = LINE - ELSE -C------ the "command" is some string... just use the part up to the argument - COMAND = LINE(1:K-1) - ENDIF -C -C---- convert it to uppercase - CALL LC2UC(COMAND) -C - CARGS = LINE(K:128) - CALL STRIP(CARGS,NCARGS) - RETURN -C - 1000 FORMAT(/A,' c> ',$) - 1020 FORMAT(A) - END ! ASKC - - - SUBROUTINE LC2UC(INPUT) - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) INPUT -C - CHARACTER*26 LCASE, UCASE - DATA LCASE / 'abcdefghijklmnopqrstuvwxyz' / - DATA UCASE / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' / -C - N = LEN(INPUT) -C - DO 10 I=1, N - K = INDEX( LCASE , INPUT(I:I) ) - IF(K.GT.0) INPUT(I:I) = UCASE(K:K) - 10 CONTINUE -C - RETURN - END ! LC2UC - - - - SUBROUTINE READI(N,IVAR,ERROR) - use complexify - implicit complex(a-h, o-z) - DIMENSION IVAR(N) - LOGICAL ERROR -C-------------------------------------------------- -C Reads N integer variables, leaving unchanged -C if only is entered. -C-------------------------------------------------- - DIMENSION IVTMP(40) - CHARACTER*80 LINE -C - READ(*,1000) LINE - 1000 FORMAT(A80) -C - DO 10 I=1, N - IVTMP(I) = IVAR(I) - 10 CONTINUE -C - NTMP = 40 - CALL GETINT(LINE,IVTMP,NTMP,ERROR) -C - IF(ERROR) RETURN -C - DO 20 I=1, N - IVAR(I) = IVTMP(I) - 20 CONTINUE -C - RETURN - END ! READI - - - - SUBROUTINE READR(N,VAR,ERROR) - use complexify - implicit complex(a-h, o-z) - DIMENSION VAR(N) - LOGICAL ERROR -C------------------------------------------------- -C Reads N real variables, leaving unchanged -C if only is entered. -C------------------------------------------------- - DIMENSION VTMP(40) - CHARACTER*80 LINE -C - READ(*,1000) LINE - 1000 FORMAT(A80) -C - DO 10 I=1, N - VTMP(I) = VAR(I) - 10 CONTINUE -C - NTMP = 40 - CALL GETFLT(LINE,VTMP,NTMP,ERROR) -C - IF(ERROR) RETURN -C - DO 20 I=1, N - VAR(I) = VTMP(I) - 20 CONTINUE -C - RETURN - END ! READR - - - - - SUBROUTINE GETINT(INPUT,A,N,ERROR) - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) INPUT - INTEGER A(*) - LOGICAL ERROR -C---------------------------------------------------------- -C Parses character string INPUT into an array -C of integer numbers returned in A(1...N) -C -C Will attempt to extract no more than N numbers, -C unless N = 0, in which case all numbers present -C in INPUT will be extracted. -C -C N returns how many numbers were actually extracted. -C---------------------------------------------------------- - CHARACTER*130 REC -C -C---- only first 128 characters in INPUT will be parsed - ILEN = MIN( LEN(INPUT) , 128 ) - ILENP = ILEN + 2 -C -C---- put input into local work string (which will be munched) - REC(1:ILENP) = INPUT(1:ILEN) // ' ,' -C -C---- ignore everything after a "!" character - K = INDEX(REC,'!') - IF(K.GT.0) REC(1:ILEN) = REC(1:K-1) -C - NINP = N -C -C---- count up how many numbers are to be extracted - N = 0 - K = 1 - DO 10 IPASS=1, ILEN -C------ search for next space or comma starting with current index K - KSPACE = INDEX(REC(K:ILENP),' ') + K - 1 - KCOMMA = INDEX(REC(K:ILENP),',') + K - 1 -C - IF(K.ceq.KSPACE) THEN -C------- just skip this space - K = K+1 - GO TO 9 - ENDIF -C - IF(K.ceq.KCOMMA) THEN -C------- comma found.. increment number count and keep looking - N = N+1 - K = K+1 - GO TO 9 - ENDIF -C -C------ neither space nor comma found, so we ran into a number... -C- ...increment number counter and keep looking after next space or comma - N = N+1 - K = MIN(KSPACE,KCOMMA) + 1 -C - 9 IF(K.GE.ILEN) GO TO 11 - 10 CONTINUE -C -C---- decide on how many numbers to read, and go ahead and read them - 11 IF(NINP.GT.0) N = MIN( N, NINP ) - READ(REC(1:ILEN),*,ERR=20) (A(I),I=1,N) - ERROR = .FALSE. - RETURN -C -C---- bzzzt !!! - 20 CONTINUE -ccc WRITE(*,*) 'GETINT: String-to-integer conversion error.' - N = 0 - ERROR = .TRUE. - RETURN - END - - - SUBROUTINE GETFLT(INPUT,A,N,ERROR) - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) INPUT - complex A(*) - LOGICAL ERROR -C---------------------------------------------------------- -C Parses character string INPUT into an array -C of real numbers returned in A(1...N) -C -C Will attempt to extract no more than N numbers, -C unless N = 0, in which case all numbers present -C in INPUT will be extracted. -C -C N returns how many numbers were actually extracted. -C---------------------------------------------------------- - CHARACTER*130 REC -C -C---- only first 128 characters in INPUT will be parsed - ILEN = MIN( LEN(INPUT) , 128 ) - ILENP = ILEN + 2 -C -C---- put input into local work string (which will be munched) - REC(1:ILENP) = INPUT(1:ILEN) // ' ,' -C -C---- ignore everything after a "!" character - K = INDEX(REC,'!') - IF(K.GT.0) REC(1:ILEN) = REC(1:K-1) -C - NINP = N -C -C---- count up how many numbers are to be extracted - N = 0 - K = 1 - DO 10 IPASS=1, ILEN -C------ search for next space or comma starting with current index K - KSPACE = INDEX(REC(K:ILENP),' ') + K - 1 - KCOMMA = INDEX(REC(K:ILENP),',') + K - 1 -C - IF(K.ceq.KSPACE) THEN -C------- just skip this space - K = K+1 - GO TO 9 - ENDIF -C - IF(K.ceq.KCOMMA) THEN -C------- comma found.. increment number count and keep looking - N = N+1 - K = K+1 - GO TO 9 - ENDIF -C -C------ neither space nor comma found, so we ran into a number... -C- ...increment number counter and keep looking after next space or comma - N = N+1 - K = MIN(KSPACE,KCOMMA) + 1 -C - 9 IF(K.GE.ILEN) GO TO 11 - 10 CONTINUE -C -C---- decide on how many numbers to read, and go ahead and read them - 11 IF(NINP.GT.0) N = MIN( N, NINP ) - READ(REC(1:ILEN),*,ERR=20) (A(I),I=1,N) - ERROR = .FALSE. - RETURN -C -C---- bzzzt !!! - 20 CONTINUE -ccc WRITE(*,*) 'GETFLT: String-to-integer conversion error.' - N = 0 - ERROR = .TRUE. - RETURN - END - - - - SUBROUTINE STRIP(STRING,NS) - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) STRING -C------------------------------------------- -C Strips leading blanks off string -C and returns length of non-blank part. -C------------------------------------------- - N = LEN(STRING) -C -C---- find last non-blank character - DO 10 K2=N, 1, -1 - IF(STRING(K2:K2).cne.' ') GO TO 11 - 10 CONTINUE - K2 = 0 - 11 CONTINUE -C -C---- find first non-blank character - DO 20 K1=1, K2 - IF(STRING(K1:K1).cne.' ') GO TO 21 - 20 CONTINUE - 21 CONTINUE -C -C---- number of non-blank characters - NS = K2 - K1 + 1 - IF(NS.ceq.0) RETURN -C -C---- shift STRING so first character is non-blank - STRING(1:NS) = STRING(K1:K2) -C -C---- pad tail of STRING with blanks - DO 30 K=NS+1, N - STRING(K:K) = ' ' - 30 CONTINUE -C - RETURN - END - diff --git a/deps/src/xfoil_cs/c_xbl.f b/deps/src/xfoil_cs/c_xbl.f deleted file mode 100644 index f03c6ea..0000000 --- a/deps/src/xfoil_cs/c_xbl.f +++ /dev/null @@ -1,1616 +0,0 @@ -C*********************************************************************** -C Module: xbl.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C -C MODIFIED 2.24.06 by D. BERKENSTOCK TO REMOVE TEXT OUTPUTS -C - - SUBROUTINE SETBL -C------------------------------------------------- -C Sets up the BL Newton system coefficients -C for the current BL variables and the edge -C velocities received from SETUP. The local -C BL system coefficients are then -C incorporated into the global Newton system. -C------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - include 'c_XBL.INC' - complex USAV(IVX,2) - complex U1_M(2*IVX), U2_M(2*IVX) - complex D1_M(2*IVX), D2_M(2*IVX) - complex ULE1_M(2*IVX), ULE2_M(2*IVX) - complex UTE1_M(2*IVX), UTE2_M(2*IVX) - complex MA_CLMR, MSQ_CLMR, MDI -C -C -c write(*,*) 'Inside Setbl' -c write(*,*) 'Xsi at start of setbl',XSI -C---- set the CL used to define Mach, Reynolds numbers - IF(LALFA) THEN - CLMR = CL - ELSE - CLMR = CLSPEC - ENDIF -C -C---- set current MINF(CL) - CALL MRCL(CLMR,MA_CLMR,RE_CLMR) - MSQ_CLMR = 2.0*MINF*MA_CLMR -C -C---- set compressibility parameter TKLAM and derivative TK_MSQ - CALL COMSET -C -C---- set gas constant (= Cp/Cv) - GAMBL = GAMMA - GM1BL = GAMM1 -C -C---- set parameters for compressibility correction - QINFBL = QINF - TKBL = TKLAM - TKBL_MS = TKL_MSQ -C -C---- stagnation density and 1/enthalpy - RSTBL = (1.0 + 0.5*GM1BL*MINF**2) ** (1.0/GM1BL) - RSTBL_MS = 0.5*RSTBL/(1.0 + 0.5*GM1BL*MINF**2) -C - HSTINV = GM1BL*(MINF/QINFBL)**2 / (1.0 + 0.5*GM1BL*MINF**2) - HSTINV_MS = GM1BL*( 1.0/QINFBL)**2 / (1.0 + 0.5*GM1BL*MINF**2) - & - 0.5*GM1BL*HSTINV / (1.0 + 0.5*GM1BL*MINF**2) -C -C---- Sutherland's const./To (assumes stagnation conditions are at STP) - HVRAT = 0.35 -C -C---- set Reynolds number based on freestream density, velocity, viscosity - HERAT = 1.0 - 0.5*QINFBL**2*HSTINV - HERAT_MS = - 0.5*QINFBL**2*HSTINV_MS -C - REYBL = REINF * SQRT(HERAT**3) * (1.0+HVRAT)/(HERAT+HVRAT) - REYBL_RE = SQRT(HERAT**3) * (1.0+HVRAT)/(HERAT+HVRAT) - REYBL_MS = REYBL * (1.5/HERAT - 1.0/(HERAT+HVRAT))*HERAT_MS -C - AMCRIT = ACRIT -C -C---- save TE thickness - DWTE = WGAP(1) -C - IF(.NOT.LBLINI) THEN -C----- initialize BL by marching with Ue (fudge at separation) -C WRITE(*,*) -C WRITE(*,*) 'Initializing BL ...' -c write(*,*)'VS2 before calling MRCHUE',VS2 - CALL MRCHUE - LBLINI = .TRUE. - ENDIF -C -c WRITE(*,*) 'XSI after mrchue',xsi -C -C---- march BL with current Ue and Ds to establish transition - CALL MRCHDU -C - DO 5 IS=1, 2 - DO 6 IBL=2, NBL(IS) - USAV(IBL,IS) = UEDG(IBL,IS) - 6 CONTINUE - 5 CONTINUE -C - CALL UESET -C - DO 7 IS=1, 2 - DO 8 IBL=2, NBL(IS) - TEMP = USAV(IBL,IS) - USAV(IBL,IS) = UEDG(IBL,IS) - UEDG(IBL,IS) = TEMP - 8 CONTINUE - 7 CONTINUE -C - ILE1 = IPAN(2,1) - ILE2 = IPAN(2,2) - ITE1 = IPAN(IBLTE(1),1) - ITE2 = IPAN(IBLTE(2),2) -C - JVTE1 = ISYS(IBLTE(1),1) - JVTE2 = ISYS(IBLTE(2),2) -C - DULE1 = UEDG(2,1) - USAV(2,1) - DULE2 = UEDG(2,2) - USAV(2,2) -C -C---- set LE and TE Ue sensitivities wrt all m values - DO 10 JS=1, 2 - DO 110 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - ULE1_M(JV) = -VTI( 2,1)*VTI(JBL,JS)*DIJ(ILE1,J) - ULE2_M(JV) = -VTI( 2,2)*VTI(JBL,JS)*DIJ(ILE2,J) - UTE1_M(JV) = -VTI(IBLTE(1),1)*VTI(JBL,JS)*DIJ(ITE1,J) - UTE2_M(JV) = -VTI(IBLTE(2),2)*VTI(JBL,JS)*DIJ(ITE2,J) - 110 CONTINUE - 10 CONTINUE -C - ULE1_A = UINV_A(2,1) - ULE2_A = UINV_A(2,2) -C -C**** Go over each boundary layer/wake - DO 2000 IS=1, 2 -C -C---- there is no station "1" at similarity, so zero everything out - DO 20 JS=1, 2 - DO 210 JBL=2, NBL(JS) - JV = ISYS(JBL,JS) - U1_M(JV) = 0. - D1_M(JV) = 0. - 210 CONTINUE - 20 CONTINUE - U1_A = 0. - D1_A = 0. -C - DUE1 = 0. - DDS1 = 0. -C -C---- similarity station pressure gradient parameter x/u du/dx - IBL = 2 - BULE = 1.0 -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C - TRAN = .FALSE. - TURB = .FALSE. -C -C**** Sweep downstream setting up BL equation linearizations - DO 1000 IBL=2, NBL(IS) -c write(*,*) 'Xsi at start of 1000 loop',XSI - IV = ISYS(IBL,IS) -C - SIMI = IBL.ceq.2 - WAKE = IBL.GT.IBLTE(IS) - TRAN = IBL.ceq.ITRAN(IS) - TURB = IBL.GT.ITRAN(IS) -C - I = IPAN(IBL,IS) -C -C---- set primary variables for current station -c write(*,*) 'Xsi at start of 1000 loop',XSI -c write(*,*) 'IBL',IBL - XSI = XSSI(IBL,IS) -c write(*,*) 'XSSI:',XSSI -c stop - - IF(IBL.LT.ITRAN(IS)) AMI = CTAU(IBL,IS) - IF(IBL.GE.ITRAN(IS)) CTI = CTAU(IBL,IS) - UEI = UEDG(IBL,IS) - THI = THET(IBL,IS) - MDI = MASS(IBL,IS) -C - DSI = MDI/UEI -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C -C---- set derivatives of DSI (= D2) - D2_M2 = 1.0/UEI - D2_U2 = -DSI/UEI -C - DO 30 JS=1, 2 - DO 310 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - U2_M(JV) = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - D2_M(JV) = D2_U2*U2_M(JV) - 310 CONTINUE - 30 CONTINUE - D2_M(IV) = D2_M(IV) + D2_M2 -C - U2_A = UINV_A(IBL,IS) - D2_A = D2_U2*U2_A -C -C---- "forced" changes due to mismatch between UEDG and USAV=UINV+dij*MASS - DUE2 = UEDG(IBL,IS) - USAV(IBL,IS) - DDS2 = D2_U2*DUE2 -c write(*,*) 'X2 before BLPRV',X2 -c write(*,*) 'Xsi before BLPRV',XSI - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) -c write(*,*) 'X2 after BLPRV',X2 - CALL BLKIN -c write(*,*) 'Xsi after BLKIN',XSI - - -C---- check for transition and set TRAN, XT, etc. if found - IF(TRAN) THEN -c WRITE(*,*) 'Calling TRCHECK 1...' - CALL TRCHEK - -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - AMI = AMPL2 - ENDIF - IF((IBL.ceq.ITRAN(IS)) .AND. .NOT.TRAN) THEN -C WRITE(*,*) 'SETBL: Xtr??? n1 n2: ', AMPL1, AMPL2 - ENDIF - -c write(*,*) 'Xsi after tran check',XSI - -C---- assemble 10x4 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C - IF(IBL.ceq.IBLTE(IS)+1) THEN -C -C----- define quantities at start of wake, adding TE base thickness to Dstar - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) -C - TTE_TTE1 = 1.0 - TTE_TTE2 = 1.0 - DTE_MTE1 = 1.0 / UEDG(IBLTE(1),1) - DTE_UTE1 = -DSTR(IBLTE(1),1) / UEDG(IBLTE(1),1) - DTE_MTE2 = 1.0 / UEDG(IBLTE(2),2) - DTE_UTE2 = -DSTR(IBLTE(2),2) / UEDG(IBLTE(2),2) - CTE_CTE1 = THET(IBLTE(1),1)/TTE - CTE_CTE2 = THET(IBLTE(2),2)/TTE - CTE_TTE1 = (CTAU(IBLTE(1),1) - CTE)/TTE - CTE_TTE2 = (CTAU(IBLTE(2),2) - CTE)/TTE -C -C----- re-define D1 sensitivities wrt m since D1 depends on both TE Ds values - DO 35 JS=1, 2 - DO 350 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - D1_M(JV) = DTE_UTE1*UTE1_M(JV) + DTE_UTE2*UTE2_M(JV) - 350 CONTINUE - 35 CONTINUE - D1_M(JVTE1) = D1_M(JVTE1) + DTE_MTE1 - D1_M(JVTE2) = D1_M(JVTE2) + DTE_MTE2 -C -C----- "forced" changes from UEDG --- USAV=UINV+dij*MASS mismatch - DUE1 = 0. - DDS1 = DTE_UTE1*(UEDG(IBLTE(1),1) - USAV(IBLTE(1),1)) - & + DTE_UTE2*(UEDG(IBLTE(2),2) - USAV(IBLTE(2),2)) -C -c write(*,*) 'Xsi after if stuff',XSI - ELSE -c write(*,*) 'Xsi bfore calling blsys again',XSI - CALL BLSYS -C - ENDIF -C -C -C---- Save wall shear and equil. max shear coefficient for plotting output - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 - DELT(IBL,IS) = DE2 - USLP(IBL,IS) = 1.60/(1.0+US2) -C -C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -c IF(WAKE) THEN -c ALD = DLCON -c ELSE -c ALD = 1.0 -c ENDIF -cC -c IF(TURB .AND. .NOT.WAKE) THEN -c GCC = GCCON -c HKC = HK2 - 1.0 - GCC/RT2 -c IF(HKC .LT. 0.01) THEN -c HKC = 0.01 -c ENDIF -c ELSE -c HKC = HK2 - 1.0 -c ENDIF -cC -c HR = HKC / (GACON*ALD*HK2) -c UQ = (0.5*CF2 - HR**2) / (GBCON*D2) -cC -c IF(TURB) THEN -c IBLP = MIN(IBL+1,NBL(IS)) -c IBLM = MAX(IBL-1,2 ) -c DXSSI = XSSI(IBLP,IS) - XSSI(IBLM,IS) -c IF(DXXSI.EQ.0.0) DXSSI = 1.0 -c GUXD(IBL,IS) = -LOG(UEDG(IBLP,IS)/UEDG(IBLM,IS)) / DXSSI -c GUXQ(IBL,IS) = -UQ -c ELSE -c GUXD(IBL,IS) = 0.0 -c GUXQ(IBL,IS) = 0.0 -c ENDIF -C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ -C -C---- set XI sensitivities wrt LE Ue changes - IF(IS.ceq.1) THEN - XI_ULE1 = SST_GO - XI_ULE2 = -SST_GP - ELSE - XI_ULE1 = -SST_GO - XI_ULE2 = SST_GP - ENDIF -C -C---- stuff BL system coefficients into main Jacobian matrix -C - DO 40 JV=1, NSYS - VM(1,JV,IV) = VS1(1,3)*D1_M(JV) + VS1(1,4)*U1_M(JV) - & + VS2(1,3)*D2_M(JV) + VS2(1,4)*U2_M(JV) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 40 CONTINUE -C - VB(1,1,IV) = VS1(1,1) - VB(1,2,IV) = VS1(1,2) -C - VA(1,1,IV) = VS2(1,1) - VA(1,2,IV) = VS2(1,2) -C - IF(LALFA) THEN - VDEL(1,2,IV) = VSR(1)*RE_CLMR + VSM(1)*MSQ_CLMR - ELSE - VDEL(1,2,IV) = - & (VS1(1,4)*U1_A + VS1(1,3)*D1_A) - & + (VS2(1,4)*U2_A + VS2(1,3)*D2_A) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(1,1,IV) = VSREZ(1) - & + (VS1(1,4)*DUE1 + VS1(1,3)*DDS1) - & + (VS2(1,4)*DUE2 + VS2(1,3)*DDS2) - & + (VS1(1,5) + VS2(1,5) + VSX(1)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - DO 50 JV=1, NSYS - VM(2,JV,IV) = VS1(2,3)*D1_M(JV) + VS1(2,4)*U1_M(JV) - & + VS2(2,3)*D2_M(JV) + VS2(2,4)*U2_M(JV) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 50 CONTINUE -C - VB(2,1,IV) = VS1(2,1) - VB(2,2,IV) = VS1(2,2) -C - VA(2,1,IV) = VS2(2,1) - VA(2,2,IV) = VS2(2,2) -C - IF(LALFA) THEN - VDEL(2,2,IV) = VSR(2)*RE_CLMR + VSM(2)*MSQ_CLMR - ELSE - VDEL(2,2,IV) = - & (VS1(2,4)*U1_A + VS1(2,3)*D1_A) - & + (VS2(2,4)*U2_A + VS2(2,3)*D2_A) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(2,1,IV) = VSREZ(2) - & + (VS1(2,4)*DUE1 + VS1(2,3)*DDS1) - & + (VS2(2,4)*DUE2 + VS2(2,3)*DDS2) - & + (VS1(2,5) + VS2(2,5) + VSX(2)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - DO 60 JV=1, NSYS - VM(3,JV,IV) = VS1(3,3)*D1_M(JV) + VS1(3,4)*U1_M(JV) - & + VS2(3,3)*D2_M(JV) + VS2(3,4)*U2_M(JV) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*ULE1_M(JV) + XI_ULE2*ULE2_M(JV)) - 60 CONTINUE -C - VB(3,1,IV) = VS1(3,1) - VB(3,2,IV) = VS1(3,2) -C - VA(3,1,IV) = VS2(3,1) - VA(3,2,IV) = VS2(3,2) -C - IF(LALFA) THEN - VDEL(3,2,IV) = VSR(3)*RE_CLMR + VSM(3)*MSQ_CLMR - ELSE - VDEL(3,2,IV) = - & (VS1(3,4)*U1_A + VS1(3,3)*D1_A) - & + (VS2(3,4)*U2_A + VS2(3,3)*D2_A) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*ULE1_A + XI_ULE2*ULE2_A) - ENDIF -C - VDEL(3,1,IV) = VSREZ(3) - & + (VS1(3,4)*DUE1 + VS1(3,3)*DDS1) - & + (VS2(3,4)*DUE2 + VS2(3,3)*DDS2) - & + (VS1(3,5) + VS2(3,5) + VSX(3)) - & *(XI_ULE1*DULE1 + XI_ULE2*DULE2) -C -C - IF(IBL.ceq.IBLTE(IS)+1) THEN -C -C----- redefine coefficients for TTE, DTE, etc - VZ(1,1) = VS1(1,1)*CTE_CTE1 - VZ(1,2) = VS1(1,1)*CTE_TTE1 + VS1(1,2)*TTE_TTE1 - VB(1,1,IV) = VS1(1,1)*CTE_CTE2 - VB(1,2,IV) = VS1(1,1)*CTE_TTE2 + VS1(1,2)*TTE_TTE2 -C - VZ(2,1) = VS1(2,1)*CTE_CTE1 - VZ(2,2) = VS1(2,1)*CTE_TTE1 + VS1(2,2)*TTE_TTE1 - VB(2,1,IV) = VS1(2,1)*CTE_CTE2 - VB(2,2,IV) = VS1(2,1)*CTE_TTE2 + VS1(2,2)*TTE_TTE2 -C - VZ(3,1) = VS1(3,1)*CTE_CTE1 - VZ(3,2) = VS1(3,1)*CTE_TTE1 + VS1(3,2)*TTE_TTE1 - VB(3,1,IV) = VS1(3,1)*CTE_CTE2 - VB(3,2,IV) = VS1(3,1)*CTE_TTE2 + VS1(3,2)*TTE_TTE2 -C - ENDIF -C -C---- turbulent intervals will follow if currently at transition interval - IF(TRAN) THEN - TURB = .TRUE. -C -C------ save transition location - ITRAN(IS) = IBL - TFORCE(IS) = TRFORC - XSSITR(IS) = XT -C -C------ interpolate airfoil geometry to find transition x/c -C- (for user output) - IF(IS.ceq.1) THEN - STR = SST - XT - ELSE - STR = SST + XT - ENDIF - CHX = XTE - XLE - CHY = YTE - YLE - CHSQ = CHX**2 + CHY**2 - XTR = SEVAL(STR,X,XP,S,N) - YTR = SEVAL(STR,Y,YP,S,N) - XOCTR(IS) = ((XTR-XLE)*CHX + (YTR-YLE)*CHY)/CHSQ - YOCTR(IS) = ((YTR-YLE)*CHX - (XTR-XLE)*CHY)/CHSQ - ENDIF -C - TRAN = .FALSE. -C - IF(IBL.ceq.IBLTE(IS)) THEN -C----- set "2" variables at TE to wake correlations for next station -C - TURB = .TRUE. - WAKE = .TRUE. - CALL BLVAR(3) - CALL BLMID(3) - ENDIF -C - DO 80 JS=1, 2 - DO 810 JBL=2, NBL(JS) - JV = ISYS(JBL,JS) - U1_M(JV) = U2_M(JV) - D1_M(JV) = D2_M(JV) - 810 CONTINUE - 80 CONTINUE -C - U1_A = U2_A - D1_A = D2_A -C - DUE1 = DUE2 - DDS1 = DDS2 -C -C---- set BL variables for next station - DO 190 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 190 CONTINUE -C -C---- next streamwise station -c write(*,*) 'Xsi after main 1000 loop',XSI - 1000 CONTINUE - - - - IF(TFORCE(IS)) THEN -C WRITE(*,9100) IS,XOCTR(IS),ITRAN(IS) - 9100 FORMAT(1X,'Side',I2,' forced transition at x/c = ',F7.4,I5) - ELSE -C WRITE(*,9200) IS,XOCTR(IS),ITRAN(IS) - 9200 FORMAT(1X,'Side',I2,' free transition at x/c = ',F7.4,I5) - ENDIF -C -C---- next airfoil side - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE IBLSYS -C--------------------------------------------- -C Sets the BL Newton system line number -C corresponding to each BL station. -C--------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - include 'c_XBL.INC' -C - IV = 0 - DO 10 IS=1, 2 - DO 110 IBL=2, NBL(IS) - IV = IV+1 - ISYS(IBL,IS) = IV - 110 CONTINUE - 10 CONTINUE -C - NSYS = IV - IF(NSYS.GT.2*IVX) STOP '*** IBLSYS: BL system array overflow. ***' -C - RETURN - END - - - SUBROUTINE MRCHUE -C---------------------------------------------------- -C Marches the BLs and wake in direct mode using -C the UEDG array. If separation is encountered, -C a plausible value of Hk extrapolated from -C upstream is prescribed instead. Continuous -C checking of transition onset is performed. -C---------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - include 'c_XBL.INC' - LOGICAL DIRECT - complex MSQ -C -C---- shape parameters for separation criteria - HLMAX = 3.8 - HTMAX = 2.5 -C - DO 2000 IS=1, 2 -C -C WRITE(*,*) ' side ', IS, ' ...' -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C -C---- initialize similarity station with Thwaites' formula - IBL = 2 - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -C BULE = LOG(UEDG(IBL+1,IS)/UEI) / LOG(XSSI(IBL+1,IS)/XSI) -C BULE = MAX( -.08 , BULE ) - BULE = 1.0 - UCON = UEI/XSI**BULE - TSQ = 0.45/(UCON*(5.0*BULE+1.0)*REYBL) * XSI**(1.0-BULE) - THI = SQRT(TSQ) - DSI = 2.2*THI - AMI = 0.0 -C -C---- initialize Ctau for first turbulent station - CTI = 0.03 -C - TRAN = .FALSE. - TURB = .FALSE. - ITRAN(IS) = IBLTE(IS) -C -C---- march downstream - DO 1000 IBL=2, NBL(IS) - IBM = IBL-1 -C - IW = IBL - IBLTE(IS) -C - SIMI = IBL.ceq.2 - WAKE = IBL.GT.IBLTE(IS) -C -C------ prescribed quantities - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C - DIRECT = .TRUE. -C -C------ Newton iteration loop for current station - DO 100 ITBL=1, 25 -C -C-------- assemble 10x3 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C (the "1" station coefficients will be ignored) -C -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C-------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 2...' -c write(*,*) 'X2 before TRCHEK',X2 - CALL TRCHEK -c write(*,*) 'X2 after TRCHEK',X2 - -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 -C -C--------- fixed BUG MD 7 Jun 99 - IF(TRAN) THEN - ITRAN(IS) = IBL - IF(CTI.LE.0.0) THEN - CTI = 0.03 - S2 = CTI - ENDIF - ELSE - ITRAN(IS) = IBL+2 - ENDIF -C -C - ENDIF -C - IF(IBL.ceq.IBLTE(IS)+1) THEN - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) - ELSE -c write(*,*) 'ITBL:',ITBL -c write(*,*) 'VS2 before BLSYS',VS2 -c write(*,*) 'VS1 before BLSYS',VS1 - CALL BLSYS -c write(*,*) 'VS1 after BLSYS',VS1 -c write(*,*) 'VS2 after BLSYS',VS2 - ENDIF -C - IF(DIRECT) THEN -C -C--------- try direct mode (set dUe = 0 in currently empty 4th line) - VS2(4,1) = 0. - VS2(4,2) = 0. - VS2(4,3) = 0. - VS2(4,4) = 1.0 - VSREZ(4) = 0. -C -C--------- solve Newton system for current "2" station - CALL GAUSS(4,4,VS2,VSREZ,1) -C -C--------- determine max changes and underrelax if necessary - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - IF(IBL.LT.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/10.0)) - IF(IBL.GE.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/CTI )) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C--------- see if direct mode is not applicable - IF(IBL .cne. IBLTE(IS)+1) THEN -C -C---------- calculate resulting kinematic shape parameter Hk - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - HTEST = (DSI + RLX*VSREZ(3)) / (THI + RLX*VSREZ(2)) - CALL HKIN( HTEST, MSQ, HKTEST, DUMMY, DUMMY) -C -C---------- decide whether to do direct or inverse problem based on Hk - IF(IBL.LT.ITRAN(IS)) HMAX = HLMAX - IF(IBL.GE.ITRAN(IS)) HMAX = HTMAX - DIRECT = HKTEST.LT.HMAX - ENDIF -C - IF(DIRECT) THEN -C---------- update as usual -ccc IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - ELSE -C---------- set prescribed Hk for inverse calculation at the current station - IF(IBL.LT.ITRAN(IS)) THEN -C----------- laminar case: relatively slow increase in Hk downstream - HTARG = HK1 + 0.03*(X2-X1)/T1 - ELSE IF(IBL.ceq.ITRAN(IS)) THEN -C----------- transition interval: weighted laminar and turbulent case - HTARG = HK1 + (0.03*(XT-X1) - 0.15*(X2-XT))/T1 - ELSE IF(WAKE) THEN -C----------- turbulent wake case: -C- asymptotic wake behavior with approximate Backward Euler - CONST = 0.03*(X2-X1)/T1 - HK2 = HK1 - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HK2 = HK2 - (HK2 + CONST*(HK2-1.0)**3 - HK1) - & /(1.0 + 3.0*CONST*(HK2-1.0)**2) - HTARG = HK2 - ELSE -C----------- turbulent case: relatively fast decrease in Hk downstream - HTARG = HK1 - 0.15*(X2-X1)/T1 - ENDIF -C -C---------- limit specified Hk to something reasonable - IF(WAKE) THEN - HTARG = MAX( HTARG , 1.01 ) - ELSE - HTARG = MAX( HTARG , HMAX ) - ENDIF -C -C WRITE(*,1300) IBL, HTARG - 1300 FORMAT(' MRCHUE: Inverse mode at', I4, ' Hk =', F8.3) -C -C---------- try again with prescribed Hk - GO TO 100 -C - ENDIF -C - ELSE -C -C-------- inverse mode (force Hk to prescribed value HTARG) - VS2(4,1) = 0. - VS2(4,2) = HK2_T2 - VS2(4,3) = HK2_D2 - VS2(4,4) = HK2_U2 - VSREZ(4) = HTARG - HK2 -c write(*,*) 'VS2 before Guass',VS2 - CALL GAUSS(4,4,VS2,VSREZ,1) -C - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - IF(IBL.GE.ITRAN(IS)) DMAX = MAX( DMAX , ABS(VSREZ(1)/CTI)) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C--------- update variables -ccc IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - UEI = UEI + RLX*VSREZ(4) -C - ENDIF -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) THEN - CTI = MIN(CTI , 0.30 ) - CTI = MAX(CTI , 0.0000001 ) - ENDIF -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - DSW = DSI - DSWAKI - CALL DSLIM(DSW,THI,UEI,MSQ,HKLIM) - DSI = DSW + DSWAKI -C - IF(DMAX.LE.1.0E-5) GO TO 110 -C - 100 CONTINUE -C WRITE(*,1350) IBL, IS, DMAX - 1350 FORMAT(' MRCHUE: Convergence failed at',I4,' side',I2, - & ' Res =', E12.4) -C -C------ the current unconverged solution might still be reasonable... -CCC IF(DMAX .LE. 0.1) GO TO 110 - IF(DMAX .LE. 0.1) GO TO 109 -C -C------- the current solution is garbage --> extrapolate values instead - IF(IBL.GT.3) THEN - IF(IBL.LE.IBLTE(IS)) THEN - THI = THET(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - DSI = DSTR(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - ELSE IF(IBL.ceq.IBLTE(IS)+1) THEN - CTI = CTE - THI = TTE - DSI = DTE - ELSE - THI = THET(IBM,IS) - RATLEN = (XSSI(IBL,IS)-XSSI(IBM,IS)) / (10.0*DSTR(IBM,IS)) - DSI = (DSTR(IBM,IS) + THI*RATLEN) / (1.0 + RATLEN) - ENDIF - IF(IBL.ceq.ITRAN(IS)) CTI = 0.05 - IF(IBL.GT.ITRAN(IS)) CTI = CTAU(IBM,IS) -C - UEI = UEDG(IBL,IS) - IF(IBL.GT.2 .AND. IBL.LT.NBL(IS)) - & UEI = 0.5*(UEDG(IBL-1,IS) + UEDG(IBL+1,IS)) - ENDIF -C - 109 CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 3...' - - CALL TRCHEK -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C -C------- set all other extrapolated values for current station - IF(IBL.LT.ITRAN(IS)) CALL BLVAR(1) - IF(IBL.GE.ITRAN(IS)) CALL BLVAR(2) - IF(WAKE) CALL BLVAR(3) -C - IF(IBL.LT.ITRAN(IS)) CALL BLMID(1) - IF(IBL.GE.ITRAN(IS)) CALL BLMID(2) - IF(WAKE) CALL BLMID(3) -C -C------ pick up here after the Newton iterations - 110 CONTINUE -C -C------ store primary variables - IF(IBL.LT.ITRAN(IS)) CTAU(IBL,IS) = AMI - IF(IBL.GE.ITRAN(IS)) CTAU(IBL,IS) = CTI - THET(IBL,IS) = THI - DSTR(IBL,IS) = DSI - UEDG(IBL,IS) = UEI - MASS(IBL,IS) = DSI*UEI - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 - DELT(IBL,IS) = DE2 -C -C------ set "1" variables to "2" variables for next streamwise station - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN - DO 310 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 310 CONTINUE -C -C------ turbulent intervals will follow transition interval or TE - IF(TRAN .OR. (IBL.ceq.IBLTE(IS))) THEN - TURB = .TRUE. -C -C------- save transition location - TFORCE(IS) = TRFORC - - XSSITR(IS) = XT - ENDIF -C - TRAN = .FALSE. -C - IF(IBL.ceq.IBLTE(IS)) THEN - THI = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DSI = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - ENDIF -C - 1000 CONTINUE - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE MRCHDU -C---------------------------------------------------- -C Marches the BLs and wake in mixed mode using -C the current Ue and Hk. The calculated Ue -C and Hk lie along a line quasi-normal to the -C natural Ue-Hk characteristic line of the -C current BL so that the Goldstein or Levy-Lees -C singularity is never encountered. Continuous -C checking of transition onset is performed. -C---------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - include 'c_XBL.INC' - complex VTMP(4,5), VZTMP(4) - complex MSQ - complex SENNEW -ccc REAL MDI -C - DATA DEPS / 5.0E-6 / -C -C---- constant controlling how far Hk is allowed to deviate -C- from the specified value. - SENSWT = 1000.0 - SENNEW = 0.0 -C - DO 2000 IS=1, 2 -C -C---- set forced transition arc length position - CALL XIFSET(IS) -C -C---- set leading edge pressure gradient parameter x/u du/dx - IBL = 2 - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) -CCC BULE = LOG(UEDG(IBL+1,IS)/UEI) / LOG(XSSI(IBL+1,IS)/XSI) -CCC BULE = MAX( -.08 , BULE ) - BULE = 1.0 -C -C---- old transition station - ITROLD = ITRAN(IS) -C - TRAN = .FALSE. - TURB = .FALSE. - ITRAN(IS) = IBLTE(IS) -C -C---- march downstream - DO 1000 IBL=2, NBL(IS) - IBM = IBL-1 -C - SIMI = IBL.ceq.2 - WAKE = IBL.GT.IBLTE(IS) -C -C------ initialize current station to existing variables - XSI = XSSI(IBL,IS) - UEI = UEDG(IBL,IS) - THI = THET(IBL,IS) - DSI = DSTR(IBL,IS) -CCC MDI = MASS(IBL,IS) -C -C------ fixed BUG MD 7 June 99 - IF(IBL.LT.ITROLD) THEN - AMI = CTAU(IBL,IS) - CTI = 0.03 - ELSE - CTI = CTAU(IBL,IS) - IF(CTI.LE.0.0) CTI = 0.03 - ENDIF -C -CCC DSI = MDI/UEI -C - IF(WAKE) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C - IF(IBL.LE.IBLTE(IS)) DSI = MAX(DSI-DSWAKI,1.02000*THI) + DSWAKI - IF(IBL.GT.IBLTE(IS)) DSI = MAX(DSI-DSWAKI,1.00005*THI) + DSWAKI -C -C------ Newton iteration loop for current station - DO 100 ITBL=1, 25 -C -C-------- assemble 10x3 linearized system for dCtau, dTh, dDs, dUe, dXi -C at the previous "1" station and the current "2" station -C (the "1" station coefficients will be ignored) -C -C - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C-------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 4...' - - CALL TRCHEK -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C - IF(IBL.ceq.IBLTE(IS)+1) THEN - TTE = THET(IBLTE(1),1) + THET(IBLTE(2),2) - DTE = DSTR(IBLTE(1),1) + DSTR(IBLTE(2),2) + ANTE - CTE = ( CTAU(IBLTE(1),1)*THET(IBLTE(1),1) - & + CTAU(IBLTE(2),2)*THET(IBLTE(2),2) ) / TTE - CALL TESYS(CTE,TTE,DTE) - ELSE - CALL BLSYS - ENDIF -C -C-------- set stuff at first iteration... - IF(ITBL.ceq.1) THEN -C -C--------- set "baseline" Ue and Hk for forming Ue(Hk) relation - UEREF = U2 - HKREF = HK2 -C -C--------- if current point IBL was turbulent and is now laminar, then... - IF(IBL.LT.ITRAN(IS) .AND. IBL.GE.ITROLD ) THEN -C---------- extrapolate baseline Hk - UEM = UEDG(IBL-1,IS) - DSM = DSTR(IBL-1,IS) - THM = THET(IBL-1,IS) - MSQ = UEM*UEM*HSTINV / (GM1BL*(1.0 - 0.5*UEM*UEM*HSTINV)) - CALL HKIN( DSM/THM, MSQ, HKREF, DUMMY, DUMMY ) - ENDIF -C -C--------- if current point IBL was laminar, then... - IF(IBL.LT.ITROLD) THEN -C---------- reinitialize or extrapolate Ctau if it's now turbulent - IF(TRAN) CTAU(IBL,IS) = 0.03 - IF(TURB) CTAU(IBL,IS) = CTAU(IBL-1,IS) - IF(TRAN .OR. TURB) THEN - CTI = CTAU(IBL,IS) - S2 = CTI - ENDIF - ENDIF -C - ENDIF -C -C - IF(SIMI .OR. (IBL.ceq.IBLTE(IS)+1)) THEN -C -C--------- for similarity station or first wake point, prescribe Ue - VS2(4,1) = 0. - VS2(4,2) = 0. - VS2(4,3) = 0. - VS2(4,4) = U2_UEI - VSREZ(4) = UEREF - U2 -C - ELSE -C -C********* calculate Ue-Hk characteristic slope -C - DO 20 K=1, 4 - VZTMP(K) = VSREZ(K) - DO 201 L=1, 5 - VTMP(K,L) = VS2(K,L) - 201 CONTINUE - 20 CONTINUE -C -C--------- set unit dHk - VTMP(4,1) = 0. - VTMP(4,2) = HK2_T2 - VTMP(4,3) = HK2_D2 - VTMP(4,4) = HK2_U2*U2_UEI - VZTMP(4) = 1.0 -C -C--------- calculate dUe response - CALL GAUSS(4,4,VTMP,VZTMP,1) -C -C--------- set SENSWT * (normalized dUe/dHk) - SENNEW = SENSWT * VZTMP(4) * HKREF/UEREF - IF(ITBL.LE.5) THEN - SENS = SENNEW - ELSE IF(ITBL.LE.15) THEN - SENS = 0.5*(SENS + SENNEW) - ENDIF -C -C--------- set prescribed Ue-Hk combination - VS2(4,1) = 0. - VS2(4,2) = HK2_T2 * HKREF - VS2(4,3) = HK2_D2 * HKREF - VS2(4,4) =( HK2_U2 * HKREF + SENS/UEREF )*U2_UEI - VSREZ(4) = -(HKREF**2)*(HK2 / HKREF - 1.0) - & - SENS*(U2 / UEREF - 1.0) -C - ENDIF -C -C-------- solve Newton system for current "2" station - CALL GAUSS(4,4,VS2,VSREZ,1) -C -C-------- determine max changes and underrelax if necessary - DMAX = MAX( ABS(VSREZ(2)/THI), - & ABS(VSREZ(3)/DSI) ) - IF(IBL.GE.ITRAN(IS)) DMAX = MAX(DMAX,ABS(VSREZ(1)/(10.0*CTI))) -C - RLX = 1.0 - IF(DMAX.GT.0.3) RLX = 0.3/DMAX -C -C-------- update as usual - IF(IBL.LT.ITRAN(IS)) AMI = AMI + RLX*VSREZ(1) - IF(IBL.GE.ITRAN(IS)) CTI = CTI + RLX*VSREZ(1) - THI = THI + RLX*VSREZ(2) - DSI = DSI + RLX*VSREZ(3) - UEI = UEI + RLX*VSREZ(4) -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) THEN - CTI = MIN(CTI , 0.30 ) - CTI = MAX(CTI , 0.0000001 ) - ENDIF -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEI*UEI*HSTINV / (GM1BL*(1.0 - 0.5*UEI*UEI*HSTINV)) - DSW = DSI - DSWAKI - CALL DSLIM(DSW,THI,UEI,MSQ,HKLIM) - DSI = DSW + DSWAKI -C - IF(DMAX.LE.DEPS) GO TO 110 -C - 100 CONTINUE -C -C WRITE(*,1350) IBL, IS, DMAX - 1350 FORMAT(' MRCHDU: Convergence failed at',I4,' side',I2, - & ' Res =', E12.4) -C -C------ the current unconverged solution might still be reasonable... -CCC IF(DMAX .LE. 0.1) GO TO 110 - IF(DMAX .LE. 0.1) GO TO 109 -C -C------- the current solution is garbage --> extrapolate values instead - IF(IBL.GT.3) THEN - IF(IBL.LE.IBLTE(IS)) THEN - THI = THET(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - DSI = DSTR(IBM,IS) * (XSSI(IBL,IS)/XSSI(IBM,IS))**0.5 - UEI = UEDG(IBM,IS) - ELSE IF(IBL.ceq.IBLTE(IS)+1) THEN - CTI = CTE - THI = TTE - DSI = DTE - UEI = UEDG(IBM,IS) - ELSE - THI = THET(IBM,IS) - RATLEN = (XSSI(IBL,IS)-XSSI(IBM,IS)) / (10.0*DSTR(IBM,IS)) - DSI = (DSTR(IBM,IS) + THI*RATLEN) / (1.0 + RATLEN) - UEI = UEDG(IBM,IS) - ENDIF - IF(IBL.ceq.ITRAN(IS)) CTI = 0.05 - IF(IBL.GT.ITRAN(IS)) CTI = CTAU(IBM,IS) - ENDIF -C - 109 CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN -C -C------- check for transition and set appropriate flags and things - IF((.NOT.SIMI) .AND. (.NOT.TURB)) THEN -c WRITE(*,*) 'Calling TRCHECK 5...' - - CALL TRCHEK -c IF(EXITFLAG.EQ.0) THEN -c RETURN -c ENDIF - - AMI = AMPL2 - IF( TRAN) ITRAN(IS) = IBL - IF(.NOT.TRAN) ITRAN(IS) = IBL+2 - ENDIF -C -C------- set all other extrapolated values for current station - IF(IBL.LT.ITRAN(IS)) CALL BLVAR(1) - IF(IBL.GE.ITRAN(IS)) CALL BLVAR(2) - IF(WAKE) CALL BLVAR(3) -C - IF(IBL.LT.ITRAN(IS)) CALL BLMID(1) - IF(IBL.GE.ITRAN(IS)) CALL BLMID(2) - IF(WAKE) CALL BLMID(3) -C -C------ pick up here after the Newton iterations - 110 CONTINUE -C - SENS = SENNEW -C -C------ store primary variables - IF(IBL.LT.ITRAN(IS)) CTAU(IBL,IS) = AMI - IF(IBL.GE.ITRAN(IS)) CTAU(IBL,IS) = CTI - THET(IBL,IS) = THI - DSTR(IBL,IS) = DSI - UEDG(IBL,IS) = UEI - MASS(IBL,IS) = DSI*UEI - TAU(IBL,IS) = 0.5*R2*U2*U2*CF2 - DIS(IBL,IS) = R2*U2*U2*U2*DI2*HS2*0.5 - CTQ(IBL,IS) = CQ2 -C -C------ set "1" variables to "2" variables for next streamwise station - CALL BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) - CALL BLKIN - DO 310 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 310 CONTINUE -C -C -C------ turbulent intervals will follow transition interval or TE - IF(TRAN .OR. (IBL.ceq.IBLTE(IS))) THEN - TURB = .TRUE. -C -C------- save transition location - TFORCE(IS) = TRFORC - XSSITR(IS) = XT - ENDIF -C - TRAN = .FALSE. -C - 1000 CONTINUE -C - 2000 CONTINUE -C - RETURN - END - - - SUBROUTINE XIFSET(IS) -C----------------------------------------------------- -C Sets forced-transition BL coordinate locations. -C----------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - include 'c_XBL.INC' -C - IF(XSTRIP(IS).GE.1.0) THEN - XIFORC = XSSI(IBLTE(IS),IS) - RETURN - ENDIF -C - CHX = XTE - XLE - CHY = YTE - YLE - CHSQ = CHX**2 + CHY**2 -C -C---- calculate chord-based x/c, y/c - DO 10 I=1, N - W1(I) = ((X(I)-XLE)*CHX + (Y(I)-YLE)*CHY) / CHSQ - W2(I) = ((Y(I)-YLE)*CHX - (X(I)-XLE)*CHY) / CHSQ - 10 CONTINUE -C - CALL SPLIND(W1,W3,S,N,-999.0,-999.0) - CALL SPLIND(W2,W4,S,N,-999.0,-999.0) -C - IF(IS.ceq.1) THEN -C -C----- set approximate arc length of forced transition point for SINVRT - STR = SLE + (S(1)-SLE)*XSTRIP(IS) -C -C----- calculate actual arc length - CALL SINVRT(STR,XSTRIP(IS),W1,W3,S,N) -C -C----- set BL coordinate value - XIFORC = MIN( (SST - STR) , XSSI(IBLTE(IS),IS) ) -C - ELSE -C----- same for bottom side -C - STR = SLE + (S(N)-SLE)*XSTRIP(IS) - CALL SINVRT(STR,XSTRIP(IS),W1,W3,S,N) - XIFORC = MIN( (STR - SST) , XSSI(IBLTE(IS),IS) ) -C - ENDIF -C - IF(XIFORC .LT. 0.0) THEN -C WRITE(*,1000) IS - 1000 FORMAT(/' *** Stagnation point is past trip on side',I2,' ***') - XIFORC = XSSI(IBLTE(IS),IS) - ENDIF -C - RETURN - END - - - - - SUBROUTINE UPDATE -C------------------------------------------------------------------ -C Adds on Newton deltas to boundary layer variables. -C Checks for excessive changes and underrelaxes if necessary. -C Calculates max and rms changes. -C Also calculates the change in the global variable "AC". -C If LALFA=.TRUE. , "AC" is CL -C If LALFA=.FALSE., "AC" is alpha -C------------------------------------------------------------------ - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - complex UNEW(IVX,2), U_AC(IVX,2) - complex QNEW(IQX), Q_AC(IQX) - EQUIVALENCE (VA(1,1,1), UNEW(1,1)) , - & (VB(1,1,1), QNEW(1) ) - EQUIVALENCE (VA(1,1,IVX), U_AC(1,1)) , - & (VB(1,1,IVX), Q_AC(1) ) - complex MSQ -C -C---- max allowable alpha changes per iteration - DALMAX = 0.5*DTOR - DALMIN = -0.5*DTOR -C -C---- max allowable CL change per iteration - DCLMAX = 0.5 - DCLMIN = -0.5 - IF(MATYP.cne.1) DCLMIN = MAX(-0.5 , -0.9*CL) -C - HSTINV = GAMM1*(MINF/QINF)**2 / (1.0 + 0.5*GAMM1*MINF**2) -C -C---- calculate new Ue distribution assuming no under-relaxation -C- also set the sensitivity of Ue wrt to alpha or Re - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - I = IPAN(IBL,IS) -C - DUI = 0. - DUI_AC = 0. - DO 100 JS=1, 2 - DO 1000 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - JV = ISYS(JBL,JS) - UE_M = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - DUI = DUI + UE_M*(MASS(JBL,JS)+VDEL(3,1,JV)) - DUI_AC = DUI_AC + UE_M*( -VDEL(3,2,JV)) - 1000 CONTINUE - 100 CONTINUE -C -C-------- UINV depends on "AC" only if "AC" is alpha - IF(LALFA) THEN - UINV_AC = 0. - ELSE - UINV_AC = UINV_A(IBL,IS) - ENDIF -C - UNEW(IBL,IS) = UINV(IBL,IS) + DUI - U_AC(IBL,IS) = UINV_AC + DUI_AC -C - 10 CONTINUE - 1 CONTINUE -C -C---- set new Qtan from new Ue with appropriate sign change - DO 2 IS=1, 2 - DO 20 IBL=2, IBLTE(IS) - I = IPAN(IBL,IS) - QNEW(I) = VTI(IBL,IS)*UNEW(IBL,IS) - Q_AC(I) = VTI(IBL,IS)*U_AC(IBL,IS) - 20 CONTINUE - 2 CONTINUE -C -C---- calculate new CL from this new Qtan - SA = SIN(ALFA) - CA = COS(ALFA) -C - BETA = SQRT(1.0 - MINF**2) - BETA_MSQ = -0.5/BETA -C - BFAC = 0.5*MINF**2 / (1.0 + BETA) - BFAC_MSQ = 0.5 / (1.0 + BETA) - & - BFAC / (1.0 + BETA) * BETA_MSQ -C - CLNEW = 0. - CL_A = 0. - CL_MS = 0. - CL_AC = 0. -C - I = 1 - CGINC = 1.0 - (QNEW(I)/QINF)**2 - CPG1 = CGINC / (BETA + BFAC*CGINC) - CPG1_MS = -CPG1/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_Q = -2.0*QNEW(I)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG1)/ (BETA + BFAC*CGINC) - CPG1_AC = CPC_CPI*CPI_Q*Q_AC(I) -C - DO 3 I=1, N - IP = I+1 - IF(I.ceq.N) IP = 1 -C - CGINC = 1.0 - (QNEW(IP)/QINF)**2 - CPG2 = CGINC / (BETA + BFAC*CGINC) - CPG2_MS = -CPG2/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_Q = -2.0*QNEW(IP)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG2)/ (BETA + BFAC*CGINC) - CPG2_AC = CPC_CPI*CPI_Q*Q_AC(IP) -C - DX = (X(IP) - X(I))*CA + (Y(IP) - Y(I))*SA - DX_A = -(X(IP) - X(I))*SA + (Y(IP) - Y(I))*CA -C - AG = 0.5*(CPG2 + CPG1 ) - AG_MS = 0.5*(CPG2_MS + CPG1_MS) - AG_AC = 0.5*(CPG2_AC + CPG1_AC) -C - CLNEW = CLNEW + DX *AG - CL_A = CL_A + DX_A*AG - CL_MS = CL_MS + DX *AG_MS - CL_AC = CL_AC + DX *AG_AC -C - CPG1 = CPG2 - CPG1_MS = CPG2_MS - CPG1_AC = CPG2_AC - 3 CONTINUE -C -C---- initialize under-relaxation factor - RLX = 1.0 -C - IF(LALFA) THEN -C===== alpha is prescribed: AC is CL -C -C----- set change in Re to account for CL changing, since Re = Re(CL) - DAC = (CLNEW - CL) / (1.0 - CL_AC - CL_MS*2.0*MINF*MINF_CL) -C -C----- set under-relaxation factor if Re change is too large - IF(RLX*DAC .GT. DCLMAX) RLX = DCLMAX/DAC - IF(RLX*DAC .LT. DCLMIN) RLX = DCLMIN/DAC -C - ELSE -C===== CL is prescribed: AC is alpha -C -C----- set change in alpha to drive CL to prescribed value - DAC = (CLNEW - CLSPEC) / (0.0 - CL_AC - CL_A) -C -C----- set under-relaxation factor if alpha change is too large - IF(RLX*DAC .GT. DALMAX) RLX = DALMAX/DAC - IF(RLX*DAC .LT. DALMIN) RLX = DALMIN/DAC -C - ENDIF -C - RMSBL = 0. - RMXBL = 0. -C - DHI = 1.5 - DLO = -.5 -C -C---- calculate changes in BL variables and under-relaxation if needed - DO 4 IS=1, 2 - DO 40 IBL=2, NBL(IS) - IV = ISYS(IBL,IS) -C -C-------- set changes without underrelaxation - DCTAU = VDEL(1,1,IV) - DAC*VDEL(1,2,IV) - DTHET = VDEL(2,1,IV) - DAC*VDEL(2,2,IV) - DMASS = VDEL(3,1,IV) - DAC*VDEL(3,2,IV) - DUEDG = UNEW(IBL,IS) + DAC*U_AC(IBL,IS) - UEDG(IBL,IS) - DDSTR = (DMASS - DSTR(IBL,IS)*DUEDG)/UEDG(IBL,IS) -C -C-------- normalize changes - IF(IBL.LT.ITRAN(IS)) DN1 = DCTAU / 10.0 - IF(IBL.GE.ITRAN(IS)) DN1 = DCTAU / CTAU(IBL,IS) - DN2 = DTHET / THET(IBL,IS) - DN3 = DDSTR / DSTR(IBL,IS) - DN4 = ABS(DUEDG)/0.25 -C -C-------- accumulate for rms change - RMSBL = RMSBL + DN1**2 + DN2**2 + DN3**2 + DN4**2 -C -C-------- see if Ctau needs underrelaxation - RDN1 = RLX*DN1 - IF(ABS(DN1) .GT. ABS(RMXBL)) THEN - RMXBL = DN1 - IF(IBL.LT.ITRAN(IS)) VMXBL = 'n' - IF(IBL.GE.ITRAN(IS)) VMXBL = 'C' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN1 .GT. DHI) RLX = DHI/DN1 - IF(RDN1 .LT. DLO) RLX = DLO/DN1 -C -C-------- see if Theta needs underrelaxation - RDN2 = RLX*DN2 - IF(ABS(DN2) .GT. ABS(RMXBL)) THEN - RMXBL = DN2 - VMXBL = 'T' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN2 .GT. DHI) RLX = DHI/DN2 - IF(RDN2 .LT. DLO) RLX = DLO/DN2 -C -C-------- see if Dstar needs underrelaxation - RDN3 = RLX*DN3 - IF(ABS(DN3) .GT. ABS(RMXBL)) THEN - RMXBL = DN3 - VMXBL = 'D' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN3 .GT. DHI) RLX = DHI/DN3 - IF(RDN3 .LT. DLO) RLX = DLO/DN3 -C -C-------- see if Ue needs underrelaxation - RDN4 = RLX*DN4 - IF(ABS(DN4) .GT. ABS(RMXBL)) THEN - RMXBL = DUEDG - VMXBL = 'U' - IMXBL = IBL - ISMXBL = IS - ENDIF - IF(RDN4 .GT. DHI) RLX = DHI/DN4 - IF(RDN4 .LT. DLO) RLX = DLO/DN4 -C - 40 CONTINUE - 4 CONTINUE -C -C---- set true rms change - RMSBL = SQRT( RMSBL / (4.0*FLOAT( NBL(1)+NBL(2) )) ) -C -C - IF(LALFA) THEN -C----- set underrelaxed change in Reynolds number from change in lift - CL = CL + RLX*DAC - ELSE -C----- set underrelaxed change in alpha - ALFA = ALFA + RLX*DAC - ADEG = ALFA/DTOR - ENDIF -C -C---- update BL variables with underrelaxed changes - DO 5 IS=1, 2 - DO 50 IBL=2, NBL(IS) - IV = ISYS(IBL,IS) -C - DCTAU = VDEL(1,1,IV) - DAC*VDEL(1,2,IV) - DTHET = VDEL(2,1,IV) - DAC*VDEL(2,2,IV) - DMASS = VDEL(3,1,IV) - DAC*VDEL(3,2,IV) - DUEDG = UNEW(IBL,IS) + DAC*U_AC(IBL,IS) - UEDG(IBL,IS) - DDSTR = (DMASS - DSTR(IBL,IS)*DUEDG)/UEDG(IBL,IS) -C - CTAU(IBL,IS) = CTAU(IBL,IS) + RLX*DCTAU - THET(IBL,IS) = THET(IBL,IS) + RLX*DTHET - DSTR(IBL,IS) = DSTR(IBL,IS) + RLX*DDSTR - UEDG(IBL,IS) = UEDG(IBL,IS) + RLX*DUEDG -C - IF(IBL.GT.IBLTE(IS)) THEN - IW = IBL - IBLTE(IS) - DSWAKI = WGAP(IW) - ELSE - DSWAKI = 0. - ENDIF -C -C-------- eliminate absurd transients - IF(IBL.GE.ITRAN(IS)) - & CTAU(IBL,IS) = MIN( CTAU(IBL,IS) , 0.25 ) -C - IF(IBL.LE.IBLTE(IS)) THEN - HKLIM = 1.02 - ELSE - HKLIM = 1.00005 - ENDIF - MSQ = UEDG(IBL,IS)**2*HSTINV - & / (GAMM1*(1.0 - 0.5*UEDG(IBL,IS)**2*HSTINV)) - DSW = DSTR(IBL,IS) - DSWAKI - CALL DSLIM(DSW,THET(IBL,IS),UEDG(IBL,IS),MSQ,HKLIM) - DSTR(IBL,IS) = DSW + DSWAKI -C -C-------- set new mass defect (nonlinear update) - MASS(IBL,IS) = DSTR(IBL,IS) * UEDG(IBL,IS) -C - 50 CONTINUE - 5 CONTINUE -C -C -C---- equate upper wake arrays to lower wake arrays - DO 6 KBL=1, NBL(2)-IBLTE(2) - CTAU(IBLTE(1)+KBL,1) = CTAU(IBLTE(2)+KBL,2) - THET(IBLTE(1)+KBL,1) = THET(IBLTE(2)+KBL,2) - DSTR(IBLTE(1)+KBL,1) = DSTR(IBLTE(2)+KBL,2) - UEDG(IBLTE(1)+KBL,1) = UEDG(IBLTE(2)+KBL,2) - TAU(IBLTE(1)+KBL,1) = TAU(IBLTE(2)+KBL,2) - DIS(IBLTE(1)+KBL,1) = DIS(IBLTE(2)+KBL,2) - CTQ(IBLTE(1)+KBL,1) = CTQ(IBLTE(2)+KBL,2) - 6 CONTINUE -C - RETURN - END - - - - SUBROUTINE DSLIM(DSTR,THET,UEDG,MSQ,HKLIM) - use complexify - IMPLICIT complex (A-H,M,O-Z) -C - H = DSTR/THET - CALL HKIN(H,MSQ,HK,HK_H,HK_M) -C - DH = MAX( 0.0 , HKLIM-HK ) / HK_H - DSTR = DSTR + DH*THET -C - RETURN - END - - diff --git a/deps/src/xfoil_cs/c_xblsys.f b/deps/src/xfoil_cs/c_xblsys.f deleted file mode 100644 index ab1862c..0000000 --- a/deps/src/xfoil_cs/c_xblsys.f +++ /dev/null @@ -1,2433 +0,0 @@ -C*********************************************************************** -C Module: xblsys.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - - SUBROUTINE TRCHEK - use complexify - implicit complex(a-h, o-z) - -C -C---- 1st-order amplification equation -c CALL TRCHEK1 -C -C---- 2nd-order amplification equation - CALL TRCHEK2 -C - - RETURN - END - - - SUBROUTINE AXSET( HK1, T1, RT1, A1, - & HK2, T2, RT2, A2, ACRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -C---------------------------------------------------------- -C Returns average amplification AX over interval 1..2 -C---------------------------------------------------------- -C -cC========================== -cC---- 1st-order -- based on "1" quantities only -c$$$ CALL DAMPL( HK1, T1, RT1, AX1, AX1_HK1, AX1_T1, AX1_RT1 ) -c$$$ AX2_HK2 = 0.0 -c$$$ AX2_T2 = 0.0 -c$$$ AX2_RT2 = 0.0 -c$$$cC -c$$$ AX1_A1 = 0.0 -c$$$ AX2_A2 = 0.0 -c$$$cC -c$$$ AX = AX1 -c$$$ AX_AX1 = 1.0 -c$$$ AX_AX2 = 0.0 -c$$$cC -c$$$ ARG = MIN( 20.0*(ACRIT-A1) , 20.0 ) -c$$$ EXN = EXP(-ARG) -c$$$ EXN_A1 = 20.0*EXN -c$$$ EXN_A2 = 0. -c$$$cC -c$$$ DAX = EXN * 0.0004/T1 -c$$$ DAX_A1 = EXN_A1* 0.0004/T1 -c$$$ DAX_A2 = 0. -c$$$ DAX_T1 = -DAX/T1 -c$$$ DAX_T2 = 0. -C -C========================== -C---- 2nd-order - use complexify - implicit complex(a-h, o-z) - CALL DAMPL( HK1, T1, RT1, AX1, AX1_HK1, AX1_T1, AX1_RT1 ) - CALL DAMPL( HK2, T2, RT2, AX2, AX2_HK2, AX2_T2, AX2_RT2 ) -C -CC---- simple-average version -C AXA = 0.5*(AX1 + AX2) -C IF(AXA .LE. 0.0) THEN -C AXA = 0.0 -C AXA_AX1 = 0.0 -C AXA_AX2 = 0.0 -C ELSE -C AXA_AX1 = 0.5 -C AXA_AX2 = 0.5 -C ENDIF -C -C---- rms-average version (seems a little better on coarse grids) - AXSQ = 0.5*(AX1**2 + AX2**2) - IF(AXSQ .LE. 0.0) THEN - AXA = 0.0 - AXA_AX1 = 0.0 - AXA_AX2 = 0.0 - ELSE - AXA = SQRT(AXSQ) - AXA_AX1 = 0.5*AX1/AXA - AXA_AX2 = 0.5*AX2/AXA - ENDIF -C -C----- small additional term to ensure dN/dx > 0 near N = Ncrit - ARG = MIN( 20.0*(ACRIT-0.5*(A1+A2)) , 20.0 ) - IF(ARG.LE.0.0) THEN - EXN = 1.0 -CC EXN_AC = 0. - EXN_A1 = 0. - EXN_A2 = 0. - ELSE - EXN = EXP(-ARG) -CC EXN_AC = -20.0 *EXN - EXN_A1 = 20.0*0.5*EXN - EXN_A2 = 20.0*0.5*EXN - ENDIF -C - DAX = EXN * 0.002/(T1+T2) -CC DAX_AC = EXN_AC * 0.002/(T1+T2) - DAX_A1 = EXN_A1 * 0.002/(T1+T2) - DAX_A2 = EXN_A2 * 0.002/(T1+T2) - DAX_T1 = -DAX/(T1+T2) - DAX_T2 = -DAX/(T1+T2) -C -c -c DAX = 0. -c DAX_A1 = 0. -c DAX_A2 = 0. -c DAX_AC = 0. -c DAX_T1 = 0. -c DAX_T2 = 0. -C========================== -C - AX = AXA + DAX -C - AX_HK1 = AXA_AX1*AX1_HK1 - AX_T1 = AXA_AX1*AX1_T1 + DAX_T1 - AX_RT1 = AXA_AX1*AX1_RT1 - AX_A1 = DAX_A1 -C - AX_HK2 = AXA_AX2*AX2_HK2 - AX_T2 = AXA_AX2*AX2_T2 + DAX_T2 - AX_RT2 = AXA_AX2*AX2_RT2 - AX_A2 = DAX_A2 -C - - RETURN - END - - -c SUBROUTINE TRCHEK1 -cC------------------------------------------------- -C Checks if transition occurs in the current -C interval 1..2 (IBL-1...IBL) on side IS. -C -cC Old first-order version. -cC -cC Growth rate is evaluated at the upstream -cC point "1". The discrete amplification -cC equation is -cC -cC Ncrit - N(X1) -cC ------------- = N'(X1) -cC XT - X1 -cC -cC which can be immediately solved for -cC the transition location XT. -cC------------------------------------------------- -c use complexify -c implicit complex(a-h, o-z) -c INCLUDE 'c_XBL.INC' -cc -c -c -cC---- calculate AMPL2 value -c CALL AXSET( HK1, T1, RT1, AMPL1, -c & HK2, T2, RT2, AMPL2, AMCRIT, -c & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, -c & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -c AMPL2 = AMPL1 + AX*(X2-X1) -cC -cC---- test for free or forced transition -c TRFREE = AMPL2.GE.AMCRIT -c TRFORC = XIFORC.GT.X1 .AND. XIFORC.LE.X2 -cC -cC---- set transition interval flag -c TRAN = TRFORC .OR. TRFREE -cC -cC---- if no transition yet, just return -c IF(.NOT.TRAN) RETURN -cC -cC---- resolve if both forced and free transition -c IF(TRFREE .AND. TRFORC) THEN -c XT = (AMCRIT-AMPL1)/AX + X1 -c TRFORC = XIFORC .LT. XT -c TRFREE = XIFORC .GE. XT -c ENDIF -cC -c IF(TRFORC) THEN -cC----- if forced transition, then XT is prescribed -c XT = XIFORC -c XT_A1 = 0. -c XT_X1 = 0. -c XT_T1 = 0. -c XT_D1 = 0. -c XT_U1 = 0. -c XT_X2 = 0. -c XT_T2 = 0. -c XT_D2 = 0. -c XT_U2 = 0. -c XT_MS = 0. -c XT_RE = 0. -c XT_XF = 1.0 -c ELSE -cC----- if free transition, XT is related to BL variables -cC- by the amplification equation -cC -c XT = (AMCRIT-AMPL1)/AX + X1 -c XT_AX = -(AMCRIT-AMPL1)/AX**2 -cC -c XT_A1 = -1.0/AX - (AMCRIT-AMPL1)/AX**2 * AX_A1 -c XT_X1 = 1.0 -c XT_T1 = XT_AX*(AX_HK1*HK1_T1 + AX_T1 + AX_RT1*RT1_T1) -c XT_D1 = XT_AX*(AX_HK1*HK1_D1 ) -c XT_U1 = XT_AX*(AX_HK1*HK1_U1 + AX_RT1*RT1_U1) -c XT_X2 = 0. -c XT_T2 = 0. -c XT_D2 = 0. -c XT_U2 = 0. -c XT_MS = XT_AX*(AX_HK1*HK1_MS + AX_RT1*RT1_MS) -c XT_RE = XT_AX*( AX_RT1*RT1_RE) -c XT_XF = 0.0 -c ENDIF -cC -c RETURN -c END - - - SUBROUTINE TRCHEK2 -C---------------------------------------------------------------- -C New second-order version: December 1994. -C -C Checks if transition occurs in the current interval X1..X2. -C If transition occurs, then set transition location XT, and -C its sensitivities to "1" and "2" variables. If no transition, -C set amplification AMPL2. -C -C -C Solves the implicit amplification equation for N2: -C -C N2 - N1 N'(XT,NT) + N'(X1,N1) -C ------- = --------------------- -C X2 - X1 2 -C -C In effect, a 2-point central difference is used between -C X1..X2 (no transition), or X1..XT (transition). The switch -C is done by defining XT,NT in the equation above depending -C on whether N2 exceeds Ncrit. -C -C If N2Ncrit: NT=Ncrit , XT=(Ncrit-N1)/(N2-N1) (transition) -C -C -C---------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - include 'c_XBL.INC' - DATA DAEPS / 5.0E-5 / -CCC DATA DAEPS / 1.0D-12 / -C -C---- save variables and sensitivities at IBL ("2") for future restoration - DO 5 ICOM=1, NCOM - C2SAV(ICOM) = COM2(ICOM) - 5 CONTINUE -C -C---- calculate average amplification rate AX over X1..X2 interval - CALL AXSET( HK1, T1, RT1, AMPL1, - & HK2, T2, RT2, AMPL2, AMCRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -C -C---- set initial guess for iterate N2 (AMPL2) at X2 - AMPL2 = AMPL1 + AX*(X2-X1) -C -C---- solve implicit system for amplification AMPL2 - DO 100 ITAM=1, 30 -C -C---- define weighting factors WF1,WF2 for defining "T" quantities from 1,2 -C - IF(AMPL2 .LE. AMCRIT) THEN -C------ there is no transition yet, "T" is the same as "2" - AMPLT = AMPL2 - AMPLT_A2 = 1.0 - SFA = 1.0 - SFA_A1 = 0. - SFA_A2 = 0. - ELSE -C------ there is transition in X1..X2, "T" is set from N1, N2 - AMPLT = AMCRIT - AMPLT_A2 = 0. - SFA = (AMPLT - AMPL1)/(AMPL2-AMPL1) - SFA_A1 = ( SFA - 1.0 )/(AMPL2-AMPL1) - SFA_A2 = ( - SFA )/(AMPL2-AMPL1) - ENDIF -C - IF(XIFORC.LT.X2) THEN - SFX = (XIFORC - X1 )/(X2-X1) - SFX_X1 = (SFX - 1.0)/(X2-X1) - SFX_X2 = ( - SFX)/(X2-X1) - SFX_XF = 1.0 /(X2-X1) - ELSE - SFX = 1.0 - SFX_X1 = 0. - SFX_X2 = 0. - SFX_XF = 0. - ENDIF -C -C---- set weighting factor from free or forced transition - IF(SFA.LT.SFX) THEN - WF2 = SFA - WF2_A1 = SFA_A1 - WF2_A2 = SFA_A2 - WF2_X1 = 0. - WF2_X2 = 0. - WF2_XF = 0. - ELSE - WF2 = SFX - WF2_A1 = 0. - WF2_A2 = 0. - WF2_X1 = SFX_X1 - WF2_X2 = SFX_X2 - WF2_XF = SFX_XF - ENDIF -C -C -C===================== -CC---- 1st-order (based on "1" quantites only, for testing) -C WF2 = 0.0 -C WF2_A1 = 0.0 -C WF2_A2 = 0.0 -C WF2_X1 = 0.0 -C WF2_X2 = 0.0 -C WF2_XF = 0.0 -C===================== -C - WF1 = 1.0 - WF2 - WF1_A1 = - WF2_A1 - WF1_A2 = - WF2_A2 - WF1_X1 = - WF2_X1 - WF1_X2 = - WF2_X2 - WF1_XF = - WF2_XF -C -C---- interpolate BL variables to XT - XT = X1*WF1 + X2*WF2 - TT = T1*WF1 + T2*WF2 - DT = D1*WF1 + D2*WF2 - UT = U1*WF1 + U2*WF2 -C - XT_A2 = X1*WF1_A2 + X2*WF2_A2 - TT_A2 = T1*WF1_A2 + T2*WF2_A2 - DT_A2 = D1*WF1_A2 + D2*WF2_A2 - UT_A2 = U1*WF1_A2 + U2*WF2_A2 -C -C---- temporarily set "2" variables from "T" for BLKIN - X2 = XT - T2 = TT - D2 = DT - U2 = UT -C -C---- calculate laminar secondary "T" variables HKT, RTT - CALL BLKIN -C - HKT = HK2 - HKT_TT = HK2_T2 - HKT_DT = HK2_D2 - HKT_UT = HK2_U2 - HKT_MS = HK2_MS -C - RTT = RT2 - RTT_TT = RT2_T2 - RTT_UT = RT2_U2 - RTT_MS = RT2_MS - RTT_RE = RT2_RE -C -C---- restore clobbered "2" variables, except for AMPL2 - AMSAVE = AMPL2 - DO 8 ICOM=1, NCOM - COM2(ICOM) = C2SAV(ICOM) - 8 CONTINUE - AMPL2 = AMSAVE -C -C---- calculate amplification rate AX over current X1-XT interval - CALL AXSET( HK1, T1, RT1, AMPL1, - & HKT, TT, RTT, AMPLT, AMCRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HKT, AX_TT, AX_RTT, AX_AT ) -C -C---- punch out early if there is no amplification here - IF(AX .LE. 0.0) GO TO 101 -C -C---- set sensitivity of AX(A2) - AX_A2 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_A2 - & + (AX_HKT*HKT_DT )*DT_A2 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_A2 - & + AX_AT *AMPLT_A2 -C -C---- residual for implicit AMPL2 definition (amplification equation) - RES = AMPL2 - AMPL1 - AX *(X2-X1) - RES_A2 = 1.0 - AX_A2*(X2-X1) -C - DA2 = -RES/RES_A2 -C - RLX = 1.0 - DXT = XT_A2*DA2 -C - IF(RLX*ABS(DXT/(X2-X1)) .GT. 0.05) RLX = 0.05*ABS((X2-X1)/DXT) - IF(RLX*ABS(DA2) .GT. 1.0 ) RLX = 1.0 *ABS( 1.0 /DA2) -C -C---- check if converged - IF(ABS(DA2) .LT. DAEPS) GO TO 101 -C - IF((AMPL2.GT.AMCRIT .AND. AMPL2+RLX*DA2.LT.AMCRIT).OR. - & (AMPL2.LT.AMCRIT .AND. AMPL2+RLX*DA2.GT.AMCRIT) ) THEN -C------ limited Newton step so AMPL2 doesn't step across AMCRIT either way - AMPL2 = AMCRIT - ELSE -C------ regular Newton step - AMPL2 = AMPL2 + RLX*DA2 - ENDIF -C - 100 CONTINUE -C DO SOMETHING ABOUT THIS! - -c WRITE(*,*) 'TRCHEK2: N2 convergence failed.' -C WRITE(*,6700) X1, XT, X2, AMPL1, AMPLT, AMPL2, AX, DA2 -c WRITE(*,*) "CONVERGENCE PROBLEMS IN BL ANALYSIS, XBLSYS.F" - cl = -10 - cd = -10 - cm = -10 -c write(*,*) cl - LVCONV = .FALSE. -c GOTO 123 -c STOP - RETURN - 6700 FORMAT(1X,'x:', 3F9.5,' N:',3F7.3,' Nx:',F8.3,' dN:',E10.3) -C - 101 CONTINUE -C -C -C---- test for free or forced transition - TRFREE = AMPL2 .GE. AMCRIT - TRFORC = XIFORC.GT.X1 .AND. XIFORC.LE.X2 -C -C---- set transition interval flag - TRAN = TRFORC .OR. TRFREE -C - IF(.NOT.TRAN) RETURN -C -C---- resolve if both forced and free transition - IF(TRFREE .AND. TRFORC) THEN - TRFORC = XIFORC .LT. XT - TRFREE = XIFORC .GE. XT - ENDIF -C - IF(TRFORC) THEN -C----- if forced transition, then XT is prescribed, -C- no sense calculating the sensitivities, since we know them... - XT = XIFORC - XT_A1 = 0. - XT_X1 = 0. - XT_T1 = 0. - XT_D1 = 0. - XT_U1 = 0. - XT_X2 = 0. - XT_T2 = 0. - XT_D2 = 0. - XT_U2 = 0. - XT_MS = 0. - XT_RE = 0. - XT_XF = 1.0 - RETURN - ENDIF -C -C---- free transition ... set sensitivities of XT -C -C---- XT( X1 X2 A1 A2 XF ), TT( T1 T2 A1 A2 X1 X2 XF), DT( ... -CC XT = X1*WF1 + X2*WF2 -CC TT = T1*WF1 + T2*WF2 -CC DT = D1*WF1 + D2*WF2 -CC UT = U1*WF1 + U2*WF2 -C - XT_X1 = WF1 - TT_T1 = WF1 - DT_D1 = WF1 - UT_U1 = WF1 -C - XT_X2 = WF2 - TT_T2 = WF2 - DT_D2 = WF2 - UT_U2 = WF2 -C - XT_A1 = X1*WF1_A1 + X2*WF2_A1 - TT_A1 = T1*WF1_A1 + T2*WF2_A1 - DT_A1 = D1*WF1_A1 + D2*WF2_A1 - UT_A1 = U1*WF1_A1 + U2*WF2_A1 -C -CC XT_A2 = X1*WF1_A2 + X2*WF2_A2 -CC TT_A2 = T1*WF1_A2 + T2*WF2_A2 -CC DT_A2 = D1*WF1_A2 + D2*WF2_A2 -CC UT_A2 = U1*WF1_A2 + U2*WF2_A2 -C - XT_X1 = X1*WF1_X1 + X2*WF2_X1 + XT_X1 - TT_X1 = T1*WF1_X1 + T2*WF2_X1 - DT_X1 = D1*WF1_X1 + D2*WF2_X1 - UT_X1 = U1*WF1_X1 + U2*WF2_X1 -C - XT_X2 = X1*WF1_X2 + X2*WF2_X2 + XT_X2 - TT_X2 = T1*WF1_X2 + T2*WF2_X2 - DT_X2 = D1*WF1_X2 + D2*WF2_X2 - UT_X2 = U1*WF1_X2 + U2*WF2_X2 -C - XT_XF = X1*WF1_XF + X2*WF2_XF - TT_XF = T1*WF1_XF + T2*WF2_XF - DT_XF = D1*WF1_XF + D2*WF2_XF - UT_XF = U1*WF1_XF + U2*WF2_XF -C -C---- at this point, AX = AX( HK1, T1, RT1, A1, HKT, TT, RTT, AT ) -C -C---- set sensitivities of AX( T1 D1 U1 A1 T2 D2 U2 A2 MS RE ) - AX_T1 = AX_HK1*HK1_T1 + AX_T1 + AX_RT1*RT1_T1 - & + (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_T1 - AX_D1 = AX_HK1*HK1_D1 - & + (AX_HKT*HKT_DT )*DT_D1 - AX_U1 = AX_HK1*HK1_U1 + AX_RT1*RT1_U1 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_U1 - AX_A1 = AX_A1 - & + (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_A1 - & + (AX_HKT*HKT_DT )*DT_A1 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_A1 - AX_X1 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_X1 - & + (AX_HKT*HKT_DT )*DT_X1 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_X1 -C - AX_T2 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_T2 - AX_D2 = (AX_HKT*HKT_DT )*DT_D2 - AX_U2 = (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_U2 - AX_A2 = AX_AT *AMPLT_A2 - & + (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_A2 - & + (AX_HKT*HKT_DT )*DT_A2 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_A2 - AX_X2 = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_X2 - & + (AX_HKT*HKT_DT )*DT_X2 - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_X2 -C - AX_XF = (AX_HKT*HKT_TT + AX_TT + AX_RTT*RTT_TT)*TT_XF - & + (AX_HKT*HKT_DT )*DT_XF - & + (AX_HKT*HKT_UT + AX_RTT*RTT_UT)*UT_XF -C - AX_MS = AX_HKT*HKT_MS + AX_RTT*RTT_MS - & + AX_HK1*HK1_MS + AX_RT1*RT1_MS - AX_RE = AX_RTT*RTT_RE - & + AX_RT1*RT1_RE -C -C -C---- set sensitivities of residual RES -CCC RES = AMPL2 - AMPL1 - AX*(X2-X1) - Z_AX = - (X2-X1) -C - Z_A1 = Z_AX*AX_A1 - 1.0 - Z_T1 = Z_AX*AX_T1 - Z_D1 = Z_AX*AX_D1 - Z_U1 = Z_AX*AX_U1 - Z_X1 = Z_AX*AX_X1 + AX -C - Z_A2 = Z_AX*AX_A2 + 1.0 - Z_T2 = Z_AX*AX_T2 - Z_D2 = Z_AX*AX_D2 - Z_U2 = Z_AX*AX_U2 - Z_X2 = Z_AX*AX_X2 - AX -C - Z_XF = Z_AX*AX_XF - Z_MS = Z_AX*AX_MS - Z_RE = Z_AX*AX_RE -C -C---- set sensitivities of XT, with RES being stationary for A2 constraint - XT_A1 = XT_A1 - (XT_A2/Z_A2)*Z_A1 - XT_T1 = - (XT_A2/Z_A2)*Z_T1 - XT_D1 = - (XT_A2/Z_A2)*Z_D1 - XT_U1 = - (XT_A2/Z_A2)*Z_U1 - XT_X1 = XT_X1 - (XT_A2/Z_A2)*Z_X1 - XT_T2 = - (XT_A2/Z_A2)*Z_T2 - XT_D2 = - (XT_A2/Z_A2)*Z_D2 - XT_U2 = - (XT_A2/Z_A2)*Z_U2 - XT_X2 = XT_X2 - (XT_A2/Z_A2)*Z_X2 - XT_MS = - (XT_A2/Z_A2)*Z_MS - XT_RE = - (XT_A2/Z_A2)*Z_RE - XT_XF = 0.0 -C - 123 CONTINUE - RETURN - END - - - SUBROUTINE BLSYS -C------------------------------------------------------------------ -C -C Sets up the BL Newton system governing the current interval: -C -C | ||dA1| | ||dA2| | | -C | VS1 ||dT1| + | VS2 ||dT2| = |VSREZ| -C | ||dD1| | ||dD2| | | -C |dU1| |dU2| -C |dX1| |dX2| -C -C 3x5 5x1 3x5 5x1 3x1 -C -C The system as shown corresponds to a laminar station -C If TRAN, then dS2 replaces dA2 -C If TURB, then dS1, dS2 replace dA1, dA2 -C -C------------------------------------------------------------------ - use complexify -c IMPLICIT complex(M) - implicit complex(a-h,m, o-z) - include 'c_XBL.INC' - -c write(*,*) 'VS1 before first part',VS1 -c write(*,*) 'VS2 before first part',VS2 - -C -C---- calculate secondary BL variables and their sensitivities -c write(*,*) 'X2 before the first part',X2 - IF(WAKE) THEN - CALL BLVAR(3) - CALL BLMID(3) - ELSE IF(TURB.OR.TRAN) THEN - CALL BLVAR(2) - CALL BLMID(2) - ELSE - CALL BLVAR(1) - CALL BLMID(1) - ENDIF -C -c write(*,*) 'VS1 after first part',VS1 -c write(*,*) 'VS2 after first part',VS2 -c write(*,*) 'X2 after the first part',X2 -C---- for the similarity station, "1" and "2" variables are the same - IF(SIMI) THEN - DO 3 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - 3 CONTINUE - ENDIF -C -C---- set up appropriate finite difference system for current interval -c complex ERROR IS HERE______________________-- -c write(*,*) 'TRAN',TRAN - IF(TRAN) THEN -c write(*,*) 'call trdif' - CALL TRDIF - ELSE IF(SIMI) THEN -c write(*,*) 'call bldif(0)' - CALL BLDIF(0) - ELSE IF(.NOT.TURB) THEN -c write(*,*) 'call bldif(1)' -c - CALL BLDIF(1) -c <-----error here - ELSE IF(WAKE) THEN -c write(*,*) 'call bldif(3)' - CALL BLDIF(3) - ELSE IF(TURB) THEN -c write(*,*) 'call bldif(2)' - CALL BLDIF(2) - ENDIF -c write(*,*) 'X2 after the second part',X2 -c_______________________________________- -cc write(*,*) 'VS1 after second part',VS1 -c write(*,*) 'VS2 after second part',VS2 -c stop - - IF(SIMI) THEN -C----- at similarity station, "1" variables are really "2" variables - DO 10 K=1, 4 - DO 101 L=1, 5 - VS2(K,L) = VS1(K,L) + VS2(K,L) - VS1(K,L) = 0. - 101 CONTINUE - 10 CONTINUE - ENDIF -C -C---- change system over into incompressible Uei and Mach - DO 20 K=1, 4 -C -C------ residual derivatives wrt compressible Uec - RES_U1 = VS1(K,4) - RES_U2 = VS2(K,4) - RES_MS = VSM(K) -C -C------ combine with derivatives of compressible U1,U2 = Uec(Uei M) - VS1(K,4) = RES_U1*U1_UEI - VS2(K,4) = RES_U2*U2_UEI - VSM(K) = RES_U1*U1_MS + RES_U2*U2_MS + RES_MS - 20 CONTINUE -C -c write(*,*) 'X2 at end',X2 - RETURN - END - - - SUBROUTINE TESYS(CTE,TTE,DTE) -C-------------------------------------------------------- -C Sets up "dummy" BL system between airfoil TE point -C and first wake point infinitesimally behind TE. -C-------------------------------------------------------- - use complexify - implicit complex(a-h,m, o-z) -c IMPLICIT complex (M) - include 'c_XBL.INC' -C - DO 55 K=1, 4 - VSREZ(K) = 0. - VSM(K) = 0. - VSR(K) = 0. - VSX(K) = 0. - DO 551 L=1, 5 - VS1(K,L) = 0. - VS2(K,L) = 0. - 551 CONTINUE - 55 CONTINUE -C - CALL BLVAR(3) -C - VS1(1,1) = -1.0 - VS2(1,1) = 1.0 - VSREZ(1) = CTE - S2 -C - VS1(2,2) = -1.0 - VS2(2,2) = 1.0 - VSREZ(2) = TTE - T2 -C - VS1(3,3) = -1.0 - VS2(3,3) = 1.0 - VSREZ(3) = DTE - D2 - DW2 -C - RETURN - END - - - SUBROUTINE BLPRV(XSI,AMI,CTI,THI,DSI,DSWAKI,UEI) -C---------------------------------------------------------- -C Set BL primary "2" variables from parameter list -C---------------------------------------------------------- - use complexify - implicit complex(a-h,m, o-z) -c IMPLICIT complex(M) - include 'c_XBL.INC' -C - X2 = XSI - AMPL2 = AMI - S2 = CTI - T2 = THI - D2 = DSI - DSWAKI - DW2 = DSWAKI -C - U2 = UEI*(1.0-TKBL) / (1.0 - TKBL*(UEI/QINFBL)**2) - U2_UEI = (1.0 + TKBL*(2.0*U2*UEI/QINFBL**2 - 1.0)) - & / (1.0 - TKBL*(UEI/QINFBL)**2) - U2_MS = (U2*(UEI/QINFBL)**2 - UEI)*TKBL_MS - & / (1.0 - TKBL*(UEI/QINFBL)**2) -C - RETURN - END ! BLPRV - - - SUBROUTINE BLKIN -C---------------------------------------------------------- -C Calculates turbulence-independent secondary "2" -C variables from the primary "2" variables. -C---------------------------------------------------------- - use complexify - implicit complex(a-h,m, o-z) -c IMPLICIT complex(M) - include 'c_XBL.INC' -C -C---- set edge Mach number ** 2 - M2 = U2*U2*HSTINV / (GM1BL*(1.0 - 0.5*U2*U2*HSTINV)) - TR2 = 1.0 + 0.5*GM1BL*M2 - M2_U2 = 2.0*M2*TR2/U2 - M2_MS = U2*U2*TR2 / (GM1BL*(1.0 - 0.5*U2*U2*HSTINV)) - & * HSTINV_MS -C -C---- set edge static density (isentropic relation) - R2 = RSTBL *TR2**(-1.0/GM1BL) - R2_U2 = -R2/TR2 * 0.5*M2_U2 - R2_MS = -R2/TR2 * 0.5*M2_MS - & + RSTBL_MS*TR2**(-1.0/GM1BL) -C -C---- set shape parameter - H2 = D2/T2 - H2_D2 = 1.0/T2 - H2_T2 = -H2/T2 -C -C---- set edge static/stagnation enthalpy - HERAT = 1.0 - 0.5*U2*U2*HSTINV - HE_U2 = - U2*HSTINV - HE_MS = - 0.5*U2*U2*HSTINV_MS -C -C---- set molecular viscosity - V2 = SQRT((HERAT)**3) * (1.0+HVRAT)/(HERAT+HVRAT)/REYBL - V2_HE = V2*(1.5/HERAT - 1.0/(HERAT+HVRAT)) -C - V2_U2 = V2_HE*HE_U2 - V2_MS = -V2/REYBL * REYBL_MS + V2_HE*HE_MS - V2_RE = -V2/REYBL * REYBL_RE -C -C---- set kinematic shape parameter - CALL HKIN( H2, M2, HK2, HK2_H2, HK2_M2 ) -C - HK2_U2 = HK2_M2*M2_U2 - HK2_T2 = HK2_H2*H2_T2 - HK2_D2 = HK2_H2*H2_D2 - HK2_MS = HK2_M2*M2_MS -C -C---- set momentum thickness Reynolds number - RT2 = R2*U2*T2/V2 - RT2_U2 = RT2*(1.0/U2 + R2_U2/R2 - V2_U2/V2) - RT2_T2 = RT2/T2 - RT2_MS = RT2*( R2_MS/R2 - V2_MS/V2) - RT2_RE = RT2*( - V2_RE/V2) -C - RETURN - END ! BLKIN - - - - SUBROUTINE BLVAR(ITYP) -C---------------------------------------------------- -C Calculates all secondary "2" variables from -C the primary "2" variables X2, U2, T2, D2, S2. -C Also calculates the sensitivities of the -C secondary variables wrt the primary variables. -C -C ITYP = 1 : laminar -C ITYP = 2 : turbulent -C ITYP = 3 : turbulent wake -C---------------------------------------------------- - use complexify - implicit complex(a-h,m, o-z) -c IMPLICIT complex(M) - include 'c_XBL.INC' -C - IF(ITYP.ceq.3) HK2 = MAX(HK2,1.00005) - IF(ITYP.cne.3) HK2 = MAX(HK2,1.05000) -C -C---- density thickness shape parameter ( H** ) - CALL HCT( HK2, M2, HC2, HC2_HK2, HC2_M2 ) - HC2_U2 = HC2_HK2*HK2_U2 + HC2_M2*M2_U2 - HC2_T2 = HC2_HK2*HK2_T2 - HC2_D2 = HC2_HK2*HK2_D2 - HC2_MS = HC2_HK2*HK2_MS + HC2_M2*M2_MS -C -C---- set KE thickness shape parameter from H - H* correlations - IF(ITYP.ceq.1) THEN - CALL HSL( HK2, RT2, M2, HS2, HS2_HK2, HS2_RT2, HS2_M2 ) - ELSE - CALL HST( HK2, RT2, M2, HS2, HS2_HK2, HS2_RT2, HS2_M2 ) - ENDIF -C - HS2_U2 = HS2_HK2*HK2_U2 + HS2_RT2*RT2_U2 + HS2_M2*M2_U2 - HS2_T2 = HS2_HK2*HK2_T2 + HS2_RT2*RT2_T2 - HS2_D2 = HS2_HK2*HK2_D2 - HS2_MS = HS2_HK2*HK2_MS + HS2_RT2*RT2_MS + HS2_M2*M2_MS - HS2_RE = HS2_RT2*RT2_RE -C -C---- normalized slip velocity Us - US2 = 0.5*HS2*( 1.0 - (HK2-1.0)/(GBCON*H2) ) - US2_HS2 = 0.5 * ( 1.0 - (HK2-1.0)/(GBCON*H2) ) - US2_HK2 = 0.5*HS2*( - 1.0 /(GBCON*H2) ) - US2_H2 = 0.5*HS2* (HK2-1.0)/(GBCON*H2**2) -C - US2_U2 = US2_HS2*HS2_U2 + US2_HK2*HK2_U2 - US2_T2 = US2_HS2*HS2_T2 + US2_HK2*HK2_T2 + US2_H2*H2_T2 - US2_D2 = US2_HS2*HS2_D2 + US2_HK2*HK2_D2 + US2_H2*H2_D2 - US2_MS = US2_HS2*HS2_MS + US2_HK2*HK2_MS - US2_RE = US2_HS2*HS2_RE -C - IF(ITYP.LE.2 .AND. US2.GT.0.95) THEN -CCC WRITE(*,*) 'BLVAR: Us clamped:', US2 - US2 = 0.98 - US2_U2 = 0. - US2_T2 = 0. - US2_D2 = 0. - US2_MS = 0. - US2_RE = 0. - ENDIF -C - IF((ITYP.ceq.3) .AND. US2.GT.0.99995) THEN -CCC WRITE(*,*) 'BLVAR: Wake Us clamped:', US2 - US2 = 0.99995 - US2_U2 = 0. - US2_T2 = 0. - US2_D2 = 0. - US2_MS = 0. - US2_RE = 0. - ENDIF -C -C---- equilibrium wake layer shear coefficient (Ctau)EQ ** 1/2 -C ... NEW 12 Oct 94 - GCC = 0.0 - HKC = HK2 - 1.0 - HKC_HK2 = 1.0 - HKC_RT2 = 0.0 - IF(ITYP.ceq.2) THEN - GCC = GCCON - HKC = HK2 - 1.0 - GCC/RT2 - HKC_HK2 = 1.0 - HKC_RT2 = GCC/RT2**2 - IF(HKC .LT. 0.01) THEN - HKC = 0.01 - HKC_HK2 = 0.0 - HKC_RT2 = 0.0 - ENDIF - ENDIF -C - HKB = HK2 - 1.0 - USB = 1.0 - US2 - CQ2 = - & SQRT( CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**2) ) - CQ2_HS2 = CTCON *HKB*HKC**2 / (USB*H2*HK2**2) * 0.5/CQ2 - CQ2_US2 = CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**2) / USB * 0.5/CQ2 - CQ2_HK2 = CTCON*HS2 *HKC**2 / (USB*H2*HK2**2) * 0.5/CQ2 - & - CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**3) * 2.0 * 0.5/CQ2 - & + CTCON*HS2*HKB*HKC / (USB*H2*HK2**2) * 2.0 * 0.5/CQ2 - & *HKC_HK2 - CQ2_RT2 = CTCON*HS2*HKB*HKC / (USB*H2*HK2**2) * 2.0 * 0.5/CQ2 - & *HKC_RT2 - CQ2_H2 =-CTCON*HS2*HKB*HKC**2 / (USB*H2*HK2**2) / H2 * 0.5/CQ2 -C - CQ2_U2 = CQ2_HS2*HS2_U2 + CQ2_US2*US2_U2 + CQ2_HK2*HK2_U2 - CQ2_T2 = CQ2_HS2*HS2_T2 + CQ2_US2*US2_T2 + CQ2_HK2*HK2_T2 - CQ2_D2 = CQ2_HS2*HS2_D2 + CQ2_US2*US2_D2 + CQ2_HK2*HK2_D2 - CQ2_MS = CQ2_HS2*HS2_MS + CQ2_US2*US2_MS + CQ2_HK2*HK2_MS - CQ2_RE = CQ2_HS2*HS2_RE + CQ2_US2*US2_RE -C - CQ2_U2 = CQ2_U2 + CQ2_RT2*RT2_U2 - CQ2_T2 = CQ2_T2 + CQ2_H2*H2_T2 + CQ2_RT2*RT2_T2 - CQ2_D2 = CQ2_D2 + CQ2_H2*H2_D2 - CQ2_MS = CQ2_MS + CQ2_RT2*RT2_MS - CQ2_RE = CQ2_RE + CQ2_RT2*RT2_RE -C -C -C---- set skin friction coefficient - IF(ITYP.ceq.3) THEN -C----- wake - CF2 = 0. - CF2_HK2 = 0. - CF2_RT2 = 0. - CF2_M2 = 0. - ELSE IF(ITYP.ceq.1) THEN -C----- laminar - CALL CFL( HK2, RT2, M2, CF2, CF2_HK2, CF2_RT2, CF2_M2 ) - ELSE -C----- turbulent - CALL CFT( HK2, RT2, M2, CF2, CF2_HK2, CF2_RT2, CF2_M2 ) - CALL CFL( HK2, RT2, M2, CF2L,CF2L_HK2,CF2L_RT2,CF2L_M2) - IF(CF2L.GT.CF2) THEN -C------- laminar Cf is greater than turbulent Cf -- use laminar -C- (this will only occur for unreasonably small Rtheta) -ccc write(*,*) 'Cft Cfl Rt Hk:', CF2, CF2L, RT2, HK2, X2 - CF2 = CF2L - CF2_HK2 = CF2L_HK2 - CF2_RT2 = CF2L_RT2 - CF2_M2 = CF2L_M2 - ENDIF - ENDIF -C - CF2_U2 = CF2_HK2*HK2_U2 + CF2_RT2*RT2_U2 + CF2_M2*M2_U2 - CF2_T2 = CF2_HK2*HK2_T2 + CF2_RT2*RT2_T2 - CF2_D2 = CF2_HK2*HK2_D2 - CF2_MS = CF2_HK2*HK2_MS + CF2_RT2*RT2_MS + CF2_M2*M2_MS - CF2_RE = CF2_RT2*RT2_RE -C -C---- dissipation function 2 CD / H* - IF(ITYP.ceq.1) THEN -C -C----- laminar - CALL DIL( HK2, RT2, DI2, DI2_HK2, DI2_RT2 ) -C - DI2_U2 = DI2_HK2*HK2_U2 + DI2_RT2*RT2_U2 - DI2_T2 = DI2_HK2*HK2_T2 + DI2_RT2*RT2_T2 - DI2_D2 = DI2_HK2*HK2_D2 - DI2_S2 = 0. - DI2_MS = DI2_HK2*HK2_MS + DI2_RT2*RT2_MS - DI2_RE = DI2_RT2*RT2_RE -C - ELSE IF(ITYP.ceq.2) THEN -C -CCC CALL DIT( HS2, US2, CF2, S2, DI2, -CCC & DI2_HS2, DI2_US2, DI2_CF2, DI2_S2 ) -C -C----- turbulent wall contribution - CALL CFT(HK2, RT2, M2, CF2T, CF2T_HK2, CF2T_RT2, CF2T_M2) - CF2T_U2 = CF2T_HK2*HK2_U2 + CF2T_RT2*RT2_U2 + CF2T_M2*M2_U2 - CF2T_T2 = CF2T_HK2*HK2_T2 + CF2T_RT2*RT2_T2 - CF2T_D2 = CF2T_HK2*HK2_D2 - CF2T_MS = CF2T_HK2*HK2_MS + CF2T_RT2*RT2_MS + CF2T_M2*M2_MS - CF2T_RE = CF2T_RT2*RT2_RE -C - DI2 = ( 0.5*CF2T*US2 ) * 2.0/HS2 - DI2_HS2 = -( 0.5*CF2T*US2 ) * 2.0/HS2**2 - DI2_US2 = ( 0.5*CF2T ) * 2.0/HS2 - DI2_CF2T = ( 0.5 *US2 ) * 2.0/HS2 -C - DI2_S2 = 0.0 - DI2_U2 = DI2_HS2*HS2_U2 + DI2_US2*US2_U2 + DI2_CF2T*CF2T_U2 - DI2_T2 = DI2_HS2*HS2_T2 + DI2_US2*US2_T2 + DI2_CF2T*CF2T_T2 - DI2_D2 = DI2_HS2*HS2_D2 + DI2_US2*US2_D2 + DI2_CF2T*CF2T_D2 - DI2_MS = DI2_HS2*HS2_MS + DI2_US2*US2_MS + DI2_CF2T*CF2T_MS - DI2_RE = DI2_HS2*HS2_RE + DI2_US2*US2_RE + DI2_CF2T*CF2T_RE -C -C -C----- set minimum Hk for wake layer to still exist - GRT = LOG(RT2) - HMIN = 1.0 + 2.1/GRT - HM_RT2 = -(2.1/GRT**2) / RT2 -C -C----- set factor DFAC for correcting wall dissipation for very low Hk - FL = (HK2-1.0)/(HMIN-1.0) - FL_HK2 = 1.0/(HMIN-1.0) - FL_RT2 = ( -FL/(HMIN-1.0) ) * HM_RT2 -C - TFL = TANH(FL) - DFAC = 0.5 + 0.5* TFL - DF_FL = 0.5*(1.0 - TFL**2) -C - DF_HK2 = DF_FL*FL_HK2 - DF_RT2 = DF_FL*FL_RT2 -C - DI2_S2 = DI2_S2*DFAC - DI2_U2 = DI2_U2*DFAC + DI2*(DF_HK2*HK2_U2 + DF_RT2*RT2_U2) - DI2_T2 = DI2_T2*DFAC + DI2*(DF_HK2*HK2_T2 + DF_RT2*RT2_T2) - DI2_D2 = DI2_D2*DFAC + DI2*(DF_HK2*HK2_D2 ) - DI2_MS = DI2_MS*DFAC + DI2*(DF_HK2*HK2_MS + DF_RT2*RT2_MS) - DI2_RE = DI2_RE*DFAC + DI2*( DF_RT2*RT2_RE) - DI2 = DI2 *DFAC -C - ELSE -C -C----- zero wall contribution for wake - DI2 = 0.0 - DI2_S2 = 0.0 - DI2_U2 = 0.0 - DI2_T2 = 0.0 - DI2_D2 = 0.0 - DI2_MS = 0.0 - DI2_RE = 0.0 -C - ENDIF -C -C -C---- Add on turbulent outer layer contribution - IF(ITYP.cne.1) THEN -C - DD = S2**2 * (0.995-US2) * 2.0/HS2 - DD_HS2 = -S2**2 * (0.995-US2) * 2.0/HS2**2 - DD_US2 = -S2**2 * 2.0/HS2 - DD_S2 = S2*2.0* (0.995-US2) * 2.0/HS2 -C - DI2 = DI2 + DD - DI2_S2 = DD_S2 - DI2_U2 = DI2_U2 + DD_HS2*HS2_U2 + DD_US2*US2_U2 - DI2_T2 = DI2_T2 + DD_HS2*HS2_T2 + DD_US2*US2_T2 - DI2_D2 = DI2_D2 + DD_HS2*HS2_D2 + DD_US2*US2_D2 - DI2_MS = DI2_MS + DD_HS2*HS2_MS + DD_US2*US2_MS - DI2_RE = DI2_RE + DD_HS2*HS2_RE + DD_US2*US2_RE -C -C----- add laminar stress contribution to outer layer CD -c### - DD = 0.15*(0.995-US2)**2 / RT2 * 2.0/HS2 - DD_US2 = -0.15*(0.995-US2)*2. / RT2 * 2.0/HS2 - DD_HS2 = -DD/HS2 - DD_RT2 = -DD/RT2 -C - DI2 = DI2 + DD - DI2_U2 = DI2_U2 + DD_HS2*HS2_U2 + DD_US2*US2_U2 + DD_RT2*RT2_U2 - DI2_T2 = DI2_T2 + DD_HS2*HS2_T2 + DD_US2*US2_T2 + DD_RT2*RT2_T2 - DI2_D2 = DI2_D2 + DD_HS2*HS2_D2 + DD_US2*US2_D2 - DI2_MS = DI2_MS + DD_HS2*HS2_MS + DD_US2*US2_MS + DD_RT2*RT2_MS - DI2_RE = DI2_RE + DD_HS2*HS2_RE + DD_US2*US2_RE + DD_RT2*RT2_RE -C - ENDIF -C -C - IF(ITYP.ceq.2) THEN - CALL DIL( HK2, RT2, DI2L, DI2L_HK2, DI2L_RT2 ) -C - IF(DI2L.GT.DI2) THEN -C------- laminar CD is greater than turbulent CD -- use laminar -C- (this will only occur for unreasonably small Rtheta) -ccc write(*,*) 'CDt CDl Rt Hk:', DI2, DI2L, RT2, HK2 - DI2 = DI2L - DI2_S2 = 0. - DI2_U2 = DI2L_HK2*HK2_U2 + DI2L_RT2*RT2_U2 - DI2_T2 = DI2L_HK2*HK2_T2 + DI2L_RT2*RT2_T2 - DI2_D2 = DI2L_HK2*HK2_D2 - DI2_MS = DI2L_HK2*HK2_MS + DI2L_RT2*RT2_MS - DI2_RE = DI2L_RT2*RT2_RE - ENDIF - ENDIF -C -cC----- add on CD contribution of inner shear layer -c IF(ITYP.EQ.3 .AND. DW2.GT.0.0) THEN -c DKON = 0.03*0.75**3 -c DDI = DKON*US2**3 -c DDI_US2 = 3.0*DKON*US2**2 -c DI2 = DI2 + DDI * DW2/DWTE -c DI2_U2 = DI2_U2 + DDI_US2*US2_U2 * DW2/DWTE -c DI2_T2 = DI2_T2 + DDI_US2*US2_T2 * DW2/DWTE -c DI2_D2 = DI2_D2 + DDI_US2*US2_D2 * DW2/DWTE -c DI2_MS = DI2_MS + DDI_US2*US2_MS * DW2/DWTE -c DI2_RE = DI2_RE + DDI_US2*US2_RE * DW2/DWTE -c ENDIF -C - IF(ITYP.ceq.3) THEN -C------ laminar wake CD - CALL DILW( HK2, RT2, DI2L, DI2L_HK2, DI2L_RT2 ) - IF(DI2L .GT. DI2) THEN -C------- laminar wake CD is greater than turbulent CD -- use laminar -C- (this will only occur for unreasonably small Rtheta) -ccc write(*,*) 'CDt CDl Rt Hk:', DI2, DI2L, RT2, HK2 - DI2 = DI2L - DI2_S2 = 0. - DI2_U2 = DI2L_HK2*HK2_U2 + DI2L_RT2*RT2_U2 - DI2_T2 = DI2L_HK2*HK2_T2 + DI2L_RT2*RT2_T2 - DI2_D2 = DI2L_HK2*HK2_D2 - DI2_MS = DI2L_HK2*HK2_MS + DI2L_RT2*RT2_MS - DI2_RE = DI2L_RT2*RT2_RE - ENDIF - ENDIF -C -C - IF(ITYP.ceq.3) THEN -C----- double dissipation for the wake (two wake halves) - DI2 = DI2 *2.0 - DI2_S2 = DI2_S2*2.0 - DI2_U2 = DI2_U2*2.0 - DI2_T2 = DI2_T2*2.0 - DI2_D2 = DI2_D2*2.0 - DI2_MS = DI2_MS*2.0 - DI2_RE = DI2_RE*2.0 - ENDIF -C -C---- BL thickness (Delta) from simplified Green's correlation - DE2 = (3.15 + 1.72/(HK2-1.0) )*T2 + D2 - DE2_HK2 = ( - 1.72/(HK2-1.0)**2)*T2 -C - DE2_U2 = DE2_HK2*HK2_U2 - DE2_T2 = DE2_HK2*HK2_T2 + (3.15 + 1.72/(HK2-1.0)) - DE2_D2 = DE2_HK2*HK2_D2 + 1.0 - DE2_MS = DE2_HK2*HK2_MS -C -ccc HDMAX = 15.0 - HDMAX = 12.0 - IF(DE2 .GT. HDMAX*T2) THEN -cccc IF(DE2 .GT. HDMAX*T2 .AND. (HK2 .GT. 4.0 .OR. ITYP.EQ.3)) THEN - DE2 = HDMAX*T2 - DE2_U2 = 0.0 - DE2_T2 = HDMAX - DE2_D2 = 0.0 - DE2_MS = 0.0 - ENDIF -C - RETURN - END - - - SUBROUTINE BLMID(ITYP) -C---------------------------------------------------- -C Calculates midpoint skin friction CFM -C -C ITYP = 1 : laminar -C ITYP = 2 : turbulent -C ITYP = 3 : turbulent wake -C---------------------------------------------------- - use complexify -c IMPLICIT complex(M) - implicit complex(a-h,m, o-z) - include 'c_XBL.INC' -C -C---- set similarity variables if not defined - IF(SIMI) THEN - HK1 = HK2 - HK1_T1 = HK2_T2 - HK1_D1 = HK2_D2 - HK1_U1 = HK2_U2 - HK1_MS = HK2_MS - RT1 = RT2 - RT1_T1 = RT2_T2 - RT1_U1 = RT2_U2 - RT1_MS = RT2_MS - RT1_RE = RT2_RE - M1 = M2 - M1_U1 = M2_U2 - M1_MS = M2_MS - ENDIF -C -C---- define stuff for midpoint CF - HKA = 0.5*(HK1 + HK2) - RTA = 0.5*(RT1 + RT2) - MA = 0.5*(M1 + M2 ) -C -C---- midpoint skin friction coefficient (zero in wake) - IF(ITYP.ceq.3) THEN - CFM = 0. - CFM_HKA = 0. - CFM_RTA = 0. - CFM_MA = 0. - CFM_MS = 0. - ELSE IF(ITYP.ceq.1) THEN - CALL CFL( HKA, RTA, MA, CFM, CFM_HKA, CFM_RTA, CFM_MA ) - ELSE - CALL CFT( HKA, RTA, MA, CFM, CFM_HKA, CFM_RTA, CFM_MA ) - CALL CFL( HKA, RTA, MA, CFML,CFML_HKA,CFML_RTA,CFML_MA) - IF(CFML.GT.CFM) THEN -ccc write(*,*) 'Cft Cfl Rt Hk:', CFM, CFML, RTA, HKA, 0.5*(X1+X2) - CFM = CFML - CFM_HKA = CFML_HKA - CFM_RTA = CFML_RTA - CFM_MA = CFML_MA - ENDIF - ENDIF -C - CFM_U1 = 0.5*(CFM_HKA*HK1_U1 + CFM_MA*M1_U1 + CFM_RTA*RT1_U1) - CFM_T1 = 0.5*(CFM_HKA*HK1_T1 + CFM_RTA*RT1_T1) - CFM_D1 = 0.5*(CFM_HKA*HK1_D1 ) -C - CFM_U2 = 0.5*(CFM_HKA*HK2_U2 + CFM_MA*M2_U2 + CFM_RTA*RT2_U2) - CFM_T2 = 0.5*(CFM_HKA*HK2_T2 + CFM_RTA*RT2_T2) - CFM_D2 = 0.5*(CFM_HKA*HK2_D2 ) -C - CFM_MS = 0.5*(CFM_HKA*HK1_MS + CFM_MA*M1_MS + CFM_RTA*RT1_MS - & + CFM_HKA*HK2_MS + CFM_MA*M2_MS + CFM_RTA*RT2_MS) - CFM_RE = 0.5*( CFM_RTA*RT1_RE - & + CFM_RTA*RT2_RE) -C - RETURN - END ! BLMID - - - SUBROUTINE TRDIF -C----------------------------------------------- -C Sets up the Newton system governing the -C transition interval. Equations governing -C the laminar part X1 < xi < XT and -C the turbulent part XT < xi < X2 -C are simply summed. -C----------------------------------------------- - use complexify - IMPLICIT complex(M) - implicit complex(a-h, o-z) - include 'c_XBL.INC' - complex BL1(4,5), BL2(4,5), BLREZ(4), BLM(4), BLR(4), BLX(4) - & , BT1(4,5), BT2(4,5), BTREZ(4), BTM(4), BTR(4), BTX(4) -C -C---- save variables and sensitivities for future restoration - DO 5 ICOM=1, NCOM - C1SAV(ICOM) = COM1(ICOM) - C2SAV(ICOM) = COM2(ICOM) - 5 CONTINUE -C -C---- weighting factors for linear interpolation to transition point - WF2 = (XT-X1)/(X2-X1) - WF2_XT = 1.0/(X2-X1) -C - WF2_A1 = WF2_XT*XT_A1 - WF2_X1 = WF2_XT*XT_X1 + (WF2-1.0)/(X2-X1) - WF2_X2 = WF2_XT*XT_X2 - WF2 /(X2-X1) - WF2_T1 = WF2_XT*XT_T1 - WF2_T2 = WF2_XT*XT_T2 - WF2_D1 = WF2_XT*XT_D1 - WF2_D2 = WF2_XT*XT_D2 - WF2_U1 = WF2_XT*XT_U1 - WF2_U2 = WF2_XT*XT_U2 - WF2_MS = WF2_XT*XT_MS - WF2_RE = WF2_XT*XT_RE - WF2_XF = WF2_XT*XT_XF -C - WF1 = 1.0 - WF2 - WF1_A1 = -WF2_A1 - WF1_X1 = -WF2_X1 - WF1_X2 = -WF2_X2 - WF1_T1 = -WF2_T1 - WF1_T2 = -WF2_T2 - WF1_D1 = -WF2_D1 - WF1_D2 = -WF2_D2 - WF1_U1 = -WF2_U1 - WF1_U2 = -WF2_U2 - WF1_MS = -WF2_MS - WF1_RE = -WF2_RE - WF1_XF = -WF2_XF -C -C -C**** FIRST, do laminar part between X1 and XT -C -C-----interpolate primary variables to transition point - TT = T1*WF1 + T2*WF2 - TT_A1 = T1*WF1_A1 + T2*WF2_A1 - TT_X1 = T1*WF1_X1 + T2*WF2_X1 - TT_X2 = T1*WF1_X2 + T2*WF2_X2 - TT_T1 = T1*WF1_T1 + T2*WF2_T1 + WF1 - TT_T2 = T1*WF1_T2 + T2*WF2_T2 + WF2 - TT_D1 = T1*WF1_D1 + T2*WF2_D1 - TT_D2 = T1*WF1_D2 + T2*WF2_D2 - TT_U1 = T1*WF1_U1 + T2*WF2_U1 - TT_U2 = T1*WF1_U2 + T2*WF2_U2 - TT_MS = T1*WF1_MS + T2*WF2_MS - TT_RE = T1*WF1_RE + T2*WF2_RE - TT_XF = T1*WF1_XF + T2*WF2_XF -C - DT = D1*WF1 + D2*WF2 - DT_A1 = D1*WF1_A1 + D2*WF2_A1 - DT_X1 = D1*WF1_X1 + D2*WF2_X1 - DT_X2 = D1*WF1_X2 + D2*WF2_X2 - DT_T1 = D1*WF1_T1 + D2*WF2_T1 - DT_T2 = D1*WF1_T2 + D2*WF2_T2 - DT_D1 = D1*WF1_D1 + D2*WF2_D1 + WF1 - DT_D2 = D1*WF1_D2 + D2*WF2_D2 + WF2 - DT_U1 = D1*WF1_U1 + D2*WF2_U1 - DT_U2 = D1*WF1_U2 + D2*WF2_U2 - DT_MS = D1*WF1_MS + D2*WF2_MS - DT_RE = D1*WF1_RE + D2*WF2_RE - DT_XF = D1*WF1_XF + D2*WF2_XF -C - UT = U1*WF1 + U2*WF2 - UT_A1 = U1*WF1_A1 + U2*WF2_A1 - UT_X1 = U1*WF1_X1 + U2*WF2_X1 - UT_X2 = U1*WF1_X2 + U2*WF2_X2 - UT_T1 = U1*WF1_T1 + U2*WF2_T1 - UT_T2 = U1*WF1_T2 + U2*WF2_T2 - UT_D1 = U1*WF1_D1 + U2*WF2_D1 - UT_D2 = U1*WF1_D2 + U2*WF2_D2 - UT_U1 = U1*WF1_U1 + U2*WF2_U1 + WF1 - UT_U2 = U1*WF1_U2 + U2*WF2_U2 + WF2 - UT_MS = U1*WF1_MS + U2*WF2_MS - UT_RE = U1*WF1_RE + U2*WF2_RE - UT_XF = U1*WF1_XF + U2*WF2_XF -C -C---- set primary "T" variables at XT (really placed into "2" variables) - X2 = XT - T2 = TT - D2 = DT - U2 = UT -C - AMPL2 = AMCRIT - S2 = 0. -C -C---- calculate laminar secondary "T" variables - CALL BLKIN - CALL BLVAR(1) -C -C---- calculate X1-XT midpoint CFM value - CALL BLMID(1) -C= -C= at this point, all "2" variables are really "T" variables at XT -C= -C -C---- set up Newton system for dAm, dTh, dDs, dUe, dXi at X1 and XT - CALL BLDIF(1) -C -C---- The current Newton system is in terms of "1" and "T" variables, -C- so calculate its equivalent in terms of "1" and "2" variables. -C- In other words, convert residual sensitivities wrt "T" variables -C- into sensitivities wrt "1" and "2" variables. The amplification -C- equation is unnecessary here, so the K=1 row is left empty. - DO 10 K=2, 3 - BLREZ(K) = VSREZ(K) - BLM(K) = VSM(K) - & + VS2(K,2)*TT_MS - & + VS2(K,3)*DT_MS - & + VS2(K,4)*UT_MS - & + VS2(K,5)*XT_MS - BLR(K) = VSR(K) - & + VS2(K,2)*TT_RE - & + VS2(K,3)*DT_RE - & + VS2(K,4)*UT_RE - & + VS2(K,5)*XT_RE - BLX(K) = VSX(K) - & + VS2(K,2)*TT_XF - & + VS2(K,3)*DT_XF - & + VS2(K,4)*UT_XF - & + VS2(K,5)*XT_XF -C - BL1(K,1) = VS1(K,1) - & + VS2(K,2)*TT_A1 - & + VS2(K,3)*DT_A1 - & + VS2(K,4)*UT_A1 - & + VS2(K,5)*XT_A1 - BL1(K,2) = VS1(K,2) - & + VS2(K,2)*TT_T1 - & + VS2(K,3)*DT_T1 - & + VS2(K,4)*UT_T1 - & + VS2(K,5)*XT_T1 - BL1(K,3) = VS1(K,3) - & + VS2(K,2)*TT_D1 - & + VS2(K,3)*DT_D1 - & + VS2(K,4)*UT_D1 - & + VS2(K,5)*XT_D1 - BL1(K,4) = VS1(K,4) - & + VS2(K,2)*TT_U1 - & + VS2(K,3)*DT_U1 - & + VS2(K,4)*UT_U1 - & + VS2(K,5)*XT_U1 - BL1(K,5) = VS1(K,5) - & + VS2(K,2)*TT_X1 - & + VS2(K,3)*DT_X1 - & + VS2(K,4)*UT_X1 - & + VS2(K,5)*XT_X1 -C - BL2(K,1) = 0. - BL2(K,2) = VS2(K,2)*TT_T2 - & + VS2(K,3)*DT_T2 - & + VS2(K,4)*UT_T2 - & + VS2(K,5)*XT_T2 - BL2(K,3) = VS2(K,2)*TT_D2 - & + VS2(K,3)*DT_D2 - & + VS2(K,4)*UT_D2 - & + VS2(K,5)*XT_D2 - BL2(K,4) = VS2(K,2)*TT_U2 - & + VS2(K,3)*DT_U2 - & + VS2(K,4)*UT_U2 - & + VS2(K,5)*XT_U2 - BL2(K,5) = VS2(K,2)*TT_X2 - & + VS2(K,3)*DT_X2 - & + VS2(K,4)*UT_X2 - & + VS2(K,5)*XT_X2 -C - 10 CONTINUE -C -C -C**** SECOND, set up turbulent part between XT and X2 **** -C -C---- calculate equilibrium shear coefficient CQT at transition point - CALL BLVAR(2) -C -C---- set initial shear coefficient value ST at transition point -C- ( note that CQ2, CQ2_T2, etc. are really "CQT", "CQT_TT", etc.) -C - CTR = 1.8*EXP(-3.3/(HK2-1.0)) - CTR_HK2 = CTR * 3.3/(HK2-1.0)**2 -C -c CTR = 1.1*EXP(-10.0/HK2**2) -c CTR_HK2 = CTR * 10.0 * 2.0/HK2**3 -C -CCC CTR = 1.2 -CCC CTR = 0.7 -CCC CTR_HK2 = 0.0 -C - ST = CTR*CQ2 - ST_TT = CTR*CQ2_T2 + CQ2*CTR_HK2*HK2_T2 - ST_DT = CTR*CQ2_D2 + CQ2*CTR_HK2*HK2_D2 - ST_UT = CTR*CQ2_U2 + CQ2*CTR_HK2*HK2_U2 - ST_MS = CTR*CQ2_MS + CQ2*CTR_HK2*HK2_MS - ST_RE = CTR*CQ2_RE -C -C---- calculate ST sensitivities wrt the actual "1" and "2" variables - ST_A1 = ST_TT*TT_A1 + ST_DT*DT_A1 + ST_UT*UT_A1 - ST_X1 = ST_TT*TT_X1 + ST_DT*DT_X1 + ST_UT*UT_X1 - ST_X2 = ST_TT*TT_X2 + ST_DT*DT_X2 + ST_UT*UT_X2 - ST_T1 = ST_TT*TT_T1 + ST_DT*DT_T1 + ST_UT*UT_T1 - ST_T2 = ST_TT*TT_T2 + ST_DT*DT_T2 + ST_UT*UT_T2 - ST_D1 = ST_TT*TT_D1 + ST_DT*DT_D1 + ST_UT*UT_D1 - ST_D2 = ST_TT*TT_D2 + ST_DT*DT_D2 + ST_UT*UT_D2 - ST_U1 = ST_TT*TT_U1 + ST_DT*DT_U1 + ST_UT*UT_U1 - ST_U2 = ST_TT*TT_U2 + ST_DT*DT_U2 + ST_UT*UT_U2 - ST_MS = ST_TT*TT_MS + ST_DT*DT_MS + ST_UT*UT_MS + ST_MS - ST_RE = ST_TT*TT_RE + ST_DT*DT_RE + ST_UT*UT_RE + ST_RE - ST_XF = ST_TT*TT_XF + ST_DT*DT_XF + ST_UT*UT_XF -C - AMPL2 = 0. - S2 = ST -C -C---- recalculate turbulent secondary "T" variables using proper CTI - CALL BLVAR(2) -C -C---- set "1" variables to "T" variables and reset "2" variables -C- to their saved turbulent values - DO 30 ICOM=1, NCOM - COM1(ICOM) = COM2(ICOM) - COM2(ICOM) = C2SAV(ICOM) - 30 CONTINUE -C -C---- calculate XT-X2 midpoint CFM value - CALL BLMID(2) -C -C---- set up Newton system for dCt, dTh, dDs, dUe, dXi at XT and X2 - CALL BLDIF(2) -C -C---- convert sensitivities wrt "T" variables into sensitivities -C- wrt "1" and "2" variables as done before for the laminar part - DO 40 K=1, 3 - BTREZ(K) = VSREZ(K) - BTM(K) = VSM(K) - & + VS1(K,1)*ST_MS - & + VS1(K,2)*TT_MS - & + VS1(K,3)*DT_MS - & + VS1(K,4)*UT_MS - & + VS1(K,5)*XT_MS - BTR(K) = VSR(K) - & + VS1(K,1)*ST_RE - & + VS1(K,2)*TT_RE - & + VS1(K,3)*DT_RE - & + VS1(K,4)*UT_RE - & + VS1(K,5)*XT_RE - BTX(K) = VSX(K) - & + VS1(K,1)*ST_XF - & + VS1(K,2)*TT_XF - & + VS1(K,3)*DT_XF - & + VS1(K,4)*UT_XF - & + VS1(K,5)*XT_XF -C - BT1(K,1) = VS1(K,1)*ST_A1 - & + VS1(K,2)*TT_A1 - & + VS1(K,3)*DT_A1 - & + VS1(K,4)*UT_A1 - & + VS1(K,5)*XT_A1 - BT1(K,2) = VS1(K,1)*ST_T1 - & + VS1(K,2)*TT_T1 - & + VS1(K,3)*DT_T1 - & + VS1(K,4)*UT_T1 - & + VS1(K,5)*XT_T1 - BT1(K,3) = VS1(K,1)*ST_D1 - & + VS1(K,2)*TT_D1 - & + VS1(K,3)*DT_D1 - & + VS1(K,4)*UT_D1 - & + VS1(K,5)*XT_D1 - BT1(K,4) = VS1(K,1)*ST_U1 - & + VS1(K,2)*TT_U1 - & + VS1(K,3)*DT_U1 - & + VS1(K,4)*UT_U1 - & + VS1(K,5)*XT_U1 - BT1(K,5) = VS1(K,1)*ST_X1 - & + VS1(K,2)*TT_X1 - & + VS1(K,3)*DT_X1 - & + VS1(K,4)*UT_X1 - & + VS1(K,5)*XT_X1 -C - BT2(K,1) = VS2(K,1) - BT2(K,2) = VS2(K,2) - & + VS1(K,1)*ST_T2 - & + VS1(K,2)*TT_T2 - & + VS1(K,3)*DT_T2 - & + VS1(K,4)*UT_T2 - & + VS1(K,5)*XT_T2 - BT2(K,3) = VS2(K,3) - & + VS1(K,1)*ST_D2 - & + VS1(K,2)*TT_D2 - & + VS1(K,3)*DT_D2 - & + VS1(K,4)*UT_D2 - & + VS1(K,5)*XT_D2 - BT2(K,4) = VS2(K,4) - & + VS1(K,1)*ST_U2 - & + VS1(K,2)*TT_U2 - & + VS1(K,3)*DT_U2 - & + VS1(K,4)*UT_U2 - & + VS1(K,5)*XT_U2 - BT2(K,5) = VS2(K,5) - & + VS1(K,1)*ST_X2 - & + VS1(K,2)*TT_X2 - & + VS1(K,3)*DT_X2 - & + VS1(K,4)*UT_X2 - & + VS1(K,5)*XT_X2 -C - 40 CONTINUE -C -C---- Add up laminar and turbulent parts to get final system -C- in terms of honest-to-God "1" and "2" variables. - VSREZ(1) = BTREZ(1) - VSREZ(2) = BLREZ(2) + BTREZ(2) - VSREZ(3) = BLREZ(3) + BTREZ(3) - VSM(1) = BTM(1) - VSM(2) = BLM(2) + BTM(2) - VSM(3) = BLM(3) + BTM(3) - VSR(1) = BTR(1) - VSR(2) = BLR(2) + BTR(2) - VSR(3) = BLR(3) + BTR(3) - VSX(1) = BTX(1) - VSX(2) = BLX(2) + BTX(2) - VSX(3) = BLX(3) + BTX(3) - DO 60 L=1, 5 - VS1(1,L) = BT1(1,L) - VS2(1,L) = BT2(1,L) - VS1(2,L) = BL1(2,L) + BT1(2,L) - VS2(2,L) = BL2(2,L) + BT2(2,L) - VS1(3,L) = BL1(3,L) + BT1(3,L) - VS2(3,L) = BL2(3,L) + BT2(3,L) - 60 CONTINUE -C -C---- To be sanitary, restore "1" quantities which got clobbered -C- in all of the numerical gymnastics above. The "2" variables -C- were already restored for the XT-X2 differencing part. - DO 70 ICOM=1, NCOM - COM1(ICOM) = C1SAV(ICOM) - 70 CONTINUE -C - RETURN - END - - - SUBROUTINE BLDIF(ITYP) -C----------------------------------------------------------- -C Sets up the Newton system coefficients and residuals -C -C ITYP = 0 : similarity station -C ITYP = 1 : laminar interval -C ITYP = 2 : turbulent interval -C ITYP = 3 : wake interval -C -C This routine knows nothing about a transition interval, -C which is taken care of by TRDIF. -C----------------------------------------------------------- - use complexify -c IMPLICIT complex(M) - implicit complex(a-h,m, o-z) - include 'c_XBL.INC' -C - IF(ITYP.ceq.0) THEN -C----- similarity logarithmic differences (prescribed) - XLOG = 1.0 - ULOG = BULE - TLOG = 0.5*(1.0 - BULE) - HLOG = 0. - DDLOG = 0. - ELSE -C----- usual logarithmic differences - XLOG = LOG(X2/X1) - - ULOG = LOG(U2/U1) - TLOG = LOG(T2/T1) - HLOG = LOG(HS2/HS1) - -c write(*,*) 'X2',X2 -c write(*,*) 'X1',X1 -c write(*,*) 'logx2/x1',XLOG -c write(*,*) 'U1',U1 -c write(*,*) 'U2',U2 -c write(*,*) 'T1',T1 -c write(*,*) 'T2',T2 -c write(*,*) 'HS1',HS1 -c write(*,*) 'HS2',HS2 - -c XLOG = 2.0*(X2-X1)/(X2+X1) - -c ULOG = 2.0*(U2-U1)/(U2+U1) -c TLOG = 2.0*(T2-T1)/(T2+T1) -c HLOG = 2.0*(HS2-HS1)/(HS2+HS1) -c write(*,*) 'stuff',XLOG,ULOG,TLOG,HLOG - DDLOG = 1.0 - ENDIF -C - DO 55 K=1, 4 - VSREZ(K) = 0. - VSM(K) = 0. - VSR(K) = 0. - VSX(K) = 0. - DO 551 L=1, 5 - VS1(K,L) = 0. - VS2(K,L) = 0. - 551 CONTINUE - 55 CONTINUE -C -C---- set triggering constant for local upwinding - HUPWT = 1.0 -C -ccc HDCON = 5.0*HUPWT -ccc HD_HK1 = 0.0 -ccc HD_HK2 = 0.0 -C - HDCON = 5.0*HUPWT/HK2**2 - HD_HK1 = 0.0 - HD_HK2 = -HDCON*2.0/HK2 -C -C---- use less upwinding in the wake - IF(ITYP.ceq.3) THEN - HDCON = HUPWT/HK2**2 - HD_HK1 = 0.0 - HD_HK2 = -HDCON*2.0/HK2 - ENDIF -C -C---- local upwinding is based on local change in log(Hk-1) -C- (mainly kicks in at transition) - ARG = ABS((HK2-1.0)/(HK1-1.0)) -c write(*,*) 'ARG:',ARG - HL = LOG(ARG) -c write(*,*) 'log arg:',HL - HL_HK1 = -1.0/(HK1-1.0) - HL_HK2 = 1.0/(HK2-1.0) -C -C---- set local upwinding parameter UPW and linearize it -C -C UPW = 0.5 Trapezoidal -C UPW = 1.0 Backward Euler -C - HLSQ = MIN( HL**2 , 15.0 ) - EHH = EXP(-HLSQ*HDCON) - UPW = 1.0 - 0.5*EHH - UPW_HL = EHH * HL *HDCON - UPW_HD = 0.5*EHH * HLSQ -C - UPW_HK1 = UPW_HL*HL_HK1 + UPW_HD*HD_HK1 - UPW_HK2 = UPW_HL*HL_HK2 + UPW_HD*HD_HK2 -C - UPW_U1 = UPW_HK1*HK1_U1 - UPW_T1 = UPW_HK1*HK1_T1 - UPW_D1 = UPW_HK1*HK1_D1 - UPW_U2 = UPW_HK2*HK2_U2 - UPW_T2 = UPW_HK2*HK2_T2 - UPW_D2 = UPW_HK2*HK2_D2 - UPW_MS = UPW_HK1*HK1_MS - & + UPW_HK2*HK2_MS -C -C - IF(ITYP.ceq.0) THEN -C -C***** LE point --> set zero amplification factor - VS2(1,1) = 1.0 - VSR(1) = 0. - VSREZ(1) = -AMPL2 -C - ELSE IF(ITYP.ceq.1) THEN -C -C***** laminar part --> set amplification equation -C -C----- set average amplification AX over interval X1..X2 - CALL AXSET( HK1, T1, RT1, AMPL1, - & HK2, T2, RT2, AMPL2, AMCRIT, - & AX, AX_HK1, AX_T1, AX_RT1, AX_A1, - & AX_HK2, AX_T2, AX_RT2, AX_A2 ) -C - REZC = AMPL2 - AMPL1 - AX*(X2-X1) - Z_AX = -(X2-X1) -C - VS1(1,1) = Z_AX* AX_A1 - 1.0 - VS1(1,2) = Z_AX*(AX_HK1*HK1_T1 + AX_T1 + AX_RT1*RT1_T1) - VS1(1,3) = Z_AX*(AX_HK1*HK1_D1 ) - VS1(1,4) = Z_AX*(AX_HK1*HK1_U1 + AX_RT1*RT1_U1) - VS1(1,5) = AX - VS2(1,1) = Z_AX* AX_A2 + 1.0 - VS2(1,2) = Z_AX*(AX_HK2*HK2_T2 + AX_T2 + AX_RT2*RT2_T2) - VS2(1,3) = Z_AX*(AX_HK2*HK2_D2 ) - VS2(1,4) = Z_AX*(AX_HK2*HK2_U2 + AX_RT2*RT2_U2) - VS2(1,5) = -AX - VSM(1) = Z_AX*(AX_HK1*HK1_MS + AX_RT1*RT1_MS - & + AX_HK2*HK2_MS + AX_RT2*RT2_MS) - VSR(1) = Z_AX*( AX_RT1*RT1_RE - & + AX_RT2*RT2_RE) - VSX(1) = 0. - VSREZ(1) = -REZC -C - ELSE -C -C***** turbulent part --> set shear lag equation -C - SA = (1.0-UPW)*S1 + UPW*S2 - CQA = (1.0-UPW)*CQ1 + UPW*CQ2 - CFA = (1.0-UPW)*CF1 + UPW*CF2 - HKA = (1.0-UPW)*HK1 + UPW*HK2 -C - USA = 0.5*(US1 + US2) - RTA = 0.5*(RT1 + RT2) - DEA = 0.5*(DE1 + DE2) - DA = 0.5*(D1 + D2 ) -C -C - IF(ITYP.ceq.3) THEN -C------ increased dissipation length in wake (decrease its reciprocal) - ALD = DLCON - ELSE - ALD = 1.0 - ENDIF -C -C----- set and linearize equilibrium 1/Ue dUe/dx ... NEW 12 Oct 94 - IF(ITYP.ceq.2) THEN - GCC = GCCON - HKC = HKA - 1.0 - GCC/RTA - HKC_HKA = 1.0 - HKC_RTA = GCC/RTA**2 - IF(HKC .LT. 0.01) THEN - HKC = 0.01 - HKC_HKA = 0.0 - HKC_RTA = 0.0 - ENDIF - ELSE - GCC = 0.0 - HKC = HKA - 1.0 - HKC_HKA = 1.0 - HKC_RTA = 0.0 - ENDIF -C - HR = HKC / (GACON*ALD*HKA) - HR_HKA = HKC_HKA / (GACON*ALD*HKA) - HR / HKA - HR_RTA = HKC_RTA / (GACON*ALD*HKA) -C - UQ = (0.5*CFA - HR**2) / (GBCON*DA) - UQ_HKA = -2.0*HR*HR_HKA / (GBCON*DA) - UQ_RTA = -2.0*HR*HR_RTA / (GBCON*DA) - UQ_CFA = 0.5 / (GBCON*DA) - UQ_DA = -UQ/DA - UQ_UPW = UQ_CFA*(CF2-CF1) + UQ_HKA*(HK2-HK1) -C - UQ_T1 = (1.0-UPW)*(UQ_CFA*CF1_T1 + UQ_HKA*HK1_T1) + UQ_UPW*UPW_T1 - UQ_D1 = (1.0-UPW)*(UQ_CFA*CF1_D1 + UQ_HKA*HK1_D1) + UQ_UPW*UPW_D1 - UQ_U1 = (1.0-UPW)*(UQ_CFA*CF1_U1 + UQ_HKA*HK1_U1) + UQ_UPW*UPW_U1 - UQ_T2 = UPW *(UQ_CFA*CF2_T2 + UQ_HKA*HK2_T2) + UQ_UPW*UPW_T2 - UQ_D2 = UPW *(UQ_CFA*CF2_D2 + UQ_HKA*HK2_D2) + UQ_UPW*UPW_D2 - UQ_U2 = UPW *(UQ_CFA*CF2_U2 + UQ_HKA*HK2_U2) + UQ_UPW*UPW_U2 - UQ_MS = (1.0-UPW)*(UQ_CFA*CF1_MS + UQ_HKA*HK1_MS) + UQ_UPW*UPW_MS - & + UPW *(UQ_CFA*CF2_MS + UQ_HKA*HK2_MS) - UQ_RE = (1.0-UPW)* UQ_CFA*CF1_RE - & + UPW * UQ_CFA*CF2_RE -C - UQ_T1 = UQ_T1 + 0.5*UQ_RTA*RT1_T1 - UQ_D1 = UQ_D1 + 0.5*UQ_DA - UQ_U1 = UQ_U1 + 0.5*UQ_RTA*RT1_U1 - UQ_T2 = UQ_T2 + 0.5*UQ_RTA*RT2_T2 - UQ_D2 = UQ_D2 + 0.5*UQ_DA - UQ_U2 = UQ_U2 + 0.5*UQ_RTA*RT2_U2 - UQ_MS = UQ_MS + 0.5*UQ_RTA*RT1_MS - & + 0.5*UQ_RTA*RT2_MS - UQ_RE = UQ_RE + 0.5*UQ_RTA*RT1_RE - & + 0.5*UQ_RTA*RT2_RE -C - SCC = SCCON*1.333/(1.0+USA) - SCC_USA = -SCC/(1.0+USA) -C - SCC_US1 = SCC_USA*0.5 - SCC_US2 = SCC_USA*0.5 -C -C - SLOG = LOG(S2/S1) - DXI = X2 - X1 -C - REZC = SCC*(CQA - SA*ALD)*DXI - & - DEA*2.0* SLOG - & + DEA*2.0*(UQ*DXI - ULOG) -C - -c if( ! (rt2.gt.1.0e3 .and. rt1.le.1.0e3) .or. -c & (rt2.gt.1.0e4 .and. rt1.le.1.0e4) .or. -c & (rt2.gt.1.0e5 .and. rt1.le.1.0e5) ) then -c gga = (HKA-1.0-GCC/RTA)/HKA / sqrt(0.5*CFA) -c write(*,4455) rta, hka, gga, cfa, cqa, sa, uq, ulog/dxi -c 4455 format(1x,f7.0, 2f9.4,f10.6,2f8.5,2f10.5) -c endif - - - Z_CFA = DEA*2.0*UQ_CFA*DXI - Z_HKA = DEA*2.0*UQ_HKA*DXI - Z_DA = DEA*2.0*UQ_DA *DXI - Z_SL = -DEA*2.0 - Z_UL = -DEA*2.0 - Z_DXI = SCC *(CQA - SA*ALD) + DEA*2.0*UQ - Z_USA = SCC_USA*(CQA - SA*ALD)*DXI - Z_CQA = SCC*DXI - Z_SA = -SCC*DXI*ALD - Z_DEA = 2.0*(UQ*DXI - ULOG - SLOG) -C - Z_UPW = Z_CQA*(CQ2-CQ1) + Z_SA *(S2 -S1 ) - & + Z_CFA*(CF2-CF1) + Z_HKA*(HK2-HK1) - Z_DE1 = 0.5*Z_DEA - Z_DE2 = 0.5*Z_DEA - Z_US1 = 0.5*Z_USA - Z_US2 = 0.5*Z_USA - Z_D1 = 0.5*Z_DA - Z_D2 = 0.5*Z_DA - Z_U1 = - Z_UL/U1 - Z_U2 = Z_UL/U2 - Z_X1 = -Z_DXI - Z_X2 = Z_DXI - Z_S1 = (1.0-UPW)*Z_SA - Z_SL/S1 - Z_S2 = UPW *Z_SA + Z_SL/S2 - Z_CQ1 = (1.0-UPW)*Z_CQA - Z_CQ2 = UPW *Z_CQA - Z_CF1 = (1.0-UPW)*Z_CFA - Z_CF2 = UPW *Z_CFA - Z_HK1 = (1.0-UPW)*Z_HKA - Z_HK2 = UPW *Z_HKA -C - VS1(1,1) = Z_S1 - VS1(1,2) = Z_UPW*UPW_T1 + Z_DE1*DE1_T1 + Z_US1*US1_T1 - VS1(1,3) = Z_D1 + Z_UPW*UPW_D1 + Z_DE1*DE1_D1 + Z_US1*US1_D1 - VS1(1,4) = Z_U1 + Z_UPW*UPW_U1 + Z_DE1*DE1_U1 + Z_US1*US1_U1 - VS1(1,5) = Z_X1 - VS2(1,1) = Z_S2 - VS2(1,2) = Z_UPW*UPW_T2 + Z_DE2*DE2_T2 + Z_US2*US2_T2 - VS2(1,3) = Z_D2 + Z_UPW*UPW_D2 + Z_DE2*DE2_D2 + Z_US2*US2_D2 - VS2(1,4) = Z_U2 + Z_UPW*UPW_U2 + Z_DE2*DE2_U2 + Z_US2*US2_U2 - VS2(1,5) = Z_X2 - VSM(1) = Z_UPW*UPW_MS + Z_DE1*DE1_MS + Z_US1*US1_MS - & + Z_DE2*DE2_MS + Z_US2*US2_MS -C - VS1(1,2) = VS1(1,2) + Z_CQ1*CQ1_T1 + Z_CF1*CF1_T1 + Z_HK1*HK1_T1 - VS1(1,3) = VS1(1,3) + Z_CQ1*CQ1_D1 + Z_CF1*CF1_D1 + Z_HK1*HK1_D1 - VS1(1,4) = VS1(1,4) + Z_CQ1*CQ1_U1 + Z_CF1*CF1_U1 + Z_HK1*HK1_U1 -C - VS2(1,2) = VS2(1,2) + Z_CQ2*CQ2_T2 + Z_CF2*CF2_T2 + Z_HK2*HK2_T2 - VS2(1,3) = VS2(1,3) + Z_CQ2*CQ2_D2 + Z_CF2*CF2_D2 + Z_HK2*HK2_D2 - VS2(1,4) = VS2(1,4) + Z_CQ2*CQ2_U2 + Z_CF2*CF2_U2 + Z_HK2*HK2_U2 -C - VSM(1) = VSM(1) + Z_CQ1*CQ1_MS + Z_CF1*CF1_MS + Z_HK1*HK1_MS - & + Z_CQ2*CQ2_MS + Z_CF2*CF2_MS + Z_HK2*HK2_MS - VSR(1) = Z_CQ1*CQ1_RE + Z_CF1*CF1_RE - & + Z_CQ2*CQ2_RE + Z_CF2*CF2_RE - VSX(1) = 0. - VSREZ(1) = -REZC -C - ENDIF -C -C**** Set up momentum equation - HA = 0.5*(H1 + H2) - MA = 0.5*(M1 + M2) - XA = 0.5*(X1 + X2) - TA = 0.5*(T1 + T2) - HWA = 0.5*(DW1/T1 + DW2/T2) -C -C---- set Cf term, using central value CFM for better accuracy in drag - CFX = 0.50*CFM*XA/TA + 0.25*(CF1*X1/T1 + CF2*X2/T2) - CFX_XA = 0.50*CFM /TA - CFX_TA = -.50*CFM*XA/TA**2 -C - CFX_X1 = 0.25*CF1 /T1 + CFX_XA*0.5 - CFX_X2 = 0.25*CF2 /T2 + CFX_XA*0.5 - CFX_T1 = -.25*CF1*X1/T1**2 + CFX_TA*0.5 - CFX_T2 = -.25*CF2*X2/T2**2 + CFX_TA*0.5 - CFX_CF1 = 0.25* X1/T1 - CFX_CF2 = 0.25* X2/T2 - CFX_CFM = 0.50* XA/TA -C - BTMP = HA + 2.0 - MA + HWA -C - REZT = TLOG + BTMP*ULOG - XLOG*0.5*CFX - Z_CFX = -XLOG*0.5 - Z_HA = ULOG - Z_HWA = ULOG - Z_MA = -ULOG - Z_XL =-DDLOG * 0.5*CFX - Z_UL = DDLOG * BTMP - Z_TL = DDLOG -C - Z_CFM = Z_CFX*CFX_CFM - Z_CF1 = Z_CFX*CFX_CF1 - Z_CF2 = Z_CFX*CFX_CF2 -C - Z_T1 = -Z_TL/T1 + Z_CFX*CFX_T1 + Z_HWA*0.5*(-DW1/T1**2) - Z_T2 = Z_TL/T2 + Z_CFX*CFX_T2 + Z_HWA*0.5*(-DW2/T2**2) - Z_X1 = -Z_XL/X1 + Z_CFX*CFX_X1 - Z_X2 = Z_XL/X2 + Z_CFX*CFX_X2 - Z_U1 = -Z_UL/U1 - Z_U2 = Z_UL/U2 -C - VS1(2,2) = 0.5*Z_HA*H1_T1 + Z_CFM*CFM_T1 + Z_CF1*CF1_T1 + Z_T1 - VS1(2,3) = 0.5*Z_HA*H1_D1 + Z_CFM*CFM_D1 + Z_CF1*CF1_D1 - VS1(2,4) = 0.5*Z_MA*M1_U1 + Z_CFM*CFM_U1 + Z_CF1*CF1_U1 + Z_U1 - VS1(2,5) = Z_X1 - VS2(2,2) = 0.5*Z_HA*H2_T2 + Z_CFM*CFM_T2 + Z_CF2*CF2_T2 + Z_T2 - VS2(2,3) = 0.5*Z_HA*H2_D2 + Z_CFM*CFM_D2 + Z_CF2*CF2_D2 - VS2(2,4) = 0.5*Z_MA*M2_U2 + Z_CFM*CFM_U2 + Z_CF2*CF2_U2 + Z_U2 - VS2(2,5) = Z_X2 -C - VSM(2) = 0.5*Z_MA*M1_MS + Z_CFM*CFM_MS + Z_CF1*CF1_MS - & + 0.5*Z_MA*M2_MS + Z_CF2*CF2_MS - VSR(2) = Z_CFM*CFM_RE + Z_CF1*CF1_RE - & + Z_CF2*CF2_RE - VSX(2) = 0. - VSREZ(2) = -REZT -C -C**** Set up shape parameter equation -C - XOT1 = X1/T1 - XOT2 = X2/T2 -C - HA = 0.5*(H1 + H2 ) - HSA = 0.5*(HS1 + HS2) - HCA = 0.5*(HC1 + HC2) - HWA = 0.5*(DW1/T1 + DW2/T2) -C - DIX = (1.0-UPW)*DI1*XOT1 + UPW*DI2*XOT2 - CFX = (1.0-UPW)*CF1*XOT1 + UPW*CF2*XOT2 - DIX_UPW = DI2*XOT2 - DI1*XOT1 - CFX_UPW = CF2*XOT2 - CF1*XOT1 -C - BTMP = 2.0*HCA/HSA + 1.0 - HA - HWA -C - REZH = HLOG + BTMP*ULOG + XLOG*(0.5*CFX-DIX) - Z_CFX = XLOG*0.5 - Z_DIX = -XLOG - Z_HCA = 2.0*ULOG/HSA - Z_HA = -ULOG - Z_HWA = -ULOG - Z_XL = DDLOG * (0.5*CFX-DIX) - Z_UL = DDLOG * BTMP - Z_HL = DDLOG -C - Z_UPW = Z_CFX*CFX_UPW + Z_DIX*DIX_UPW -C - Z_HS1 = -HCA*ULOG/HSA**2 - Z_HL/HS1 - Z_HS2 = -HCA*ULOG/HSA**2 + Z_HL/HS2 -C - Z_CF1 = (1.0-UPW)*Z_CFX*XOT1 - Z_CF2 = UPW *Z_CFX*XOT2 - Z_DI1 = (1.0-UPW)*Z_DIX*XOT1 - Z_DI2 = UPW *Z_DIX*XOT2 -C - Z_T1 = (1.0-UPW)*(Z_CFX*CF1 + Z_DIX*DI1)*(-XOT1/T1) - Z_T2 = UPW *(Z_CFX*CF2 + Z_DIX*DI2)*(-XOT2/T2) - Z_X1 = (1.0-UPW)*(Z_CFX*CF1 + Z_DIX*DI1)/ T1 - Z_XL/X1 - Z_X2 = UPW *(Z_CFX*CF2 + Z_DIX*DI2)/ T2 + Z_XL/X2 - Z_U1 = - Z_UL/U1 - Z_U2 = Z_UL/U2 -C - Z_T1 = Z_T1 + Z_HWA*0.5*(-DW1/T1**2) - Z_T2 = Z_T2 + Z_HWA*0.5*(-DW2/T2**2) -C - VS1(3,1) = Z_DI1*DI1_S1 - VS1(3,2) = Z_HS1*HS1_T1 + Z_CF1*CF1_T1 + Z_DI1*DI1_T1 + Z_T1 - VS1(3,3) = Z_HS1*HS1_D1 + Z_CF1*CF1_D1 + Z_DI1*DI1_D1 - VS1(3,4) = Z_HS1*HS1_U1 + Z_CF1*CF1_U1 + Z_DI1*DI1_U1 + Z_U1 - VS1(3,5) = Z_X1 - VS2(3,1) = Z_DI2*DI2_S2 - VS2(3,2) = Z_HS2*HS2_T2 + Z_CF2*CF2_T2 + Z_DI2*DI2_T2 + Z_T2 - VS2(3,3) = Z_HS2*HS2_D2 + Z_CF2*CF2_D2 + Z_DI2*DI2_D2 - VS2(3,4) = Z_HS2*HS2_U2 + Z_CF2*CF2_U2 + Z_DI2*DI2_U2 + Z_U2 - VS2(3,5) = Z_X2 - VSM(3) = Z_HS1*HS1_MS + Z_CF1*CF1_MS + Z_DI1*DI1_MS - & + Z_HS2*HS2_MS + Z_CF2*CF2_MS + Z_DI2*DI2_MS - VSR(3) = Z_HS1*HS1_RE + Z_CF1*CF1_RE + Z_DI1*DI1_RE - & + Z_HS2*HS2_RE + Z_CF2*CF2_RE + Z_DI2*DI2_RE -C - VS1(3,2) = VS1(3,2) + 0.5*(Z_HCA*HC1_T1+Z_HA*H1_T1) + Z_UPW*UPW_T1 - VS1(3,3) = VS1(3,3) + 0.5*(Z_HCA*HC1_D1+Z_HA*H1_D1) + Z_UPW*UPW_D1 - VS1(3,4) = VS1(3,4) + 0.5*(Z_HCA*HC1_U1 ) + Z_UPW*UPW_U1 - VS2(3,2) = VS2(3,2) + 0.5*(Z_HCA*HC2_T2+Z_HA*H2_T2) + Z_UPW*UPW_T2 - VS2(3,3) = VS2(3,3) + 0.5*(Z_HCA*HC2_D2+Z_HA*H2_D2) + Z_UPW*UPW_D2 - VS2(3,4) = VS2(3,4) + 0.5*(Z_HCA*HC2_U2 ) + Z_UPW*UPW_U2 -C - VSM(3) = VSM(3) + 0.5*(Z_HCA*HC1_MS ) + Z_UPW*UPW_MS - & + 0.5*(Z_HCA*HC2_MS ) -C - VSX(3) = 0. - VSREZ(3) = -REZH -C - RETURN - END - - - - SUBROUTINE DAMPL( HK, TH, RT, AX, AX_HK, AX_TH, AX_RT ) -C============================================================== -C Amplification rate routine for envelope e^n method. -C Reference: -C Drela, M., Giles, M., -C "Viscous/Inviscid Analysis of Transonic and -C Low Reynolds Number Airfoils", -C AIAA Journal, Oct. 1987. -C -C NEW VERSION. March 1991 (latest bug fix July 93) -C - m(H) correlation made more accurate up to H=20 -C - for H > 5, non-similar profiles are used -C instead of Falkner-Skan profiles. These -C non-similar profiles have smaller reverse -C velocities, are more representative of typical -C separation bubble profiles. -C-------------------------------------------------------------- -C -C input : HK kinematic shape parameter -C TH momentum thickness -C RT momentum-thickness Reynolds number -C -C output: AX envelope spatial amplification rate -C AX_(.) sensitivity of AX to parameter (.) -C -C -C Usage: The log of the envelope amplitude N(x) is -C calculated by integrating AX (= dN/dx) with -C respect to the streamwise distance x. -C x -C / -C N(x) = | AX(H(x),Th(x),Rth(x)) dx -C / -C 0 -C The integration can be started from the leading -C edge since AX will be returned as zero when RT -C is below the critical Rtheta. Transition occurs -C when N(x) reaches Ncrit (Ncrit= 9 is "standard"). -C============================================================== - use complexify - IMPLICIT complex (A-H,M,O-Z) -ccc DATA DGR / 0.04 / - DATA DGR / 0.08 / -C - HMI = 1.0/(HK - 1.0) - HMI_HK = -HMI**2 -C -C---- log10(Critical Rth) - H correlation for Falkner-Skan profiles - AA = 2.492*HMI**0.43 - AA_HK = (AA/HMI)*0.43 * HMI_HK -C - BB = TANH(14.0*HMI - 9.24) - BB_HK = (1.0 - BB*BB) * 14.0 * HMI_HK -C - GRCRIT = AA + 0.7*(BB + 1.0) - GRC_HK = AA_HK + 0.7* BB_HK -C -C - GR = LOG10(RT) - GR_RT = 1.0 / (2.3025851*RT) -C - IF(GR .LT. GRCRIT-DGR) THEN -C -C----- no amplification for Rtheta < Rcrit - AX = 0. - AX_HK = 0. - AX_TH = 0. - AX_RT = 0. -C - ELSE -C -C----- Set steep cubic ramp used to turn on AX smoothly as Rtheta -C- exceeds Rcrit (previously, this was done discontinuously). -C- The ramp goes between -DGR < log10(Rtheta/Rcrit) < DGR -C - RNORM = (GR - (GRCRIT-DGR)) / (2.0*DGR) - RN_HK = - GRC_HK / (2.0*DGR) - RN_RT = GR_RT / (2.0*DGR) -C - IF(RNORM .GE. 1.0) THEN - RFAC = 1.0 - RFAC_HK = 0. - RFAC_RT = 0. - ELSE - RFAC = 3.0*RNORM**2 - 2.0*RNORM**3 - RFAC_RN = 6.0*RNORM - 6.0*RNORM**2 -C - RFAC_HK = RFAC_RN*RN_HK - RFAC_RT = RFAC_RN*RN_RT - ENDIF -C -C----- Amplification envelope slope correlation for Falkner-Skan - ARG = 3.87*HMI - 2.52 - ARG_HK = 3.87*HMI_HK -C - EX = EXP(-ARG**2) - EX_HK = EX * (-2.0*ARG*ARG_HK) -C - DADR = 0.028*(HK-1.0) - 0.0345*EX - DADR_HK = 0.028 - 0.0345*EX_HK -C -C----- new m(H) correlation 1 March 91 - AF = -0.05 + 2.7*HMI - 5.5*HMI**2 + 3.0*HMI**3 - AF_HMI = 2.7 - 11.0*HMI + 9.0*HMI**2 - AF_HK = AF_HMI*HMI_HK -C - AX = (AF *DADR/TH ) * RFAC - AX_HK = (AF_HK*DADR/TH + AF*DADR_HK/TH) * RFAC - & + (AF *DADR/TH ) * RFAC_HK - AX_TH = -AX/TH - AX_RT = (AF *DADR/TH ) * RFAC_RT -C - ENDIF -C - RETURN - END ! DAMPL - - - - SUBROUTINE HKIN( H, MSQ, HK, HK_H, HK_MSQ ) - use complexify - implicit complex(a-h, o-z) - complex MSQ -C -C---- calculate kinematic shape parameter (assuming air) -C (from Whitfield ) - HK = (H - 0.29*MSQ)/(1.0 + 0.113*MSQ) - HK_H = 1.0 /(1.0 + 0.113*MSQ) - HK_MSQ = (-.29 - 0.113*HK)/(1.0 + 0.113*MSQ) -C - RETURN - END - - - - SUBROUTINE DIL( HK, RT, DI, DI_HK, DI_RT ) -C -C---- Laminar dissipation function ( 2 CD/H* ) (from Falkner-Skan) - use complexify - implicit complex(a-h, o-z) - IF(HK.LT.4.0) THEN - DI = ( 0.00205 * (4.0-HK)**5.5 + 0.207 ) / RT - DI_HK = ( -.00205*5.5*(4.0-HK)**4.5 ) / RT - ELSE - HKB = HK - 4.0 - DEN = 1.0 + 0.02*HKB**2 - DI = ( -.0016 * HKB**2 /DEN + 0.207 ) / RT - DI_HK = ( -.0016*2.0*HKB*(1.0/DEN - 0.02*HKB**2/DEN**2) ) / RT - ENDIF - DI_RT = -DI/RT -C - RETURN - END - - - SUBROUTINE DILW( HK, RT, DI, DI_HK, DI_RT ) - use complexify - implicit complex(a-h, o-z) - complex MSQ -C - MSQ = 0. - CALL HSL( HK, RT, MSQ, HS, HS_HK, HS_RT, HS_MSQ ) -C -C---- Laminar wake dissipation function ( 2 CD/H* ) - RCD = 1.10 * (1.0 - 1.0/HK)**2 / HK - RCD_HK = -1.10 * (1.0 - 1.0/HK)*2.0 / HK**3 - & - RCD/HK -C - DI = 2.0*RCD /(HS*RT) - DI_HK = 2.0*RCD_HK/(HS*RT) - (DI/HS)*HS_HK - DI_RT = -DI/RT - (DI/HS)*HS_RT -C - RETURN - END - - - SUBROUTINE HSL( HK, RT, MSQ, HS, HS_HK, HS_RT, HS_MSQ ) - use complexify - implicit complex(a-h, o-z) - complex MSQ -C -C---- Laminar HS correlation - IF(HK.LT.4.35) THEN - TMP = HK - 4.35 - HS = 0.0111*TMP**2/(HK+1.0) - & - 0.0278*TMP**3/(HK+1.0) + 1.528 - & - 0.0002*(TMP*HK)**2 - HS_HK = 0.0111*(2.0*TMP - TMP**2/(HK+1.0))/(HK+1.0) - & - 0.0278*(3.0*TMP**2 - TMP**3/(HK+1.0))/(HK+1.0) - & - 0.0002*2.0*TMP*HK * (TMP + HK) - ELSE - HS = 0.015* (HK-4.35)**2/HK + 1.528 - HS_HK = 0.015*2.0*(HK-4.35) /HK - & - 0.015* (HK-4.35)**2/HK**2 - ENDIF -C - HS_RT = 0. - HS_MSQ = 0. -C - RETURN - END - - - SUBROUTINE CFL( HK, RT, MSQ, CF, CF_HK, CF_RT, CF_MSQ ) - use complexify - implicit complex(a-h, o-z) - complex MSQ -C -C---- Laminar skin friction function ( Cf ) ( from Falkner-Skan ) - IF(HK.LT.5.5) THEN - TMP = (5.5-HK)**3 / (HK+1.0) - CF = ( 0.0727*TMP - 0.07 )/RT - CF_HK = ( -.0727*TMP*3.0/(5.5-HK) - 0.0727*TMP/(HK+1.0))/RT - ELSE - TMP = 1.0 - 1.0/(HK-4.5) - CF = ( 0.015*TMP**2 - 0.07 ) / RT - CF_HK = ( 0.015*TMP*2.0/(HK-4.5)**2 ) / RT - ENDIF - CF_RT = -CF/RT - CF_MSQ = 0.0 -C - RETURN - END - - - - SUBROUTINE DIT( HS, US, CF, ST, DI, DI_HS, DI_US, DI_CF, DI_ST ) -C -C---- Turbulent dissipation function ( 2 CD/H* ) - use complexify - implicit complex(a-h, o-z) - DI = ( 0.5*CF*US + ST*ST*(1.0-US) ) * 2.0/HS - DI_HS = -( 0.5*CF*US + ST*ST*(1.0-US) ) * 2.0/HS**2 - DI_US = ( 0.5*CF - ST*ST ) * 2.0/HS - DI_CF = ( 0.5 *US ) * 2.0/HS - DI_ST = ( 2.0*ST*(1.0-US) ) * 2.0/HS -C - RETURN - END - - - SUBROUTINE HST( HK, RT, MSQ, HS, HS_HK, HS_RT, HS_MSQ ) - use complexify - IMPLICIT complex (A-H,M,O-Z) -C -C---- Turbulent HS correlation -C - DATA HSMIN, DHSINF / 1.500, 0.015 / -C -C---- ### 12/4/94 -C---- limited Rtheta dependence for Rtheta < 200 -C -C - IF(RT.GT.400.0) THEN - HO = 3.0 + 400.0/RT - HO_RT = - 400.0/RT**2 - ELSE - HO = 4.0 - HO_RT = 0. - ENDIF -C - IF(RT.GT.200.0) THEN - RTZ = RT - RTZ_RT = 1. - ELSE - RTZ = 200.0 - RTZ_RT = 0. - ENDIF -C - IF(HK.LT.HO) THEN -C----- attached branch -C======================================================= -C----- old correlation -C- (from Swafford profiles) -c SRT = SQRT(RT) -c HEX = (HO-HK)**1.6 -c RTMP = 0.165 - 1.6/SRT -c HS = HSMIN + 4.0/RT + RTMP*HEX/HK -c HS_HK = RTMP*HEX/HK*(-1.6/(HO-HK) - 1.0/HK) -c HS_RT = -4.0/RT**2 + HEX/HK*0.8/SRT/RT -c & + RTMP*HEX/HK*1.6/(HO-HK)*HO_RT -C======================================================= -C----- new correlation 29 Nov 91 -C- (from arctan(y+) + Schlichting profiles) - HR = ( HO - HK)/(HO-1.0) - HR_HK = - 1.0/(HO-1.0) - HR_RT = (1.0 - HR)/(HO-1.0) * HO_RT - HS = (2.0-HSMIN-4.0/RTZ)*HR**2 * 1.5/(HK+0.5) + HSMIN - & + 4.0/RTZ - HS_HK =-(2.0-HSMIN-4.0/RTZ)*HR**2 * 1.5/(HK+0.5)**2 - & + (2.0-HSMIN-4.0/RTZ)*HR*2.0 * 1.5/(HK+0.5) * HR_HK - HS_RT = (2.0-HSMIN-4.0/RTZ)*HR*2.0 * 1.5/(HK+0.5) * HR_RT - & + (HR**2 * 1.5/(HK+0.5) - 1.0)*4.0/RTZ**2 * RTZ_RT -C - ELSE -C -C----- separated branch - GRT = LOG(RTZ) - HDIF = HK - HO - RTMP = HK - HO + 4.0/GRT - HTMP = 0.007*GRT/RTMP**2 + DHSINF/HK - HTMP_HK = -.014*GRT/RTMP**3 - DHSINF/HK**2 - HTMP_RT = -.014*GRT/RTMP**3 * (-HO_RT - 4.0/GRT**2/RTZ * RTZ_RT) - & + 0.007 /RTMP**2 / RTZ * RTZ_RT - HS = HDIF**2 * HTMP + HSMIN + 4.0/RTZ - HS_HK = HDIF*2.0* HTMP - & + HDIF**2 * HTMP_HK - HS_RT = HDIF**2 * HTMP_RT - 4.0/RTZ**2 * RTZ_RT - & + HDIF*2.0* HTMP * (-HO_RT) -C - ENDIF -C -C---- fudge HS slightly to make sure HS -> 2 as HK -> 1 -C- (unnecessary with new correlation) -c HTF = 0.485/9.0 * (HK-4.0)**2/HK + 1.515 -c HTF_HK = 0.485/9.0 * (1.0-16.0/HK**2) -c ARG = MAX( 10.0*(1.0 - HK) , -15.0 ) -c HXX = EXP(ARG) -c HXX_HK = -10.0*HXX -cC -c HS_HK = (1.0-HXX)*HS_HK + HXX*HTF_HK -c & + ( -HS + HTF )*HXX_HK -c HS_RT = (1.0-HXX)*HS_RT -c HS = (1.0-HXX)*HS + HXX*HTF -C -C---- Whitfield's minor additional compressibility correction - FM = 1.0 + 0.014*MSQ - HS = ( HS + 0.028*MSQ ) / FM - HS_HK = ( HS_HK ) / FM - HS_RT = ( HS_RT ) / FM - HS_MSQ = 0.028/FM - 0.014*HS/FM -C - RETURN - END - - - - SUBROUTINE CFT( HK, RT, MSQ, CF, CF_HK, CF_RT, CF_MSQ ) - use complexify - IMPLICIT complex (A-H,M,O-Z) - DATA GAM /1.4/ -C -C---- Turbulent skin friction function ( Cf ) (Coles) - GM1 = GAM - 1.0 - FC = SQRT(1.0 + 0.5*GM1*MSQ) - GRT = LOG(RT/FC) - GRT = MAX(GRT,3.0) -C - GEX = -1.74 - 0.31*HK -C - ARG = -1.33*HK - ARG = MAX(-20.0, ARG ) -C - THK = TANH(4.0 - HK/0.875) -C - CFO = 0.3*EXP(ARG) * (GRT/2.3026)**GEX - CF = ( CFO + 1.1E-4*(THK-1.0) ) / FC - CF_HK = (-1.33*CFO - 0.31*LOG(GRT/2.3026)*CFO - & - 1.1E-4*(1.0-THK**2) / 0.875 ) / FC - CF_RT = GEX*CFO/(FC*GRT) / RT - CF_MSQ = GEX*CFO/(FC*GRT) * (-0.25*GM1/FC**2) - 0.25*GM1*CF/FC**2 -C - RETURN - END ! CFT - - - - SUBROUTINE HCT( HK, MSQ, HC, HC_HK, HC_MSQ ) - use complexify - implicit complex(a-h, o-z) - complex MSQ -C -C---- density shape parameter (from Whitfield) - HC = MSQ * (0.064/(HK-0.8) + 0.251) - HC_HK = MSQ * (-.064/(HK-0.8)**2 ) - HC_MSQ = 0.064/(HK-0.8) + 0.251 -C - RETURN - END diff --git a/deps/src/xfoil_cs/c_xfoil.f b/deps/src/xfoil_cs/c_xfoil.f deleted file mode 100644 index b9843c9..0000000 --- a/deps/src/xfoil_cs/c_xfoil.f +++ /dev/null @@ -1,2123 +0,0 @@ -C*********************************************************************** -C Module: xfoil.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C -C*********************************************************************** -C UPDATED: Dan Berkenstock March 2006, Stanford ADL -C -C Functionality changed to command line driven for use in -C optimization. -C -C 030606: Updated as xfoil subroutine for wrapping in python -C 060806: Modified subroutine xfoil to subroutine initialize -C for greater clarity in python wrapping -C 060806: Stripped everything to do with plotting and gui -C*********************************************************************** -C - SUBROUTINE XFOIL -c---- used to be subroutine xfoil - - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*4 COMAND - CHARACTER*128 COMARG - CHARACTER*1 ANS - CHARACTER*128 OUTFILE - - DIMENSION IINPUT(20) - DIMENSION RINPUT(20) - DIMENSION GRADIENT(150) - LOGICAL ERROR - -C---- max panel angle threshold for warning - DATA ANGTOL / 40.0 / - -c---- call initialization function -c write(*,*) 'before init' - CALL INIT -c write(*,*) 'after init' -c LU = 8 -c CALL GETDEF(LU,'xfoil.def', .TRUE.) - -c---- read file in variable 'FNAME' should be unlabelled airfoil file - LU = 9 -c CALL AREAD(LU,FNAME,IBX,XB,YB,NB,NAME,ISPARS,ITYPE,1) -c write(*,*) 'fname',FNAME -c write(*,*) 'ITYPE',ITYPE -c write(*,*) 'before load' -c write(*,*) 'XB',XB -c write(*,*) 'YB',YB -c write(*,*) 'NB', NB -c CALL PANGEN(.FALSE.) -c CALL LOAD(FNAME,ITYPE) - - CALL ABCOPY(.TRUE.) - CALL PANGEN(.FALSE.) -c write(*,*) 'XB',XB -c write(*,*) 'YB',YB -c write(*,*) 'NB', NB -c write(*,*) 'Chord', chord -c write(*,*) 'lead/trail',XLE,YLE,XTE,YTE - ITYPE = 1 -c write(*,*) 'X',X -c write(*,*) 'Y',Y - RETURN - STOP - END ! XFOIL -C--------------------------------------------------- - - SUBROUTINE setNACA(camber,position,thickness) - ! This function is wrapped - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - complex camber,position,thickness - complex Xreturn (NB),Yreturn(NB) - call NACA(camber,position,thickness,XB,YB) - END - - SUBROUTINE NACA(camber,position,thickness,Xreturn,Yreturn) - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - complex camber,position,thickness - complex Xreturn(NB),Yreturn(NB) -C---- number of points per side - NSIDE = IQX/3 -C - IDES = IDES1 -C - ITYPE = 0 - IF(IDES.LE.25099) ITYPE = 5 - IF(IDES.LE.9999 ) ITYPE = 4 -C - IF(ITYPE.ceq.0) THEN - WRITE(*,*) 'This designation not implemented.' - RETURN - ENDIF -C -c IF(ITYPE.EQ.4) CALL NACA4(IDES,W1,W2,W3,NSIDE,XB,YB,NB,NAME) - camber = camber/100 - position = position/10 - thickness = thickness/100 -c print *, 'camber',camber -c print *, 'position',position -c print *, 'thickness',thickness - IF(ITYPE.ceq.4) CALL NACA4B(camber,position,thickness,W1,W2,W3, - * NSIDE,XB,YB,NB,NAME) - do i=1,NB - Xreturn(i) = XB(i) - Yreturn(i) = YB(i) - end do - CALL STRIP(NAME,NNAME) -C -C---- see if routines didn't recognize designator - - LCLOCK = .FALSE. -C - XBF = 0.0 - YBF = 0.0 - LBFLAP = .FALSE. -C - CALL SCALC(XB,YB,SB,NB) - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C - CALL GEOPAR(XB,XBP,YB,YBP,SB,NB, W1, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB ) -C -! WRITE(*,1200) NB -! 1200 FORMAT(/' Buffer airfoil set using', I4,' points') -C -C---- set paneling -! print *,'calling pangen' -! CALL PANGEN(.FALSE.) -! print *,'done pangen' -ccc CALL PANPLT -C - RETURN - END ! NACA - - - SUBROUTINE INIT -C--------------------------------------------------- -C Variable initialization/default routine. -C See file XFOIL.INC for variable description. -C--------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - PI = 4.0*ATAN(1.0) - HOPI = 0.50/PI - QOPI = 0.25/PI - DTOR = PI/180.0 -C -C---- default Cp/Cv (air) - GAMMA = 1.4 - GAMM1 = GAMMA - 1.0 -C -C---- set unity freestream speed - QINF = 1.0 -C -C---- initialize freestream Mach number to zero - MATYP = 1 -C MINF1 = 0. -C - ALFA = 0.0 - COSA = 1.0 - SINA = 0.0 -C - DO 10 I=1, IQX - GAMU(I,1) = 0. - GAMU(I,2) = 0. - GAM(I) = 0. - GAM_A(I) = 0. - 10 CONTINUE - PSIO = 0. -C - CL = 0. - CM = 0. - CD = 0. -C - SIGTE = 0.0 - GAMTE = 0.0 - SIGTE_A = 0. - GAMTE_A = 0. -C - DO 20 I=1, IZX - SIG(I) = 0. - 20 CONTINUE -C - NQSP = 0 - DO 30 K=1, IPX - ALQSP(K) = 0. - CLQSP(K) = 0. - CMQSP(K) = 0. - DO 302 I=1, IBX - QSPEC(I,K) = 0. - 302 CONTINUE - 30 CONTINUE -C - AWAKE = 0.0 - AVISC = 0.0 -C - KIMAGE = 1 - YIMAGE = -10.0 - LIMAGE = .FALSE. -C - LGAMU = .FALSE. - LQINU = .FALSE. - LVISC = .FALSE. - LWAKE = .FALSE. - LPACC = .FALSE. - LBLINI = .FALSE. - LIPAN = .FALSE. - LQAIJ = .FALSE. - LADIJ = .FALSE. - LWDIJ = .FALSE. - LCPXX = .FALSE. - LQVDES = .FALSE. - LQSPEC = .FALSE. - LQREFL = .FALSE. - LVCONV = .FALSE. - LCPREF = .FALSE. - LFOREF = .FALSE. - LPFILE = .FALSE. - LPFILX = .FALSE. - LPPSHO = .FALSE. - LBFLAP = .FALSE. - LFLAP = .FALSE. - LEIW = .FALSE. - LSCINI = .FALSE. - LPLOT = .FALSE. - LCLIP = .FALSE. - LVLAB = .TRUE. - LCMINP = .FALSE. - LHMOMP = .FALSE. -C - LCURS = .TRUE. - LLAND = .TRUE. - LGSAME = .FALSE. -C - LGPARM = .TRUE. - LPLCAM = .FALSE. -C -C---- input airfoil will not be normalized - LNORM = .FALSE. -C -C---- airfoil will not be forced symmetric - LQSYM = .FALSE. - LGSYM = .FALSE. -C -C---- endpoint slopes will be matched - LQSLOP = .TRUE. - LGSLOP = .TRUE. - LCSLOP = .TRUE. -C -C---- grids on Qspec(s) and buffer airfoil geometry plots will be plotted - LQGRID = .TRUE. - LGGRID = .TRUE. - LGTICK = .TRUE. -C -C---- no grid on Cp plots - LCPGRD = .FALSE. -C -C---- grid and no symbols are to be used on BL variable plots - LBLGRD = .TRUE. - LBLSYM = .FALSE. -C -C---- buffer and current airfoil flap hinge coordinates - XBF = 0.0 - YBF = 0.0 - XOF = 0.0 - YOF = 0.0 -C - NCPREF = 0 -C n -C---- circle plane array size (largest 2 + 1 that will fit array size) - ANN = LOG(FLOAT((2*IQX)-1))/LOG(2.0) - NN = INT( ANN + 0.00001 ) - NC1 = 2**NN + 1 - IF(NC1 .GT. 257) NC1 = 2**(NN-1) + 1 -C -C---- default paneling parameters - NPAN = 140 - CVPAR = 1.0 - CTERAT = 0.15 - CTRRAT = 0.2 -C -C---- default paneling refinement zone x/c endpoints - XSREF1 = 1.0 - XSREF2 = 1.0 - XPREF1 = 1.0 - XPREF2 = 1.0 -C -C---- no polars present to begin with - NPOL = 0 - IPACT = 0 - DO IP = 1, NPX - PFNAME(IP) = ' ' - PFNAMX(IP) = ' ' - ENDDO -C -C---- no reference polars - NPOLREF = 0 -C -C---- plot aspect ratio, character size - PLOTAR = 0.55 - CH = 0.015 -C -C---- airfoil node tick-mark size (as fraction of arc length) - GTICK = 0.0005 -C -C---- Cp limits in Cp vs x plot -c CPMAX = 1.0 -c CPMIN = -2.0 -c CPDEL = -0.5 -c PFAC = PLOTAR/(CPMAX-CPMIN) -C -C---- DCp limits in CAMB loading plot -c YPMIN = -0.2 -c YPMAX = 0.4 -C -C---- scaling factor for Cp vector plot -c VFAC = 0.25 -C -C---- offsets and scale factor for airfoil in Cp vs x plot -c XOFAIR = 0.09 -c YOFAIR = -.01 -c FACAIR = 0.70 -C -C---- u/Qinf scale factor for profile plotting -c UPRWT = 0.02 -C -C---- polar plot options, grid, list, legend, no CDW -c LPGRID = .TRUE. -c LPCDW = .FALSE. -c LPLIST = .TRUE. -c LPLEGN = .TRUE. -C -C---- axis limits and annotation deltas for polar plot -c CPOLPLF(1,ICD) = 0.0 -c CPOLPLF(2,ICD) = 0.04 -c CPOLPLF(3,ICD) = 0.01 -C -c CPOLPLF(1,ICL) = 0. -c CPOLPLF(2,ICL) = 1.5 -c CPOLPLF(3,ICL) = 0.5 -C -c CPOLPLF(1,ICM) = -0.25 -c CPOLPLF(2,ICM) = 0.0 -c CPOLPLF(3,ICM) = 0.05 -C -c CPOLPLF(1,IAL) = -4.0 -c CPOLPLF(2,IAL) = 10.0 -c CPOLPLF(3,IAL) = 2.0 -C -C---- widths of plot boxes in polar plot page -c XCDWID = 0.45 -c XALWID = 0.25 -c XOCWID = 0.20 -C -C---- color index for each polar -c DO IP=1, NPX -c ICOLP(IP) = 3 + MOD(IP-1,8) -c ENDDO -C -C---- default Cm reference location - XCMREF = 0.25 - YCMREF = 0. -C -C---- default viscous parameters - RETYP = 1 -C REINF1 = 0. - ACRIT = 9.0 - XSTRIP(1) = 1.0 - XSTRIP(2) = 1.0 - XOCTR(1) = 1.0 - XOCTR(2) = 1.0 - YOCTR(1) = 0. - YOCTR(2) = 0. - WAKLEN = 1.0 -C -C---- Newton iteration limit -C ITMAX = 10 -C -C---- max number of unconverged sequence points for early exit - NSEQEX = 4 -C -C---- drop tolerance for BL system solver - VACCEL = 0.01 -C -C---- inverse-mapping auto-filter level - FFILT = 0.0 -C -C---- default overlay airfoil filename - ONAME = ' ' -C -C---- default filename prefix - PREFIX = ' ' -C -C---- Plotting flag -c IDEV = 1 ! X11 window only -c IDEV = 2 ! B&W PostScript output file only (no color) -c IDEV = 3 ! both X11 and B&W PostScript file -c IDEV = 4 ! Color PostScript output file only -c IDEV = 5 ! both X11 and Color PostScript file -C -C---- Re-plotting flag (for hardcopy) - IDEVRP = 2 ! B&W PostScript -c IDEVRP = 4 ! Color PostScript -C -C---- PostScript output logical unit and file specification - IPSLU = 0 ! output to file plot.ps on LU 4 (default case) -c IPSLU = ? ! output to file plot?.ps on LU 10+? -C -C---- screen fraction taken up by plot window upon opening - SCRNFR = 0.80 -C -C---- Default plot size in inches -C- (Default plot window is 11.0 x 8.5) -C- (Must be smaller than XPAGE if objects are to fit on paper page) - SIZE = 10.0 - -C---- plot-window dimensions in inches for plot blowup calculations -C- currently, 11.0 x 8.5 default window is hard-wired in libPlt -c XPAGE = 11.0 -c YPAGE = 8.5 -C -C---- page margins in inches -c XMARG = 0.0 -c YMARG = 0.0 -C -C---- set top and bottom-side colors -c ICOLS(1) = 5 -c ICOLS(2) = 7 -C -C 3 red -C 4 orange -C 5 yellow -C 6 green -C 7 cyan -C 8 blue -C 9 violet -C 10 magenta -C -C -c CALL PLINITIALIZE -C -C---- set up color spectrum -c NCOLOR = 64 -c CALL COLORSPECTRUMHUES(NCOLOR,'RYGCBM') -C -C -c NNAME = 32 -c NAME = ' ' -CCC 12345678901234567890123456789012 -C -C---- MSES domain parameters (not used in XFOIL) - ISPARS = ' -2.0 3.0 -2.5 3.5' -C -C---- set MINF, REINF, based on current CL-dependence - CALL MRCL((1.0,0.0),MINF_CL,REINF_CL) -C -C---- set various compressibility parameters from MINF - CALL COMSET -C - RETURN - END ! INIT - - - SUBROUTINE MRCL(CLS,M_CLS,R_CLS) -C------------------------------------------- -C Sets actual Mach, Reynolds numbers -C from unit-CL values and specified CLS -C depending on MATYP,RETYP flags. -C------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - complex M_CLS -C - CLA = MAX( CLS , 0.000001 ) -C - IF(RETYP.LT.1 .OR. RETYP.GT.3) THEN - WRITE(*,*) 'MRCL: Illegal Re(CL) dependence trigger.' - WRITE(*,*) ' Setting fixed Re.' - RETYP = 1 - ENDIF - IF(MATYP.LT.1 .OR. MATYP.GT.3) THEN - WRITE(*,*) 'MRCL: Illegal Mach(CL) dependence trigger.' - WRITE(*,*) ' Setting fixed Mach.' - MATYP = 1 - ENDIF -C -C - IF(MATYP.ceq.1) THEN -C - MINF = MINF1 - M_CLS = 0. -C - ELSE IF(MATYP.ceq.2) THEN -C - MINF = MINF1/SQRT(CLA) - M_CLS = -0.5*MINF/CLA -C - ELSE IF(MATYP.ceq.3) THEN -C - MINF = MINF1 - M_CLS = 0. -C - ENDIF -C -C - IF(RETYP.ceq.1) THEN -C - REINF = REINF1 - R_CLS = 0. -C - ELSE IF(RETYP.ceq.2) THEN -C - REINF = REINF1/SQRT(CLA) - R_CLS = -0.5*REINF/CLA -C - ELSE IF(RETYP.ceq.3) THEN -C - REINF = REINF1/CLA - R_CLS = -REINF /CLA -C - ENDIF -C -C - IF(MINF .GE. 0.99) THEN - WRITE(*,*) - WRITE(*,*) 'MRCL: CL too low for chosen Mach(CL) dependence' - WRITE(*,*) ' Aritificially limiting Mach to 0.99' - MINF = 0.99 - M_CLS = 0. - ENDIF -C - RRAT = 1.0 - IF(REINF1 .GT. 0.0) RRAT = REINF/REINF1 -C - IF(RRAT .GT. 100.0) THEN - WRITE(*,*) - WRITE(*,*) 'MRCL: CL too low for chosen Re(CL) dependence' - WRITE(*,*) ' Aritificially limiting Re to ',REINF1*100.0 - REINF = REINF1*100.0 - R_CLS = 0. - ENDIF -C - RETURN - END ! MRCL - -C***************************************************************** -C -C READS PARAM FILE -C -C***************************************************************** - - SUBROUTINE GETDEF(LU,FILNAM,LASK) - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) FILNAM - LOGICAL LASK -C----------------------------------------------------- -C Reads in default parameters from file xfoil.def -C If LASK=t, ask user if file is to be read. -C----------------------------------------------------- - include 'c_XFOIL.INC' - LOGICAL LCOLOR - CHARACTER*1 ANS -C - 1000 FORMAT(A) -C - OPEN(LU,FILE=FILNAM,STATUS='OLD',ERR=90) - IF(LASK) THEN - WRITE(*,1050) FILNAM - 1050 FORMAT(/' Read settings from file ', A, ' ? Y') - READ(*,1000) ANS - IF(INDEX('Nn',ANS).cne.0) THEN - CLOSE(LU) - RETURN - ENDIF - ENDIF -C - CLMIN = CPOLPLF(1,ICL) - CLMAX = CPOLPLF(2,ICL) - CLDEL = CPOLPLF(3,ICL) -C - CDMIN = CPOLPLF(1,ICD) - CDMAX = CPOLPLF(2,ICD) - CDDEL = CPOLPLF(3,ICD) -C - ALMIN = CPOLPLF(1,IAL) - ALMAX = CPOLPLF(2,IAL) - ALDEL = CPOLPLF(3,IAL) -C - CMMIN = CPOLPLF(1,ICM) - CMMAX = CPOLPLF(2,ICM) - CMDEL = CPOLPLF(3,ICM) -C -C---- default paneling parameters (viscous) - READ(LU,*,ERR=80) NPAN, CVPAR, CTERAT, CTRRAT - READ(LU,*,ERR=80) XSREF1, XSREF2, XPREF1, XPREF2 -C -C---- plotting parameters - READ(LU,*,ERR=80) SIZE, PLOTAR, CH, SCRNFR -C -C---- plot sizes - READ(LU,*,ERR=80) XPAGE, YPAGE, XMARG, YMARG -C -C---- plot flags - READ(LU,*,ERR=80) LCOLOR, LCURS -C -C---- Cp limits in Cp vs x plot - READ(LU,*,ERR=80) CPMAX, CPMIN, CPDEL - PFAC = PLOTAR/(CPMAX-CPMIN) -C -C---- airfoil x-offset and scale factor in Cp vs x plot, BL profile weight - READ(LU,*,ERR=80) XOFAIR, FACAIR, UPRWT -C -C---- polar plot CL,CD,alpha,CM min,max,delta - READ(LU,*,ERR=80) (CPOLPLF(K,ICL), K=1, 3) - READ(LU,*,ERR=80) (CPOLPLF(K,ICD), K=1, 3) - READ(LU,*,ERR=80) (CPOLPLF(K,IAL), K=1, 3) - READ(LU,*,ERR=80) (CPOLPLF(K,ICM), K=1, 3) -C -C---- default Mach and viscous parameters - READ(LU,*,ERR=80) MATYP, MINF1, VACCEL - READ(LU,*,ERR=80) RETYP, RMILL, ACRIT - READ(LU,*,ERR=80) XSTRIP(1), XSTRIP(2) -C - IF( LCOLOR) IDEVRP = 4 - IF(.NOT.LCOLOR) IDEVRP = 2 -C - REINF1 = RMILL * 1.0E6 -C -C---- set MINF, REINF - CALL MRCL((1.0,0.0),MINF_CL,REINF_CL) -C -C---- set various compressibility parameters from new MINF - CALL COMSET -C - CLOSE(LU) -C WRITE(*,1600) FILNAM - 1600 FORMAT(/' Default parameters read in from file ', A,':' /) - CALL WRTDEF(6) - RETURN -C - 80 CONTINUE - CLOSE(LU) -C WRITE(*,1800) FILNAM - 1800 FORMAT(/' File ', A,' read error' - & /' Settings may have been changed') - RETURN -C - 90 CONTINUE -C WRITE(*,1900) FILNAM - 1900 FORMAT(/' File ', A,' not found') - RETURN -C - END ! GETDEF - - - - SUBROUTINE WRTDEF(LU) -C------------------------------------------ -C Writes default parameters to unit LU -C------------------------------------------ - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - LOGICAL LCOLOR -C - LCOLOR = IDEVRP.ceq.4 -C -C---- default paneling parameters (viscous) - WRITE(LU,1010) NPAN , CVPAR , CTERAT, CTRRAT - WRITE(LU,1020) XSREF1, XSREF2, XPREF1, XPREF2 -C -C---- plotting parameters - WRITE(LU,1030) SIZE, PLOTAR, CH, SCRNFR -C -C---- plot sizes - WRITE(LU,1032) XPAGE, YPAGE, XMARG, YMARG -C -C---- plot flags - WRITE(LU,1034) LCOLOR, LCURS -C -C---- Cp limits in Cp vs x plot - WRITE(LU,1040) CPMAX, CPMIN, CPDEL -C -C---- x-offset and scale factor for airfoil on Cp vs x plot - WRITE(LU,1050) XOFAIR, FACAIR, UPRWT -C -C---- polar plot CL,CD,alpha,CM min,max,delta - WRITE(LU,1061) (CPOLPLF(K,ICL), K=1, 3) - WRITE(LU,1062) (CPOLPLF(K,ICD), K=1, 3) - WRITE(LU,1063) (CPOLPLF(K,IAL), K=1, 3) - WRITE(LU,1064) (CPOLPLF(K,ICM), K=1, 3) -C -C---- default viscous parameters - WRITE(LU,1071) MATYP , MINF1 , VACCEL - WRITE(LU,1072) RETYP , REINF1/1.0E6 , ACRIT - WRITE(LU,1080) XSTRIP(1), XSTRIP(2) -C - RETURN -C............................................... - 1010 FORMAT(1X,I5,4X,F9.4,F9.4,F9.4,' | Npan PPanel TErat REFrat') - 1020 FORMAT(1X,F9.4 ,F9.4,F9.4,F9.4,' | XrefS1 XrefS2 XrefP1 XrefP2') - 1030 FORMAT(1X,F9.4 ,F9.4,F9.4,F9.4,' | Size plotAR CHsize ScrnFr') - 1032 FORMAT(1X,F9.4 ,F9.4,F9.4,F9.4,' | Xpage Ypage Xmargn Ymargn') - 1034 FORMAT(1X,L2,7X,L2,7X,9X , 9X ,' | Lcolor Lcursor' ) - 1040 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CPmax CPmin CPdel' ) - 1050 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | XoffAir ScalAir BLUwt' ) - 1061 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CLmin CLmax CLdel' ) - 1062 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CDmin CDmax CDdel' ) - 1063 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | ALmin ALmax ALdel' ) - 1064 FORMAT(1X,F9.4 ,F9.4,F9.4, 9X ,' | CMmin CMmax CMdel' ) - 1071 FORMAT(1X,I3,6X,F9.4,F9.4, 9X ,' | MAtype Mach Vaccel' ) - 1072 FORMAT(1X,I3,6X,F9.4,F9.4, 9X ,' | REtype Re/10^6 Ncrit' ) - 1080 FORMAT(1X,F9.4 ,F9.4, 9X , 9X ,' | XtripT XtripB' ) - END ! WRTDEF - - - SUBROUTINE COMSET - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- set Karman-Tsien parameter TKLAM - BETA = SQRT(1.0 - MINF**2) - BETA_MSQ = -0.5/BETA -C - TKLAM = MINF**2 / (1.0 + BETA)**2 - TKL_MSQ = 1.0 / (1.0 + BETA)**2 - & - 2.0*TKLAM/ (1.0 + BETA) * BETA_MSQ -C -C---- set sonic Pressure coefficient and speed - IF(MINF.ceq.0.0) THEN - CPSTAR = -999.0 - QSTAR = 999.0 - ELSE - CPSTAR = 2.0 / (GAMMA*MINF**2) - & * (( (1.0 + 0.5*GAMM1*MINF**2) - & /(1.0 + 0.5*GAMM1 ))**(GAMMA/GAMM1) - 1.0) - QSTAR = QINF/MINF - & * SQRT( (1.0 + 0.5*GAMM1*MINF**2) - & /(1.0 + 0.5*GAMM1 ) ) - ENDIF -C - RETURN - END ! COMSET - - - SUBROUTINE CPCALC(N,Q,QINF,MINF,CP) -C--------------------------------------------- -C Sets compressible Cp from speed. -C--------------------------------------------- - use complexify - implicit complex(a-h, o-z) - DIMENSION Q(N),CP(N) - complex MINF -C - LOGICAL DENNEG -C - BETA = SQRT(1.0 - MINF**2) - BFAC = 0.5*MINF**2 / (1.0 + BETA) -C - DENNEG = .FALSE. -C - DO 20 I=1, N - CPINC = 1.0 - (Q(I)/QINF)**2 - DEN = BETA + BFAC*CPINC - CP(I) = CPINC / DEN - IF(DEN .LE. 0.0) DENNEG = .TRUE. - 20 CONTINUE -C - IF(DENNEG) THEN - WRITE(*,*) - WRITE(*,*) 'CPCALC: Local speed too large. ', - & 'Compressibility corrections invalid.' - ENDIF -C - RETURN - END ! CPCALC - -C*********************************************************** -C -C CL CALCULATION ROUTINE -C -C*********************************************************** - - SUBROUTINE CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, - & XREF,YREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) -C----------------------------------------------------------- -C Integrates surface pressures to get CL and CM. -C Integrates skin friction to get CDF. -C Calculates dCL/dAlpha for prescribed-CL routines. -C----------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N),Y(N), GAM(N), GAM_A(N) - complex MINF -C -C---- moment-reference coordinates -ccc XREF = 0.25 -ccc YREF = 0. -C -C - SA = SIN(ALFA) - CA = COS(ALFA) -C - BETA = SQRT(1.0 - MINF**2) - BETA_MSQ = -0.5/BETA -C - BFAC = 0.5*MINF**2 / (1.0 + BETA) - BFAC_MSQ = 0.5 / (1.0 + BETA) - & - BFAC / (1.0 + BETA) * BETA_MSQ -C - CL = 0.0 - CM = 0.0 - - CDP = 0.0 -C - CL_ALF = 0. - CL_MSQ = 0. -C - I = 1 - CGINC = 1.0 - (GAM(I)/QINF)**2 - CPG1 = CGINC/(BETA + BFAC*CGINC) - CPG1_MSQ = -CPG1/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_GAM = -2.0*GAM(I)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG1)/ (BETA + BFAC*CGINC) - CPG1_ALF = CPC_CPI*CPI_GAM*GAM_A(I) -C - DO 10 I=1, N - IP = I+1 - IF(I.ceq.N) IP = 1 -C - CGINC = 1.0 - (GAM(IP)/QINF)**2 - CPG2 = CGINC/(BETA + BFAC*CGINC) - CPG2_MSQ = -CPG2/(BETA + BFAC*CGINC)*(BETA_MSQ + BFAC_MSQ*CGINC) -C - CPI_GAM = -2.0*GAM(IP)/QINF**2 - CPC_CPI = (1.0 - BFAC*CPG2)/ (BETA + BFAC*CGINC) - CPG2_ALF = CPC_CPI*CPI_GAM*GAM_A(IP) -C - DX = (X(IP) - X(I))*CA + (Y(IP) - Y(I))*SA - DY = (Y(IP) - Y(I))*CA - (X(IP) - X(I))*SA - DG = CPG2 - CPG1 -C - AX = (0.5*(X(IP)+X(I))-XREF)*CA + (0.5*(Y(IP)+Y(I))-YREF)*SA - AY = (0.5*(Y(IP)+Y(I))-YREF)*CA - (0.5*(X(IP)+X(I))-XREF)*SA - AG = 0.5*(CPG2 + CPG1) -C - DX_ALF = -(X(IP) - X(I))*SA + (Y(IP) - Y(I))*CA - AG_ALF = 0.5*(CPG2_ALF + CPG1_ALF) - AG_MSQ = 0.5*(CPG2_MSQ + CPG1_MSQ) -C - CL = CL + DX* AG - CDP = CDP - DY* AG - CM = CM - DX*(AG*AX + DG*DX/12.0) - & - DY*(AG*AY + DG*DY/12.0) -C - CL_ALF = CL_ALF + DX*AG_ALF + AG*DX_ALF - CL_MSQ = CL_MSQ + DX*AG_MSQ -C - CPG1 = CPG2 - CPG1_ALF = CPG2_ALF - CPG1_MSQ = CPG2_MSQ - 10 CONTINUE -C - RETURN - END ! CLCALC - -C************************************************************************ - - SUBROUTINE CDCALC - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - SA = SIN(ALFA) - CA = COS(ALFA) -C - IF(LVISC .AND. LBLINI) THEN -C -C----- set variables at the end of the wake - THWAKE = THET(NBL(2),2) - URAT = UEDG(NBL(2),2)/QINF - UEWAKE = UEDG(NBL(2),2) * (1.0-TKLAM) / (1.0 - TKLAM*URAT**2) - SHWAKE = DSTR(NBL(2),2)/THET(NBL(2),2) -C -C----- extrapolate wake to downstream infinity using Squire-Young relation -C (reduces errors of the wake not being long enough) - CD = 2.0*THWAKE * (UEWAKE/QINF)**(0.5*(5.0+SHWAKE)) -C - ELSE -C - CD = 0.0 -C - ENDIF -C -C---- calculate friction drag coefficient - CDF = 0.0 - DO 20 IS=1, 2 - DO 205 IBL=3, IBLTE(IS) - I = IPAN(IBL ,IS) - IM = IPAN(IBL-1,IS) - DX = (X(I) - X(IM))*CA + (Y(I) - Y(IM))*SA - CDF = CDF + 0.5*(TAU(IBL,IS)+TAU(IBL-1,IS))*DX * 2.0/QINF**2 - 205 CONTINUE - 20 CONTINUE -C - RETURN - END ! CDCALC - - -C############################################################# -C READS IN AIRFOIL COORDS -C -C############################################################# - SUBROUTINE LOAD(FILNAM,ITYPE) -C------------------------------------------------------ -C Reads airfoil file into buffer airfoil -C and does various initial processesing on it. -C------------------------------------------------------ - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*(*) FILNAM -C - FNAME = FILNAM -C -c IF(FNAME(1:1).EQ.' ') FNAME = 'INPUTAIRFOIL' - LU = 9 - - - IF(ITYPE.ceq.0) RETURN -C -C IF(ITYPE.EQ.1) CALL ASKS('Enter airfoil name^',NAME) - NAME = 'INPUTAIRFOIL' - CALL STRIP(NAME,NNAME) -C -C---- set default prefix for other filenames - KDOT = INDEX(FNAME,'.') - IF(KDOT.ceq.0) THEN - PREFIX = FNAME - ELSE - PREFIX = FNAME(1:KDOT-1) - ENDIF - CALL STRIP(PREFIX,NPREFIX) -C -C---- calculate airfoil area assuming counterclockwise ordering - AREA = 0.0 - DO 50 I=1, NB - IP = I+1 - IF(I.ceq.NB) IP = 1 - AREA = AREA + 0.5*(YB(I)+YB(IP))*(XB(I)-XB(IP)) - 50 CONTINUE -C - IF(AREA.GE.0.0) THEN - LCLOCK = .FALSE. -C WRITE(*,1010) NB - ELSE -C----- if area is negative (clockwise order), reverse coordinate order - LCLOCK = .TRUE. -C WRITE(*,1011) NB - DO 55 I=1, NB/2 - XTMP = XB(NB-I+1) - YTMP = YB(NB-I+1) - XB(NB-I+1) = XB(I) - YB(NB-I+1) = YB(I) - XB(I) = XTMP - YB(I) = YTMP - 55 CONTINUE - ENDIF -C - IF(LNORM) THEN - CALL NORM(XB,XBP,YB,YBP,SB,NB) -C WRITE(*,1020) - ENDIF -C - CALL SCALC(XB,YB,SB,NB) - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C - CALL GEOPAR(XB,XBP,YB,YBP,SB,NB, W1, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB ) -C - XBLE = SEVAL(SBLE,XB,XBP,SB,NB) - YBLE = SEVAL(SBLE,YB,YBP,SB,NB) - XBTE = 0.5*(XB(1) + XB(NB)) - YBTE = 0.5*(YB(1) + YB(NB)) -C -C WRITE(*,1050) XBLE,YBLE, CHORDB, -C & XBTE,YBTE -C -C---- set reasonable MSES domain parameters for non-MSES coordinate file -c IF(ITYPE.LE.2) THEN -c XBLE = SEVAL(SBLE,XB,XBP,SB,NB) -c YBLE = SEVAL(SBLE,YB,YBP,SB,NB) -c XINL = XBLE - 2.0*CHORDB -c XOUT = XBLE + 3.0*CHORDB -c YBOT = YBLE - 2.5*CHORDB -c YTOP = YBLE + 3.5*CHORDB -c XINL = AINT(20.0*ABS(XINL/CHORDB)+0.5)/20.0 * SIGN(CHORDB,XINL) -c XOUT = AINT(20.0*ABS(XOUT/CHORDB)+0.5)/20.0 * SIGN(CHORDB,XOUT) -c YBOT = AINT(20.0*ABS(YBOT/CHORDB)+0.5)/20.0 * SIGN(CHORDB,YBOT) -c YTOP = AINT(20.0*ABS(YTOP/CHORDB)+0.5)/20.0 * SIGN(CHORDB,YTOP) -C WRITE(ISPARS,1005) XINL, XOUT, YBOT, YTOP -c 1005 FORMAT(1X, 4F8.2 ) -c ENDIF -C -C---- wipe out old flap hinge location - XBF = 0.0 - YBF = 0.0 - LBFLAP = .FALSE. -C -C---- wipe out off-design alphas, CLs -cc NALOFF = 0 -cc NCLOFF = 0 -C - RETURN -C............................................................... - 1010 FORMAT(/' Number of input coordinate points:', I4 - & /' Counterclockwise ordering') - 1011 FORMAT(/' Number of input coordinate points:', I4 - & /' Clockwise ordering') - 1020 FORMAT(/' Airfoil has been normalized') - 1050 FORMAT(/' LE x,y =', 2F10.5,' | Chord =',F10.5 - & /' TE x,y =', 2F10.5,' |' ) - END ! LOAD - - - - SUBROUTINE SAVE(IFTYP,FNAME1) -C-------------------------------- -C Writes out current airfoil -C-------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*(*) FNAME1 -C - CHARACTER*1 ANS -C - LU = 2 -C -C---- get output filename if it was not supplied - IF(FNAME1(1:1) .cne. ' ') THEN - FNAME = FNAME1 - ELSE - CALL ASKS('Enter output filename^',FNAME) - ENDIF -C - OPEN(LU,FILE=FNAME,STATUS='OLD',ERR=5) - WRITE(*,*) - WRITE(*,*) 'Output file exists. Overwrite? Y' - READ(*,1000) ANS - IF(INDEX('Nn',ANS).ceq.0) GO TO 6 -C - CLOSE(LU) - WRITE(*,*) 'Current airfoil not saved.' - RETURN -C - 5 OPEN(LU,FILE=FNAME,STATUS='NEW',ERR=90) - 6 REWIND(LU) -C - IF(IFTYP.GE.1) THEN -C----- write name to first line - WRITE(LU,1000) NAME(1:NNAME) - ENDIF -C - IF(IFTYP.GE.2) THEN -C----- write MSES domain parameters to second line - DO K=80, 1, -1 - IF(INDEX(ISPARS(K:K),' ') .cne. 1) GO TO 11 - ENDDO - 11 CONTINUE -C - WRITE(LU,1000) ISPARS(1:K) - ENDIF -C - IF(LCLOCK) THEN -C----- write out in clockwise order (reversed from internal XFOIL order) - IBEG = N - IEND = 1 - INCR = -1 - ELSE -C----- write out in counterclockwise order (same as internal XFOIL order) - IBEG = 1 - IEND = N - INCR = 1 - ENDIF -C - IF(IFTYP.ceq.-1) THEN - DO I=IBEG, IEND, INCR - WRITE(LU,1400) INT(X(I)+SIGN(0.5,X(I))), - & INT(Y(I)+SIGN(0.5,Y(I))) - ENDDO - ELSE - DO I=IBEG, IEND, INCR - WRITE(LU,1100) X(I),Y(I) - ENDDO - ENDIF -C - CLOSE(LU) - RETURN -C - 90 WRITE(*,*) 'Bad filename.' - WRITE(*,*) 'Current airfoil not saved.' - RETURN -C - 1000 FORMAT(A) - 1100 FORMAT(1X,2F12.6) - 1400 FORMAT(1X,2I12 ) - END ! SAVE - - - - SUBROUTINE MSAVE(FNAME1) -C------------------------------------------ -C Writes out current airfoil as one -C element in a multielement MSES file. -C------------------------------------------ - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*(*) FNAME1 -C - CHARACTER*80 NAME1, ISPARS1 -C - PARAMETER (NEX=5) - DIMENSION NTMP(NEX) - DIMENSION XTMP(2*IQX,NEX), YTMP(2*IQX,NEX) - EQUIVALENCE (Q(1,1),XTMP(1,1)), (Q(1,IQX/2),YTMP(1,1)) -C - LU = 2 -C -C---- get output filename if it was not supplied - IF(FNAME1(1:1) .cne. ' ') THEN - FNAME = FNAME1 - ELSE - CALL ASKS('Enter output filename for element replacement^',FNAME) - ENDIF -C - OPEN(LU,FILE=FNAME,STATUS='OLD',ERR=9005) -C - READ(LU,1000,ERR=9010) NAME1 - READ(LU,1000,ERR=9010) ISPARS1 -C - DO NN1=80, 2, -1 - IF(NAME1(NN1:NN1) .cne. ' ') GO TO 10 - ENDDO - 10 CONTINUE -C - DO NI1=80, 2, -1 - IF(ISPARS1(NI1:NI1) .cne. ' ') GO TO 20 - ENDDO - 20 CONTINUE -C -C---- read in existing airfoil coordinates - 40 DO 55 IEL=1, NEX - DO 50 I=1, 2*IQX+1 - READ(LU,*,END=56) XTMP(I,IEL), YTMP(I,IEL) - IF(XTMP(I,IEL).ceq.999.0) THEN - NTMP(IEL) = I-1 - GO TO 55 - ENDIF - 50 CONTINUE - STOP 'LOAD: Array overflow' - 55 CONTINUE - NEL = NEX -C - 56 IF(I.ceq.1) THEN -C----- coordinate file has "999.0 999.0" at the end ... - NEL = IEL-1 - ELSE -C----- coordinate file has no ending line - NEL = IEL - NTMP(IEL) = I-1 - ENDIF -C -C - WRITE(*,3010) NEL - CALL ASKI('Enter element to be replaced by current airfoil^',IEL) -C - IF(IEL.LT.1 .OR. IEL.GT.NEL+1) THEN - WRITE(*,*) 'Element number inappropriate. Airfoil not written.' - CLOSE(LU) - RETURN - ELSE IF(IEL.ceq.NEL+1) THEN - NEL = NEL+1 - ENDIF -C -C - NTMP(IEL) = N - DO 70 I = 1, NTMP(IEL) - IF(LCLOCK) THEN -C------- write out in clockwise order (reversed from internal XFOIL order) - IDIR = NTMP(IEL) - I + 1 - ELSE -C------- write out in counterclockwise order (same as internal XFOIL order) - IDIR = I - ENDIF - XTMP(I,IEL) = X(IDIR) - YTMP(I,IEL) = Y(IDIR) - 70 CONTINUE -C -C - REWIND(LU) -C -C---- write first 2 lines of MSES format coordinate file - WRITE(LU,1000) NAME1(1:NN1) - WRITE(LU,1000) ISPARS1(1:NI1) -C - DO 80 IEL=1, NEL - DO 805 I=1, NTMP(IEL) - WRITE(LU,1100) XTMP(I,IEL),YTMP(I,IEL) - 805 CONTINUE - IF(IEL.LT.NEL) WRITE(LU,*) ' 999.0 999.0' - 80 CONTINUE -C - CLOSE(LU) - RETURN -C - 9005 WRITE(*,*) 'Old file OPEN error. Airfoil not saved.' - RETURN -C - 9010 WRITE(*,*) 'Old file READ error. Airfoil not saved.' - CLOSE(LU) - RETURN -C - 1000 FORMAT(A) - 1100 FORMAT(1X,5F12.6) - 3010 FORMAT(/' Specified multielement airfoil has',I2,' elements.') - END ! MSAVE - - - - SUBROUTINE ROTATE(X,Y,N,ALFA) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), Y(N) -C - SA = SIN(ALFA) - CA = COS(ALFA) -CCC XOFF = 0.25*(1.0-CA) -CCC YOFF = 0.25*SA - XOFF = 0. - YOFF = 0. - DO 8 I=1, N - XT = X(I) - YT = Y(I) - X(I) = CA*XT + SA*YT + XOFF - Y(I) = CA*YT - SA*XT + YOFF - 8 CONTINUE -C - RETURN - END - - - SUBROUTINE PANGEN(SHOPAR) -C--------------------------------------------------- -C Set paneling distribution from buffer airfoil -C geometry, thus creating current airfoil. -C -C If REFINE=True, bunch points at x=XSREF on -C top side and at x=XPREF on bottom side -C by setting a fictitious local curvature of -C CTRRAT*(LE curvature) there. -C--------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - LOGICAL SHOPAR -C - IF(NB.LT.2) THEN -C WRITE(*,*) 'PANGEN: Buffer airfoil not available.' - N = 0 - RETURN - ENDIF -C -C---- Number of temporary nodes for panel distribution calculation -C exceeds the specified panel number by factor of IPFAC. - IPFAC = 3 -C -C---- number of airfoil panel points - N = NPAN -C -cC---- number of wake points -c NW = NPAN/8 + 2 -c IF(NW.GT.IWX) THEN -c WRITE(*,*) -c & 'Array size (IWX) too small. Last wake point index reduced.' -c NW = IWX -c ENDIF -C -C---- set arc length spline parameter - CALL SCALC(XB,YB,SB,NB) -C -C---- spline raw airfoil coordinates - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C -C---- normalizing length (~ chord) - SBREF = 0.5*(SB(NB)-SB(1)) -C -C---- set up curvature array - DO I = 1, NB - W5(I) = ABS( CURV(SB(I),XB,XBP,YB,YBP,SB,NB) ) * SBREF - ENDDO -C -C---- locate LE point arc length value and the normalized curvature there - CALL LEFIND(SBLE,XB,XBP,YB,YBP,SB,NB) - CVLE = ABS( CURV(SBLE,XB,XBP,YB,YBP,SB,NB) ) * SBREF -C -C---- check for doubled point (sharp corner) at LE - IBLE = 0 - DO I = 1, NB-1 - IF((SBLE.ceq.SB(I)) .AND. (SBLE.ceq.SB(I+1))) THEN - IBLE = I -C WRITE(*,*) -C WRITE(*,*) 'Sharp leading edge' - GO TO 21 - ENDIF - ENDDO - 21 CONTINUE -C -C---- set LE, TE points - XBLE = SEVAL(SBLE,XB,XBP,SB,NB) - YBLE = SEVAL(SBLE,YB,YBP,SB,NB) - XBTE = 0.5*(XB(1)+XB(NB)) - YBTE = 0.5*(YB(1)+YB(NB)) - CHBSQ = (XBTE-XBLE)**2 + (YBTE-YBLE)**2 -C -C---- set average curvature over 2*NK+1 points within Rcurv of LE point - NK = 3 - CVSUM = 0. - DO K = -NK, NK - FRAC = FLOAT(K)/FLOAT(NK) - SBK = SBLE + FRAC*SBREF/MAX(CVLE,20.0) - CVK = ABS( CURV(SBK,XB,XBP,YB,YBP,SB,NB) ) * SBREF - CVSUM = CVSUM + CVK - ENDDO - CVAVG = CVSUM/FLOAT(2*NK+1) -C -C---- dummy curvature for sharp LE - IF(IBLE.cne.0) CVAVG = 10.0 -C -C---- set curvature attraction coefficient actually used - CC = 6.0 * CVPAR -C -C---- set artificial curvature at TE to bunch panels there - CVTE = CVAVG * CTERAT - W5(1) = CVTE - W5(NB) = CVTE -C -C -C**** smooth curvature array for smoother panel size distribution **** -C -CCC CALL ASKR('Enter curvature smoothing length/c^',SMOOL) -CCC SMOOL = 0.010 -C -C---- set smoothing length = 1 / averaged LE curvature, but -C- no more than 5% of chord and no less than 1/4 average panel spacing - SMOOL = MAX( 1.0/MAX(CVAVG,20.0) , 0.25 /FLOAT(NPAN/2) ) -C - SMOOSQ = (SMOOL*SBREF) ** 2 -C -C---- set up tri-diagonal system for smoothed curvatures - W2(1) = 1.0 - W3(1) = 0.0 - DO I=2, NB-1 - DSM = SB(I) - SB(I-1) - DSP = SB(I+1) - SB(I) - DSO = 0.5*(SB(I+1) - SB(I-1)) -C - IF((DSM.ceq.0.0) .OR. (DSP.ceq.0.0)) THEN -C------- leave curvature at corner point unchanged - W1(I) = 0.0 - W2(I) = 1.0 - W3(I) = 0.0 - ELSE - W1(I) = SMOOSQ * ( - 1.0/DSM) / DSO - W2(I) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - W3(I) = SMOOSQ * (-1.0/DSP ) / DSO - ENDIF - ENDDO -C - W1(NB) = 0.0 - W2(NB) = 1.0 -C -C---- fix curvature at LE point by modifying equations adjacent to LE - DO I=2, NB-1 - IF((SB(I).ceq.SBLE) .OR. (I.ceq.IBLE) .OR. (I.ceq.IBLE+1)) THEN -C------- if node falls right on LE point, fix curvature there - W1(I) = 0. - W2(I) = 1.0 - W3(I) = 0. - W5(I) = CVLE - ELSE IF(SB(I-1).LT.SBLE .AND. SB(I).GT.SBLE) THEN -C------- modify equation at node just before LE point - DSM = SB(I-1) - SB(I-2) - DSP = SBLE - SB(I-1) - DSO = 0.5*(SBLE - SB(I-2)) -C - W1(I-1) = SMOOSQ * ( - 1.0/DSM) / DSO - W2(I-1) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - W3(I-1) = 0. - W5(I-1) = W5(I-1) + SMOOSQ*CVLE/(DSP*DSO) -C -C------- modify equation at node just after LE point - DSM = SB(I) - SBLE - DSP = SB(I+1) - SB(I) - DSO = 0.5*(SB(I+1) - SBLE) - W1(I) = 0. - W2(I) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - W3(I) = SMOOSQ * (-1.0/DSP ) / DSO - W5(I) = W5(I) + SMOOSQ*CVLE/(DSM*DSO) -C - GO TO 51 - ENDIF - ENDDO - 51 CONTINUE -C -C---- set artificial curvature at bunching points and fix it there - DO I=2, NB-1 -C------ chord-based x/c coordinate - XOC = ( (XB(I)-XBLE)*(XBTE-XBLE) - & + (YB(I)-YBLE)*(YBTE-YBLE) ) / CHBSQ -C - IF(SB(I).LT.SBLE) THEN -C------- check if top side point is in refinement area - IF(XOC.GT.XSREF1 .AND. XOC.LT.XSREF2) THEN - W1(I) = 0. - W2(I) = 1.0 - W3(I) = 0. - W5(I) = CVLE*CTRRAT - ENDIF - ELSE -C------- check if bottom side point is in refinement area - IF(XOC.GT.XPREF1 .AND. XOC.LT.XPREF2) THEN - W1(I) = 0. - W2(I) = 1.0 - W3(I) = 0. - W5(I) = CVLE*CTRRAT - ENDIF - ENDIF - ENDDO -C -C---- solve for smoothed curvature array W5 - IF(IBLE.ceq.0) THEN - CALL TRISOL(W2,W1,W3,W5,NB) - ELSE - I = 1 - CALL TRISOL(W2(I),W1(I),W3(I),W5(I),IBLE) - I = IBLE+1 - CALL TRISOL(W2(I),W1(I),W3(I),W5(I),NB-IBLE) - ENDIF -C -C---- find max curvature - CVMAX = 0. - DO I=1, NB - CVMAX = MAX( CVMAX , ABS(W5(I)) ) - ENDDO -C -C---- normalize curvature array - DO I=1, NB - W5(I) = W5(I) / CVMAX - ENDDO -C -C---- spline curvature array - CALL SEGSPL(W5,W6,SB,NB) -C -C---- Set initial guess for node positions uniform in s. -C More nodes than specified (by factor of IPFAC) are -C temporarily used for more reliable convergence. - NN = IPFAC*(N-1)+1 -C -C---- ratio of lengths of panel at TE to one away from the TE - RDSTE = 0.667 - RTF = (RDSTE-1.0)*FLOAT(IPFAC) + 1.0 -C - IF(IBLE.ceq.0) THEN -C - DSAVG = (SB(NB)-SB(1))/(FLOAT(NN-3) + 2.0*RTF) - SNEW(1) = SB(1) - DO I=2, NN-1 - SNEW(I) = SB(1) + DSAVG * (FLOAT(I-2) + RTF) - ENDDO - SNEW(NN) = SB(NB) -C - ELSE -C - NFRAC1 = (N * IBLE) / NB -C - NN1 = IPFAC*(NFRAC1-1)+1 - DSAVG1 = (SBLE-SB(1))/(FLOAT(NN1-2) + RTF) - SNEW(1) = SB(1) - DO I=2, NN1 - SNEW(I) = SB(1) + DSAVG1 * (FLOAT(I-2) + RTF) - ENDDO -C - NN2 = NN - NN1 + 1 - DSAVG2 = (SB(NB)-SBLE)/(FLOAT(NN2-2) + RTF) - DO I=2, NN2-1 - SNEW(I-1+NN1) = SBLE + DSAVG2 * (FLOAT(I-2) + RTF) - ENDDO - SNEW(NN) = SB(NB) -C - ENDIF -C -C---- Newton iteration loop for new node positions - DO 10 ITER=1, 20 -C -C------ set up tri-diagonal system for node position deltas - CV1 = SEVAL(SNEW(1),W5,W6,SB,NB) - CV2 = SEVAL(SNEW(2),W5,W6,SB,NB) - CVS1 = DEVAL(SNEW(1),W5,W6,SB,NB) - CVS2 = DEVAL(SNEW(2),W5,W6,SB,NB) -C - CAVM = SQRT(CV1**2 + CV2**2) - IF(CAVM .ceq. 0.0) THEN - CAVM_S1 = 0. - CAVM_S2 = 0. - ELSE - CAVM_S1 = CVS1 * CV1/CAVM - CAVM_S2 = CVS2 * CV2/CAVM - ENDIF -C - DO 110 I=2, NN-1 - DSM = SNEW(I) - SNEW(I-1) - DSP = SNEW(I) - SNEW(I+1) - CV3 = SEVAL(SNEW(I+1),W5,W6,SB,NB) - CVS3 = DEVAL(SNEW(I+1),W5,W6,SB,NB) -C - CAVP = SQRT(CV3**2 + CV2**2) - IF(CAVP .ceq. 0.0) THEN - CAVP_S2 = 0. - CAVP_S3 = 0. - ELSE - CAVP_S2 = CVS2 * CV2/CAVP - CAVP_S3 = CVS3 * CV3/CAVP - ENDIF -C - FM = CC*CAVM + 1.0 - FP = CC*CAVP + 1.0 -C - REZ = DSP*FP + DSM*FM -C -C-------- lower, main, and upper diagonals - W1(I) = -FM + CC* DSM*CAVM_S1 - W2(I) = FP + FM + CC*(DSP*CAVP_S2 + DSM*CAVM_S2) - W3(I) = -FP + CC* DSP*CAVP_S3 -C -C-------- residual, requiring that -C (1 + C*curv)*deltaS is equal on both sides of node i - W4(I) = -REZ -C - CV1 = CV2 - CV2 = CV3 - CVS1 = CVS2 - CVS2 = CVS3 - CAVM = CAVP - CAVM_S1 = CAVP_S2 - CAVM_S2 = CAVP_S3 - 110 CONTINUE -C -C------ fix endpoints (at TE) - W2(1) = 1.0 - W3(1) = 0.0 - W4(1) = 0.0 - W1(NN) = 0.0 - W2(NN) = 1.0 - W4(NN) = 0.0 -C - IF(RTF .cne. 1.0) THEN -C------- fudge equations adjacent to TE to get TE panel length ratio RTF -C - I = 2 - W4(I) = -((SNEW(I) - SNEW(I-1)) + RTF*(SNEW(I) - SNEW(I+1))) - W1(I) = -1.0 - W2(I) = 1.0 + RTF - W3(I) = - RTF -C - I = NN-1 - W4(I) = -((SNEW(I) - SNEW(I+1)) + RTF*(SNEW(I) - SNEW(I-1))) - W3(I) = -1.0 - W2(I) = 1.0 + RTF - W1(I) = - RTF - ENDIF -C -C -C------ fix sharp LE point - IF(IBLE.cne.0) THEN - I = NN1 - W1(I) = 0.0 - W2(I) = 1.0 - W3(I) = 0.0 - W4(I) = SBLE - SNEW(I) - ENDIF -C -C------ solve for changes W4 in node position arc length values - CALL TRISOL(W2,W1,W3,W4,NN) -C -C------ find under-relaxation factor to keep nodes from changing order - RLX = 1.0 - DMAX = 0.0 - DO I=1, NN-1 - DS = SNEW(I+1) - SNEW(I) - DDS = W4(I+1) - W4(I) - DSRAT = 1.0 + RLX*DDS/DS - IF(DSRAT.GT.4.0) RLX = (4.0-1.0)*DS/DDS - IF(DSRAT.LT.0.2) RLX = (0.2-1.0)*DS/DDS - DMAX = MAX(ABS(W4(I)),DMAX) - ENDDO -C -C------ update node position - DO I=2, NN-1 - SNEW(I) = SNEW(I) + RLX*W4(I) - ENDDO -C -CCC IF(RLX.EQ.1.0) WRITE(*,*) DMAX -CCC IF(RLX.NE.1.0) WRITE(*,*) DMAX,' RLX =',RLX - IF(ABS(DMAX).LT.1.E-3) GO TO 11 - 10 CONTINUE - WRITE(*,*) 'Paneling convergence failed. Continuing anyway...' -C - 11 CONTINUE -C -C---- set new panel node coordinates - DO I=1, N - IND = IPFAC*(I-1) + 1 - S(I) = SNEW(IND) - X(I) = SEVAL(SNEW(IND),XB,XBP,SB,NB) - Y(I) = SEVAL(SNEW(IND),YB,YBP,SB,NB) - ENDDO -C -C -C---- go over buffer airfoil again, checking for corners (double points) - NCORN = 0 - DO 25 IB=1, NB-1 - IF(SB(IB) .ceq. SB(IB+1)) THEN -C------- found one ! -C - NCORN = NCORN+1 - XBCORN = XB(IB) - YBCORN = YB(IB) - SBCORN = SB(IB) -C -C------- find current-airfoil panel which contains corner - DO 252 I=1, N -C -C--------- keep stepping until first node past corner - IF(S(I) .LE. SBCORN) GO TO 252 -C -C---------- move remainder of panel nodes to make room for additional node - DO 2522 J=N, I, -1 - X(J+1) = X(J) - Y(J+1) = Y(J) - S(J+1) = S(J) - 2522 CONTINUE - N = N+1 -C - IF(N .GT. IQX-1) - & STOP 'PANEL: Too many panels. Increase IQX in XFOIL.INC' -C - X(I) = XBCORN - Y(I) = YBCORN - S(I) = SBCORN -C -C---------- shift nodes adjacent to corner to keep panel sizes comparable - IF(I-2 .GE. 1) THEN - S(I-1) = 0.5*(S(I) + S(I-2)) - X(I-1) = SEVAL(S(I-1),XB,XBP,SB,NB) - Y(I-1) = SEVAL(S(I-1),YB,YBP,SB,NB) - ENDIF -C - IF(I+2 .LE. N) THEN - S(I+1) = 0.5*(S(I) + S(I+2)) - X(I+1) = SEVAL(S(I+1),XB,XBP,SB,NB) - Y(I+1) = SEVAL(S(I+1),YB,YBP,SB,NB) - ENDIF -C -C---------- go on to next input geometry point to check for corner - GO TO 25 -C - 252 CONTINUE - ENDIF - 25 CONTINUE -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) - CALL LEFIND(SLE,X,XP,Y,YP,S,N) -C - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT( (XTE-XLE)**2 + (YTE-YLE)**2 ) -C -C---- calculate panel size ratios (user info) - DSMIN = 1000.0 - DSMAX = -1000.0 - DO 40 I=1, N-1 - DS = S(I+1)-S(I) - IF(DS .ceq. 0.0) GO TO 40 - DSMIN = MIN(DSMIN,DS) - DSMAX = MAX(DSMAX,DS) - 40 CONTINUE -C - DSMIN = DSMIN*FLOAT(N-1)/S(N) - DSMAX = DSMAX*FLOAT(N-1)/S(N) -ccc WRITE(*,*) 'DSmin/DSavg = ',DSMIN,' DSmax/DSavg = ',DSMAX -C -C---- set various flags for new airfoil - LGAMU = .FALSE. - LQINU = .FALSE. - LWAKE = .FALSE. - LQAIJ = .FALSE. - LADIJ = .FALSE. - LWDIJ = .FALSE. - LIPAN = .FALSE. - LBLINI = .FALSE. - LVCONV = .FALSE. - LSCINI = .FALSE. - LQSPEC = .FALSE. - LGSAME = .FALSE. -C - IF(LBFLAP) THEN - XOF = XBF - YOF = YBF - LFLAP = .TRUE. - ENDIF -C -C---- determine if TE is blunt or sharp, calculate TE geometry parameters - CALL TECALC -C -C---- calculate normal vectors - CALL NCALC(X,Y,S,N,NX,NY) -C -C---- calculate panel angles for panel routines - CALL APCALC -C - IF(SHARP) THEN -C WRITE(*,1090) 'Sharp trailing edge' - ELSE - GAP = SQRT((X(1)-X(N))**2 + (Y(1)-Y(N))**2) -C WRITE(*,1090) 'Blunt trailing edge. Gap =', GAP - ENDIF - 1090 FORMAT(/1X,A,F9.5) -C -C IF(SHOPAR) WRITE(*,1100) NPAN, CVPAR, CTERAT, CTRRAT, -C & XSREF1, XSREF2, XPREF1, XPREF2 -C 1100 FORMAT(/' Paneling parameters used...' -C & /' Number of panel nodes ' , I4 -C & /' Panel bunching parameter ' , F6.3 -C & /' TE/LE panel density ratio ' , F6.3 -C & /' Refined-area/LE panel density ratio ' , F6.3 -C & /' Top side refined area x/c limits ' , 2F6.3 -C & /' Bottom side refined area x/c limits ' , 2F6.3) -C - RETURN - END ! PANGEN - - - -c SUBROUTINE GETPAN -c INCLUDE 'XFOIL.INC' -c LOGICAL LCHANGE -c CHARACTER*4 VAR -c CHARACTER*128 COMARG -C -c DIMENSION IINPUT(20) -c DIMENSION RINPUT(20) -c LOGICAL ERROR -C -c IF(NB.LE.1) THEN -c WRITE(*,*) 'GETPAN: Buffer airfoil not available.' -c RETURN -c ENDIF -C -c 5 CONTINUE -c IF(N.LE.1) THEN -c WRITE(*,*) 'No current airfoil to plot' -c ELSE -c CALL PANPLT -c ENDIF -c LCHANGE = .FALSE. -cC -c 10 WRITE(*,1000) NPAN, CVPAR, CTERAT, CTRRAT, -c & XSREF1, XSREF2, XPREF1, XPREF2 -c 1000 FORMAT( -c & /' Present paneling parameters...' -c & /' N i Number of panel nodes ' , I4 -c & /' P r Panel bunching parameter ' , F6.3 -c & /' T r TE/LE panel density ratio ' , F6.3 -c & /' R r Refined area/LE panel density ratio ' , F6.3 -c & /' XT rr Top side refined area x/c limits ' , 2F6.3 -c & /' XB rr Bottom side refined area x/c limits ' , 2F6.3 -c & /' Z oom' -c & /' U nzoom' ) -cC -c 12 CALL ASKC('Change what ? ( if nothing else)^',VAR,COMARG) -cC -c IF(VAR.EQ.'Z ') THEN -c CALL USETZOOM(.TRUE.,.TRUE.) -c CALL REPLOT(IDEV) -c GO TO 12 -c ENDIF -cC -c IF(VAR.EQ.'U ') THEN -c CALL CLRZOOM -c CALL REPLOT(IDEV) -c GO TO 12 -c ENDIF -cC -cC -c DO I=1, 20 -c IINPUT(I) = 0 -c RINPUT(I) = 0.0 -c ENDDO -c NINPUT = 0 -c CALL GETINT(COMARG,IINPUT,NINPUT,ERROR) -c NINPUT = 0 -c CALL GETFLT(COMARG,RINPUT,NINPUT,ERROR) -cC -c IF (VAR.EQ.' ') THEN -cC -c IF(LCHANGE) THEN -cC -cC-------- set new panel distribution, and display max panel corner angle -c CALL PANGEN(.FALSE.) -c IF(N.GT.0) CALL CANG(X,Y,N,1,IMAX,AMAX) -cC -cC-------- go back to paneling menu -c GO TO 5 -c ENDIF -cC -c CALL CLRZOOM -c RETURN -cC -c ELSE IF(VAR.EQ.'N ' .OR. VAR.EQ.'n ') THEN -cC -c IF(NINPUT.GE.1) THEN -c NPAN = IINPUT(1) -c ELSE -c CALL ASKI('Enter number of panel nodes^',NPAN) -c ENDIF -c IF(NPAN .GT. IQX-6) THEN -c NPAN = IQX - 6 -c WRITE(*,1200) NPAN -c 1200 FORMAT(1X,' Number of panel nodes reduced to array limit:',I4) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'P ' .OR. VAR.EQ.'p ') THEN -cC -c IF(NINPUT.GE.1) THEN -c CVPAR = RINPUT(1) -c ELSE -c CALL ASKR('Enter panel bunching parameter (0 to ~1)^',CVPAR) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'T ' .OR. VAR.EQ.'t ') THEN -cC -c IF(NINPUT.GE.1) THEN -c CTERAT = RINPUT(1) -c ELSE -c CALL ASKR('Enter TE/LE panel density ratio^',CTERAT) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'R ' .OR. VAR.EQ.'r ') THEN -cC -c IF(NINPUT.GE.1) THEN -c CTRRAT = RINPUT(1) -c ELSE -c CALL ASKR('Enter refined-area panel density ratio^',CTRRAT) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'XT ' .OR. VAR.EQ.'xt ') THEN -cC -c IF(NINPUT.GE.2) THEN -c XSREF1 = RINPUT(1) -c XSREF2 = RINPUT(2) -c ELSE -c CALL ASKR('Enter left top side refinement limit^',XSREF1) -c CALL ASKR('Enter right top side refinement limit^',XSREF2) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE IF(VAR.EQ.'XB ' .OR. VAR.EQ.'xb ') THEN -cC -c IF(NINPUT.GE.2) THEN -c XPREF1 = RINPUT(1) -c XPREF2 = RINPUT(2) -c ELSE -c CALL ASKR('Enter left bottom side refinement limit^',XPREF1) -c CALL ASKR('Enter right bottom side refinement limit^',XPREF2) -c ENDIF -c LCHANGE = .TRUE. -cC -c ELSE -cC -c WRITE(*,*) -c WRITE(*,*) '*** Input not recognized ***' -c GO TO 10 -cC -c ENDIF -cC -c GO TO 12 -cC -c END ! GETPAN - - - SUBROUTINE TECALC -C------------------------------------------- -C Calculates total and projected TE gap -C areas and TE panel strengths. -C------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- set TE base vector and TE bisector components - DXTE = X(1) - X(N) - DYTE = Y(1) - Y(N) - DXS = 0.5*(-XP(1) + XP(N)) - DYS = 0.5*(-YP(1) + YP(N)) -C -C---- normal and streamwise projected TE gap areas - ANTE = DXS*DYTE - DYS*DXTE - ASTE = DXS*DXTE + DYS*DYTE -C -C---- total TE gap area - DSTE = SQRT(DXTE**2 + DYTE**2) -C - SHARP = DSTE .LT. 0.0001*CHORD -C - IF(SHARP) THEN - SCS = 1.0 - SDS = 0.0 - ELSE - SCS = ANTE/DSTE - SDS = ASTE/DSTE - ENDIF -C -C---- TE panel source and vorticity strengths - SIGTE = 0.5*(GAM(1) - GAM(N))*SCS - GAMTE = -.5*(GAM(1) - GAM(N))*SDS -C - SIGTE_A = 0.5*(GAM_A(1) - GAM_A(N))*SCS - GAMTE_A = -.5*(GAM_A(1) - GAM_A(N))*SDS -C - RETURN - END ! TECALC - - - - SUBROUTINE INTE -C----------------------------------------------------------- -C Interpolates two airfoils into an intermediate shape. -C Extrapolation is also possible to a reasonable extent. -C----------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*2 CAIR - INTEGER CNINT(2) - complex SINT(IBX,2), - & XINT(IBX,2), XPINT(IBX,2), - & YINT(IBX,2), YPINT(IBX,2), - & SLEINT(2) - CHARACTER*20 PROMPTN - CHARACTER*48 NAMEINT(2) - CHARACTER*80 ISPARST -C - LU = 21 -C - 1000 FORMAT(A) -C - WRITE(*,1100) NAME - DO IP=1, NPOL - IF(NXYPOL(IP).GT.0) THEN - WRITE(*,1200) IP, NAMEPOL(IP) - ENDIF - ENDDO - IF (NPOL.ceq.0) THEN - PROMPTN = '" ( F C ): ' - NPR = 12 - ELSEIF(NPOL.ceq.1) THEN - PROMPTN = '" ( F C 1 ): ' - NPR = 14 - ELSEIF(NPOL.ceq.2) THEN - PROMPTN = '" ( F C 1 2 ): ' - NPR = 16 - ELSE - PROMPTN = '" ( F C 1 2.. ): ' - NPR = 18 - ENDIF -C - 1100 FORMAT(/ ' F disk file' - & / ' C current airfoil ', A) - 1200 FORMAT( 1X,I2,' polar airfoil ', A) -C - 2100 FORMAT(/' Select source of airfoil "',I1, A, $) -C - DO 40 K = 1, 2 - IAIR = K - 1 - 20 WRITE(*,2100) IAIR, PROMPTN(1:NPR) - READ(*,1000) CAIR -C - IF (INDEX('Ff',CAIR(1:1)).cne.0) THEN - CALL ASKS('Enter filename^',FNAME) - CALL AREAD(LU,FNAME,IBX, - & XINT(1,K),YINT(1,K),CNINT(K), - & NAMEINT(K),ISPARST,ITYPE,0) - IF(ITYPE.ceq.0) RETURN -C - ELSEIF(INDEX('Cc',CAIR(1:1)).cne.0) THEN - IF(N.LE.1) THEN - WRITE(*,*) 'No current airfoil available' - GO TO 20 - ENDIF -C - CNINT(K) = N - DO I = 1, N - XINT(I,K) = X(I) - YINT(I,K) = Y(I) - ENDDO - NAMEINT(K) = NAME -C - ELSE - READ(CAIR,*,ERR=90) IP - IF(IP.LT.1 .OR. IP.GT.NPOL) THEN - GO TO 90 - ELSEIF(NXYPOL(IP).LE.0) THEN - GO TO 90 - ELSE - CNINT(K) = NXYPOL(IP) - DO I = 1, N - XINT(I,K) = CPOLXY(I,1,IP) - YINT(I,K) = CPOLXY(I,2,IP) - ENDDO - ENDIF - NAMEINT(K) = NAMEPOL(IP) -C - ENDIF -C - CALL SCALC(XINT(1,K),YINT(1,K),SINT(1,K),CNINT(K)) - CALL SEGSPLD(XINT(1,K),XPINT(1,K),SINT(1,K),CNINT(K),-999.,-999.) - CALL SEGSPLD(YINT(1,K),YPINT(1,K),SINT(1,K),CNINT(K),-999.,-999.) - CALL LEFIND(SLEINT(K), - & XINT(1,K),XPINT(1,K), - & YINT(1,K),YPINT(1,K),SINT(1,K),CNINT(K)) - 40 CONTINUE -C - WRITE(*,*) - WRITE(*,*) 'airfoil "0": ', NAMEINT(1) - WRITE(*,*) 'airfoil "1": ', NAMEINT(2) - FRAC = 0.5 - CALL ASKR('Specify interpolating fraction 0...1^',FRAC) -C - CALL INTER(XINT(1,1),XPINT(1,1), - & YINT(1,1),YPINT(1,1),SINT(1,1),CNINT(1),SLEINT(1), - & XINT(1,2),XPINT(1,2), - & YINT(1,2),YPINT(1,2),SINT(1,2),CNINT(2),SLEINT(2), - & XB,YB,NB,FRAC) -C - CALL SCALC(XB,YB,SB,NB) - CALL SEGSPL(XB,XBP,SB,NB) - CALL SEGSPL(YB,YBP,SB,NB) -C - CALL GEOPAR(XB,XBP,YB,YBP,SB,NB, W1, - & SBLE,CHORDB,AREAB,RADBLE,ANGBTE, - & EI11BA,EI22BA,APX1BA,APX2BA, - & EI11BT,EI22BT,APX1BT,APX2BT, - & THICKB,CAMBRB ) -C - CALL ASKS('Enter new airfoil name^',NAME) - WRITE(*,*) - WRITE(*,*) 'Result has been placed in buffer airfoil' - WRITE(*,*) 'Execute PCOP or PANE to set new current airfoil' - RETURN -C - 90 CONTINUE - WRITE(*,*) - WRITE(*,*) 'Invalid response' - RETURN - END ! INTE diff --git a/deps/src/xfoil_cs/c_xgdes.f b/deps/src/xfoil_cs/c_xgdes.f deleted file mode 100644 index dfcecc4..0000000 --- a/deps/src/xfoil_cs/c_xgdes.f +++ /dev/null @@ -1,127 +0,0 @@ -C*********************************************************************** -C Module: xgdes.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE ABCOPY(LCONF) - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - LOGICAL LCONF -C - IF(NB.LE.1) THEN - WRITE(*,*) 'ABCOPY: Buffer airfoil not available.' - RETURN - ELSEIF(NB.GT.IQX-5) THEN - WRITE(*,*) 'Maximum number of panel nodes : ',IQX-5 - WRITE(*,*) 'Number of buffer airfoil points: ',NB - WRITE(*,*) 'Current airfoil cannot be set.' - WRITE(*,*) 'Try executing PANE at Top Level instead.' - RETURN - ENDIF - IF(N.cne.NB) LBLINI = .FALSE. -C - N = NB - DO 101 I=1, N - X(I) = XB(I) - Y(I) = YB(I) - 101 CONTINUE - LGSAME = .TRUE. -C - IF(LBFLAP) THEN - XOF = XBF - YOF = YBF - LFLAP = .TRUE. - ENDIF -C -C---- strip out doubled points - I = 1 - 102 CONTINUE - I = I+1 - IF((X(I-1).ceq.X(I)) .AND. (Y(I-1).ceq.Y(I))) THEN - DO 104 J=I, N-1 - X(J) = X(J+1) - Y(J) = Y(J+1) - 104 CONTINUE - N = N-1 - ENDIF - IF(I.LT.N) GO TO 102 -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) - CALL NCALC(X,Y,S,N,NX,NY) - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT( (XTE-XLE)**2 + (YTE-YLE)**2 ) - CALL TECALC - CALL APCALC -C - LGAMU = .FALSE. - LQINU = .FALSE. - LWAKE = .FALSE. - LQAIJ = .FALSE. - LADIJ = .FALSE. - LWDIJ = .FALSE. - LIPAN = .FALSE. - LVCONV = .FALSE. - LSCINI = .FALSE. -CCC LBLINI = .FALSE. -C -C IF(LCONF) WRITE(*,1200) N -C 1200 FORMAT(/' Current airfoil nodes set from buffer airfoil nodes (', -C & I4,' )') -C - RETURN - END ! ABCOPY - - - SUBROUTINE GETXYF(X,XP,Y,YP,S,N, TOPS,BOTS,XF,YF) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N),XP(N),Y(N),YP(N),S(N) -C - IF(XF .ceq. -999.0) - & CALL ASKR('Enter flap hinge x location^',XF) -C -C---- find top and bottom y at hinge x location - TOPS = S(1) + (X(1) - XF) - BOTS = S(N) - (X(N) - XF) - CALL SINVRT(TOPS,XF,X,XP,S,N) - CALL SINVRT(BOTS,XF,X,XP,S,N) - TOPY = SEVAL(TOPS,Y,YP,S,N) - BOTY = SEVAL(BOTS,Y,YP,S,N) -C - WRITE(*,1000) TOPY, BOTY - 1000 FORMAT(/' Top surface: y =', F8.4,' y/t = 1.0' - & /' Bottom surface: y =', F8.4,' y/t = 0.0') -C - IF(YF .ceq. -999.0) - & CALL ASKR( - & 'Enter flap hinge y location (or 999 to specify y/t)^',YF) -C - IF(YF .ceq. 999.0) THEN - CALL ASKR('Enter flap hinge relative y/t location^',YREL) - YF = TOPY*YREL + BOTY*(1.0-YREL) - ENDIF -C - RETURN - END ! GETXYF diff --git a/deps/src/xfoil_cs/c_xgeom.f b/deps/src/xfoil_cs/c_xgeom.f deleted file mode 100644 index da2bd86..0000000 --- a/deps/src/xfoil_cs/c_xgeom.f +++ /dev/null @@ -1,1450 +0,0 @@ -C*********************************************************************** -C Module: xgeom.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - SUBROUTINE LEFIND(SLE,X,XP,Y,YP,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C------------------------------------------------------ -C Locates leading edge spline-parameter value SLE -C -C The defining condition is -C -C (X-XTE,Y-YTE) . (X',Y') = 0 at S = SLE -C -C i.e. the surface tangent is normal to the chord -C line connecting X(SLE),Y(SLE) and the TE point. -C------------------------------------------------------ -C -C---- convergence tolerance - DSEPS = (S(N)-S(1)) * 1.0E-5 -C -C---- set trailing edge point coordinates - XTE = 0.5*(X(1) + X(N)) - YTE = 0.5*(Y(1) + Y(N)) -C -C---- get first guess for SLE - DO 10 I=3, N-2 - DXTE = X(I) - XTE - DYTE = Y(I) - YTE - DX = X(I+1) - X(I) - DY = Y(I+1) - Y(I) - DOTP = DXTE*DX + DYTE*DY - IF(DOTP .LT. 0.0) GO TO 11 - 10 CONTINUE -C - 11 SLE = S(I) -C -C---- check for sharp LE case - IF(S(I) .ceq. S(I-1)) THEN -ccc WRITE(*,*) 'Sharp LE found at ',I,SLE - RETURN - ENDIF -C -C---- Newton iteration to get exact SLE value - DO 20 ITER=1, 50 - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - DXDS = DEVAL(SLE,X,XP,S,N) - DYDS = DEVAL(SLE,Y,YP,S,N) - DXDD = D2VAL(SLE,X,XP,S,N) - DYDD = D2VAL(SLE,Y,YP,S,N) -C - XCHORD = XLE - XTE - YCHORD = YLE - YTE -C -C------ drive dot product between chord line and LE tangent to zero - RES = XCHORD*DXDS + YCHORD*DYDS - RESS = DXDS *DXDS + DYDS *DYDS - & + XCHORD*DXDD + YCHORD*DYDD -C -C------ Newton delta for SLE - DSLE = -RES/RESS -C - DSLE = MAX( DSLE , -0.02*ABS(XCHORD+YCHORD) ) - DSLE = MIN( DSLE , 0.02*ABS(XCHORD+YCHORD) ) - SLE = SLE + DSLE - IF(ABS(DSLE) .LT. DSEPS) RETURN - 20 CONTINUE - WRITE(*,*) 'LEFIND: LE point not found. Continuing...' - SLE = S(I) - RETURN - END - - - - SUBROUTINE XLFIND(SLE,X,XP,Y,YP,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C------------------------------------------------------ -C Locates leftmost (minimum x) point location SLE -C -C The defining condition is -C -C X' = 0 at S = SLE -C -C i.e. the surface tangent is vertical -C------------------------------------------------------ -C - DSLEN = S(N) - S(1) -C -C---- convergence tolerance - DSEPS = (S(N)-S(1)) * 1.0E-5 -C -C---- get first guess for SLE - DO 10 I=3, N-2 - DX = X(I+1) - X(I) - IF(DX .GT. 0.0) GO TO 11 - 10 CONTINUE -C - 11 SLE = S(I) -C -C---- check for sharp LE case - IF(S(I) .ceq. S(I-1)) THEN -ccc WRITE(*,*) 'Sharp LE found at ',I,SLE - RETURN - ENDIF -C -C---- Newton iteration to get exact SLE value - DO 20 ITER=1, 50 - DXDS = DEVAL(SLE,X,XP,S,N) - DXDD = D2VAL(SLE,X,XP,S,N) -C -C------ drive DXDS to zero - RES = DXDS - RESS = DXDD -C -C------ Newton delta for SLE - DSLE = -RES/RESS -C - DSLE = MAX( DSLE , -0.01*ABS(DSLEN) ) - DSLE = MIN( DSLE , 0.01*ABS(DSLEN) ) - SLE = SLE + DSLE - IF(ABS(DSLE) .LT. DSEPS) RETURN - 20 CONTINUE - WRITE(*,*) 'XLFIND: Left point not found. Continuing...' - SLE = S(I) - RETURN - END ! XLFIND - - - - SUBROUTINE NSFIND(SLE,X,XP,Y,YP,S,N) - use complexify - implicit complex(a-h, o-z) - complex X(*),Y(*),S(*),XP(*),YP(*) -C---------------------------------------------------------- -C Finds "nose" of airfoil where curvature is a maximum -C---------------------------------------------------------- -C - PARAMETER (NMAX=500) - DIMENSION A(NMAX), B(NMAX), C(NMAX), CV(NMAX) -C - IF(N.GT.NMAX) STOP 'NSFIND: Local array overflow. Increase NMAX.' -C -C---- set up curvature array - DO 3 I=1, N - CV(I) = CURV(S(I),X,XP,Y,YP,S,N) - 3 CONTINUE -C -C---- curvature smoothing length - SMOOL = 0.006*(S(N)-S(1)) -C -C---- set up tri-diagonal system for smoothed curvatures - SMOOSQ = SMOOL**2 - A(1) = 1.0 - C(1) = 0.0 - DO 4 I=2, N-1 - DSM = S(I) - S(I-1) - DSP = S(I+1) - S(I) - DSO = 0.5*(S(I+1) - S(I-1)) -C - IF((DSM.ceq.0.0) .OR. (DSP.ceq.0.0)) THEN -C------- leave curvature at corner point unchanged - B(I) = 0.0 - A(I) = 1.0 - C(I) = 0.0 - ELSE - B(I) = SMOOSQ * ( - 1.0/DSM) / DSO - A(I) = SMOOSQ * ( 1.0/DSP + 1.0/DSM) / DSO + 1.0 - C(I) = SMOOSQ * (-1.0/DSP ) / DSO - ENDIF - 4 CONTINUE - B(N) = 0.0 - A(N) = 1.0 -C - CALL TRISOL(A,B,C,CV,N) -C -C---- find max curvature index - CVMAX = 0. - IVMAX = 0 - DO 71 I=2, N-1 - IF(ABS(CV(I)) .GT. CVMAX) THEN - CVMAX = ABS(CV(I)) - IVMAX = I - ENDIF - 71 CONTINUE -C -C---- fit a parabola to the curvature at the three points near maximum - I = IVMAX -C - IP = I+1 - IM = I-1 - IF(S(I) .ceq. S(IP)) IP = I+2 - IF(S(I) .ceq. S(IM)) IM = I-2 - - DSM = S(I) - S(IM) - DSP = S(IP) - S(I) -C - CVSM = (CV(I)-CV(IM))/DSM - CVSP = (CV(IP)-CV(I))/DSP -C -C---- 1st and 2nd derivatives at i=IVMAX - CVS = (CVSM*DSP + CVSP*DSM)/(DSP+DSM) - CVSS = 2.0*(CVSP-CVSM)/(DSP+DSM) -C -C---- set location of arc length at maximum of parabola - DS = -CVS/CVSS - SLE = S(I) + DS -C - RETURN - END - - - SUBROUTINE SOPPS(SOPP, SI, X,XP,Y,YP,S,N, SLE) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C-------------------------------------------------- -C Calculates arc length SOPP of point -C which is opposite of point SI, on the -C other side of the airfoil baseline -C-------------------------------------------------- -C -C---- reference length for testing convergence - SLEN = S(N) - S(1) -C -C---This fails miserably with sharp LE foils, tsk,tsk,tsk HHY 4/24/01 -C---- set baseline vector normal to surface at LE point -c DXC = -DEVAL(SLE,Y,YP,S,N) -c DYC = DEVAL(SLE,X,XP,S,N) -c DSC = SQRT(DXC**2 + DYC**2) -c DXC = DXC/DSC -c DYC = DYC/DSC -C -C---Rational alternative 4/24/01 HHY - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT((XTE-XLE)**2 + (YTE-YLE)**2) -C---- set unit chord-line vector - DXC = (XTE-XLE) / CHORD - DYC = (YTE-YLE) / CHORD -C -C - IF(SI.LT.SLE) THEN - IN = 1 - INOPP = N - ELSE - IN = N - INOPP = 1 - ENDIF - SFRAC = (SI-SLE)/(S(IN)-SLE) - SOPP = SLE + SFRAC*(S(INOPP)-SLE) -C - - IF(ABS(SFRAC) .LE. 1.0E-5) THEN - SOPP = SLE - RETURN - ENDIF -C -C---- XBAR = x coordinate in chord-line axes - XI = SEVAL(SI , X,XP,S,N) - YI = SEVAL(SI , Y,YP,S,N) - XLE = SEVAL(SLE, X,XP,S,N) - YLE = SEVAL(SLE, Y,YP,S,N) - XBAR = (XI-XLE)*DXC + (YI-YLE)*DYC -C -C---- converge on exact opposite point with same XBAR value - DO 300 ITER=1, 12 - XOPP = SEVAL(SOPP,X,XP,S,N) - YOPP = SEVAL(SOPP,Y,YP,S,N) - XOPPD = DEVAL(SOPP,X,XP,S,N) - YOPPD = DEVAL(SOPP,Y,YP,S,N) -C - RES = (XOPP -XLE)*DXC + (YOPP -YLE)*DYC - XBAR - RESD = XOPPD *DXC + YOPPD *DYC -C - IF(ABS(RES)/SLEN .LT. 1.0E-5) GO TO 305 - IF(RESD .ceq. 0.0) GO TO 303 -C - DSOPP = -RES/RESD - SOPP = SOPP + DSOPP -C -c write(*,*) abs(SFRAC)/slen - - IF(ABS(DSOPP)/SLEN .LT. 1.0E-5) GO TO 305 - 300 CONTINUE - 303 WRITE(*,*) - & 'SOPPS: Opposite-point location failed. Continuing...' - SOPP = SLE + SFRAC*(S(INOPP)-SLE) -C - 305 CONTINUE - RETURN - END ! SOPPS - - - - SUBROUTINE NORM(X,XP,Y,YP,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C----------------------------------------------- -C Scales coordinates to get unit chord -C----------------------------------------------- -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) -C - CALL LEFIND(SLE,X,XP,Y,YP,S,N) -C - XMAX = 0.5*(X(1) + X(N)) - XMIN = SEVAL(SLE,X,XP,S,N) - YMIN = SEVAL(SLE,Y,YP,S,N) -C - FUDGE = 1.0/(XMAX-XMIN) - DO 40 I=1, N - X(I) = (X(I)-XMIN)*FUDGE - Y(I) = (Y(I)-YMIN)*FUDGE - S(I) = S(I)*FUDGE - 40 CONTINUE -C - RETURN - END - - -C*************************************************************************** -C -C GEOPAR -> Feeds into NACA Subroutine in xfoil.f -C -C*************************************************************************** - SUBROUTINE GEOPAR(X,XP,Y,YP,S,N, T, - & SLE,CHORD,AREA,RADLE,ANGTE, - & EI11A,EI22A,APX1A,APX2A, - & EI11T,EI22T,APX1T,APX2T, - & THICK,CAMBR) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*), XP(*), Y(*), YP(*), S(*), T(*) -C - PARAMETER (IBX=600) - DIMENSION - & XCAM(2*IBX), YCAM(2*IBX), YCAMP(2*IBX), - & XTHK(2*IBX), YTHK(2*IBX), YTHKP(2*IBX) -C------------------------------------------------------ -C Sets geometric parameters for airfoil shape -C------------------------------------------------------ - CALL LEFIND(SLE,X,XP,Y,YP,S,N) -C - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) -C - CHSQ = (XTE-XLE)**2 + (YTE-YLE)**2 - CHORD = SQRT(CHSQ) -C - CURVLE = CURV(SLE,X,XP,Y,YP,S,N) -C - RADLE = 0.0 - IF(ABS(CURVLE) .GT. 0.001*(S(N)-S(1))) RADLE = 1.0 / CURVLE -C - ANG1 = ATAN2( -YP(1) , -XP(1) ) - ANG2 = ATANC( YP(N) , XP(N) , ANG1 ) - ANGTE = ANG2 - ANG1 -C - - DO I=1, N - T(I) = 1.0 - ENDDO -C - CALL AECALC(N,X,Y,T, 1, - & AREA,XCENA,YCENA,EI11A,EI22A,APX1A,APX2A) -C - CALL AECALC(N,X,Y,T, 2, - & SLEN,XCENT,YCENT,EI11T,EI22T,APX1T,APX2T) -C -C--- Old, approximate thickness,camber routine (on discrete points only) - CALL TCCALC(X,XP,Y,YP,S,N, THICK,XTHICK, CAMBR,XCAMBR ) -C -C--- More accurate thickness and camber estimates -cc CALL GETCAM(XCAM,YCAM,NCAM,XTHK,YTHK,NTHK, -cc & X,XP,Y,YP,S,N ) -cc CALL GETMAX(XCAM,YCAM,YCAMP,NCAM,XCAMBR,CAMBR) -cc CALL GETMAX(XTHK,YTHK,YTHKP,NTHK,XTHICK,THICK) -cc THICK = 2.0*THICK -C -C WRITE(*,1000) THICK,XTHICK,CAMBR,XCAMBR -C 1000 FORMAT( ' Max thickness = ',F12.6,' at x = ',F7.3, -C & /' Max camber = ',F12.6,' at x = ',F7.3) - - -C - RETURN - END ! GEOPAR -C -C********************************************************************* - - SUBROUTINE AECALC(N,X,Y,T, ITYPE, - & AREA,XCEN,YCEN,EI11,EI22,APX1,APX2) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),Y(*),T(*) -C--------------------------------------------------------------- -C Calculates geometric properties of shape X,Y -C -C Input: -C N number of points -C X(.) shape coordinate point arrays -C Y(.) -C T(.) skin-thickness array, used only if ITYPE = 2 -C ITYPE = 1 ... integration is over whole area dx dy -C = 2 ... integration is over skin area t ds -C -C Output: -C XCEN,YCEN centroid location -C EI11,EI22 principal moments of inertia -C APX1,APX2 principal-axis angles -C--------------------------------------------------------------- - DATA PI / 3.141592653589793238 / -C - SINT = 0.0 - AINT = 0.0 - XINT = 0.0 - YINT = 0.0 - XXINT = 0.0 - XYINT = 0.0 - YYINT = 0.0 -C - DO 10 IO = 1, N - IF(IO.ceq.N) THEN - IP = 1 - ELSE - IP = IO + 1 - ENDIF -C - DX = X(IO) - X(IP) - DY = Y(IO) - Y(IP) - XA = (X(IO) + X(IP))*0.50 - YA = (Y(IO) + Y(IP))*0.50 - TA = (T(IO) + T(IP))*0.50 -C - DS = SQRT(DX*DX + DY*DY) - SINT = SINT + DS - - IF(ITYPE.ceq.1) THEN -C-------- integrate over airfoil cross-section - DA = YA*DX - AINT = AINT + DA - XINT = XINT + XA *DA - YINT = YINT + YA *DA/2.0 - XXINT = XXINT + XA*XA*DA - XYINT = XYINT + XA*YA*DA/2.0 - YYINT = YYINT + YA*YA*DA/3.0 - ELSE -C-------- integrate over skin thickness - DA = TA*DS - AINT = AINT + DA - XINT = XINT + XA *DA - YINT = YINT + YA *DA - XXINT = XXINT + XA*XA*DA - XYINT = XYINT + XA*YA*DA - YYINT = YYINT + YA*YA*DA - ENDIF -C - 10 CONTINUE -C - AREA = AINT -C - IF(AINT .ceq. 0.0) THEN - XCEN = 0.0 - YCEN = 0.0 - EI11 = 0.0 - EI22 = 0.0 - APX1 = 0.0 - APX2 = ATAN2(1.0,0.0) - RETURN - ENDIF -C -C -C---- calculate centroid location - XCEN = XINT/AINT - YCEN = YINT/AINT -C -C---- calculate inertias - EIXX = YYINT - YCEN*YCEN*AINT - EIXY = XYINT - XCEN*YCEN*AINT - EIYY = XXINT - XCEN*XCEN*AINT -C -C---- set principal-axis inertias, EI11 is closest to "up-down" bending inertia - EISQ = 0.25*(EIXX - EIYY)**2 + EIXY**2 - SGN = SIGN( 1.0 , EIYY-EIXX ) - EI11 = 0.5*(EIXX + EIYY) - SGN*SQRT(EISQ) - EI22 = 0.5*(EIXX + EIYY) + SGN*SQRT(EISQ) -C - IF((EI11.ceq.0.0) .OR. (EI22.ceq.0.0)) THEN -C----- vanishing section stiffness - APX1 = 0.0 - APX2 = ATAN2(1.0,0.0) -C - ELSEIF(EISQ/(EI11*EI22) .LT. (0.001*SINT)**4) THEN -C----- rotationally-invariant section (circle, square, etc.) - APX1 = 0.0 - APX2 = ATAN2(1.0,0.0) -C - ELSE -C----- normal airfoil section - C1 = EIXY - S1 = EIXX-EI11 -C - C2 = EIXY - S2 = EIXX-EI22 -C - IF(ABS(S1).GT.ABS(S2)) THEN - APX1 = ATAN2(S1,C1) - APX2 = APX1 + 0.5*PI - ELSE - APX2 = ATAN2(S2,C2) - APX1 = APX2 - 0.5*PI - ENDIF - - IF(APX1.LT.-0.5*PI) APX1 = APX1 + PI - IF(APX1.GT.+0.5*PI) APX1 = APX1 - PI - IF(APX2.LT.-0.5*PI) APX2 = APX2 + PI - IF(APX2.GT.+0.5*PI) APX2 = APX2 - PI -C - ENDIF -C - RETURN - END ! AECALC - - - - SUBROUTINE TCCALC(X,XP,Y,YP,S,N, - & THICK,XTHICK, CAMBR,XCAMBR ) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C--------------------------------------------------------------- -C Calculates max thickness and camber at airfoil points -C -C Note: this routine does not find the maximum camber or -C thickness exactly as it only looks at discrete points -C -C Input: -C N number of points -C X(.) shape coordinate point arrays -C Y(.) -C -C Output: -C THICK max thickness -C CAMBR max camber -C--------------------------------------------------------------- - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT((XTE-XLE)**2 + (YTE-YLE)**2) -C -C---- set unit chord-line vector - DXC = (XTE-XLE) / CHORD - DYC = (YTE-YLE) / CHORD -C - THICK = 0. - XTHICK = 0. - CAMBR = 0. - XCAMBR = 0. -C -C---- go over each point, finding the y-thickness and camber - DO 30 I=1, N - XBAR = (X(I)-XLE)*DXC + (Y(I)-YLE)*DYC - YBAR = (Y(I)-YLE)*DXC - (X(I)-XLE)*DYC -C -C------ set point on the opposite side with the same chord x value - CALL SOPPS(SOPP, S(I), X,XP,Y,YP,S,N, SLE) -cc write(*,*) 'SOPP = ', SOPP - XOPP = SEVAL(SOPP,X,XP,S,N) - YOPP = SEVAL(SOPP,Y,YP,S,N) -C - YBAROP = (YOPP-YLE)*DXC - (XOPP-XLE)*DYC -C - YC = 0.5*(YBAR+YBAROP) - YT = ABS(YBAR-YBAROP) -C - IF(ABS(YC) .GT. ABS(CAMBR)) THEN - CAMBR = YC - XCAMBR = XOPP - ENDIF - IF(ABS(YT) .GT. ABS(THICK)) THEN - THICK = YT - XTHICK = XOPP - ENDIF - 30 CONTINUE -C - RETURN - END ! TCCALC - - - - SUBROUTINE YSYM(X,XP,Y,YP,S,NX,N,ISIDE, XNEW,YNEW) -C--------------------------------------------------------- -C Makes passed-in airfoil symmetric about chord line. -C--------------------------------------------------------- - - use complexify - implicit complex(a-h, o-z) - DIMENSION X(NX),XP(NX),Y(NX),YP(NX),S(NX) - DIMENSION XNEW(NX), YNEW(NX) -C - SREF = S(N) - S(1) -C - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHSQ = (XTE-XLE)**2 + (YTE-YLE)**2 -C -C---- set unit chord-line vector - DXC = (XTE-XLE) / SQRT(CHSQ) - DYC = (YTE-YLE) / SQRT(CHSQ) -C -C---- find index of node ILE which is just before leading edge point - DO 5 I=2, N - DS = S(I) - S(I-1) - IF(S(I)-SLE .GE. -0.01*DS) GO TO 6 - 5 CONTINUE - 6 CONTINUE - ILE = I-1 -C - DS = S(ILE+1) - S(ILE) - IF(SLE-S(ILE-1) .LT. 0.1*DS) THEN -C------ point is just before LE, we will move it ahead to LE - ILE1 = ILE - 1 - ILE2 = ILE + 1 - ELSE IF(S(ILE+1)-SLE .LT. 0.1*DS) THEN -C------ point is just after LE, we will move it back to LE - ILE1 = ILE - ILE2 = ILE + 2 - ELSE -C------ no point is near LE ... we will add new point - ILE1 = ILE - ILE2 = ILE + 1 - ENDIF -C -C---- set index limits of side which will set symmetric geometry - IF(ISIDE.ceq.1) THEN - IG1 = 1 - IG2 = ILE1 - IGDIR = +1 - ELSE - IG1 = N - IG2 = ILE2 - IGDIR = -1 - ENDIF -C -C---- set new number of points, including LE point - NNEW = 2*(IABS(IG2-IG1) + 1) + 1 - IF(NNEW.GT.NX) STOP 'YSYM: Array overflow on passed arrays.' -C -C---- set symmetric geometry - DO 10 I=IG1, IG2, IGDIR -C -C------ coordinates in chord-line axes - XBAR = (X(I)-XLE)*DXC + (Y(I)-YLE)*DYC - YBAR = (Y(I)-YLE)*DXC - (X(I)-XLE)*DYC -C - I1 = 1 + (I - IG1)*IGDIR - I2 = NNEW - (I - IG1)*IGDIR -C - XNEW(I1) = XLE + XBAR*DXC - YBAR*DYC - XNEW(I2) = XLE + XBAR*DXC + YBAR*DYC -C - YNEW(I1) = YLE + YBAR*DXC + XBAR*DYC - YNEW(I2) = YLE - YBAR*DXC + XBAR*DYC - 10 CONTINUE -C -C---- set new LE point - XNEW(NNEW/2+1) = XLE - YNEW(NNEW/2+1) = YLE -C -C---- set geometry for returning - N = NNEW - DO 20 IG = 1, N - IF(IGDIR.ceq.+1) THEN - I = IG - ELSE - I = N - IG + 1 - ENDIF - X(I) = XNEW(IG) - Y(I) = YNEW(IG) - 20 CONTINUE -C - CALL SCALC(X,Y,S,N) - CALL SEGSPL(X,XP,S,N) - CALL SEGSPL(Y,YP,S,N) -C - RETURN - END ! YSYM - - - - SUBROUTINE LERSCL(X,XP,Y,YP,S,N, DOC,RFAC, XNEW,YNEW) -C--------------------------------------------------------- -C Adjusts airfoil to scale LE radius by factor RFAC. -C Blending of new shape is done with decay length DOC. -C--------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) - DIMENSION XNEW(*), YNEW(*) -C - CALL LEFIND(SLE,X,XP,Y,YP,S,N) - XLE = SEVAL(SLE,X,XP,S,N) - YLE = SEVAL(SLE,Y,YP,S,N) - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) - CHORD = SQRT((XTE-XLE)**2 + (YTE-YLE)**2) -C -C---- set unit chord-line vector - DXC = (XTE-XLE) / CHORD - DYC = (YTE-YLE) / CHORD -C - SRFAC = SQRT(ABS(RFAC)) -C -C---- go over each point, changing the y-thickness appropriately - DO 30 I=1, N - XBAR = (X(I)-XLE)*DXC + (Y(I)-YLE)*DYC - YBAR = (Y(I)-YLE)*DXC - (X(I)-XLE)*DYC -C -C------ set point on the opposite side with the same chord x value - CALL SOPPS(SOPP, S(I), X,XP,Y,YP,S,N, SLE) -cc write(*,*) 'SOPP = ', SOPP - - XOPP = SEVAL(SOPP,X,XP,S,N) - YOPP = SEVAL(SOPP,Y,YP,S,N) -C - YBAROP = (YOPP-YLE)*DXC - (XOPP-XLE)*DYC -C -C------ thickness factor tails off exponentially towards trailing edge - XOC = XBAR/CHORD - ARG = MIN( XOC/DOC , 15.0 ) - TFAC = 1.0 - (1.0-SRFAC)*EXP(-ARG) -C -C------ set new chord x,y coordinates by changing thickness locally - YBARCT = 0.5*(YBAR+YBAROP) + TFAC*0.5*(YBAR-YBAROP) -C - XNEW(I) = XLE + XBAR *DXC - YBARCT*DYC - YNEW(I) = YLE + YBARCT*DXC + XBAR *DYC - 30 CONTINUE -C - RETURN - END - - - - SUBROUTINE SSS(SS,S1,S2,DEL,XBF,YBF,X,XP,Y,YP,S,N,ISIDE) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*),XP(*),Y(*),YP(*),S(*) -C---------------------------------------------------------------- -C Returns arc length points S1,S2 at flap surface break -C locations. S1 is on fixed airfoil part, S2 is on flap. -C The points are defined according to two cases: -C -C -C If DEL > 0: Surface will be eliminated in S1 < s < S2 -C -C Returns the arc length values S1,S2 of the endpoints -C of the airfoil surface segment which "disappears" as a -C result of the flap deflection. The line segments between -C these enpoints and the flap hinge point (XBF,YBF) have -C an included angle of DEL. DEL is therefore the flap -C deflection which will join up the points at S1,S2. -C SS is an approximate arc length value near S1 and S2. -C It is used as an initial guess for the Newton loop -C for S1 and S2. -C -C -C If DEL = 0: Surface will be created at s = S1 = S2 -C -C If DEL=0, then S1,S2 will cooincide, and will be located -C on the airfoil surface where the segment joining the -C point at S1,S2 and the hinge point is perpendicular to -C the airfoil surface. This will be the point where the -C airfoil surface must be broken to permit a gap to open -C as a result of the flap deflection. -C---------------------------------------------------------------- -C -C---- convergence epsilon - DATA EPS / 1.0E-5 / -C - STOT = ABS( S(N) - S(1) ) -C - SIND = SIN(0.5*ABS(DEL)) -C - SSGN = 1.0 - IF(ISIDE.ceq.1) SSGN = -1.0 -C -C---- initial guesses for S1, S2 - RSQ = (SEVAL(SS,X,XP,S,N)-XBF)**2 + (SEVAL(SS,Y,YP,S,N)-YBF)**2 - S1 = SS - (SIND*SQRT(RSQ) + EPS*STOT)*SSGN - S2 = SS + (SIND*SQRT(RSQ) + EPS*STOT)*SSGN -C -C---- Newton iteration loop - DO 10 ITER=1, 10 - X1 = SEVAL(S1,X,XP,S,N) - X1P = DEVAL(S1,X,XP,S,N) - Y1 = SEVAL(S1,Y,YP,S,N) - Y1P = DEVAL(S1,Y,YP,S,N) -C - X2 = SEVAL(S2,X,XP,S,N) - X2P = DEVAL(S2,X,XP,S,N) - Y2 = SEVAL(S2,Y,YP,S,N) - Y2P = DEVAL(S2,Y,YP,S,N) -C - R1SQ = (X1-XBF)**2 + (Y1-YBF)**2 - R2SQ = (X2-XBF)**2 + (Y2-YBF)**2 - R1 = SQRT(R1SQ) - R2 = SQRT(R2SQ) -C - RRSQ = (X1-X2)**2 + (Y1-Y2)**2 - RR = SQRT(RRSQ) -C - IF(R1.LE.EPS*STOT .OR. R2.LE.EPS*STOT) THEN - S1 = SS - S2 = SS - RETURN - ENDIF -C - R1_S1 = (X1P*(X1-XBF) + Y1P*(Y1-YBF))/R1 - R2_S2 = (X2P*(X2-XBF) + Y2P*(Y2-YBF))/R2 -C - IF(SIND.GT.0.01) THEN -C - IF(RR.ceq.0.0) RETURN -C - RR_S1 = (X1P*(X1-X2) + Y1P*(Y1-Y2))/RR - RR_S2 = -(X2P*(X1-X2) + Y2P*(Y1-Y2))/RR -C -C------- Residual 1: set included angle via dot product - RS1 = ((XBF-X1)*(X2-X1) + (YBF-Y1)*(Y2-Y1))/RR - SIND*R1 - A11 = ((XBF-X1)*( -X1P) + (YBF-Y1)*( -Y1P))/RR - & + (( -X1P)*(X2-X1) + ( -Y1P)*(Y2-Y1))/RR - & - ((XBF-X1)*(X2-X1) + (YBF-Y1)*(Y2-Y1))*RR_S1/RRSQ - & - SIND*R1_S1 - A12 = ((XBF-X1)*(X2P ) + (YBF-Y1)*(Y2P ))/RR - & - ((XBF-X1)*(X2-X1) + (YBF-Y1)*(Y2-Y1))*RR_S2/RRSQ -C -C------- Residual 2: set equal length segments - RS2 = R1 - R2 - A21 = R1_S1 - A22 = - R2_S2 -C - ELSE -C -C------- Residual 1: set included angle via small angle approximation - RS1 = (R1+R2)*SIND + (S1 - S2)*SSGN - A11 = R1_S1 *SIND + SSGN - A12 = R2_S2 *SIND - SSGN -C -C------- Residual 2: set vector sum of line segments beteen the -C- endpoints and flap hinge to be perpendicular to airfoil surface. - X1PP = D2VAL(S1,X,XP,S,N) - Y1PP = D2VAL(S1,Y,YP,S,N) - X2PP = D2VAL(S2,X,XP,S,N) - Y2PP = D2VAL(S2,Y,YP,S,N) -C - XTOT = X1+X2 - 2.0*XBF - YTOT = Y1+Y2 - 2.0*YBF -C - RS2 = XTOT*(X1P+X2P) + YTOT*(Y1P+Y2P) - A21 = X1P*(X1P+X2P) + Y1P*(Y1P+Y2P) + XTOT*X1PP + YTOT*Y1PP - A22 = X2P*(X1P+X2P) + Y2P*(Y1P+Y2P) + XTOT*X2PP + YTOT*Y2PP -C - ENDIF -C - DET = A11*A22 - A12*A21 - DS1 = -(RS1*A22 - A12*RS2) / DET - DS2 = -(A11*RS2 - RS1*A21) / DET -C - DS1 = MIN( DS1 , 0.01*STOT ) - DS1 = MAX( DS1 , -.01*STOT ) - DS2 = MIN( DS2 , 0.01*STOT ) - DS2 = MAX( DS2 , -.01*STOT ) -C - S1 = S1 + DS1 - S2 = S2 + DS2 - IF(ABS(DS1)+ABS(DS2) .LT. EPS*STOT ) GO TO 11 - 10 CONTINUE - WRITE(*,*) 'SSS: failed to converge subtending angle points' - S1 = SS - S2 = SS -C - 11 CONTINUE -C -C---- make sure points are identical if included angle is zero. - IF(DEL.ceq.0.0) THEN - S1 = 0.5*(S1+S2) - S2 = S1 - ENDIF -C - RETURN - END - - - SUBROUTINE CLIS(X,XP,Y,YP,S,N) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*), XP(*), Y(*), YP(*), S(*) -C------------------------------------------------------------------- -C Displays curvatures at panel nodes. -C------------------------------------------------------------------- - PI = 4.0*ATAN(1.0) -C - CMAX = 0.0 - IMAX = 1 -C -C---- go over each point, calculating curvature - WRITE(*,1050) - DO 30 I=1, N - IF(I.ceq.1) THEN - ARAD = ATAN2(-YP(I),-XP(I)) - ELSE - ARAD = ATANC(-YP(I),-XP(I),ARAD) - ENDIF - ADEG = ARAD * 180.0/PI - CV = CURV(S(I),X,XP,Y,YP,S,N) - WRITE(*,1100) I, X(I), Y(I), S(I), ADEG, CV - IF(ABS(CV) .GT. ABS(CMAX)) THEN - CMAX = CV - IMAX = I - ENDIF - 30 CONTINUE -C - WRITE(*,1200) CMAX, IMAX, X(IMAX), Y(IMAX), S(IMAX) -C - RETURN -C - 1050 FORMAT(/' i x y s theta curv') -CCC 120 0.2134 -0.0234 -0.0234 180.024 2025.322 - 1100 FORMAT(1X,I3, 3F9.4, F11.3, F12.3) - 1200 FORMAT(/' Maximum curvature =', F14.3, - & ' at i,x,y,s = ', I3, 3F9.4 ) - END ! CLIS - - - - - - - SUBROUTINE CANG(X,Y,N,IPRINT, IMAX,AMAX) - use complexify - implicit complex(a-h, o-z) - DIMENSION X(*), Y(*) -C------------------------------------------------------------------- -C IPRINT=2: Displays all panel node corner angles -C IPRINT=1: Displays max panel node corner angle -C IPRINT=0: No display... just returns values -C------------------------------------------------------------------- -C - AMAX = 0.0 - IMAX = 1 -C -C---- go over each point, calculating corner angle - IF(IPRINT.ceq.2) WRITE(*,1050) - DO 30 I=2, N-1 - DX1 = X(I) - X(I-1) - DY1 = Y(I) - Y(I-1) - DX2 = X(I) - X(I+1) - DY2 = Y(I) - Y(I+1) -C -C------ allow for doubled points - IF((DX1.ceq.0.0) .AND. (DY1.ceq.0.0)) THEN - DX1 = X(I) - X(I-2) - DY1 = Y(I) - Y(I-2) - ENDIF - IF((DX2.ceq.0.0) .AND. (DY2.ceq.0.0)) THEN - DX2 = X(I) - X(I+2) - DY2 = Y(I) - Y(I+2) - ENDIF -C - CROSSP = (DX2*DY1 - DY2*DX1) - & / SQRT((DX1**2 + DY1**2) * (DX2**2 + DY2**2)) - ANGL = ASIN(CROSSP)*(180.0/3.1415926) - IF(IPRINT.ceq.2) WRITE(*,1100) I, X(I), Y(I), ANGL - IF(ABS(ANGL) .GT. ABS(AMAX)) THEN - AMAX = ANGL - IMAX = I - ENDIF - 30 CONTINUE -C - IF(IPRINT.GE.1) WRITE(*,1200) AMAX, IMAX, X(IMAX), Y(IMAX) -C - RETURN -C - 1050 FORMAT(/' i x y angle') -CCC 120 0.2134 -0.0234 25.322 - 1100 FORMAT(1X,I3, 2F9.4, F9.3) - 1200 FORMAT(/' Maximum panel corner angle =', F7.3, - & ' at i,x,y = ', I3, 2F9.4 ) - END ! CANG - - - - SUBROUTINE INTER(X0,XP0,Y0,YP0,S0,N0,SLE0, - & X1,XP1,Y1,YP1,S1,N1,SLE1, - & X,Y,N,FRAC) -C ..................................................................... -C -C Interpolates two source airfoil shapes into an "intermediate" shape. -C -C Procedure: -C The interpolated x coordinate at a given normalized spline -C parameter value is a weighted average of the two source -C x coordinates at the same normalized spline parameter value. -C Ditto for the y coordinates. The normalized spline parameter -C runs from 0 at the leading edge to 1 at the trailing edge on -C each surface. -C ..................................................................... -C - use complexify - implicit complex(a-h, o-z) - complex X0(N0),Y0(N0),XP0(N0),YP0(N0),S0(N0) - complex X1(N1),Y1(N1),XP1(N1),YP1(N1),S1(N1) - complex X(N),Y(N) -C -C---- number of points in interpolated airfoil is the same as in airfoil 0 - N = N0 -C -C---- interpolation weighting fractions - F0 = 1.0 - FRAC - F1 = FRAC -C -C---- top side spline parameter increments - TOPS0 = S0(1) - SLE0 - TOPS1 = S1(1) - SLE1 -C -C---- bottom side spline parameter increments - BOTS0 = S0(N0) - SLE0 - BOTS1 = S1(N1) - SLE1 -C - DO 50 I=1, N -C -C------ normalized spline parameter is taken from airfoil 0 value - IF(S0(I).LT.SLE0) SN = (S0(I) - SLE0) / TOPS0 ! top side - IF(S0(I).GE.SLE0) SN = (S0(I) - SLE0) / BOTS0 ! bottom side -C -C------ set actual spline parameters - ST0 = S0(I) - IF(ST0.LT.SLE0) ST1 = SLE1 + TOPS1 * SN - IF(ST0.GE.SLE0) ST1 = SLE1 + BOTS1 * SN -C -C------ set interpolated x,y coordinates - X(I) = F0*SEVAL(ST0,X0,XP0,S0,N0) + F1*SEVAL(ST1,X1,XP1,S1,N1) - Y(I) = F0*SEVAL(ST0,Y0,YP0,S0,N0) + F1*SEVAL(ST1,Y1,YP1,S1,N1) -C - 50 CONTINUE -C - RETURN - END ! INTER - - - - SUBROUTINE IJSECT(N,X,Y, PEX, - & AREA, SLEN, - & XC, XMIN, XMAX, XEXINT, - & YC, YMIN, YMAX, YEXINT, - & AIXX, AIXXT, - & AIYY, AIYYT, - & AJ , AJT ) - use complexify - implicit complex(a-h, o-z) -c DIMENSION X(N), Y(N) - DIMENSION X(*), Y(*) - -C - XMIN = X(1) - XMAX = X(1) - YMIN = Y(1) - YMAX = Y(1) -C - DX = X(1) - X(N) - DY = Y(1) - Y(N) - DS = SQRT(DX*DX + DY*DY) - XAVG = 0.5*(X(1) + X(N)) - YAVG = 0.5*(Y(1) + Y(N)) -C - X_DY = DY * XAVG - XX_DY = DY * XAVG**2 - XXX_DY = DY * XAVG**3 - X_DS = DS * XAVG - XX_DS = DS * XAVG**2 -C - Y_DX = DX * YAVG - YY_DX = DX * YAVG**2 - YYY_DX = DX * YAVG**3 - Y_DS = DS * YAVG - YY_DS = DS * YAVG**2 -C - C_DS = DS -C - DO 10 I = 2, N - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) - DS = SQRT(DX*DX + DY*DY) - XAVG = 0.5*(X(I) + X(I-1)) - YAVG = 0.5*(Y(I) + Y(I-1)) -C - X_DY = X_DY + DY * XAVG - XX_DY = XX_DY + DY * XAVG**2 - XXX_DY = XXX_DY + DY * XAVG**3 - X_DS = X_DS + DS * XAVG - XX_DS = XX_DS + DS * XAVG**2 -C - Y_DX = Y_DX + DX * YAVG - YY_DX = YY_DX + DX * YAVG**2 - YYY_DX = YYY_DX + DX * YAVG**3 - Y_DS = Y_DS + DS * YAVG - YY_DS = YY_DS + DS * YAVG**2 -C - C_DS = C_DS + DS -C - XMIN = MIN(XMIN,X(I)) - XMAX = MAX(XMAX,X(I)) - YMIN = MIN(YMIN,Y(I)) - YMAX = MAX(YMAX,Y(I)) - 10 CONTINUE -C - AREA = -Y_DX - SLEN = C_DS -C - IF(AREA.ceq.0.0) RETURN -C - XC = XX_DY / (2.0*X_DY) - AIYY = XXX_DY/3.0 - XX_DY*XC + X_DY*XC**2 - AIYYT = XX_DS - X_DS*XC*2.0 + C_DS*XC**2 -C - YC = YY_DX / (2.0*Y_DX) - AIXX = -YYY_DX/3.0 + YY_DX*YC - Y_DX*YC**2 - AIXXT = YY_DS - Y_DS*YC*2.0 + C_DS*YC**2 -C -C - SINT = 0. - XINT = 0. - YINT = 0. -C - DO 20 I=2, N - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) - DS = SQRT(DX*DX + DY*DY) - XAVG = 0.5*(X(I) + X(I-1)) - XC - YAVG = 0.5*(Y(I) + Y(I-1)) - YC -C - SINT = SINT + DS -cc XINT = XINT + DS * ABS(XAVG)**PEX -cc YINT = YINT + DS * ABS(YAVG)**PEX - 20 CONTINUE -C - DO I=1, N-1 - IF(X(I+1) .GE. X(I)) GO TO 30 - ENDDO - IMID = N/2 - 30 IMID = I -C - AJ = 0.0 - DO I = 2, IMID - XAVG = 0.5*(X(I) + X(I-1)) - YAVG = 0.5*(Y(I) + Y(I-1)) - DX = X(I-1) - X(I) -C - IF(XAVG.GT.X(N)) THEN - YOPP = Y(N) - GO TO 41 - ENDIF - IF(XAVG.LE.X(IMID)) THEN - YOPP = Y(IMID) - GO TO 41 - ENDIF -C - DO J = N, IMID, -1 - IF(XAVG.GT.X(J-1) .AND. XAVG.LE.X(J)) THEN - FRAC = (XAVG - X(J-1)) - & / (X(J) - X(J-1)) - YOPP = Y(J-1) + (Y(J)-Y(J-1))*FRAC - GO TO 41 - ENDIF - ENDDO - 41 CONTINUE -C - AJ = AJ + ABS(YAVG-YOPP)**3 * DX / 3.0 - ENDDO -C - AJT = 4.0*AREA**2/SLEN -C -cc XEXINT = (XINT/SINT)**(1.0/PEX) -cc YEXINT = (YINT/SINT)**(1.0/PEX) -C - RETURN - END ! IJSECT - - - SUBROUTINE AREFINE(X,Y,S,XS,YS,N, ATOL, - & NDIM,NNEW,XNEW,YNEW,X1,X2) -C------------------------------------------------------------- -C Adds points to a x,y spline contour wherever -C the angle between adjacent segments at a node -C exceeds a specified threshold. The points are -C added 1/3 of a segment before and after the -C offending node. -C -C The point adding is done only within X1..X2. -C -C Intended for doubling the number of points -C of Eppler and Selig airfoils so that they are -C suitable for clean interpolation using Xfoil's -C arc-length spline routines. -C------------------------------------------------------ - use complexify - implicit complex(a-h, o-z) - complex X(*), Y(*), S(*), XS(*), YS(*) - complex XNEW(NDIM), YNEW(NDIM) - LOGICAL LREF -C - ATOLR = ATOL * 3.14159/180.0 -C - K = 1 - XNEW(K) = X(1) - YNEW(K) = Y(1) -C - DO 10 I = 2, N-1 - IM = I-1 - IP = I+1 -C - DXM = X(I) - X(I-1) - DYM = Y(I) - Y(I-1) - DXP = X(I+1) - X(I) - DYP = Y(I+1) - Y(I) -C - CRSP = DXM*DYP - DYM*DXP - DOTP = DXM*DXP + DYM*DYP - IF((CRSP.ceq.0.0) .AND. (DOTP.ceq.0.0)) THEN - ASEG = 0.0 - ELSE - ASEG = ATAN2( CRSP , DOTP ) - ENDIF -C - LREF = ABS(ASEG) .GT. ATOLR -C - IF(LREF) THEN -C------- add extra point just before this node - SMID = S(I) - 0.3333*(S(I)-S(I-1)) - XK = SEVAL(SMID,X,XS,S,N) - YK = SEVAL(SMID,Y,YS,S,N) - IF(XK.GE.X1 .AND. XK.LE.X2) THEN - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = XK - YNEW(K) = YK - ENDIF - ENDIF -C -C------ add the node itself - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = X(I) - YNEW(K) = Y(I) -C - IF(LREF) THEN -C------- add extra point just after this node - SMID = S(I) + 0.3333*(S(I+1)-S(I)) - XK = SEVAL(SMID,X,XS,S,N) - YK = SEVAL(SMID,Y,YS,S,N) - IF(XK.GE.X1 .AND. XK.LE.X2) THEN - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = XK - YNEW(K) = YK - ENDIF - ENDIF - 10 CONTINUE -C - K = K + 1 - IF(K .GT. NDIM) GO TO 90 - XNEW(K) = X(N) - YNEW(K) = Y(N) -C - NNEW = K - RETURN -C - 90 CONTINUE - WRITE(*,*) 'SDOUBLE: Arrays will overflow. No action taken.' - NNEW = 0 - RETURN -C - END ! AREFINE - - - SUBROUTINE SCHECK(X,Y,N, STOL, LCHANGE) -C------------------------------------------------------------- -C Removes points from an x,y spline contour wherever -C the size of a segment between nodes falls below a -C a specified threshold of the adjacent segments. -C The two node points defining the short segment are -C replaced with a single node at their midpoint. -C Note that the number of nodes may be altered by -C this routine. -C -C Intended for eliminating odd "micro" panels -C that occur when blending a flap to a foil. -C If LCHANGE is set on return the airfoil definition -C has been changed and resplining should be done. -C -C The recommended value for STOL is 0.05 (meaning -C segments less than 5% of the length of either adjoining -C segment are removed). 4/24/01 HHY -C------------------------------------------------------ - use complexify - implicit complex(a-h, o-z) - complex X(*), Y(*) - LOGICAL LCHANGE -C - LCHANGE = .FALSE. -C--- Check STOL for sanity - IF(STOL.GT.0.3) THEN - WRITE(*,*) 'SCHECK: Bad value for small panels (STOL > 0.3)' - RETURN - ENDIF -C - 10 DO 20 I = 2, N-2 - IM1 = I-1 - IP1 = I+1 - IP2 = I+2 -C - DXM1 = X(I) - X(I-1) - DYM1 = Y(I) - Y(I-1) - DSM1 = SQRT(DXM1*DXM1 + DYM1*DYM1) -C - DXP1 = X(I+1) - X(I) - DYP1 = Y(I+1) - Y(I) - DSP1 = SQRT(DXP1*DXP1 + DYP1*DYP1) -C - DXP2 = X(I+2) - X(I+1) - DYP2 = Y(I+2) - Y(I+1) - DSP2 = SQRT(DXP2*DXP2 + DYP2*DYP2) -C -C------- Don't mess with doubled points (slope breaks) - IF(DSP1.ceq.0.0) GO TO 20 -C - IF(DSP1.LT.STOL*DSM1 .OR. DSP1.LT.STOL*DSP2) THEN -C------- Replace node I with average of I and I+1 - X(I) = 0.5*(X(I)+X(I+1)) - Y(I) = 0.5*(Y(I)+Y(I+1)) -C------- Remove node I+1 - DO L = I+1, N - X(L) = X(L+1) - Y(L) = Y(L+1) - END DO - N = N - 1 - LCHANGE = .TRUE. - WRITE(*,*) 'SCHECK segment removed at ',I - GO TO 10 - ENDIF -C - 20 CONTINUE -C - RETURN - END ! SCHECK - - - - - - SUBROUTINE BENDUMP -c REAL X(*), Y(*) - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - PEX = 16.0 - CALL IJSECT(N,X,Y, PEX, - & AREA, SLEN, - & XC, XMIN, XMAX, XEXINT, - & YC, YMIN, YMAX, YEXINT, - & AIXX, AIXXT, - & AIYY, AIYYT, - & AJ , AJT ) -C -c WRITE(*,*) -c WRITE(*,1200) 'Area =', AREA -c WRITE(*,1200) 'Slen =', SLEN -c WRITE(*,*) -c WRITE(*,1200) 'X-bending parameters:' -c WRITE(*,1200) ' centroid Xc =', XC -c WRITE(*,1200) ' max X-Xc =', XMAX-XC -c WRITE(*,1200) ' min X-Xc =', XMIN-XC -c WRITE(*,1200) ' solid Iyy =', AIYY -c WRITE(*,1200) ' skin Iyy/t =', AIYYT - XBAR = MAX( ABS(XMAX-XC) , ABS(XMIN-XC) ) -c WRITE(*,1200) ' solid Iyy/(X-Xc)=', AIYY /XBAR -c WRITE(*,1200) ' skin Iyy/t(X-Xc)=', AIYYT/XBAR -C -c WRITE(*,*) -c WRITE(*,1200) 'Y-bending parameters:' -c WRITE(*,1200) ' centroid Yc =', YC -c WRITE(*,1200) ' max Y-Yc =', YMAX-YC -c WRITE(*,1200) ' min Y-Yc =', YMIN-YC -c WRITE(*,1200) ' solid Ixx =', AIXX -c WRITE(*,1200) ' skin Ixx/t =', AIXXT - YBAR = MAX( ABS(YMAX-YC) , ABS(YMIN-YC) ) -c WRITE(*,1200) ' solid Ixx/(Y-Yc)=', AIXX /YBAR -c WRITE(*,1200) ' skin Ixx/t(Y-Yc)=', AIXXT/YBAR -C -c WRITE(*,*) -c WRITE(*,1200) ' power-avg X-Xc =', XEXINT -c WRITE(*,1200) ' power-avg Y-Yc =', YEXINT -C -c WRITE(*,*) -c WRITE(*,1200) ' solid J =', AJ -c WRITE(*,1200) ' skin J/t =', AJT - RETURN -C -c 1200 FORMAT(1X,A,G14.6) - END ! BENDUMP - - - - - - diff --git a/deps/src/xfoil_cs/c_xoper.f b/deps/src/xfoil_cs/c_xoper.f deleted file mode 100644 index 8a4f8f9..0000000 --- a/deps/src/xfoil_cs/c_xoper.f +++ /dev/null @@ -1,1021 +0,0 @@ -C*********************************************************************** -C Module: xoper.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** -C - SUBROUTINE OPER - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*1 ANS - CHARACTER*4 COMAND, COMOLD - LOGICAL LRECALC, LCPX, LCONV -C - CHARACTER*128 COMARG, ARGOLD, LINE -C - PARAMETER (NPRX = 101) - DIMENSION XPR(NPRX), YPR(NPRX) -C - DIMENSION NBLP(NPX) - DIMENSION IPPAI(NPX), NAPOLT(NPX) -C - DIMENSION IINPUT(20) - DIMENSION RINPUT(20) - LOGICAL ERROR -C -C---- retain last-command info if OPER is exited and then re-entered - SAVE COMOLD, ARGOLD -C -C---- logical units for polar save file, polar dump file - LUPLR = 9 - LUPLX = 11 -C - COMAND = '****' - COMARG = ' ' - LRECALC = .FALSE. - LCPX = .FALSE. - LPLOT = .FALSE. -C - IF(N.ceq.0) THEN - WRITE(*,*) - WRITE(*,*) '*** No airfoil available ***' - RETURN - ENDIF -C - IF(IPACT.cne.0) THEN - WRITE(*,5000) IPACT - 5000 FORMAT(/' Polar', I3,' is active') - ENDIF -C -ccc 500 CONTINUE - COMOLD = COMAND - ARGOLD = COMARG -C -C==================================================== -C****************************************************** -C START OF DB COMMAND STRUCTURE -C -C Main purpose is to calculate Cl/Cd either -C through inviscid or viscous calculation. -C -c LVISC = .NOT. LVISC - LVISC = .TRUE. -c LVISC = .FALSE. -C -c IF(LVISC) THEN -C IF(NINPUT.GE.1) THEN -C REINF1 = RINPUT(1) -C ELSE IF(REINF1 .EQ. 0.0) THEN -C CALL ASKR('Enter Reynolds number^',REINF1) -C ENDIF -C -C****************************************************** -C REINF1 = 100000 -C WRITE(*,*) REINF1 -C STOP - -C*****CHANGE REYNOLDS NUMBER*************************** -C ITMAX = 75 -C CALL MRSHOW(.TRUE.,.TRUE.) -c ENDIF - LCONV = .FALSE. - IF(.NOT.LRECALC) THEN -C------- set inviscid solution only if point is not being recalculated -C IF(NINPUT.GE.1) THEN -C ADEG = RINPUT(1) -C ELSE -C ADEG = ALFA/DTOR -C CALL ASKR('Enter angle of attack (deg)^',ADEG) -C ENDIF - -C ADEG = 0.0 SET IN XFOIL.F NOW - LALFA = .TRUE. - ALFA = DTOR*ADEG - QINF = 1.0 - - CALL SPECAL - - IF(ABS(ALFA-AWAKE) .GT. 1.0E-5) LWAKE = .FALSE. - IF(ABS(ALFA-AVISC) .GT. 1.0E-5) LVCONV = .FALSE. - IF(ABS(MINF-MVISC) .GT. 1.0E-5) LVCONV = .FALSE. - ENDIF -C -cs write(*,*) 'invicid CL',CL - - IF(LVISC) then -c write(*,*) 'calling viscal' - call VISCAL(ITMAX) - endif - -C CALL CPX - CALL FCPMIN - -C -C IF(LVISC .AND. LPACC .AND. LVCONV) THEN -C CALL PLRADD(LUPLR,IPACT) -C CALL PLXADD(LUPLX,IPACT) -C ENDIF -C -C IF(LVISC .AND. .NOT.LPACC .AND. .NOT.LVCONV) THEN -C WRITE(*,*) 'Type "!" to continue iterating' -C ENDIF - - -C call cpcalc(N+NW,QVIS,QINF,MINF,CPV) - call cdcalc -C CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF,XCMREF,YCMREF, -C & CL,CM,CDP, CL_ALF,CL_MSQ) - - RETURN -C - END ! OPER - - SUBROUTINE FCPMIN -C------------------------------------------------ -C Finds minimum Cp on dist for cavitation work -C------------------------------------------------ - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - XCPMNI = X(1) - XCPMNV = X(1) - CPMNI = CPI(1) - CPMNV = CPV(1) -C - DO I = 2, N + NW - IF(CPI(I) .LT. CPMNI) THEN - XCPMNI = X(I) - CPMNI = CPI(I) - ENDIF - IF(CPV(I) .LT. CPMNV) THEN - XCPMNV = X(I) - CPMNV = CPV(I) - ENDIF - ENDDO -C - - IF(LVISC)THEN - CPMN = CPMNV - ELSE - CPMN = CPMNI -C - CPMNV = CPMNI - XCPMNV = XCPMNI - ENDIF -C - RETURN - END ! FCPMIN - - - - SUBROUTINE MRSHOW(LM,LR) - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - LOGICAL LM, LR -C - IF(LM .OR. LR) WRITE(*,*) -C - IF(LM) THEN - IF(MATYP.ceq.1) WRITE(*,1100) MINF1 - IF(MATYP.ceq.2) WRITE(*,1100) MINF1, ' / sqrt(CL)' - IF(MATYP.ceq.3) WRITE(*,1100) MINF1, ' / CL' - ENDIF -C - IF(LR) THEN - IF(RETYP.ceq.1) WRITE(*,1200) INT(REINF1) - IF(RETYP.ceq.2) WRITE(*,1200) INT(REINF1), ' / sqrt(CL)' - IF(RETYP.ceq.3) WRITE(*,1200) INT(REINF1), ' / CL' - ENDIF -C - RETURN -C - 1100 FORMAT(1X,'M =' , F10.4, A) - 1200 FORMAT(1X,'Re =' , I10 , A) - END ! MRSHOW - - - - SUBROUTINE NAMMOD(NAME,KDEL,KMOD0) - use complexify - implicit complex(a-h, o-z) - CHARACTER*(*) NAME -C------------------------------------------- -C Requests new modified NAME with -C version number in brackets, e.g. -C NACA 0012 [5] -C -C If bracketed index exists in NAME, -C it is incremented by KDEL. -C If no bracketed index exists, it -C is added with initial value KMOD0, -C unless KMOD0 is negative in which -C case nothing is added. -C------------------------------------------- - CHARACTER*48 NAMDEF -C - CALL STRIP(NAME,NNAME) - KBRACK1 = INDEX(NAME,'[') - KBRACK2 = INDEX(NAME,']') -C - NAMDEF = NAME(1:NNAME) -C - IF((KBRACK1.cne.0) .AND. ( - & KBRACK2.cne.0) .AND. KBRACK2-KBRACK1.GT.1) THEN -C----- brackets exist... get number, (go get user's input on READ error) - READ(NAME(KBRACK1+1:KBRACK2-1),*,ERR=40) KMOD - KMOD = IABS(KMOD) - KMODP = MOD( KMOD+KDEL , 100 ) - IF(KBRACK1.GE.2) THEN - NAME = NAME(1:KBRACK1-1) - ELSE - NAME = ' ' - ENDIF - CALL STRIP(NAME,NNAME) - ELSEIF(KMOD0.GT.0) THEN - KMODP = MOD( KMOD0 , 100 ) - ELSE - KMODP = 0 - ENDIF -C - IF (KMODP.GE.10) THEN - NAMDEF = NAME(1:NNAME) // ' [ ]' - WRITE(NAMDEF(NNAME+3:NNAME+4),1020) KMODP - 1020 FORMAT(I2) - ELSEIF(KMODP.GE. 1) THEN - NAMDEF = NAME(1:NNAME) // ' [ ]' - WRITE(NAMDEF(NNAME+3:NNAME+3),1025) KMODP - 1025 FORMAT(I1) - ENDIF -C - 40 WRITE(*,1040) NAMDEF - 1040 FORMAT(/' Enter airfoil name or for default: ',A) - READ(*,1000) NAME - 1000 FORMAT(A) - IF(NAME .ceq. ' ') NAME = NAMDEF -C - RETURN - END ! NAMMOD - - - - SUBROUTINE BLDUMP(DIMOUT,SOUT,XOUT,YOUT, - & UEOUT,DSOUT,THOUT,CFOUT) - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - INTEGER, INTENT(OUT) :: DIMOUT - complex, DIMENSION(IZX), INTENT(OUT) :: SOUT - complex, DIMENSION(IZX), INTENT(OUT) :: XOUT - complex, DIMENSION(IZX), INTENT(OUT) :: YOUT - complex, DIMENSION(IZX), INTENT(OUT) :: UEOUT - complex, DIMENSION(IZX), INTENT(OUT) :: DSOUT - complex, DIMENSION(IZX), INTENT(OUT) :: THOUT - complex, DIMENSION(IZX), INTENT(OUT) :: CFOUT - - CALL COMSET - DO 10 I=1, N - IS = 1 - IF(GAM(I) .LT. 0.0) IS = 2 -C - IF(LIPAN .AND. LVISC) THEN - IF(IS.ceq.1) THEN - IBL = IBLTE(IS) - I + 1 - ELSE - IBL = IBLTE(IS) + I - N - ENDIF - DS = DSTR(IBL,IS) - TH = THET(IBL,IS) - CF = TAU(IBL,IS)/(0.5*QINF**2) - ELSE - DS = 0. - TH = 0. - CF = 0. - ENDIF - UE = (GAM(I)/QINF)*(1.0-TKLAM) / (1.0 - TKLAM*(GAM(I)/QINF)**2) -C - SOUT(I) = S(I) - XOUT(I) = X(I) - YOUT(I) = Y(I) - UEOUT(I) = UE - DSOUT(I) = DS - THOUT(I) = TH - CFOUT(I) = CF - 10 CONTINUE -C - IF(LWAKE) THEN - IS = 2 - DO 20 I=N+1, N+NW - IBL = IBLTE(IS) + I - N - DS = DSTR(IBL,IS) - TH = THET(IBL,IS) - CF = 0. - UI = UEDG(IBL,IS) - UE = (UI/QINF)*(1.0-TKLAM) / (1.0 - TKLAM*(UI/QINF)**2) -C - SOUT(I) = S(I) - XOUT(I) = X(I) - YOUT(I) = Y(I) - UEOUT(I) = UE - DSOUT(I) = DS - THOUT(I) = TH - CFOUT(I) = CF - 20 CONTINUE - ENDIF -C - DIMOUT = N+NW -C - RETURN - END ! BLDUMP - - - - SUBROUTINE CPDUMP(FNAME1) - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*(*) FNAME1 -C - CHARACTER*80 FILDEF -C - 1000 FORMAT(A) -C - IF(FNAME1(1:1).cne.' ') THEN - FNAME = FNAME1 - ELSE -C----- no argument... get it somehow - IF(NPREFIX.GT.0) THEN -C------ offer default using existing prefix - FILDEF = PREFIX(1:NPREFIX) // '.cp' - WRITE(*,1100) FILDEF - 1100 FORMAT(/' Enter filename: ', A) - READ(*,1000) FNAME - CALL STRIP(FNAME,NFN) - IF(NFN.ceq.0) FNAME = FILDEF - ELSE -C------ nothing available... just ask for filename - CALL ASKS('Enter filename^',FNAME) - ENDIF - ENDIF -C -C - LU = 19 - OPEN(LU,FILE=FNAME,STATUS='UNKNOWN') - REWIND(LU) -C - WRITE(LU,1000) - & '# x Cp ' -C 0.23451 0.23451 -C - CALL COMSET -C - BETA = SQRT(1.0 - MINF**2) - BFAC = 0.5*MINF**2 / (1.0 + BETA) -C - DO 10 I=1, N - CPINC = 1.0 - (GAM(I)/QINF)**2 - DEN = BETA + BFAC*CPINC - CPCOM = CPINC / DEN -C - WRITE(LU,8500) X(I), CPCOM - 8500 FORMAT(1X,2F9.5) - 10 CONTINUE -C - CLOSE(LU) - RETURN - END ! CPDUMP - - - - SUBROUTINE MHINGE -C---------------------------------------------------- -C Calculates the hinge moment of the flap about -C (XOF,YOF) by integrating surface pressures. -C---------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - IF(.NOT.LFLAP) THEN -C - CALL GETXYF(X,XP,Y,YP,S,N, TOPS,BOTS,XOF,YOF) - LFLAP = .TRUE. -C - ELSE -C -C------ find top and bottom y at hinge x location - TOPS = XOF - BOTS = S(N) - XOF - CALL SINVRT(TOPS,XOF,X,XP,S,N) - CALL SINVRT(BOTS,XOF,X,XP,S,N) -C - ENDIF -C - TOPX = SEVAL(TOPS,X,XP,S,N) - TOPY = SEVAL(TOPS,Y,YP,S,N) - BOTX = SEVAL(BOTS,X,XP,S,N) - BOTY = SEVAL(BOTS,Y,YP,S,N) -C -C - HMOM = 0. - HFX = 0. - HFY = 0. -C -C---- integrate pressures on top and bottom sides of flap - DO 20 I=2, N - IF(S(I-1).GE.TOPS .AND. S(I).LE.BOTS) GO TO 20 -C - DX = X(I) - X(I-1) - DY = Y(I) - Y(I-1) - XMID = 0.5*(X(I)+X(I-1)) - XOF - YMID = 0.5*(Y(I)+Y(I-1)) - YOF - IF(LVISC) THEN - PMID = 0.5*(CPV(I) + CPV(I-1)) - ELSE - PMID = 0.5*(CPI(I) + CPI(I-1)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX - 20 CONTINUE -C -C---- find S(I)..S(I-1) interval containing s=TOPS - DO I=2, N - IF(S(I).GT.TOPS) GO TO 31 - ENDDO -C - 31 CONTINUE -C---- add on top surface chunk TOPS..S(I-1), missed in the DO 20 loop. - DX = TOPX - X(I-1) - DY = TOPY - Y(I-1) - XMID = 0.5*(TOPX+X(I-1)) - XOF - YMID = 0.5*(TOPY+Y(I-1)) - YOF - IF(S(I) .cne. S(I-1)) THEN - FRAC = (TOPS-S(I-1))/(S(I)-S(I-1)) - ELSE - FRAC = 0. - ENDIF - IF(LVISC) THEN - TOPP = CPV(I)*FRAC + CPV(I-1)*(1.0-FRAC) - PMID = 0.5*(TOPP+CPV(I-1)) - ELSE - TOPP = CPI(I)*FRAC + CPI(I-1)*(1.0-FRAC) - PMID = 0.5*(TOPP+CPI(I-1)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- add on inside flap surface contribution from hinge to top surface - DX = XOF - TOPX - DY = YOF - TOPY - XMID = 0.5*(TOPX+XOF) - XOF - YMID = 0.5*(TOPY+YOF) - YOF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- find S(I)..S(I-1) interval containing s=BOTS - DO I=N, 2, -1 - IF(S(I-1).LT.BOTS) GO TO 41 - ENDDO -C - 41 CONTINUE -C---- add on bottom surface chunk BOTS..S(I), missed in the DO 20 loop. - DX = X(I) - BOTX - DY = Y(I) - BOTY - XMID = 0.5*(BOTX+X(I)) - XOF - YMID = 0.5*(BOTY+Y(I)) - YOF - IF(S(I) .cne. S(I-1)) THEN - FRAC = (BOTS-S(I-1))/(S(I)-S(I-1)) - ELSE - FRAC = 0. - ENDIF - IF(LVISC) THEN - BOTP = CPV(I)*FRAC + CPV(I-1)*(1.0-FRAC) - PMID = 0.5*(BOTP+CPV(I)) - ELSE - BOTP = CPI(I)*FRAC + CPI(I-1)*(1.0-FRAC) - PMID = 0.5*(BOTP+CPI(I)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- add on inside flap surface contribution from hinge to bottom surface - DX = BOTX - XOF - DY = BOTY - YOF - XMID = 0.5*(BOTX+XOF) - XOF - YMID = 0.5*(BOTY+YOF) - YOF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C -C---- add on TE base thickness contribution - DX = X(1) - X(N) - DY = Y(1) - Y(N) - XMID = 0.5*(X(1)+X(N)) - XOF - YMID = 0.5*(Y(1)+Y(N)) - YOF - IF(LVISC) THEN - PMID = 0.5*(CPV(1)+CPV(N)) - ELSE - PMID = 0.5*(CPI(1)+CPI(N)) - ENDIF - HMOM = HMOM + PMID*(XMID*DX + YMID*DY) - HFX = HFX - PMID* DY - HFY = HFY + PMID* DX -C - RETURN - END ! MHINGE - - - SUBROUTINE VPAR -C--------------------------------------------- -C Viscous parameter change menu routine. -C--------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - CHARACTER*4 COMAND - CHARACTER*128 COMARG -C - DIMENSION IINPUT(20) - DIMENSION RINPUT(20) - LOGICAL ERROR -C -C - TURB = 100.0 * EXP( -(ACRIT + 8.43)/2.4 ) - WRITE(*,1200) XSTRIP(1), XSTRIP(2), ACRIT, TURB, VACCEL -C - 500 CONTINUE - CALL ASKC('..VPAR^',COMAND,COMARG) -C - DO I=1, 20 - IINPUT(I) = 0 - RINPUT(I) = 0.0 - ENDDO - NINPUT = 20 - CALL GETINT(COMARG,IINPUT,NINPUT,ERROR) - NINPUT = 20 - CALL GETFLT(COMARG,RINPUT,NINPUT,ERROR) -C - IF(COMAND.ceq.' ') RETURN - IF(COMAND.ceq.'? ') GO TO 5 - IF(COMAND.ceq.'SHOW') GO TO 10 - IF(COMAND.ceq.'XTR ') GO TO 40 - IF(COMAND.ceq.'N ') GO TO 50 - IF(COMAND.ceq.'VACC') GO TO 70 - IF(COMAND.ceq.'INIT') GO TO 80 -C - WRITE(*,1000) COMAND - GO TO 500 -C - 5 WRITE(*,1050) - GO TO 500 -C - 10 TURB = 100.0 * EXP( -(ACRIT + 8.43)/2.4 ) - WRITE(*,1200) XSTRIP(1), XSTRIP(2), ACRIT, TURB, VACCEL - GO TO 500 -C - 40 IF(NINPUT.GE.2) THEN - XSTRIP(1) = RINPUT(1) - XSTRIP(2) = RINPUT(2) - ELSE - CALL ASKR('Enter top side Xtrip/c^',XSTRIP(1)) - CALL ASKR('Enter bottom side Xtrip/c^',XSTRIP(2)) - ENDIF - LVCONV = .FALSE. - GO TO 500 -C - 50 IF(NINPUT.GE.1) THEN - ACRIT = RINPUT(1) - ELSE - CALL ASKR('Enter critical amplification ratio^',ACRIT) - ENDIF - LVCONV = .FALSE. - GO TO 500 -C - 70 IF(NINPUT.GE.1) THEN - VACCEL = RINPUT(1) - ELSE - CALL ASKR('Enter viscous acceleration parameter^',VACCEL) - ENDIF - GO TO 500 -C - 80 LBLINI = .NOT.LBLINI - IF(.NOT.LBLINI) WRITE(*,*) 'BLs will be initialized on next point' - IF( LBLINI) WRITE(*,*) 'BLs are assumed to be initialized' - IF(.NOT.LBLINI) LIPAN = .FALSE. - GO TO 500 -C -C................................................................... -C - 1000 FORMAT(1X,A4,' command not recognized. Type a "?" for list') - 1050 FORMAT( - & /' Return to OPER menu' - & /' SHOW Display viscous parameters' - & /' XTR rr Change trip positions Xtr/c' - & /' N r Change critical amplification exponent Ncrit' - & /' VACC r Change Newton solution acceleration parameter' - & /' INIT BL initialization flag toggle') - 1200 FORMAT(/' Xtr/c =', F8.4, ' top side' - & /' Xtr/c =', F8.4, ' bottom side' - & /' Ncrit =', F8.2, ' (', F6.3, ' % turb. level )' - & /' Vacc =', F8.4 ) - END ! VPAR - - - - - SUBROUTINE SPECAL -C----------------------------------- -C Converges to specified alpha. -C----------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - complex MINF_CLM, MSQ_CLM -C -C---- calculate surface vorticity distributions for alpha = 0, 90 degrees - IF(.NOT.LGAMU .OR. .NOT.LQAIJ) CALL GGCALC -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C -C---- superimpose suitably weighted alpha = 0, 90 distributions - DO 50 I=1, N - GAM(I) = COSA*GAMU(I,1) + SINA*GAMU(I,2) - GAM_A(I) = -SINA*GAMU(I,1) + COSA*GAMU(I,2) - 50 CONTINUE - PSIO = COSA*GAMU(N+1,1) + SINA*GAMU(N+1,2) -C - CALL TECALC - CALL QISET -C -C---- set initial guess for the Newton variable CLM - CLM = 1.0 -C -C---- set corresponding M(CLM), Re(CLM) - CALL MRCL(CLM,MINF_CLM,REINF_CLM) - CALL COMSET -C -C---- set corresponding CL(M) - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) -C -C---- iterate on CLM - DO 100 ITCL=1, 20 -C - MSQ_CLM = 2.0*MINF*MINF_CLM - DCLM = (CL - CLM)/(1.0 - CL_MSQ*MSQ_CLM) -C - CLM1 = CLM - RLX = 1.0 -C -C------ under-relaxation loop to avoid driving M(CL) above 1 - DO 90 IRLX=1, 12 -C - CLM = CLM1 + RLX*DCLM -C -C-------- set new freestream Mach M(CLM) - CALL MRCL(CLM,MINF_CLM,REINF_CLM) -C -C-------- if Mach is OK, go do next Newton iteration - IF((MATYP.ceq.1) .OR. (MINF.ceq.0.0) .OR. (MINF_CLM.cne.0.0)) - & GO TO 91 -C - RLX = 0.5*RLX - 90 CONTINUE - 91 CONTINUE -C -C------ set new CL(M) - CALL COMSET - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP,CL_ALF,CL_MSQ) -C - IF(ABS(DCLM).LE.1.0E-6) GO TO 110 -C - 100 CONTINUE - WRITE(*,*) 'SPECAL: Minf convergence failed' - 110 CONTINUE -C -C---- set final Mach, CL, Cp distributions, and hinge moment - CALL MRCL(CL,MINF_CL,REINF_CL) - CALL COMSET - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) - CALL CPCALC(N,QINV,QINF,MINF,CPI) - IF(LVISC) THEN - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - ELSE - CALL CPCALC(N,QINV,QINF,MINF,CPI) - ENDIF - IF(LFLAP) CALL MHINGE -C - RETURN - END ! SPECAL - - - SUBROUTINE SPECCL -C----------------------------------------- -C Converges to specified inviscid CL. -C----------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- calculate surface vorticity distributions for alpha = 0, 90 degrees - IF(.NOT.LGAMU .OR. .NOT.LQAIJ) CALL GGCALC -C -C---- set freestream Mach from specified CL -- Mach will be held fixed - CALL MRCL(CLSPEC,MINF_CL,REINF_CL) - CALL COMSET -C -C---- current alpha is the initial guess for Newton variable ALFA - COSA = COS(ALFA) - SINA = SIN(ALFA) - DO 10 I=1, N - GAM(I) = COSA*GAMU(I,1) + SINA*GAMU(I,2) - GAM_A(I) = -SINA*GAMU(I,1) + COSA*GAMU(I,2) - 10 CONTINUE - PSIO = COSA*GAMU(N+1,1) + SINA*GAMU(N+1,2) -C -C---- get corresponding CL, CL_alpha, CL_Mach - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) -C -C---- Newton loop for alpha to get specified inviscid CL - DO 100 ITAL=1, 20 -C - DALFA = (CLSPEC - CL) / CL_ALF - RLX = 1.0 -C - ALFA = ALFA + RLX*DALFA -C -C------ set new surface speed distribution - COSA = COS(ALFA) - SINA = SIN(ALFA) - DO 40 I=1, N - GAM(I) = COSA*GAMU(I,1) + SINA*GAMU(I,2) - GAM_A(I) = -SINA*GAMU(I,1) + COSA*GAMU(I,2) - 40 CONTINUE - PSIO = COSA*GAMU(N+1,1) + SINA*GAMU(N+1,2) -C -C------ set new CL(alpha) - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP,CL_ALF,CL_MSQ) -C - IF(ABS(DALFA).LE.1.0E-6) GO TO 110 - 100 CONTINUE - WRITE(*,*) 'SPECCL: CL convergence failed' - 110 CONTINUE -C -C---- set final surface speed and Cp distributions - CALL TECALC - CALL QISET - IF(LVISC) THEN - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - ELSE - CALL CPCALC(N,QINV,QINF,MINF,CPI) - ENDIF - IF(LFLAP) CALL MHINGE -C - RETURN - END ! SPECCL - - - SUBROUTINE VISCAL(NITER1) -C---------------------------------------- -C Converges viscous operating point -C---------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- convergence tolerance - DATA EPS1 / 1.0E-10 / - DATA EPS2 / 1.0E-14 / -C - NITER = NITER1 -C -C---- calculate wake trajectory from current inviscid solution if necessary - IF(.NOT.LWAKE) THEN - CALL XYWAKE - ENDIF -C -c write(*,*) 'X after wake',X -C---- set velocities on wake from airfoil vorticity for alpha=0, 90 - CALL QWCALC -C -C---- set velocities on airfoil and wake for initial alpha - CALL QISET -C - IF(.NOT.LIPAN) THEN -C - IF(LBLINI) CALL GAMQV -C -C----- locate stagnation point arc length position and panel index - CALL STFIND -C -C----- set BL position -> panel position pointers - CALL IBLPAN -C -C----- calculate surface arc length array for current stagnation point location - CALL XICALC -C -C----- set BL position -> system line pointers - CALL IBLSYS -C - ENDIF -C -C---- set inviscid BL edge velocity UINV from QINV - CALL UICALC -C - IF(.NOT.LBLINI) THEN -C -C----- set initial Ue from inviscid Ue - DO IBL=1, NBL(1) - UEDG(IBL,1) = UINV(IBL,1) - ENDDO -C - DO IBL=1, NBL(2) - UEDG(IBL,2) = UINV(IBL,2) - ENDDO -C - ENDIF -C - IF(LVCONV) THEN -C----- set correct CL if converged point exists - CALL QVFUE - IF(LVISC) THEN - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - ELSE - CALL CPCALC(N,QINV,QINF,MINF,CPI) - ENDIF - CALL GAMQV - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP, CL_ALF,CL_MSQ) - CALL CDCALC - ENDIF -C -C---- set up source influence matrix if it doesn't exist - IF(.NOT.LWDIJ .OR. .NOT.LADIJ) CALL QDCALC -C -C---- Newton iteration for entire BL solution - IF(NITER.ceq.0) CALL ASKI('Enter number of iterations^',NITER) -C WRITE(*,*) -c WRITE(*,*) 'Solving BL system ...' - DO 1000 ITER=1, NITER -C -C------ fill Newton system for BL variables -c WRITE (*,*) 'Calling SETBL...' -c WRITE (*,*) 'Check some stuff: X',X -c WRITE (*,*) 'Check some stuff: Y',Y -c WRITE (*,*) 'Check some stuff: GAM',GAM -c WRITE (*,*) 'Check some stuff: UEDG',UEDG - CALL SETBL -c WRITE (*,*) 'Check some stuff: iter,GAM',iter,GAM -c------ DB 040306 -C -C------ solve Newton system with custom solver -c WRITE(*,*) 'CALLING BLSOLV...' - CALL BLSOLV -C -C------ update BL variables - CALL UPDATE -C - IF(LALFA) THEN -C------- set new freestream Mach, Re from new CL - CALL MRCL(CL,MINF_CL,REINF_CL) - CALL COMSET - ELSE -C------- set new inviscid speeds QINV and UINV for new alpha - CALL QISET - CALL UICALC - ENDIF -C -C------ calculate edge velocities QVIS(.) from UEDG(..) - CALL QVFUE -C -C------ set GAM distribution from QVIS - CALL GAMQV -C -C------ relocate stagnation point - CALL STMOVE -C -C------ set updated CL,CD - CALL CLCALC(N,X,Y,GAM,GAM_A,ALFA,MINF,QINF, XCMREF,YCMREF, - & CL,CM,CDP,CL_ALF,CL_MSQ) - CALL CDCALC -C -C------ display changes and test for convergence -c IF(RLX.LT.1.0) -c & WRITE(*,2000) ITER, real(RMSBL), real(RMXBL),VMXBL, -c & real(IMXBL),real(ISMXBL),real(RLX) -c IF(RLX.CEQ.1.0) -c & WRITE(*,2010)ITER, real(RMSBL), real(RMXBL), VMXBL, -c & real(IMXBL),real(ISMXBL),real(RLX) -c CDP = CD - CDF -c WRITE(*,2020) real(ALFA/DTOR), real(CL), real(CM), real(CD), -c & real(CDF), real(CDP) -C - IF(RMSBL .LT. EPS1) THEN - LVCONV = .TRUE. - AVISC = ALFA - MVISC = MINF - ENDIF - IF(RMSBL .LT. EPS2) THEN - GO TO 90 - ENDIF -C - 1000 CONTINUE -C WRITE(*,*) 'VISCAL: Convergence failed' -C - 90 CONTINUE - CALL CPCALC(N+NW,QINV,QINF,MINF,CPI) - CALL CPCALC(N+NW,QVIS,QINF,MINF,CPV) - IF(LFLAP) CALL MHINGE - RETURN -C.................................................................... - 2000 FORMAT - & (/1X,I3,' rms: ',E10.4,' max: ',E10.4,3X,A1,' at ',I4,I3, - & ' RLX:',F6.3) - 2010 FORMAT - & (/1X,I3,' rms: ',E10.4,' max: ',E10.4,3X,A1,' at ',I4,I3) - 2020 FORMAT - & ( 1X,3X,' a =', F7.3,' CL =',F8.4 / - & 1X,3X,' Cm =', F8.4, ' CD =',F9.5, - & ' => CDf =',F9.5,' CDp =',F9.5) - END ! VISCAL - - - subroutine dcpout - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -c -c Computes and writes upper and lower-surface -c Cp values at two specified x locations -c -c - x1 = 0.05 - x2 = 0.15 -c - lu = 60 - open(lu,file='dcp.out',status='old',access='append',err=10) - go to 20 -c - 10 continue - open(lu,file='dcp.out',status='new') - write(lu,*) '# ', name - write(lu,*) '# alpha CL ', - & ' Cpl05 Cpu05 dCp05 ', - & ' Cpl15 Cpu15 dCp15 ' - 20 continue -c - call spline(cpv,w1,s,n) -c - su1 = sle + x1*(s(1)-sle) - sl1 = sle + x1*(s(n)-sle) - su2 = sle + x2*(s(1)-sle) - sl2 = sle + x2*(s(n)-sle) -c - call sinvrt(sl1,x1,x,xp,s,n) - call sinvrt(su1,x1,x,xp,s,n) - call sinvrt(sl2,x2,x,xp,s,n) - call sinvrt(su2,x2,x,xp,s,n) -c - cpl1 = seval(sl1,cpv,w1,s,n) - cpu1 = seval(su1,cpv,w1,s,n) - cpl2 = seval(sl2,cpv,w1,s,n) - cpu2 = seval(su2,cpv,w1,s,n) -c - write(lu,1200) alfa/dtor, cl, - & cpl1, cpu1, cpl1-cpu1, - & cpl2, cpu2, cpl2-cpu2 - - 1200 format(1x, f7.3, f9.4, 8f10.5) -c - close(lu) -c - return - end diff --git a/deps/src/xfoil_cs/c_xpanel.f b/deps/src/xfoil_cs/c_xpanel.f deleted file mode 100644 index b4c3b2b..0000000 --- a/deps/src/xfoil_cs/c_xpanel.f +++ /dev/null @@ -1,1838 +0,0 @@ -C*********************************************************************** -C Module: xpanel.f -C -C Copyright (C) 2000 Mark Drela -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - - SUBROUTINE APCALC - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- set angles of airfoil panels - DO 10 I=1, N-1 - SX = X(I+1) - X(I) - SY = Y(I+1) - Y(I) - IF((SX.ceq.0.0) .AND. (SY.ceq.0.0)) THEN - APANEL(I) = ATAN2( -NY(I) , -NX(I) ) - ELSE - APANEL(I) = ATAN2( SX , -SY ) - ENDIF - 10 CONTINUE -C -C---- TE panel - I = N - IP = 1 - IF(SHARP) THEN - APANEL(I) = PI - ELSE - SX = X(IP) - X(I) - SY = Y(IP) - Y(I) - APANEL(I) = ATAN2( -SX , SY ) + PI - ENDIF -C - RETURN - END - - - SUBROUTINE NCALC(X,Y,S,N,XN,YN) -C--------------------------------------- -C Calculates normal unit vector -C components at airfoil panel nodes -C--------------------------------------- - use complexify - implicit complex(a-h, o-z) - DIMENSION X(N), Y(N), S(N), XN(N), YN(N) -C - IF(N.LE.1) RETURN -C - CALL SEGSPL(X,XN,S,N) - CALL SEGSPL(Y,YN,S,N) - DO 10 I=1, N - SX = YN(I) - SY = -XN(I) - SMOD = SQRT(SX*SX + SY*SY) - XN(I) = SX/SMOD - YN(I) = SY/SMOD - 10 CONTINUE -C -C---- average normal vectors at corner points - DO 20 I=1, N-1 - IF(S(I) .ceq. S(I+1)) THEN - SX = 0.5*(XN(I) + XN(I+1)) - SY = 0.5*(YN(I) + YN(I+1)) - SMOD = SQRT(SX*SX + SY*SY) - XN(I) = SX/SMOD - YN(I) = SY/SMOD - XN(I+1) = SX/SMOD - YN(I+1) = SY/SMOD - ENDIF - 20 CONTINUE -C - RETURN - END - - - SUBROUTINE PSILIN(I,XI,YI,NXI,NYI,PSI,PSI_NI,GEOLIN,SIGLIN) -C----------------------------------------------------------------------- -C Calculates current streamfunction Psi at panel node or wake node -C I due to freestream and all bound vorticity Gam on the airfoil. -C Sensitivities of Psi with respect to alpha (Z_ALFA) and inverse -C Qspec DOFs (Z_QDOF0,Z_QDOF1) which influence Gam in inverse cases. -C Also calculates the sensitivity vector dPsi/dGam (DZDG). -C -C If SIGLIN=True, then Psi includes the effects of the viscous -C source distribution Sig and the sensitivity vector dPsi/dSig -C (DZDM) is calculated. -C -C If GEOLIN=True, then the geometric sensitivity vector dPsi/dn -C is calculated, where n is the normal motion of the jth node. -C -C Airfoil: 1 < I < N -C Wake: N+1 < I < N+NW -C----------------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - complex NXO, NYO, NXP, NYP, NXI, NYI - LOGICAL GEOLIN,SIGLIN -C -C---- distance tolerance for determining if two points are the same - SEPS = (S(N)-S(1)) * 1.0E-5 - - IO = I -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C - DO 3 JO=1, N - DZDG(JO) = 0.0 - DZDN(JO) = 0.0 - DQDG(JO) = 0.0 - 3 CONTINUE -C - DO 4 JO=1, N - DZDM(JO) = 0.0 - DQDM(JO) = 0.0 - 4 CONTINUE -C - Z_QINF = 0. - Z_ALFA = 0. - Z_QDOF0 = 0. - Z_QDOF1 = 0. - Z_QDOF2 = 0. - Z_QDOF3 = 0. -C - PSI = 0. - PSI_NI = 0. -C - - - QTAN1 = 0. - QTAN2 = 0. - QTANM = 0. -C - IF(SHARP) THEN - SCS = 1.0 - SDS = 0.0 - ELSE - SCS = ANTE/DSTE - SDS = ASTE/DSTE - ENDIF -C - DO 10 JO=1, N - JP = JO+1 -C - JM = JO-1 - JQ = JP+1 -C - IF(JO.ceq.1) THEN - JM = JO - ELSE IF(JO.ceq.N-1) THEN - JQ = JP - ELSE IF(JO.ceq.N) THEN - JP = 1 - IF((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2 .LT. SEPS**2) GO TO 12 - ENDIF -C - DSO = SQRT((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2) -C -C------ skip null panel - IF(DSO .ceq. 0.0) GO TO 10 -C - DSIO = 1.0 / DSO -C - APAN = APANEL(JO) -C - RX1 = XI - X(JO) - RY1 = YI - Y(JO) - RX2 = XI - X(JP) - RY2 = YI - Y(JP) -C - SX = (X(JP) - X(JO)) * DSIO - SY = (Y(JP) - Y(JO)) * DSIO -C - X1 = SX*RX1 + SY*RY1 - X2 = SX*RX2 + SY*RY2 - YY = SX*RY1 - SY*RX1 -C - RS1 = RX1*RX1 + RY1*RY1 - RS2 = RX2*RX2 + RY2*RY2 - - -C------ set reflection flag SGN to avoid branch problems with arctan - IF(IO.GE.1 .AND. IO.LE.N) THEN -C------- no problem on airfoil surface - SGN = 1.0 - ELSE -C------- make sure arctan falls between -/+ Pi/2 - SGN = SIGN(1.0,YY) - ENDIF -C -C------ set log(r^2) and arctan(x/y), correcting for reflection if any - IF((IO.cne.JO) .AND. RS1.GT.0.0) THEN - G1 = LOG(RS1) - T1 = ATAN2(SGN*X1,SGN*YY) + (0.5 - 0.5*SGN)*PI - ELSE - G1 = 0.0 - T1 = 0.0 - ENDIF -C - IF((IO.cne.JP) .AND. RS2.GT.0.0) THEN - G2 = LOG(RS2) - T2 = ATAN2(SGN*X2,SGN*YY) + (0.5 - 0.5*SGN)*PI - ELSE - G2 = 0.0 - T2 = 0.0 - ENDIF -c if (aimag(G1) .ne.0) write(*,*) 'G1',G1 -c if (aimag(T1) .ne.0) write(*,*) 'T1',T1 -c if (aimag(T2) .ne.0) write(*,*) 'T2',T2 - - X1I = SX*NXI + SY*NYI -c if (aimag(X1I) .ne. 0) then -c write(*,*) 'SX',SX -c write(*,*) 'NXI',NXI -c write(*,*) 'SY',SY -c write(*,*) 'NYI',NYI -c endif - - X2I = SX*NXI + SY*NYI - YYI = SX*NYI - SY*NXI -C - IF(GEOLIN) THEN - NXO = NX(JO) - NYO = NY(JO) - NXP = NX(JP) - NYP = NY(JP) -C - X1O =-((RX1-X1*SX)*NXO + (RY1-X1*SY)*NYO)*DSIO-(SX*NXO+SY*NYO) - X1P = ((RX1-X1*SX)*NXP + (RY1-X1*SY)*NYP)*DSIO - X2O =-((RX2-X2*SX)*NXO + (RY2-X2*SY)*NYO)*DSIO - X2P = ((RX2-X2*SX)*NXP + (RY2-X2*SY)*NYP)*DSIO-(SX*NXP+SY*NYP) - YYO = ((RX1+X1*SY)*NYO - (RY1-X1*SX)*NXO)*DSIO-(SX*NYO-SY*NXO) - YYP =-((RX1-X1*SY)*NYP - (RY1+X1*SX)*NXP)*DSIO - ENDIF -C - IF(JO.ceq.N) GO TO 11 -C - IF(SIGLIN) THEN -C -C------- set up midpoint quantities - X0 = 0.5*(X1+X2) - RS0 = X0*X0 + YY*YY - G0 = LOG(RS0) - T0 = ATAN2(SGN*X0,SGN*YY) + (0.5 - 0.5*SGN)*PI -C -C------- calculate source contribution to Psi for 1-0 half-panel - DXINV = 1.0/(X1-X0) - PSUM = X0*(T0-APAN) - X1*(T1-APAN) + 0.5*YY*(G1-G0) - PDIF = ((X1+X0)*PSUM + RS1*(T1-APAN) - RS0*(T0-APAN) - & + (X0-X1)*YY) * DXINV -C - PSX1 = -(T1-APAN) - PSX0 = T0-APAN - PSYY = 0.5*(G1-G0) -C - PDX1 = ((X1+X0)*PSX1 + PSUM + 2.0*X1*(T1-APAN) - PDIF) * DXINV - PDX0 = ((X1+X0)*PSX0 + PSUM - 2.0*X0*(T0-APAN) + PDIF) * DXINV - PDYY = ((X1+X0)*PSYY + 2.0*(X0-X1 + YY*(T1-T0)) ) * DXINV -C - DSM = SQRT((X(JP)-X(JM))**2 + (Y(JP)-Y(JM))**2) - DSIM = 1.0/DSM -C -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SIG1 = (SIG(JP) - SIG(JM))*DSIM -CCC SSUM = SIG0 + SIG1 -CCC SDIF = SIG0 - SIG1 -C - SSUM = (SIG(JP) - SIG(JO))*DSIO + (SIG(JP) - SIG(JM))*DSIM - SDIF = (SIG(JP) - SIG(JO))*DSIO - (SIG(JP) - SIG(JM))*DSIM -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JM) = DZDM(JM) + QOPI*(-PSUM*DSIM + PDIF*DSIM) - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*DSIO - PDIF*DSIO) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*(DSIO+DSIM) - & + PDIF*(DSIO-DSIM)) -C -C------- dPsi/dni - PSNI = PSX1*X1I + PSX0*(X1I+X2I)*0.5 + PSYY*YYI - PDNI = PDX1*X1I + PDX0*(X1I+X2I)*0.5 + PDYY*YYI - - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) - -c if (aimag(PSI_NI) .ne. 0) write(*,*) 'position 1',PSI_NI -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JM) = DQDM(JM) + QOPI*(-PSNI*DSIM + PDNI*DSIM) - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*DSIO - PDNI*DSIO) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*(DSIO+DSIM) - & + PDNI*(DSIO-DSIM)) -C -C -C------- calculate source contribution to Psi for 0-2 half-panel - DXINV = 1.0/(X0-X2) - PSUM = X2*(T2-APAN) - X0*(T0-APAN) + 0.5*YY*(G0-G2) - PDIF = ((X0+X2)*PSUM + RS0*(T0-APAN) - RS2*(T2-APAN) - & + (X2-X0)*YY) * DXINV -C - PSX0 = -(T0-APAN) - PSX2 = T2-APAN - PSYY = 0.5*(G0-G2) -C - PDX0 = ((X0+X2)*PSX0 + PSUM + 2.0*X0*(T0-APAN) - PDIF) * DXINV - PDX2 = ((X0+X2)*PSX2 + PSUM - 2.0*X2*(T2-APAN) + PDIF) * DXINV - PDYY = ((X0+X2)*PSYY + 2.0*(X2-X0 + YY*(T0-T2)) ) * DXINV -C - DSP = SQRT((X(JQ)-X(JO))**2 + (Y(JQ)-Y(JO))**2) - DSIP = 1.0/DSP -C -CCC SIG2 = (SIG(JQ) - SIG(JO))*DSIP -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SSUM = SIG2 + SIG0 -CCC SDIF = SIG2 - SIG0 -C - SSUM = (SIG(JQ) - SIG(JO))*DSIP + (SIG(JP) - SIG(JO))*DSIO - SDIF = (SIG(JQ) - SIG(JO))*DSIP - (SIG(JP) - SIG(JO))*DSIO -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*(DSIP+DSIO) - & - PDIF*(DSIP-DSIO)) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*DSIO - PDIF*DSIO) - DZDM(JQ) = DZDM(JQ) + QOPI*( PSUM*DSIP + PDIF*DSIP) -C -C------- dPsi/dni - PSNI = PSX0*(X1I+X2I)*0.5 + PSX2*X2I + PSYY*YYI - PDNI = PDX0*(X1I+X2I)*0.5 + PDX2*X2I + PDYY*YYI - - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -c if (aimag(PSI_NI) .ne. 0) write(*,*) 'position 2',PSI_NI -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*(DSIP+DSIO) - & - PDNI*(DSIP-DSIO)) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*DSIO - PDNI*DSIO) - DQDM(JQ) = DQDM(JQ) + QOPI*( PSNI*DSIP + PDNI*DSIP) -C - ENDIF -C -C------ calculate vortex panel contribution to Psi - DXINV = 1.0/(X1-X2) - PSIS = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) - PSID = ((X1+X2)*PSIS + 0.5*(RS2*G2-RS1*G1 + X1*X1-X2*X2))*DXINV -C - PSX1 = 0.5*G1 - PSX2 = -.5*G2 - PSYY = T1-T2 -C - PDX1 = ((X1+X2)*PSX1 + PSIS - X1*G1 - PSID)*DXINV - PDX2 = ((X1+X2)*PSX2 + PSIS + X2*G2 + PSID)*DXINV - PDYY = ((X1+X2)*PSYY - YY*(G1-G2) )*DXINV -C - GSUM1 = GAMU(JP,1) + GAMU(JO,1) - GSUM2 = GAMU(JP,2) + GAMU(JO,2) - GDIF1 = GAMU(JP,1) - GAMU(JO,1) - GDIF2 = GAMU(JP,2) - GAMU(JO,2) -C - GSUM = GAM(JP) + GAM(JO) - GDIF = GAM(JP) - GAM(JO) -C - PSI = PSI + QOPI*(PSIS*GSUM + PSID*GDIF) -C -C------ dPsi/dGam - DZDG(JO) = DZDG(JO) + QOPI*(PSIS-PSID) - DZDG(JP) = DZDG(JP) + QOPI*(PSIS+PSID) -C -C------ dPsi/dni - PSNI = PSX1*X1I + PSX2*X2I + PSYY*YYI - PDNI = PDX1*X1I + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(GSUM*PSNI + GDIF*PDNI) -c if (aimag(PSI_NI) .ne. 0) then -c write(*,*) 'position 3',PSI_NI -c write(*,*) 'QOPI',QOPI -c write(*,*) 'GSUM', GSUM -c write(*,*) 'PSNI',PSNI -c write(*,*) 'GDIF',GDIF -c write(*,*) 'PDNI',PDNI -c write(*,*) 'PSX1',PSX1 -c write(*,*) 'X1I',X1I -c write(*,*) 'PSX2',PSX2 -c write(*,*) 'X2I',X2I -c write(*,*) 'PSYY',PSYY -c write(*,*) 'YYI',YYI -c endif - -C - QTAN1 = QTAN1 + QOPI*(GSUM1*PSNI + GDIF1*PDNI) - QTAN2 = QTAN2 + QOPI*(GSUM2*PSNI + GDIF2*PDNI) -C - DQDG(JO) = DQDG(JO) + QOPI*(PSNI - PDNI) - DQDG(JP) = DQDG(JP) + QOPI*(PSNI + PDNI) -C - IF(GEOLIN) THEN -C -C------- dPsi/dn - DZDN(JO) = DZDN(JO)+ QOPI*GSUM*(PSX1*X1O + PSX2*X2O + PSYY*YYO) - & + QOPI*GDIF*(PDX1*X1O + PDX2*X2O + PDYY*YYO) - DZDN(JP) = DZDN(JP)+ QOPI*GSUM*(PSX1*X1P + PSX2*X2P + PSYY*YYP) - & + QOPI*GDIF*(PDX1*X1P + PDX2*X2P + PDYY*YYP) -C------- dPsi/dP - Z_QDOF0 = Z_QDOF0 - & + QOPI*((PSIS-PSID)*QF0(JO) + (PSIS+PSID)*QF0(JP)) - Z_QDOF1 = Z_QDOF1 - & + QOPI*((PSIS-PSID)*QF1(JO) + (PSIS+PSID)*QF1(JP)) - Z_QDOF2 = Z_QDOF2 - & + QOPI*((PSIS-PSID)*QF2(JO) + (PSIS+PSID)*QF2(JP)) - Z_QDOF3 = Z_QDOF3 - & + QOPI*((PSIS-PSID)*QF3(JO) + (PSIS+PSID)*QF3(JP)) - ENDIF -C -C - 10 CONTINUE -C - 11 CONTINUE - PSIG = 0.5*YY*(G1-G2) + X2*(T2-APAN) - X1*(T1-APAN) - PGAM = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) -C - PSIGX1 = -(T1-APAN) - PSIGX2 = T2-APAN - PSIGYY = 0.5*(G1-G2) - PGAMX1 = 0.5*G1 - PGAMX2 = -.5*G2 - PGAMYY = T1-T2 -C - PSIGNI = PSIGX1*X1I + PSIGX2*X2I + PSIGYY*YYI - PGAMNI = PGAMX1*X1I + PGAMX2*X2I + PGAMYY*YYI -C -C---- TE panel source and vortex strengths - SIGTE1 = 0.5*SCS*(GAMU(JP,1) - GAMU(JO,1)) - SIGTE2 = 0.5*SCS*(GAMU(JP,2) - GAMU(JO,2)) - GAMTE1 = -.5*SDS*(GAMU(JP,1) - GAMU(JO,1)) - GAMTE2 = -.5*SDS*(GAMU(JP,2) - GAMU(JO,2)) -C - SIGTE = 0.5*SCS*(GAM(JP) - GAM(JO)) - GAMTE = -.5*SDS*(GAM(JP) - GAM(JO)) -C -C---- TE panel contribution to Psi - PSI = PSI + HOPI*(PSIG*SIGTE + PGAM*GAMTE) -C -C---- dPsi/dGam - DZDG(JO) = DZDG(JO) - HOPI*PSIG*SCS*0.5 - DZDG(JP) = DZDG(JP) + HOPI*PSIG*SCS*0.5 -C - DZDG(JO) = DZDG(JO) + HOPI*PGAM*SDS*0.5 - DZDG(JP) = DZDG(JP) - HOPI*PGAM*SDS*0.5 -C -C---- dPsi/dni - PSI_NI = PSI_NI + HOPI*(PSIGNI*SIGTE + PGAMNI*GAMTE) -C - QTAN1 = QTAN1 + HOPI*(PSIGNI*SIGTE1 + PGAMNI*GAMTE1) - QTAN2 = QTAN2 + HOPI*(PSIGNI*SIGTE2 + PGAMNI*GAMTE2) -C - DQDG(JO) = DQDG(JO) - HOPI*(PSIGNI*0.5*SCS - PGAMNI*0.5*SDS) - DQDG(JP) = DQDG(JP) + HOPI*(PSIGNI*0.5*SCS - PGAMNI*0.5*SDS) -C - IF(GEOLIN) THEN -C -C----- dPsi/dn - DZDN(JO) = DZDN(JO) - & + HOPI*(PSIGX1*X1O + PSIGX2*X2O + PSIGYY*YYO)*SIGTE - & + HOPI*(PGAMX1*X1O + PGAMX2*X2O + PGAMYY*YYO)*GAMTE - DZDN(JP) = DZDN(JP) - & + HOPI*(PSIGX1*X1P + PSIGX2*X2P + PSIGYY*YYP)*SIGTE - & + HOPI*(PGAMX1*X1P + PGAMX2*X2P + PGAMYY*YYP)*GAMTE -C -C----- dPsi/dP - Z_QDOF0 = Z_QDOF0 + HOPI*PSIG*0.5*(QF0(JP)-QF0(JO))*SCS - & - HOPI*PGAM*0.5*(QF0(JP)-QF0(JO))*SDS - Z_QDOF1 = Z_QDOF1 + HOPI*PSIG*0.5*(QF1(JP)-QF1(JO))*SCS - & - HOPI*PGAM*0.5*(QF1(JP)-QF1(JO))*SDS - Z_QDOF2 = Z_QDOF2 + HOPI*PSIG*0.5*(QF2(JP)-QF2(JO))*SCS - & - HOPI*PGAM*0.5*(QF2(JP)-QF2(JO))*SDS - Z_QDOF3 = Z_QDOF3 + HOPI*PSIG*0.5*(QF3(JP)-QF3(JO))*SCS - & - HOPI*PGAM*0.5*(QF3(JP)-QF3(JO))*SDS -C - ENDIF -C - 12 CONTINUE -C -C**** Freestream terms - PSI = PSI + QINF*(COSA*YI - SINA*XI) -C -C---- dPsi/dn - PSI_NI = PSI_NI + QINF*(COSA*NYI - SINA*NXI) -C - QTAN1 = QTAN1 + QINF*NYI - QTAN2 = QTAN2 - QINF*NXI -C -C---- dPsi/dQinf - Z_QINF = Z_QINF + (COSA*YI - SINA*XI) -C -C---- dPsi/dalfa - Z_ALFA = Z_ALFA - QINF*(SINA*YI + COSA*XI) -C - IF(.NOT.LIMAGE) RETURN -C -C -C - DO 20 JO=1, N - JP = JO+1 -C - JM = JO-1 - JQ = JP+1 -C - IF(JO.ceq.1) THEN - JM = JO - ELSE IF(JO.ceq.N-1) THEN - JQ = JP - ELSE IF(JO.ceq.N) THEN - JP = 1 - IF((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2 .LT. SEPS**2) GO TO 22 - ENDIF -C - DSO = SQRT((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2) -C -C------ skip null panel - IF(DSO .ceq. 0.0) GO TO 20 -C - DSIO = 1.0 / DSO -C -ccc APAN = APANEL(JO) - APAN = PI - APANEL(JO) + 2.0*ALFA -C - XJO = X(JO) + 2.0*(YIMAGE+Y(JO))*SINA - YJO = Y(JO) - 2.0*(YIMAGE+Y(JO))*COSA - XJP = X(JP) + 2.0*(YIMAGE+Y(JP))*SINA - YJP = Y(JP) - 2.0*(YIMAGE+Y(JP))*COSA -C - RX1 = XI - XJO - RY1 = YI - YJO - RX2 = XI - XJP - RY2 = YI - YJP -C - SX = (XJP - XJO) * DSIO - SY = (YJP - YJO) * DSIO -C - X1 = SX*RX1 + SY*RY1 - X2 = SX*RX2 + SY*RY2 - YY = SX*RY1 - SY*RX1 -C - RS1 = RX1*RX1 + RY1*RY1 - RS2 = RX2*RX2 + RY2*RY2 -C -C------ set reflection flag SGN to avoid branch problems with arctan - IF(IO.GE.1 .AND. IO.LE.N) THEN -C------- no problem on airfoil surface - SGN = 1.0 - ELSE -C------- make sure arctan falls between -/+ Pi/2 - SGN = SIGN(1.0,YY) - ENDIF -C -C------ set log(r^2) and arctan(x/y), correcting for reflection if any - G1 = LOG(RS1) - T1 = ATAN2(SGN*X1,SGN*YY) + (0.5 - 0.5*SGN)*PI -C - G2 = LOG(RS2) - T2 = ATAN2(SGN*X2,SGN*YY) + (0.5 - 0.5*SGN)*PI -C - X1I = SX*NXI + SY*NYI - X2I = SX*NXI + SY*NYI - YYI = SX*NYI - SY*NXI -C - IF(GEOLIN) THEN - NXO = NX(JO) - NYO = NY(JO) - NXP = NX(JP) - NYP = NY(JP) -C - X1O =-((RX1-X1*SX)*NXO + (RY1-X1*SY)*NYO)*DSIO-(SX*NXO+SY*NYO) - X1P = ((RX1-X1*SX)*NXP + (RY1-X1*SY)*NYP)*DSIO - X2O =-((RX2-X2*SX)*NXO + (RY2-X2*SY)*NYO)*DSIO - X2P = ((RX2-X2*SX)*NXP + (RY2-X2*SY)*NYP)*DSIO-(SX*NXP+SY*NYP) - YYO = ((RX1+X1*SY)*NYO - (RY1-X1*SX)*NXO)*DSIO-(SX*NYO-SY*NXO) - YYP =-((RX1-X1*SY)*NYP - (RY1+X1*SX)*NXP)*DSIO - ENDIF -C - IF(JO.ceq.N) GO TO 21 -C - IF(SIGLIN) THEN -C -C------- set up midpoint quantities - X0 = 0.5*(X1+X2) - RS0 = X0*X0 + YY*YY - G0 = LOG(RS0) - T0 = ATAN2(SGN*X0,SGN*YY) + (0.5 - 0.5*SGN)*PI -C -C------- calculate source contribution to Psi for 1-0 half-panel - DXINV = 1.0/(X1-X0) - PSUM = X0*(T0-APAN) - X1*(T1-APAN) + 0.5*YY*(G1-G0) - PDIF = ((X1+X0)*PSUM + RS1*(T1-APAN) - RS0*(T0-APAN) - & + (X0-X1)*YY) * DXINV -C - PSX1 = -(T1-APAN) - PSX0 = T0-APAN - PSYY = 0.5*(G1-G0) -C - PDX1 = ((X1+X0)*PSX1 + PSUM + 2.0*X1*(T1-APAN) - PDIF) * DXINV - PDX0 = ((X1+X0)*PSX0 + PSUM - 2.0*X0*(T0-APAN) + PDIF) * DXINV - PDYY = ((X1+X0)*PSYY + 2.0*(X0-X1 + YY*(T1-T0)) ) * DXINV -C - DSM = SQRT((X(JP)-X(JM))**2 + (Y(JP)-Y(JM))**2) - DSIM = 1.0/DSM -C -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SIG1 = (SIG(JP) - SIG(JM))*DSIM -CCC SSUM = SIG0 + SIG1 -CCC SDIF = SIG0 - SIG1 -C - SSUM = (SIG(JP) - SIG(JO))*DSIO + (SIG(JP) - SIG(JM))*DSIM - SDIF = (SIG(JP) - SIG(JO))*DSIO - (SIG(JP) - SIG(JM))*DSIM -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JM) = DZDM(JM) + QOPI*(-PSUM*DSIM + PDIF*DSIM) - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*DSIO - PDIF*DSIO) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*(DSIO+DSIM) - & + PDIF*(DSIO-DSIM)) -C -C------- dPsi/dni - PSNI = PSX1*X1I + PSX0*(X1I+X2I)*0.5 + PSYY*YYI - PDNI = PDX1*X1I + PDX0*(X1I+X2I)*0.5 + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JM) = DQDM(JM) + QOPI*(-PSNI*DSIM + PDNI*DSIM) - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*DSIO - PDNI*DSIO) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*(DSIO+DSIM) - & + PDNI*(DSIO-DSIM)) -C -C -C------- calculate source contribution to Psi for 0-2 half-panel - DXINV = 1.0/(X0-X2) - PSUM = X2*(T2-APAN) - X0*(T0-APAN) + 0.5*YY*(G0-G2) - PDIF = ((X0+X2)*PSUM + RS0*(T0-APAN) - RS2*(T2-APAN) - & + (X2-X0)*YY) * DXINV -C - PSX0 = -(T0-APAN) - PSX2 = T2-APAN - PSYY = 0.5*(G0-G2) -C - PDX0 = ((X0+X2)*PSX0 + PSUM + 2.0*X0*(T0-APAN) - PDIF) * DXINV - PDX2 = ((X0+X2)*PSX2 + PSUM - 2.0*X2*(T2-APAN) + PDIF) * DXINV - PDYY = ((X0+X2)*PSYY + 2.0*(X2-X0 + YY*(T0-T2)) ) * DXINV -C - DSP = SQRT((X(JQ)-X(JO))**2 + (Y(JQ)-Y(JO))**2) - DSIP = 1.0/DSP -C -CCC SIG2 = (SIG(JQ) - SIG(JO))*DSIP -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SSUM = SIG2 + SIG0 -CCC SDIF = SIG2 - SIG0 -C - SSUM = (SIG(JQ) - SIG(JO))*DSIP + (SIG(JP) - SIG(JO))*DSIO - SDIF = (SIG(JQ) - SIG(JO))*DSIP - (SIG(JP) - SIG(JO))*DSIO -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*(DSIP+DSIO) - & - PDIF*(DSIP-DSIO)) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*DSIO - PDIF*DSIO) - DZDM(JQ) = DZDM(JQ) + QOPI*( PSUM*DSIP + PDIF*DSIP) -C -C------- dPsi/dni - PSNI = PSX0*(X1I+X2I)*0.5 + PSX2*X2I + PSYY*YYI - PDNI = PDX0*(X1I+X2I)*0.5 + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - QTANM = QTANM + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*(DSIP+DSIO) - & - PDNI*(DSIP-DSIO)) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*DSIO - PDNI*DSIO) - DQDM(JQ) = DQDM(JQ) + QOPI*( PSNI*DSIP + PDNI*DSIP) -C - ENDIF -C -C------ calculate vortex panel contribution to Psi - DXINV = 1.0/(X1-X2) - PSIS = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) - PSID = ((X1+X2)*PSIS + 0.5*(RS2*G2-RS1*G1 + X1*X1-X2*X2))*DXINV -C - PSX1 = 0.5*G1 - PSX2 = -.5*G2 - PSYY = T1-T2 -C - PDX1 = ((X1+X2)*PSX1 + PSIS - X1*G1 - PSID)*DXINV - PDX2 = ((X1+X2)*PSX2 + PSIS + X2*G2 + PSID)*DXINV - PDYY = ((X1+X2)*PSYY - YY*(G1-G2) )*DXINV -C - GSUM1 = GAMU(JP,1) + GAMU(JO,1) - GSUM2 = GAMU(JP,2) + GAMU(JO,2) - GDIF1 = GAMU(JP,1) - GAMU(JO,1) - GDIF2 = GAMU(JP,2) - GAMU(JO,2) -C - GSUM = GAM(JP) + GAM(JO) - GDIF = GAM(JP) - GAM(JO) -C - PSI = PSI - QOPI*(PSIS*GSUM + PSID*GDIF) -C -C------ dPsi/dGam - DZDG(JO) = DZDG(JO) - QOPI*(PSIS-PSID) - DZDG(JP) = DZDG(JP) - QOPI*(PSIS+PSID) -C -C------ dPsi/dni - PSNI = PSX1*X1I + PSX2*X2I + PSYY*YYI - PDNI = PDX1*X1I + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI - QOPI*(GSUM*PSNI + GDIF*PDNI) -C - QTAN1 = QTAN1 - QOPI*(GSUM1*PSNI + GDIF1*PDNI) - QTAN2 = QTAN2 - QOPI*(GSUM2*PSNI + GDIF2*PDNI) -C - DQDG(JO) = DQDG(JO) - QOPI*(PSNI - PDNI) - DQDG(JP) = DQDG(JP) - QOPI*(PSNI + PDNI) -C - IF(GEOLIN) THEN -C -C------- dPsi/dn - DZDN(JO) = DZDN(JO)- QOPI*GSUM*(PSX1*X1O + PSX2*X2O + PSYY*YYO) - & - QOPI*GDIF*(PDX1*X1O + PDX2*X2O + PDYY*YYO) - DZDN(JP) = DZDN(JP)- QOPI*GSUM*(PSX1*X1P + PSX2*X2P + PSYY*YYP) - & - QOPI*GDIF*(PDX1*X1P + PDX2*X2P + PDYY*YYP) -C------- dPsi/dP - Z_QDOF0 = Z_QDOF0 - & - QOPI*((PSIS-PSID)*QF0(JO) + (PSIS+PSID)*QF0(JP)) - Z_QDOF1 = Z_QDOF1 - & - QOPI*((PSIS-PSID)*QF1(JO) + (PSIS+PSID)*QF1(JP)) - Z_QDOF2 = Z_QDOF2 - & - QOPI*((PSIS-PSID)*QF2(JO) + (PSIS+PSID)*QF2(JP)) - Z_QDOF3 = Z_QDOF3 - & - QOPI*((PSIS-PSID)*QF3(JO) + (PSIS+PSID)*QF3(JP)) - ENDIF -C -C - 20 CONTINUE -C - 21 CONTINUE - PSIG = 0.5*YY*(G1-G2) + X2*(T2-APAN) - X1*(T1-APAN) - PGAM = 0.5*X1*G1 - 0.5*X2*G2 + X2 - X1 + YY*(T1-T2) -C - PSIGX1 = -(T1-APAN) - PSIGX2 = T2-APAN - PSIGYY = 0.5*(G1-G2) - PGAMX1 = 0.5*G1 - PGAMX2 = -.5*G2 - PGAMYY = T1-T2 -C - PSIGNI = PSIGX1*X1I + PSIGX2*X2I + PSIGYY*YYI - PGAMNI = PGAMX1*X1I + PGAMX2*X2I + PGAMYY*YYI -C -C---- TE panel source and vortex strengths - SIGTE1 = 0.5*SCS*(GAMU(JP,1) - GAMU(JO,1)) - SIGTE2 = 0.5*SCS*(GAMU(JP,2) - GAMU(JO,2)) - GAMTE1 = -.5*SDS*(GAMU(JP,1) - GAMU(JO,1)) - GAMTE2 = -.5*SDS*(GAMU(JP,2) - GAMU(JO,2)) -C - SIGTE = 0.5*SCS*(GAM(JP) - GAM(JO)) - GAMTE = -.5*SDS*(GAM(JP) - GAM(JO)) -C -C---- TE panel contribution to Psi - PSI = PSI + HOPI*(PSIG*SIGTE - PGAM*GAMTE) -C -C---- dPsi/dGam - DZDG(JO) = DZDG(JO) - HOPI*PSIG*SCS*0.5 - DZDG(JP) = DZDG(JP) + HOPI*PSIG*SCS*0.5 -C - DZDG(JO) = DZDG(JO) - HOPI*PGAM*SDS*0.5 - DZDG(JP) = DZDG(JP) + HOPI*PGAM*SDS*0.5 -C -C---- dPsi/dni - PSI_NI = PSI_NI + HOPI*(PSIGNI*SIGTE - PGAMNI*GAMTE) -C - QTAN1 = QTAN1 + HOPI*(PSIGNI*SIGTE1 - PGAMNI*GAMTE1) - QTAN2 = QTAN2 + HOPI*(PSIGNI*SIGTE2 - PGAMNI*GAMTE2) -C - DQDG(JO) = DQDG(JO) - HOPI*(PSIGNI*0.5*SCS + PGAMNI*0.5*SDS) - DQDG(JP) = DQDG(JP) + HOPI*(PSIGNI*0.5*SCS + PGAMNI*0.5*SDS) -C - IF(GEOLIN) THEN -C -C----- dPsi/dn - DZDN(JO) = DZDN(JO) - & + HOPI*(PSIGX1*X1O + PSIGX2*X2O + PSIGYY*YYO)*SIGTE - & - HOPI*(PGAMX1*X1O + PGAMX2*X2O + PGAMYY*YYO)*GAMTE - DZDN(JP) = DZDN(JP) - & + HOPI*(PSIGX1*X1P + PSIGX2*X2P + PSIGYY*YYP)*SIGTE - & - HOPI*(PGAMX1*X1P + PGAMX2*X2P + PGAMYY*YYP)*GAMTE -C -C----- dPsi/dP - Z_QDOF0 = Z_QDOF0 + HOPI*PSIG*0.5*(QF0(JP)-QF0(JO))*SCS - & + HOPI*PGAM*0.5*(QF0(JP)-QF0(JO))*SDS - Z_QDOF1 = Z_QDOF1 + HOPI*PSIG*0.5*(QF1(JP)-QF1(JO))*SCS - & + HOPI*PGAM*0.5*(QF1(JP)-QF1(JO))*SDS - Z_QDOF2 = Z_QDOF2 + HOPI*PSIG*0.5*(QF2(JP)-QF2(JO))*SCS - & + HOPI*PGAM*0.5*(QF2(JP)-QF2(JO))*SDS - Z_QDOF3 = Z_QDOF3 + HOPI*PSIG*0.5*(QF3(JP)-QF3(JO))*SCS - & + HOPI*PGAM*0.5*(QF3(JP)-QF3(JO))*SDS -C - ENDIF -C - 22 CONTINUE -C - RETURN - END - - - SUBROUTINE PSWLIN(I,XI,YI,NXI,NYI,PSI,PSI_NI) -C-------------------------------------------------------------------- -C Calculates current streamfunction Psi and tangential velocity -C Qtan at panel node or wake node I due to freestream and wake -C sources Sig. Also calculates sensitivity vectors dPsi/dSig -C (DZDM) and dQtan/dSig (DQDM). -C -C Airfoil: 1 < I < N -C Wake: N+1 < I < N+NW -C-------------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' - complex NXI, NYI -C - IO = I -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C - DO 4 JO=N+1, N+NW - DZDM(JO) = 0.0 - DQDM(JO) = 0.0 - 4 CONTINUE -C - PSI = 0. - PSI_NI = 0. -C - DO 20 JO=N+1, N+NW-1 -C - JP = JO+1 -C - JM = JO-1 - JQ = JP+1 - IF(JO.ceq.N+1) THEN - JM = JO - ELSE IF(JO.ceq.N+NW-1) THEN - JQ = JP - ENDIF -C - DSO = SQRT((X(JO)-X(JP))**2 + (Y(JO)-Y(JP))**2) - DSIO = 1.0 / DSO -C - APAN = APANEL(JO) -C - RX1 = XI - X(JO) - RY1 = YI - Y(JO) - RX2 = XI - X(JP) - RY2 = YI - Y(JP) -C - SX = (X(JP) - X(JO)) * DSIO - SY = (Y(JP) - Y(JO)) * DSIO -C - X1 = SX*RX1 + SY*RY1 - X2 = SX*RX2 + SY*RY2 - YY = SX*RY1 - SY*RX1 -C - RS1 = RX1*RX1 + RY1*RY1 - RS2 = RX2*RX2 + RY2*RY2 -C - IF(IO.GE.N+1 .AND. IO.LE.N+NW) THEN - SGN = 1.0 - ELSE - SGN = SIGN(1.0,YY) - ENDIF -C - IF((IO.cne.JO) .AND. RS1.GT.0.0) THEN - G1 = LOG(RS1) - T1 = ATAN2(SGN*X1,SGN*YY) - (0.5 - 0.5*SGN)*PI - ELSE - G1 = 0.0 - T1 = 0.0 - ENDIF -C - IF((IO.cne.JP) .AND. RS2.GT.0.0) THEN - G2 = LOG(RS2) - T2 = ATAN2(SGN*X2,SGN*YY) - (0.5 - 0.5*SGN)*PI - ELSE - G2 = 0.0 - T2 = 0.0 - ENDIF -C - X1I = SX*NXI + SY*NYI - X2I = SX*NXI + SY*NYI - YYI = SX*NYI - SY*NXI -C -C------- set up midpoint quantities - X0 = 0.5*(X1+X2) - RS0 = X0*X0 + YY*YY - G0 = LOG(RS0) - T0 = ATAN2(SGN*X0,SGN*YY) - (0.5 - 0.5*SGN)*PI -C -C------- calculate source contribution to Psi for 1-0 half-panel - DXINV = 1.0/(X1-X0) - PSUM = X0*(T0-APAN) - X1*(T1-APAN) + 0.5*YY*(G1-G0) - PDIF = ((X1+X0)*PSUM + RS1*(T1-APAN) - RS0*(T0-APAN) - & + (X0-X1)*YY) * DXINV -C - PSX1 = -(T1-APAN) - PSX0 = T0-APAN - PSYY = 0.5*(G1-G0) -C - PDX1 = ((X1+X0)*PSX1 + PSUM + 2.0*X1*(T1-APAN) - PDIF) * DXINV - PDX0 = ((X1+X0)*PSX0 + PSUM - 2.0*X0*(T0-APAN) + PDIF) * DXINV - PDYY = ((X1+X0)*PSYY + 2.0*(X0-X1 + YY*(T1-T0)) ) * DXINV -C - DSM = SQRT((X(JP)-X(JM))**2 + (Y(JP)-Y(JM))**2) - DSIM = 1.0/DSM -C -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SIG1 = (SIG(JP) - SIG(JM))*DSIM -CCC SSUM = SIG0 + SIG1 -CCC SDIF = SIG0 - SIG1 -C - SSUM = (SIG(JP) - SIG(JO))*DSIO + (SIG(JP) - SIG(JM))*DSIM - SDIF = (SIG(JP) - SIG(JO))*DSIO - (SIG(JP) - SIG(JM))*DSIM -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JM) = DZDM(JM) + QOPI*(-PSUM*DSIM + PDIF*DSIM) - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*DSIO - PDIF*DSIO) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*(DSIO+DSIM) - & + PDIF*(DSIO-DSIM)) -C -C------- dPsi/dni - PSNI = PSX1*X1I + PSX0*(X1I+X2I)*0.5 + PSYY*YYI - PDNI = PDX1*X1I + PDX0*(X1I+X2I)*0.5 + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JM) = DQDM(JM) + QOPI*(-PSNI*DSIM + PDNI*DSIM) - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*DSIO - PDNI*DSIO) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*(DSIO+DSIM) - & + PDNI*(DSIO-DSIM)) -C -C -C------- calculate source contribution to Psi for 0-2 half-panel - DXINV = 1.0/(X0-X2) - PSUM = X2*(T2-APAN) - X0*(T0-APAN) + 0.5*YY*(G0-G2) - PDIF = ((X0+X2)*PSUM + RS0*(T0-APAN) - RS2*(T2-APAN) - & + (X2-X0)*YY) * DXINV -C - PSX0 = -(T0-APAN) - PSX2 = T2-APAN - PSYY = 0.5*(G0-G2) -C - PDX0 = ((X0+X2)*PSX0 + PSUM + 2.0*X0*(T0-APAN) - PDIF) * DXINV - PDX2 = ((X0+X2)*PSX2 + PSUM - 2.0*X2*(T2-APAN) + PDIF) * DXINV - PDYY = ((X0+X2)*PSYY + 2.0*(X2-X0 + YY*(T0-T2)) ) * DXINV -C - DSP = SQRT((X(JQ)-X(JO))**2 + (Y(JQ)-Y(JO))**2) - DSIP = 1.0/DSP -C -CCC SIG2 = (SIG(JQ) - SIG(JO))*DSIP -CCC SIG0 = (SIG(JP) - SIG(JO))*DSIO -CCC SSUM = SIG2 + SIG0 -CCC SDIF = SIG2 - SIG0 -C - SSUM = (SIG(JQ) - SIG(JO))*DSIP + (SIG(JP) - SIG(JO))*DSIO - SDIF = (SIG(JQ) - SIG(JO))*DSIP - (SIG(JP) - SIG(JO))*DSIO -C - PSI = PSI + QOPI*(PSUM*SSUM + PDIF*SDIF) -C -C------- dPsi/dm - DZDM(JO) = DZDM(JO) + QOPI*(-PSUM*(DSIP+DSIO) - & - PDIF*(DSIP-DSIO)) - DZDM(JP) = DZDM(JP) + QOPI*( PSUM*DSIO - PDIF*DSIO) - DZDM(JQ) = DZDM(JQ) + QOPI*( PSUM*DSIP + PDIF*DSIP) -C -C------- dPsi/dni - PSNI = PSX0*(X1I+X2I)*0.5 + PSX2*X2I + PSYY*YYI - PDNI = PDX0*(X1I+X2I)*0.5 + PDX2*X2I + PDYY*YYI - PSI_NI = PSI_NI + QOPI*(PSNI*SSUM + PDNI*SDIF) -C - DQDM(JO) = DQDM(JO) + QOPI*(-PSNI*(DSIP+DSIO) - & - PDNI*(DSIP-DSIO)) - DQDM(JP) = DQDM(JP) + QOPI*( PSNI*DSIO - PDNI*DSIO) - DQDM(JQ) = DQDM(JQ) + QOPI*( PSNI*DSIP + PDNI*DSIP) -C - 20 CONTINUE -C - RETURN - END - - - -C************************************************** -C -C CALLED FROM SPECAL/SPECCL -C -C************************************************** - SUBROUTINE GGCALC -C-------------------------------------------------------------- -C Calculates two surface vorticity (gamma) distributions -C for alpha = 0, 90 degrees. These are superimposed -C in SPECAL or SPECCL for specified alpha or CL. -C-------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- distance of internal control point ahead of sharp TE -C- (fraction of smaller panel length adjacent to TE) - BWT = 0.1 -C -C WRITE(*,*) 'Calculating unit vorticity distributions ...' -C - DO 10 I=1, N - GAM(I) = 0. - GAMU(I,1) = 0. - GAMU(I,2) = 0. - 10 CONTINUE - PSIO = 0. -C -C---- Set up matrix system for Psi = Psio on airfoil surface. -C- The unknowns are (dGamma)i and dPsio. - DO 20 I=1, N -C -C------ calculate Psi and dPsi/dGamma array for current node - CALL PSILIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N,.FALSE.,.TRUE.) -C - PSIINF = QINF*(COS(ALFA)*Y(I) - SIN(ALFA)*X(I)) -C -C------ RES1 = PSI( 0) - PSIO -C------ RES2 = PSI(90) - PSIO - RES1 = QINF*Y(I) - RES2 = -QINF*X(I) -C -C------ dRes/dGamma - DO 201 J=1, N - AIJ(I,J) = DZDG(J) - 201 CONTINUE -C - DO 202 J=1, N - BIJ(I,J) = -DZDM(J) - 202 CONTINUE -C -C------ dRes/dPsio - AIJ(I,N+1) = -1.0 -C - GAMU(I,1) = -RES1 - GAMU(I,2) = -RES2 -C - 20 CONTINUE -C -C---- set Kutta condition -C- RES = GAM(1) + GAM(N) - RES = 0. -C - DO 30 J=1, N+1 - AIJ(N+1,J) = 0.0 - 30 CONTINUE -C - AIJ(N+1,1) = 1.0 - AIJ(N+1,N) = 1.0 -C - GAMU(N+1,1) = -RES - GAMU(N+1,2) = -RES -C -C---- set up Kutta condition (no direct source influence) - DO 32 J=1, N - BIJ(N+1,J) = 0. - 32 CONTINUE -C - IF(SHARP) THEN -C----- set zero internal velocity in TE corner -C -C----- set TE bisector angle - AG1 = ATAN2(-YP(1),-XP(1) ) - AG2 = ATANC( YP(N), XP(N),AG1) - ABIS = 0.5*(AG1+AG2) - CBIS = COS(ABIS) - SBIS = SIN(ABIS) -C -C----- minimum panel length adjacent to TE - DS1 = SQRT( (X(1)-X(2) )**2 + (Y(1)-Y(2) )**2 ) - DS2 = SQRT( (X(N)-X(N-1))**2 + (Y(N)-Y(N-1))**2 ) - DSMIN = MIN( DS1 , DS2 ) -C -C----- control point on bisector just ahead of TE point - XBIS = XTE - BWT*DSMIN*CBIS - YBIS = YTE - BWT*DSMIN*SBIS -ccc write(*,*) xbis, ybis -C -C----- set velocity component along bisector line - CALL PSILIN(0,XBIS,YBIS,-SBIS,CBIS,PSI,QBIS,.FALSE.,.TRUE.) -C -CCC--- RES = DQDGj*Gammaj + DQDMj*Massj + QINF*(COSA*CBIS + SINA*SBIS) - RES = QBIS -C -C----- dRes/dGamma - DO J=1, N - AIJ(N,J) = DQDG(J) - ENDDO -C -C----- -dRes/dMass - DO J=1, N - BIJ(N,J) = -DQDM(J) - ENDDO -C -C----- dRes/dPsio - AIJ(N,N+1) = 0. -C -C----- -dRes/dUinf - GAMU(N,1) = -CBIS -C -C----- -dRes/dVinf - GAMU(N,2) = -SBIS -C - ENDIF -C -C---- LU-factor coefficient matrix AIJ - CALL LUDCMP(IQX,N+1,AIJ,AIJPIV) - LQAIJ = .TRUE. -C -C---- solve system for the two vorticity distributions - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,GAMU(1,1)) - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,GAMU(1,2)) -C -C---- set inviscid alpha=0,90 surface speeds for this geometry - DO 50 I=1, N - QINVU(I,1) = GAMU(I,1) - QINVU(I,2) = GAMU(I,2) - 50 CONTINUE -C - LGAMU = .TRUE. -C - RETURN - END - - - - SUBROUTINE QWCALC -C--------------------------------------------------------------- -C Sets inviscid tangential velocity for alpha = 0, 90 -C on wake due to freestream and airfoil surface vorticity. -C--------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- first wake point (same as TE) - QINVU(N+1,1) = QINVU(N,1) - QINVU(N+1,2) = QINVU(N,2) -C -C---- rest of wake - DO 10 I=N+2, N+NW - CALL PSILIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_NI,.FALSE.,.FALSE.) - QINVU(I,1) = QTAN1 - QINVU(I,2) = QTAN2 - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE QDCALC -C----------------------------------------------------- -C Calculates source panel influence coefficient -C matrix for current airfoil and wake geometry. -C----------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C WRITE(*,*) 'Calculating source influence matrix ...' -C - IF(.NOT.LADIJ) THEN -C -C----- calculate source influence matrix for airfoil surface if it doesn't exist - DO 10 J=1, N -C -C------- multiply each dPsi/Sig vector by inverse of factored dPsi/dGam matrix - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,BIJ(1,J)) -C -C------- store resulting dGam/dSig = dQtan/dSig vector - DO 105 I=1, N - DIJ(I,J) = BIJ(I,J) - 105 CONTINUE -C - 10 CONTINUE - LADIJ = .TRUE. -C - ENDIF -C -C---- set up coefficient matrix of dPsi/dm on airfoil surface - DO 20 I=1, N - CALL PSWLIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N) - DO 202 J=N+1, N+NW - BIJ(I,J) = -DZDM(J) - 202 CONTINUE - 20 CONTINUE -C -C---- set up Kutta condition (no direct source influence) - DO 32 J=N+1, N+NW - BIJ(N+1,J) = 0. - 32 CONTINUE -C -C---- sharp TE gamma extrapolation also has no source influence - IF(SHARP) THEN - DO 34 J=N+1, N+NW - BIJ(N,J) = 0. - 34 CONTINUE - ENDIF -C -C---- multiply by inverse of factored dPsi/dGam matrix - DO 40 J=N+1, N+NW - CALL BAKSUB(IQX,N+1,AIJ,AIJPIV,BIJ(1,J)) - 40 CONTINUE -C -C---- set the source influence matrix for the wake sources - DO 50 I=1, N - DO 510 J=N+1, N+NW - DIJ(I,J) = BIJ(I,J) - 510 CONTINUE - 50 CONTINUE -C -C**** Now we need to calculate the influence of sources on the wake velocities -C -C---- calculcate dQtan/dGam and dQtan/dSig at the wake points - DO 70 I=N+1, N+NW -C - IW = I-N -C -C------ airfoil contribution at wake panel node - CALL PSILIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N,.FALSE.,.TRUE.) -C - DO 710 J=1, N - CIJ(IW,J) = DQDG(J) - 710 CONTINUE -C - DO 720 J=1, N - DIJ(I,J) = DQDM(J) - 720 CONTINUE -C -C------ wake contribution - CALL PSWLIN(I,X(I),Y(I),NX(I),NY(I),PSI,PSI_N) -C - DO 730 J=N+1, N+NW - DIJ(I,J) = DQDM(J) - 730 CONTINUE -C - 70 CONTINUE -C -C---- add on effect of all sources on airfoil vorticity which effects wake Qtan - DO 80 I=N+1, N+NW - IW = I-N -C -C------ airfoil surface source contribution first - DO 810 J=1, N - SUM = 0. - DO 8100 K=1, N - SUM = SUM + CIJ(IW,K)*DIJ(K,J) - 8100 CONTINUE - DIJ(I,J) = DIJ(I,J) + SUM - 810 CONTINUE -C -C------ wake source contribution next - DO 820 J=N+1, N+NW - SUM = 0. - DO 8200 K=1, N - SUM = SUM + CIJ(IW,K)*BIJ(K,J) - 8200 CONTINUE - DIJ(I,J) = DIJ(I,J) + SUM - 820 CONTINUE -C - 80 CONTINUE -C -C---- make sure first wake point has same velocity as trailing edge - DO 90 J=1, N+NW - DIJ(N+1,J) = DIJ(N,J) - 90 CONTINUE -C - LWDIJ = .TRUE. -C - RETURN - END - - - SUBROUTINE XYWAKE -C----------------------------------------------------- -C Sets wake coordinate array for current surface -C vorticity and/or mass source distributions. -C----------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C WRITE(*,*) 'Calculating wake trajectory ...' -C -C---- number of wake points - NW = N/8 + 2 - IF(NW.GT.IWX) THEN -C WRITE(*,*) -C & 'Array size (IWX) too small. Last wake point index reduced.' - NW = IWX - ENDIF -C - DS1 = 0.5*(S(2) - S(1) + S(N) - S(N-1)) - CALL SETEXP(SNEW(N+1),DS1,WAKLEN*CHORD,NW) - - XTE = 0.5*(X(1)+X(N)) - YTE = 0.5*(Y(1)+Y(N)) -C -C---- set first wake point a tiny distance behind TE - I = N+1 - SX = 0.5*(YP(N) - YP(1)) - SY = 0.5*(XP(1) - XP(N)) - SMOD = SQRT(SX**2 + SY**2) - NX(I) = SX / SMOD - NY(I) = SY / SMOD - X(I) = XTE - 0.0001*NY(I) - Y(I) = YTE + 0.0001*NX(I) - S(I) = S(N) -C -C---- calculate streamfunction gradient components at first point - - xhat = cmplx(1,0) - yhat = cmplx(0,0) - CALL PSILIN(I,X(I),Y(I),xhat,yhat,PSI,PSI_X,.FALSE.,.FALSE.) - xhat = cmplx(0,0) - yhat = cmplx(1,0) - - CALL PSILIN(I,X(I),Y(I),xhat,yhat,PSI,PSI_Y,.FALSE.,.FALSE.) -c write(*,*) 'PSI',PSI -c write(*,*) 'PSI_X',PSI_X - -c write(*,*) 'PSI_Y',PSI_Y - -C---- set unit vector normal to wake at first point - NX(I+1) = -PSI_X / SQRT(PSI_X**2 + PSI_Y**2) - NY(I+1) = -PSI_Y / SQRT(PSI_X**2 + PSI_Y**2) -C -C---- set angle of wake panel normal - APANEL(I) = ATAN2( PSI_Y , PSI_X ) -C -C---- set rest of wake points - DO 10 I=N+2, N+NW - DS = SNEW(I) - SNEW(I-1) -C -C------ set new point DS downstream of last point - X(I) = X(I-1) - DS*NY(I) - Y(I) = Y(I-1) + DS*NX(I) - S(I) = S(I-1) + DS -C - IF(I.ceq.N+NW) GO TO 10 -C -C------- calculate normal vector for next point - - xhat = cmplx(1,0) - yhat = cmplx(0,0) - - CALL PSILIN(I,X(I),Y(I),xhat,yhat,PSI,PSI_X,.FALSE.,.FALSE.) - xhat = cmplx(0,0) - yhat = cmplx(1,0) - - CALL PSILIN(I,X(I),Y(I),xhat,yhat,PSI,PSI_Y,.FALSE.,.FALSE.) - - NX(I+1) = -PSI_X / SQRT(PSI_X**2 + PSI_Y**2) - NY(I+1) = -PSI_Y / SQRT(PSI_X**2 + PSI_Y**2) -C -C------- set angle of wake panel normal - APANEL(I) = ATAN2( PSI_Y , PSI_X ) -C - 10 CONTINUE -C -C---- set wake presence flag and corresponding alpha - LWAKE = .TRUE. - AWAKE = ALFA -C -C---- old source influence matrix is invalid for the new wake geometry - LWDIJ = .FALSE. -C - RETURN - END - - - - SUBROUTINE STFIND -C----------------------------------------- -C Locates stagnation point arc length -C location SST and panel index IST. -C----------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - DO 10 I=1, N-1 - IF(GAM(I).GE.0.0 .AND. GAM(I+1).LT.0.0) GO TO 11 - 10 CONTINUE -C -C WRITE(*,*) 'STFIND: Stagnation point not found. Continuing ...' - I = N/2 -C - 11 CONTINUE -C - IST = I - DGAM = GAM(I+1) - GAM(I) - DS = S(I+1) - S(I) -C -C---- evaluate so as to minimize roundoff for very small GAM(I) or GAM(I+1) - IF(GAM(I) .LT. -GAM(I+1)) THEN - SST = S(I) - DS*(GAM(I) /DGAM) - ELSE - SST = S(I+1) - DS*(GAM(I+1)/DGAM) - ENDIF -C -C---- tweak stagnation point if it falls right on a node (very unlikely) - IF(SST .LE. S(I) ) SST = S(I) + 1.0E-7 - IF(SST .GE. S(I+1)) SST = S(I+1) - 1.0E-7 -C - SST_GO = (SST - S(I+1))/DGAM - SST_GP = (S(I) - SST )/DGAM -C - RETURN - END - - - SUBROUTINE IBLPAN -C------------------------------------------------------------- -C Sets BL location -> panel location pointer array IPAN -C------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- top surface first - IS = 1 -C - IBL = 1 - DO 10 I=IST, 1, -1 - IBL = IBL+1 - IPAN(IBL,IS) = I - VTI(IBL,IS) = 1.0 - 10 CONTINUE -C - IBLTE(IS) = IBL - NBL(IS) = IBL -C -C---- bottom surface next - IS = 2 -C - IBL = 1 - DO 20 I=IST+1, N - IBL = IBL+1 - IPAN(IBL,IS) = I - VTI(IBL,IS) = -1.0 - 20 CONTINUE -C -C---- wake - IBLTE(IS) = IBL -C - DO 25 IW=1, NW - I = N+IW - IBL = IBLTE(IS)+IW - IPAN(IBL,IS) = I - VTI(IBL,IS) = -1.0 - 25 CONTINUE -C - NBL(IS) = IBLTE(IS) + NW -C -C---- upper wake pointers (for plotting only) - DO 35 IW=1, NW - IPAN(IBLTE(1)+IW,1) = IPAN(IBLTE(2)+IW,2) - VTI(IBLTE(1)+IW,1) = 1.0 - 35 CONTINUE -C -C - IBLMAX = MAX(IBLTE(1),IBLTE(2)) + NW - IF(IBLMAX.GT.IVX) THEN -C WRITE(*,*) ' *** BL array overflow.' -C WRITE(*,*) ' *** Increase IVX to at least', IBLMAX - STOP - ENDIF -C - LIPAN = .TRUE. - RETURN - END - - - SUBROUTINE XICALC -C------------------------------------------------------------- -C Sets BL arc length array on each airfoil side and wake -C------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - IS = 1 -C - XSSI(1,IS) = 0. -C - DO 10 IBL=2, IBLTE(IS) - I = IPAN(IBL,IS) - XSSI(IBL,IS) = SST - S(I) - 10 CONTINUE -C -C - IS = 2 -C - XSSI(1,IS) = 0. -C - DO 20 IBL=2, IBLTE(IS) - I = IPAN(IBL,IS) - XSSI(IBL,IS) = S(I) - SST - 20 CONTINUE -C - IBL = IBLTE(IS) + 1 - XSSI(IBL,IS) = XSSI(IBL-1,IS) -C - DO 25 IBL=IBLTE(IS)+2, NBL(IS) - I = IPAN(IBL,IS) - XSSI(IBL,IS) = XSSI(IBL-1,IS) -c & + SQRT((X(I)-X(I-1))**2 + (Y(I)-Y(I-1))**2) - & + SQRT( (X(I)-X(I-1))*(X(I)-X(I-1)) + - & (Y(I)-Y(I-1))*(Y(I)-Y(I-1))) - - - 25 CONTINUE -C - - -C---- trailing edge flap length to TE gap ratio - TELRAT = 2.50 -C -C---- set up parameters for TE flap cubics -C -ccc DWDXTE = YP(1)/XP(1) + YP(N)/XP(N) !!! BUG 2/2/95 -C - CROSP = (XP(1)*YP(N) - YP(1)*XP(N)) - & / SQRT( (XP(1)**2 + YP(1)**2) - & *(XP(N)**2 + YP(N)**2) ) - DWDXTE = CROSP / SQRT(1.0 - CROSP**2) -C -C---- limit cubic to avoid absurd TE gap widths - DWDXTE = MAX(DWDXTE,-3.0/TELRAT) - DWDXTE = MIN(DWDXTE, 3.0/TELRAT) -C - AA = 3.0 + TELRAT*DWDXTE - BB = -2.0 - TELRAT*DWDXTE -C - IF(SHARP) THEN - DO 30 IW=1, NW - WGAP(IW) = 0. - 30 CONTINUE - ELSE -C----- set TE flap (wake gap) array - IS = 2 - DO 35 IW=1, NW - IBL = IBLTE(IS) + IW - ZN = 1.0 - (XSSI(IBL,IS)-XSSI(IBLTE(IS),IS)) / (TELRAT*ANTE) - WGAP(IW) = 0. - IF(ZN.GE.0.0) WGAP(IW) = ANTE * (AA + BB*ZN)*ZN**2 - 35 CONTINUE - ENDIF -C - RETURN - END - - - SUBROUTINE UICALC -C-------------------------------------------------------------- -C Sets inviscid Ue from panel inviscid tangential velocity -C-------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - DO 10 IS=1, 2 - UINV (1,IS) = 0. - UINV_A(1,IS) = 0. - DO 110 IBL=2, NBL(IS) - I = IPAN(IBL,IS) - UINV (IBL,IS) = VTI(IBL,IS)*QINV (I) - UINV_A(IBL,IS) = VTI(IBL,IS)*QINV_A(I) - 110 CONTINUE - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE UECALC -C-------------------------------------------------------------- -C Sets viscous Ue from panel viscous tangential velocity -C-------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - DO 10 IS=1, 2 - UEDG(1,IS) = 0. - DO 110 IBL=2, NBL(IS) - I = IPAN(IBL,IS) - UEDG(IBL,IS) = VTI(IBL,IS)*QVIS(I) - 110 CONTINUE - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE QVFUE -C-------------------------------------------------------------- -C Sets panel viscous tangential velocity from viscous Ue -C-------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - I = IPAN(IBL,IS) - QVIS(I) = VTI(IBL,IS)*UEDG(IBL,IS) - 10 CONTINUE - 1 CONTINUE -C - RETURN - END - - - SUBROUTINE QISET -C------------------------------------------------------- -C Sets inviscid panel tangential velocity for -C current alpha. -C------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - COSA = COS(ALFA) - SINA = SIN(ALFA) -C - DO 5 I=1, N+NW - QINV (I) = COSA*QINVU(I,1) + SINA*QINVU(I,2) - QINV_A(I) = -SINA*QINVU(I,1) + COSA*QINVU(I,2) - 5 CONTINUE -C - RETURN - END - - - SUBROUTINE GAMQV - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - DO 10 I=1, N - GAM(I) = QVIS(I) - GAM_A(I) = QINV_A(I) - 10 CONTINUE -C - RETURN - END - - - SUBROUTINE STMOVE -C--------------------------------------------------- -C Moves stagnation point location to new panel. -C--------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C -C---- locate new stagnation point arc length SST from GAM distribution - ISTOLD = IST - CALL STFIND -C - IF(ISTOLD.ceq.IST) THEN -C -C----- recalculate new arc length array - CALL XICALC -C - ELSE -C -CCC WRITE(*,*) 'STMOVE: Resetting stagnation point' -C -C----- set new BL position -> panel position pointers - CALL IBLPAN -C -C----- set new inviscid BL edge velocity UINV from QINV - CALL UICALC -C -C----- recalculate new arc length array - CALL XICALC -C -C----- set BL position -> system line pointers - CALL IBLSYS -C - IF(IST.GT.ISTOLD) THEN -C------ increase in number of points on top side (IS=1) - IDIF = IST-ISTOLD -C - ITRAN(1) = ITRAN(1) + IDIF - ITRAN(2) = ITRAN(2) - IDIF -C -C------ move top side BL variables downstream - DO 110 IBL=NBL(1), IDIF+2, -1 - CTAU(IBL,1) = CTAU(IBL-IDIF,1) - THET(IBL,1) = THET(IBL-IDIF,1) - DSTR(IBL,1) = DSTR(IBL-IDIF,1) - UEDG(IBL,1) = UEDG(IBL-IDIF,1) - 110 CONTINUE -C -C------ set BL variables between old and new stagnation point - DUDX = UEDG(IDIF+2,1)/XSSI(IDIF+2,1) - DO 115 IBL=IDIF+1, 2, -1 - CTAU(IBL,1) = CTAU(IDIF+2,1) - THET(IBL,1) = THET(IDIF+2,1) - DSTR(IBL,1) = DSTR(IDIF+2,1) - UEDG(IBL,1) = DUDX * XSSI(IBL,1) - 115 CONTINUE -C -C------ move bottom side BL variables upstream - DO 120 IBL=2, NBL(2) - CTAU(IBL,2) = CTAU(IBL+IDIF,2) - THET(IBL,2) = THET(IBL+IDIF,2) - DSTR(IBL,2) = DSTR(IBL+IDIF,2) - UEDG(IBL,2) = UEDG(IBL+IDIF,2) - 120 CONTINUE -C - ELSE -C------ increase in number of points on bottom side (IS=2) - IDIF = ISTOLD-IST -C - ITRAN(1) = ITRAN(1) - IDIF - ITRAN(2) = ITRAN(2) + IDIF -C -C------ move bottom side BL variables downstream - DO 210 IBL=NBL(2), IDIF+2, -1 - CTAU(IBL,2) = CTAU(IBL-IDIF,2) - THET(IBL,2) = THET(IBL-IDIF,2) - DSTR(IBL,2) = DSTR(IBL-IDIF,2) - UEDG(IBL,2) = UEDG(IBL-IDIF,2) - 210 CONTINUE -C -C------ set BL variables between old and new stagnation point - DUDX = UEDG(IDIF+2,2)/XSSI(IDIF+2,2) - DO 215 IBL=IDIF+1, 2, -1 - CTAU(IBL,2) = CTAU(IDIF+2,2) - THET(IBL,2) = THET(IDIF+2,2) - DSTR(IBL,2) = DSTR(IDIF+2,2) - UEDG(IBL,2) = DUDX * XSSI(IBL,2) - 215 CONTINUE -C -C------ move top side BL variables upstream - DO 220 IBL=2, NBL(1) - CTAU(IBL,1) = CTAU(IBL+IDIF,1) - THET(IBL,1) = THET(IBL+IDIF,1) - DSTR(IBL,1) = DSTR(IBL+IDIF,1) - UEDG(IBL,1) = UEDG(IBL+IDIF,1) - 220 CONTINUE - ENDIF -C - ENDIF -C -C---- set new mass array since Ue has been tweaked - DO 50 IS=1, 2 - DO 510 IBL=2, NBL(IS) - MASS(IBL,IS) = DSTR(IBL,IS)*UEDG(IBL,IS) - 510 CONTINUE - 50 CONTINUE -C - RETURN - END - - - SUBROUTINE UESET -C--------------------------------------------------------- -C Sets Ue from inviscid Ue plus all source influence -C--------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - I = IPAN(IBL,IS) -C - DUI = 0. - DO 100 JS=1, 2 - DO 1000 JBL=2, NBL(JS) - J = IPAN(JBL,JS) - UE_M = -VTI(IBL,IS)*VTI(JBL,JS)*DIJ(I,J) - DUI = DUI + UE_M*MASS(JBL,JS) - 1000 CONTINUE - 100 CONTINUE -C - UEDG(IBL,IS) = UINV(IBL,IS) + DUI -C - 10 CONTINUE - 1 CONTINUE -C - RETURN - END - - - SUBROUTINE DSSET - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - DO 1 IS=1, 2 - DO 10 IBL=2, NBL(IS) - DSTR(IBL,IS) = MASS(IBL,IS) / UEDG(IBL,IS) - 10 CONTINUE - 1 CONTINUE -C - RETURN - END diff --git a/deps/src/xfoil_cs/c_xsolve.f b/deps/src/xfoil_cs/c_xsolve.f deleted file mode 100644 index 3119f08..0000000 --- a/deps/src/xfoil_cs/c_xsolve.f +++ /dev/null @@ -1,526 +0,0 @@ -C*********************************************************************** -C Module: xsolve.f -C -C Copyright (C) 2000 Mark Drela -C -C This program is free software; you can redistribute it and/or modify -C it under the terms of the GNU General Public License as published by -C the Free Software Foundation; either version 2 of the License, or -C (at your option) any later version. -C -C This program is distributed in the hope that it will be useful, -C but WITHOUT ANY WARRANTY; without even the implied warranty of -C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -C GNU General Public License for more details. -C -C You should have received a copy of the GNU General Public License -C along with this program; if not, write to the Free Software -C Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -C*********************************************************************** - - - SUBROUTINE GAUSS(NSIZ,NN,Z,R,NRHS) -C ******************************************************* -C * * -C * Solves general NxN system in NN unknowns * -C * with arbitrary number (NRHS) of righthand sides. * -C * Assumes system is invertible... * -C * ...if it isn't, a divide by zero will result. * -C * * -C * Z is the coefficient matrix... * -C * ...destroyed during solution process. * -C * R is the righthand side(s)... * -C * ...replaced by the solution vector(s). * -C * * -C * Mark Drela 1984 * -C ******************************************************* -C - use complexify - implicit complex(a-h, o-z) - DIMENSION Z(NSIZ,NSIZ), R(NSIZ,NRHS) -C - DO 1 NP=1, NN-1 - NP1 = NP+1 -C -C---------------Original Code----------- -c this utilized the following fortran command - -C IF (numerical_expression) snr1, snr2, snr3 - -c where snr1 is executed if expression is -ve -c snr2 is executed if expression is zero -c snr3 is executed if expression is +ve - -c This will have to be rewritten explictity since -c the complex numbers is giving problems - -C------ find max pivot index NX -c NX = NP -c DO 11 N=NP1, NN -c IF(ABS(Z(N,NP)) -ABS(Z(NX,NP))) 11,11,111 -c 111 NX = N -c 11 CONTINUE -C - - NX = NP - DO 11 N=NP1, NN - ARG = ABS(Z(N,NP)) - ABS(Z(NX,NP)) -c WRITE(*,*) 'Z(N,NP)',Z(N,NP) -c WRITE(*,*) 'Z(NX,NP)',Z(NX,NP) - -c WRITE(*,*) 'arg:',ARG - IF (ARG .LT. 0) then - GOTO 11 - ENDIF - IF (ARG .CEQ.0) THEN - GOTO 11 - ENDIF - if (ARG .GT. 0) THEN - GOTO 111 - ENDIF - - 111 NX = N - 11 CONTINUE - - - PIVOT = 1.0/Z(NX,NP) -C -C------ switch pivots - Z(NX,NP) = Z(NP,NP) -C -C------ switch rows & normalize pivot row - DO 12 L=NP1, NN - TEMP = Z(NX,L)*PIVOT - Z(NX,L) = Z(NP,L) - Z(NP,L) = TEMP - 12 CONTINUE -C - DO 13 L=1, NRHS - TEMP = R(NX,L)*PIVOT - R(NX,L) = R(NP,L) - R(NP,L) = TEMP - 13 CONTINUE -C -C------ forward eliminate everything - DO 15 K=NP1, NN - ZTMP = Z(K,NP) -C -C IF(ZTMP.EQ.0.0) GO TO 15 -C - DO 151 L=NP1, NN - Z(K,L) = Z(K,L) - ZTMP*Z(NP,L) - 151 CONTINUE - DO 152 L=1, NRHS - R(K,L) = R(K,L) - ZTMP*R(NP,L) - 152 CONTINUE - 15 CONTINUE -C - 1 CONTINUE -C -C---- solve for last row - DO 2 L=1, NRHS - R(NN,L) = R(NN,L)/Z(NN,NN) - 2 CONTINUE -C -C---- back substitute everything - DO 3 NP=NN-1, 1, -1 - NP1 = NP+1 - DO 31 L=1, NRHS - DO 310 K=NP1, NN - R(NP,L) = R(NP,L) - Z(NP,K)*R(K,L) - 310 CONTINUE - 31 CONTINUE - 3 CONTINUE -C - RETURN - END ! GAUSS - - -c$$$ SUBROUTINE CGAUSS(NSIZ,NN,Z,R,NRHS) -c$$$C******************************************** -c$$$C Solves general complex linear systems. -c$$$C******************************************** -c$$$ COMPLEX Z(NSIZ,NSIZ), R(NSIZ,NRHS) -c$$$ COMPLEX PIVOT, TEMP, ZTMP -c$$$C -c$$$ DO 1 NP=1, NN-1 -c$$$ NP1 = NP+1 -c$$$C -c$$$C------ find max pivot index NX -c$$$ NX = NP -c$$$ DO 11 N=NP1, NN -c$$$ IF(ABS(Z(N,NP))-ABS(Z(NX,NP))) 11,11,111 -c$$$ 111 NX = N -c$$$ 11 CONTINUE -c$$$C -c$$$ PIVOT = (1.0,0.0)/Z(NX,NP) -c$$$C -c$$$C------ switch pivots -c$$$ Z(NX,NP) = Z(NP,NP) -c$$$C -c$$$C------ switch rows & normalize pivot row -c$$$ DO 12 L=NP1, NN -c$$$ TEMP = Z(NX,L)*PIVOT -c$$$ Z(NX,L) = Z(NP,L) -c$$$ Z(NP,L) = TEMP -c$$$ 12 CONTINUE -c$$$C -c$$$ DO 13 L=1, NRHS -c$$$ TEMP = R(NX,L)*PIVOT -c$$$ R(NX,L) = R(NP,L) -c$$$ R(NP,L) = TEMP -c$$$ 13 CONTINUE -c$$$C -c$$$C------ forward eliminate everything -c$$$ DO 15 K=NP1, NN -c$$$ ZTMP = Z(K,NP) -c$$$C -c$$$C IF(ZTMP.EQ.0.0) GO TO 15 -c$$$C -c$$$ DO 151 L=NP1, NN -c$$$ Z(K,L) = Z(K,L) - ZTMP*Z(NP,L) -c$$$ 151 CONTINUE -c$$$ DO 152 L=1, NRHS -c$$$ R(K,L) = R(K,L) - ZTMP*R(NP,L) -c$$$ 152 CONTINUE -c$$$ 15 CONTINUE -c$$$C -c$$$ 1 CONTINUE -c$$$C -c$$$C---- solve for last row -c$$$ DO 2 L=1, NRHS -c$$$ R(NN,L) = R(NN,L)/Z(NN,NN) -c$$$ 2 CONTINUE -c$$$C -c$$$C---- back substitute everything -c$$$ DO 3 NP=NN-1, 1, -1 -c$$$ NP1 = NP+1 -c$$$ DO 31 L=1, NRHS -c$$$ DO 310 K=NP1, NN -c$$$ R(NP,L) = R(NP,L) - Z(NP,K)*R(K,L) -c$$$ 310 CONTINUE -c$$$ 31 CONTINUE -c$$$ 3 CONTINUE -c$$$C -c$$$ RETURN -c$$$ END ! CGAUSS - - - - SUBROUTINE LUDCMP(NSIZ,N,A,INDX) -C ******************************************************* -C * * -C * Factors a full NxN matrix into an LU form. * -C * Subr. BAKSUB can back-substitute it with some RHS.* -C * Assumes matrix is non-singular... * -C * ...if it isn't, a divide by zero will result. * -C * * -C * A is the matrix... * -C * ...replaced with its LU factors. * -C * * -C * Mark Drela 1988 * -C ******************************************************* -C - use complexify - implicit complex(a-h, o-z) - DIMENSION A(NSIZ,NSIZ), INDX(NSIZ) -C - PARAMETER (NVX=300) - DIMENSION VV(NVX) -C - IF(N.GT.NVX) STOP 'LUDCMP: Array overflow. Increase NVX.' -C - DO 12 I=1, N - AAMAX = 0. - DO 11 J=1, N - AAMAX = MAX( ABS(A(I,J)) , AAMAX ) - 11 CONTINUE - VV(I) = 1.0/AAMAX - 12 CONTINUE -C - DO 19 J=1, N - DO 14 I=1, J-1 - SUM = A(I,J) - DO 13 K=1, I-1 - SUM = SUM - A(I,K)*A(K,J) - 13 CONTINUE - A(I,J) = SUM - 14 CONTINUE -C - AAMAX = 0. - DO 16 I=J, N - SUM = A(I,J) - DO 15 K=1, J-1 - SUM = SUM - A(I,K)*A(K,J) - 15 CONTINUE - A(I,J) = SUM -C - DUM = VV(I)*ABS(SUM) - IF(DUM.GE.AAMAX) THEN - IMAX = I - AAMAX = DUM - ENDIF - 16 CONTINUE -C - IF(J.cne.IMAX) THEN - DO 17 K=1, N - DUM = A(IMAX,K) - A(IMAX,K) = A(J,K) - A(J,K) = DUM - 17 CONTINUE - VV(IMAX) = VV(J) - ENDIF -C - INDX(J) = IMAX - IF(J.cne.N) THEN - DUM = 1.0/A(J,J) - DO 18 I=J+1, N - A(I,J) = A(I,J)*DUM - 18 CONTINUE - ENDIF -C - 19 CONTINUE -C - RETURN - END ! LUDCMP - - - SUBROUTINE BAKSUB(NSIZ,N,A,INDX,B) - use complexify - implicit complex(a-h, o-z) - DIMENSION A(NSIZ,NSIZ), B(NSIZ), INDX(NSIZ) -C - II = 0 - DO 12 I=1, N - LL = INDX(I) - SUM = B(LL) - B(LL) = B(I) - IF(II.cne.0) THEN - DO 11 J=II, I-1 - SUM = SUM - A(I,J)*B(J) - 11 CONTINUE - ELSE IF(SUM.cne.0.0) THEN - II = I - ENDIF - B(I) = SUM - 12 CONTINUE -C - DO 14 I=N, 1, -1 - SUM = B(I) - IF(I.LT.N) THEN - DO 13 J=I+1, N - SUM = SUM - A(I,J)*B(J) - 13 CONTINUE - ENDIF - B(I) = SUM/A(I,I) - 14 CONTINUE -C - RETURN - END ! BAKSUB - - - - SUBROUTINE BLSOLV -C----------------------------------------------------------------- -C Custom solver for coupled viscous-inviscid Newton system: -C -C A | | . | | . | d R S -C B A | . | | . | d R S -C | B A . | | . | d R S -C . . . . | | . | d = R - dRe S -C | | | B A | . | d R S -C | Z | | B A . | d R S -C . . . . . . . | d R S -C | | | | | | B A d R S -C -C A, B, Z 3x3 blocks containing linearized BL equation coefficients -C | 3x1 vectors containing mass defect influence -C coefficients on Ue -C d 3x1 unknown vectors (Newton deltas for Ctau, Theta, m) -C R 3x1 residual vectors -C S 3x1 Re influence vectors -C----------------------------------------------------------------- - use complexify - implicit complex(a-h, o-z) - include 'c_XFOIL.INC' -C - IVTE1 = ISYS(IBLTE(1),1) -C - DO 1000 IV=1, NSYS -C - IVP = IV + 1 -C -C====== Invert VA(IV) block -C -C------ normalize first row - PIVOT = 1.0 / VA(1,1,IV) - VA(1,2,IV) = VA(1,2,IV) * PIVOT - DO 10 L=IV, NSYS - VM(1,L,IV) = VM(1,L,IV)*PIVOT - 10 CONTINUE - VDEL(1,1,IV) = VDEL(1,1,IV)*PIVOT - VDEL(1,2,IV) = VDEL(1,2,IV)*PIVOT -C -C------ eliminate lower first column in VA block - DO 15 K=2, 3 - VTMP = VA(K,1,IV) - VA(K,2,IV) = VA(K,2,IV) - VTMP*VA(1,2,IV) - DO 150 L=IV, NSYS - VM(K,L,IV) = VM(K,L,IV) - VTMP*VM(1,L,IV) - 150 CONTINUE - VDEL(K,1,IV) = VDEL(K,1,IV) - VTMP*VDEL(1,1,IV) - VDEL(K,2,IV) = VDEL(K,2,IV) - VTMP*VDEL(1,2,IV) - 15 CONTINUE -C -C -C------ normalize second row - PIVOT = 1.0 / VA(2,2,IV) - DO 20 L=IV, NSYS - VM(2,L,IV) = VM(2,L,IV)*PIVOT - 20 CONTINUE - VDEL(2,1,IV) = VDEL(2,1,IV)*PIVOT - VDEL(2,2,IV) = VDEL(2,2,IV)*PIVOT -C -C------ eliminate lower second column in VA block - K = 3 - VTMP = VA(K,2,IV) - DO 250 L=IV, NSYS - VM(K,L,IV) = VM(K,L,IV) - VTMP*VM(2,L,IV) - 250 CONTINUE - VDEL(K,1,IV) = VDEL(K,1,IV) - VTMP*VDEL(2,1,IV) - VDEL(K,2,IV) = VDEL(K,2,IV) - VTMP*VDEL(2,2,IV) -C -C -C------ normalize third row - PIVOT = 1.0/VM(3,IV,IV) - DO 350 L=IVP, NSYS - VM(3,L,IV) = VM(3,L,IV)*PIVOT - 350 CONTINUE - VDEL(3,1,IV) = VDEL(3,1,IV)*PIVOT - VDEL(3,2,IV) = VDEL(3,2,IV)*PIVOT -C -C -C------ eliminate upper third column in VA block - VTMP1 = VM(1,IV,IV) - VTMP2 = VM(2,IV,IV) - DO 450 L=IVP, NSYS - VM(1,L,IV) = VM(1,L,IV) - VTMP1*VM(3,L,IV) - VM(2,L,IV) = VM(2,L,IV) - VTMP2*VM(3,L,IV) - 450 CONTINUE - VDEL(1,1,IV) = VDEL(1,1,IV) - VTMP1*VDEL(3,1,IV) - VDEL(2,1,IV) = VDEL(2,1,IV) - VTMP2*VDEL(3,1,IV) - VDEL(1,2,IV) = VDEL(1,2,IV) - VTMP1*VDEL(3,2,IV) - VDEL(2,2,IV) = VDEL(2,2,IV) - VTMP2*VDEL(3,2,IV) -C -C------ eliminate upper second column in VA block - VTMP = VA(1,2,IV) - DO 460 L=IVP, NSYS - VM(1,L,IV) = VM(1,L,IV) - VTMP*VM(2,L,IV) - 460 CONTINUE - VDEL(1,1,IV) = VDEL(1,1,IV) - VTMP*VDEL(2,1,IV) - VDEL(1,2,IV) = VDEL(1,2,IV) - VTMP*VDEL(2,2,IV) -C -C - IF(IV.ceq.NSYS) GO TO 1000 -C -C====== Eliminate VB(IV+1) block, rows 1 -> 3 - DO 50 K=1, 3 - VTMP1 = VB(K, 1,IVP) - VTMP2 = VB(K, 2,IVP) - VTMP3 = VM(K,IV,IVP) - DO 510 L=IVP, NSYS - VM(K,L,IVP) = VM(K,L,IVP) - & - ( VTMP1*VM(1,L,IV) - & + VTMP2*VM(2,L,IV) - & + VTMP3*VM(3,L,IV) ) - 510 CONTINUE - VDEL(K,1,IVP) = VDEL(K,1,IVP) - & - ( VTMP1*VDEL(1,1,IV) - & + VTMP2*VDEL(2,1,IV) - & + VTMP3*VDEL(3,1,IV) ) - VDEL(K,2,IVP) = VDEL(K,2,IVP) - & - ( VTMP1*VDEL(1,2,IV) - & + VTMP2*VDEL(2,2,IV) - & + VTMP3*VDEL(3,2,IV) ) - 50 CONTINUE -C - IF(IV.ceq.IVTE1) THEN -C------- eliminate VZ block - IVZ = ISYS(IBLTE(2)+1,2) -C - DO 55 K=1, 3 - VTMP1 = VZ(K,1) - VTMP2 = VZ(K,2) - DO 515 L=IVP, NSYS - VM(K,L,IVZ) = VM(K,L,IVZ) - & - ( VTMP1*VM(1,L,IV) - & + VTMP2*VM(2,L,IV) ) - 515 CONTINUE - VDEL(K,1,IVZ) = VDEL(K,1,IVZ) - & - ( VTMP1*VDEL(1,1,IV) - & + VTMP2*VDEL(2,1,IV) ) - VDEL(K,2,IVZ) = VDEL(K,2,IVZ) - & - ( VTMP1*VDEL(1,2,IV) - & + VTMP2*VDEL(2,2,IV) ) - 55 CONTINUE - ENDIF -C - IF(IVP.ceq.NSYS) GO TO 1000 -C -C====== Eliminate lower VM column - DO 60 KV=IV+2, NSYS - VTMP1 = VM(1,IV,KV) - VTMP2 = VM(2,IV,KV) - VTMP3 = VM(3,IV,KV) -C - IF(ABS(VTMP1).GT.VACCEL) THEN - DO 610 L=IVP, NSYS - VM(1,L,KV) = VM(1,L,KV) - VTMP1*VM(3,L,IV) - 610 CONTINUE - VDEL(1,1,KV) = VDEL(1,1,KV) - VTMP1*VDEL(3,1,IV) - VDEL(1,2,KV) = VDEL(1,2,KV) - VTMP1*VDEL(3,2,IV) - ENDIF -C - IF(ABS(VTMP2).GT.VACCEL) THEN - DO 620 L=IVP, NSYS - VM(2,L,KV) = VM(2,L,KV) - VTMP2*VM(3,L,IV) - 620 CONTINUE - VDEL(2,1,KV) = VDEL(2,1,KV) - VTMP2*VDEL(3,1,IV) - VDEL(2,2,KV) = VDEL(2,2,KV) - VTMP2*VDEL(3,2,IV) - ENDIF -C - IF(ABS(VTMP3).GT.VACCEL) THEN - DO 630 L=IVP, NSYS - VM(3,L,KV) = VM(3,L,KV) - VTMP3*VM(3,L,IV) - 630 CONTINUE - VDEL(3,1,KV) = VDEL(3,1,KV) - VTMP3*VDEL(3,1,IV) - VDEL(3,2,KV) = VDEL(3,2,KV) - VTMP3*VDEL(3,2,IV) - ENDIF -C - 60 CONTINUE -C - 1000 CONTINUE -C -C -C - DO 2000 IV=NSYS, 2, -1 -C -C------ eliminate upper VM columns - VTMP = VDEL(3,1,IV) - DO 81 KV=IV-1, 1, -1 - VDEL(1,1,KV) = VDEL(1,1,KV) - VM(1,IV,KV)*VTMP - VDEL(2,1,KV) = VDEL(2,1,KV) - VM(2,IV,KV)*VTMP - VDEL(3,1,KV) = VDEL(3,1,KV) - VM(3,IV,KV)*VTMP - 81 CONTINUE -C - VTMP = VDEL(3,2,IV) - DO 82 KV=IV-1, 1, -1 - VDEL(1,2,KV) = VDEL(1,2,KV) - VM(1,IV,KV)*VTMP - VDEL(2,2,KV) = VDEL(2,2,KV) - VM(2,IV,KV)*VTMP - VDEL(3,2,KV) = VDEL(3,2,KV) - VM(3,IV,KV)*VTMP - 82 CONTINUE -C - 2000 CONTINUE -C - RETURN - END diff --git a/deps/src/xfoil_cs/c_xutils.f b/deps/src/xfoil_cs/c_xutils.f deleted file mode 100644 index cd39b9b..0000000 --- a/deps/src/xfoil_cs/c_xutils.f +++ /dev/null @@ -1,116 +0,0 @@ - - - - SUBROUTINE SETEXP(S,DS1,SMAX,NN) -C........................................................ -C Sets geometrically stretched array S: -C -C S(i+1) - S(i) = r * [S(i) - S(i-1)] -C -C S (output) array to be set -C DS1 (input) first S increment: S(2) - S(1) -C SMAX (input) final S value: S(NN) -C NN (input) number of points -C........................................................ - use complexify - implicit complex(a-h, o-z) - complex S(NN) -C - SIGMA = SMAX/DS1 - NEX = NN-1 - RNEX = FLOAT(NEX) - RNI = 1.0/RNEX -C -C---- solve quadratic for initial geometric ratio guess - AAA = RNEX*(RNEX-1.0)*(RNEX-2.0) / 6.0 - BBB = RNEX*(RNEX-1.0) / 2.0 - CCC = RNEX - SIGMA -C - DISC = BBB**2 - 4.0*AAA*CCC - DISC = MAX( 0.0 , DISC ) -C - IF(NEX.LE.1) THEN - STOP 'SETEXP: Cannot fill array. N too small.' - ELSE IF(NEX.ceq.2) THEN - RATIO = -CCC/BBB + 1.0 - ELSE - RATIO = (-BBB + SQRT(DISC))/(2.0*AAA) + 1.0 - ENDIF -C - IF(RATIO.ceq.1.0) GO TO 11 -C -C---- Newton iteration for actual geometric ratio - DO 1 ITER=1, 100 - SIGMAN = (RATIO**NEX - 1.0) / (RATIO - 1.0) - RES = SIGMAN**RNI - SIGMA**RNI - DRESDR = RNI*SIGMAN**RNI - & * (RNEX*RATIO**(NEX-1) - SIGMAN) / (RATIO**NEX - 1.0) -C - DRATIO = -RES/DRESDR - RATIO = RATIO + DRATIO -C - IF(ABS(DRATIO) .LT. 1.0E-5) GO TO 11 -C - 1 CONTINUE -c WRITE(*,*) 'SETEXP: Convergence failed. Continuing anyway ...' -C -C---- set up stretched array using converged geometric ratio - 11 S(1) = 0.0 - DS = DS1 - DO 2 N=2, NN - S(N) = S(N-1) + DS - DS = DS*RATIO - 2 CONTINUE -C - RETURN - END - - - - FUNCTION ATANC(Y,X,THOLD) - use complexify - IMPLICIT complex (A-H,M,O-Z) -C--------------------------------------------------------------- -C ATAN2 function with branch cut checking. -C -C Increments position angle of point X,Y from some previous -C value THOLD due to a change in position, ensuring that the -C position change does not cross the ATAN2 branch cut -C (which is in the -x direction). For example: -C -C ATANC( -1.0 , -1.0 , 0.75*pi ) returns 1.25*pi , whereas -C ATAN2( -1.0 , -1.0 ) returns -.75*pi . -C -C Typically, ATANC is used to fill an array of angles: -C -C THETA(1) = ATAN2( Y(1) , X(1) ) -C DO i=2, N -C THETA(i) = ATANC( Y(i) , X(i) , THETA(i-1) ) -C END DO -C -C This will prevent the angle array THETA(i) from jumping by -C +/- 2 pi when the path X(i),Y(i) crosses the negative x axis. -C -C Input: -C X,Y point position coordinates -C THOLD position angle of nearby point -C -C Output: -C ATANC position angle of X,Y -C--------------------------------------------------------------- - DATA PI /3.1415926535897932384/ - DATA TPI /6.2831853071795864769/ -C -C---- set new position angle, ignoring branch cut in ATAN2 function for now - THNEW = ATAN2( Y , X ) - DTHET = THNEW - THOLD -C -C---- angle change cannot exceed +/- pi, so get rid of any multiples of 2 pi - DTCORR = DTHET - TPI*INT( (DTHET + SIGN(PI,DTHET))/TPI ) -C -C---- set correct new angle - ATANC = THOLD + DTCORR -C - RETURN - END ! ATANC - diff --git a/deps/src/xfoil_cs/complexify.f90 b/deps/src/xfoil_cs/complexify.f90 deleted file mode 100644 index 552bc38..0000000 --- a/deps/src/xfoil_cs/complexify.f90 +++ /dev/null @@ -1,810 +0,0 @@ -!****************************************************************************** -! Written for 'complexify.py 1.3' -! J.R.R.A.Martins 1999 -! 21-Apr-00 Fixed tan, sinh, cosh -! sign now returns complex -! added log10 and nint -! changed ==, /= and >= -- see comments below -! 20-May-00 added cosd, sind, and epsilon -! 11-Jul-00 took away cosd, sind (they are reserved, but not -! intrinsic functions in F90) -! 21-Jul-00 converted all trig functions to the value/derivative -! formulas -- not general complex number formulas -! 15-Aug-00 Fixed bug in atan2 formula and added the rest of the -! _ci and _ic cominations to the relational operators. -! P. Sturdza -! -!****************************************************************************** -! -! Assume all code is compiled with double precision (-r8 compiler flag) -! - -!TODO: -! more typ combinations: cc, cr, rc, ic ? -! check all fcns -! - -module complexify - - implicit none - -! ABS - interface abs - module procedure abs_c - end interface - -! COSD -! interface cosd -! module procedure cosd_c -! end interface - -! ACOS - interface acos - module procedure acos_c - end interface - -! SIND -! interface sind -! module procedure sind_c -! end interface - -! ASIN - interface asin - module procedure asin_c - end interface - -! ATAN - interface atan - module procedure atan_c - end interface - -! ATAN2 - interface atan2 - module procedure atan2_cc - end interface - -! COSH - interface cosh - module procedure cosh_c - end interface - -! MAX (limited to 2-4 complex args, 2 mixed args) - interface max - module procedure max_cc - module procedure max_cr - module procedure max_rc - module procedure max_ccc ! added because of DFLUX.f - module procedure max_cccc ! added because of DFLUX.f - end interface - -! MIN (limited to 2-4 complex args, 2 mixed args) - interface min - module procedure min_cc - module procedure min_cr - module procedure min_rc - module procedure min_ccc - module procedure min_cccc - end interface - -! SIGN - interface sign - module procedure sign_cc - module procedure sign_cr - module procedure sign_rc - end interface - -! DIM - interface dim - module procedure dim_cc - module procedure dim_cr - module procedure dim_rc - end interface - -! SINH - interface sinh - module procedure sinh_c - end interface - -! TAN - interface tan - module procedure tan_c - end interface - -! TANH - interface tanh - module procedure tanh_c - end interface - -! LOG10 - interface log10 - module procedure log10_c - end interface - -! NINT - interface nint - module procedure nint_c - end interface - -! EPSILON - interface epsilon - module procedure epsilon_c - end interface - -! < - interface operator (<) - module procedure lt_cc - module procedure lt_cr - module procedure lt_rc - module procedure lt_ci - module procedure lt_ic - end interface - -! <= - interface operator (<=) - module procedure le_cc - module procedure le_cr - module procedure le_rc - module procedure le_ci - module procedure le_ic - end interface - -! > - interface operator (>) - module procedure gt_cc - module procedure gt_cr - module procedure gt_rc - module procedure gt_ci - module procedure gt_ic - end interface - -!! MIPSpro Compilers: Version 7.30 won't take .ge. and .eq.. -!! But pgf90 on Linux doesn't complain, go figure. -!! It looks like a strict interpretation of FORTRAN should -!! not allow overloading of .eq. and .ne. since they already -!! have a definition for type complex, so define new operators -!! called .ceq., .cne. and, for MIPS, .cge. -!! -!! comment out (and uncomment) the appropriate versions for -!! your compiler -!! -! >= - interface operator (>=) - module procedure ge_cc - module procedure ge_cr - module procedure ge_rc - module procedure ge_ci - module procedure ge_ic - end interface -! interface operator (.cge.) -! module procedure ge_cc -! module procedure ge_rr -! module procedure ge_ii -! module procedure ge_aa -! module procedure ge_cr -! module procedure ge_rc -! module procedure ge_ci -! module procedure ge_ic -! module procedure ge_ir -! module procedure ge_ri -! end interface - -! == -! interface operator (==) -! module procedure eq_cc -! module procedure eq_cr -! module procedure eq_rc -! module procedure eq_ci -! module procedure eq_ic -! end interface - interface operator (.ceq.) - module procedure eq_cc - module procedure eq_rr - module procedure eq_ii - module procedure eq_aa - module procedure eq_cr - module procedure eq_rc - module procedure eq_ci - module procedure eq_ic - module procedure eq_ir - module procedure eq_ri - end interface - -! /= -! interface operator (/=) -! module procedure ne_cc -! module procedure ne_cr -! module procedure ne_rc -! module procedure ne_ci -! module procedure ne_ic -! end interface - interface operator (.cne.) - module procedure ne_cc - module procedure ne_rr - module procedure ne_ii - module procedure ne_aa - module procedure ne_cr - module procedure ne_rc - module procedure ne_ci - module procedure ne_ic - module procedure ne_ir - module procedure ne_ri - end interface - -contains - -!****************************************************************************** -! -! Function definitions -! -!****************************************************************************** - -! ABS, intrinsic - complex function abs_c(val) - complex, intent(in) :: val - abs_c = val - if (real(val) < 0) abs_c = cmplx(-real(val),-aimag(val)) - return - end function abs_c - -! COSD -! complex function cosd_c(z) -! complex, intent(in) :: z -! cosd_c = cos(z*3.14159265358979323846/180.) -! end function cosd_c - -! SIND -! complex function sind_c(z) -! complex, intent(in) :: z -! sind_c = sin(z*3.14159265358979323846/180.) -! end function sind_c - -! ACOS - complex function acos_c(z) - complex, intent(in) :: z -! acos_c = - cmplx(0., 1.)*log(z+sqrt(z**2-1.)) -! not general complex valued formula: - acos_c = cmplx(acos(real(z)),-aimag(z)/sqrt(1.-real(z)**2)) - return - end function acos_c - -! ASIN - complex function asin_c(z) - complex, intent(in) :: z -! asin_c = - cmplx(0., 1.)*log(cmplx(0.,1.)*z+sqrt(1.-z**2)) -! not general complex valued formula: - asin_c = cmplx(asin(real(z)),aimag(z)/sqrt(1.-real(z)**2)) - return - end function asin_c - -! ATAN - complex function atan_c(z) - complex, intent(in) :: z -! complex z2 -! real pi2, xans, yans, r, r2, x, y -! pi2 = 2.0*atan(1.0) -! r = sqrt(real(z)**2+aimag(z)**2) -! x = real(z) -! y = aimag(z) -! r2 = r*r -! xans = 0.5*atan2 (2.0*x, 1.0-r2) -! yans = 0.25*log((r2+2.0*y+1.0)/(r2-2.0*y+1.0)) -! atan_c = cmplx (xans, yans) -! not general complex valued formula: - atan_c = cmplx(atan(real(z)),aimag(z)/(1.+real(z)**2)) - return - end function atan_c - -! ATAN2 - complex function atan2_cc(csn, ccs) - complex, intent(in) :: csn, ccs -! real pi -! pi = 4.0*atan(1.0) -! if (sqrt(real(ccs)**2 + aimag(ccs)**2).eq.0.) then ! abs orig -! if (sqrt(real(csn)**2+aimag(csn)**2).eq.0.) then -! atan2_cc = cmplx(0.0) -! else -! atan2_cc = cmplx(sign(0.5*pi,real(csn)), 0.0) -! end if -! else -! atan2_cc = atan(csn/ccs) -! if (real(ccs).lt.0.) atan2_cc = atan2_cc + pi -! if (real(atan2_cc).gt.pi) atan2_cc = atan2_cc - 2.0*pi -! end if -! not general complex valued formula: - real a,b,c,d - a=real(csn) - b=aimag(csn) - c=real(ccs) - d=aimag(ccs) - atan2_cc=cmplx(atan2(a,c),(c*b-a*d)/(a**2+c**2)) - return - end function atan2_cc - -! COSH - complex function cosh_c(z) - complex, intent(in) :: z -! complex eplus, eminus -! eplus = exp(z) -! eminus = exp(z) -! cosh_c = (eplus + eminus)/2. -! not general complex valued formula: - cosh_c=cmplx(cosh(real(z)),aimag(z)*sinh(real(z))) - return - end function cosh_c - -! SINH - complex function sinh_c(z) - complex, intent(in) :: z -! complex eplus, eminus -! eplus = exp(z) -! eminus = exp(z) -! sinh_c = (eplus - eminus)/2. -! not general complex valued formula: - sinh_c=cmplx(sinh(real(z)),aimag(z)*cosh(real(z))) - return - end function sinh_c - -! TAN - complex function tan_c(z) - complex, intent(in) :: z -! complex eiplus, eiminus -! eiplus = exp(cmplx(0.,1.)*z) -! eiminus = exp(-cmplx(0.,1.)*z) -! tan_c = cmplx(0.,1.)*(eiminus - eiplus)/(eiplus + eiminus) -! not general complex valued formula: - tan_c=cmplx(tan(real(z)),aimag(z)/cos(real(z))**2) - return - end function tan_c - -! TANH - complex function tanh_c(a) - complex, intent(in) :: a -! complex eplus, eminus -! if(real(a) > 50)then -! tanh_c = 1. -! else -! eplus = exp(a) -! eminus = exp(-a) -! tanh_c = (eplus - eminus)/(eplus + eminus) -! end if -! not general complex valued formula: - tanh_c=cmplx(tanh(real(a)),aimag(a)/cosh(real(a))**2) - return - end function tanh_c - -! MAX, intrinsic - complex function max_cc(val1, val2) - complex, intent(in) :: val1, val2 - if (real(val1) > real(val2)) then - max_cc = val1 - else - max_cc = val2 - endif - return - end function max_cc - complex function max_cr(val1, val2) - complex, intent(in) :: val1 - real, intent(in) :: val2 - if (real(val1) > val2) then - max_cr = val1 - else - max_cr = cmplx(val2, 0.) - endif - return - end function max_cr - complex function max_rc(val1, val2) - real, intent(in) :: val1 - complex, intent(in) :: val2 - if (val1 > real(val2)) then - max_rc = cmplx(val1, 0.) - else - max_rc = val2 - endif - return - end function max_rc - complex function max_ccc(val1, val2, val3) - complex, intent(in) :: val1, val2, val3 - if (real(val1) > real(val2)) then - max_ccc = val1 - else - max_ccc = val2 - endif - if (real(val3) > real(max_ccc)) then - max_ccc = val3 - endif - return - end function max_ccc - function max_cccc(val1, val2, val3, val4) - complex, intent(in) :: val1, val2, val3, val4 - complex max_cccc - complex max_cccc2 - if (real(val1) > real(val2)) then - max_cccc = val1 - else - max_cccc = val2 - endif - if (real(val3) > real(val4)) then - max_cccc2 = val3 - else - max_cccc2 = val4 - endif - if (real(max_cccc2) > real(max_cccc)) then - max_cccc = max_cccc2 - endif - return - end function max_cccc - -! MIN, intrinsic - complex function min_cc(val1, val2) - complex, intent(in) :: val1, val2 - if (real(val1) < real(val2)) then - min_cc = val1 - else - min_cc = val2 - endif - return - end function min_cc - complex function min_cr(val1, val2) - complex, intent(in) :: val1 - real, intent(in) :: val2 - if (real(val1) < val2) then - min_cr = val1 - else - min_cr = cmplx(val2, 0.) - endif - return - end function min_cr - complex function min_rc(val1, val2) - real, intent(in) :: val1 - complex, intent(in) :: val2 - if (val1 < real(val2)) then - min_rc = cmplx(val1, 0.) - else - min_rc = val2 - endif - return - end function min_rc - complex function min_ccc(val1, val2, val3) - complex, intent(in) :: val1, val2, val3 - if (real(val1) < real(val2)) then - min_ccc = val1 - else - min_ccc = val2 - endif - if (real(val3) < real(min_ccc)) then - min_ccc = val3 - endif - return - end function min_ccc - function min_cccc(val1, val2, val3, val4) - complex, intent(in) :: val1, val2, val3, val4 - complex min_cccc - complex min_cccc2 - if (real(val1) < real(val2)) then - min_cccc = val1 - else - min_cccc = val2 - endif - if (real(val3) < real(val4)) then - min_cccc2 = val3 - else - min_cccc2 = val4 - endif - if (real(min_cccc2) < real(min_cccc)) then - min_cccc = min_cccc2 - endif - return - end function min_cccc - - -! SIGN, intrinsic, assume that val1 is always a complex -! in reality could be int - complex function sign_cc(val1, val2) - complex, intent(in) :: val1, val2 - real sign - if (real(val2) < 0.) then - sign = -1. - else - sign = 1. - endif - sign_cc = sign * val1 - return - end function sign_cc - complex function sign_cr(val1, val2) - complex, intent(in) :: val1 - real, intent(in) :: val2 - real sign - if (real(val2) < 0.) then - sign = -1. - else - sign = 1. - endif - sign_cr = sign * val1 - return - end function sign_cr - complex function sign_rc(val1, val2) - real, intent(in) :: val1 - complex, intent(in) :: val2 - real sign - if (real(val2) < 0.) then - sign = -1. - else - sign = 1. - endif - sign_rc = sign * val1 - return - end function sign_rc - -! DIM, intrinsic - complex function dim_cc(val1, val2) - complex, intent(in) :: val1, val2 - if (val1 > val2) then - dim_cc = val1 - val2 - else - dim_cc = cmplx(0., 0.) - endif - return - end function dim_cc - complex function dim_cr(val1, val2) - complex, intent(in) :: val1 - real, intent(in) :: val2 - if (val1 > val2) then - dim_cr = val1 - cmplx(val2, 0.) - else - dim_cr = cmplx(0., 0.) - endif - return - end function dim_cr - complex function dim_rc(val1, val2) - real, intent(in) :: val1 - complex, intent(in) :: val2 - if (val1 > val2) then - dim_rc = cmplx(val1, 0.) - val2 - else - dim_rc = cmplx(0., 0.) - endif - return - end function dim_rc - -! LOG10 - complex function log10_c(z) - complex, intent(in) :: z - log10_c=log(z)/log((10.0,0.0)) - end function log10_c - -! NINT - integer function nint_c(z) - complex, intent(in) :: z - nint_c=nint(real(z)) - end function nint_c - -! EPSILON !! bad news ulness compiled with -r8 - complex function epsilon_c(z) - complex, intent(in) :: z - epsilon_c=epsilon(real(z)) - end function epsilon_c - -! <, .lt. - logical function lt_cc(lhs, rhs) - complex, intent(in) :: lhs, rhs - lt_cc = real(lhs) < real(rhs) - end function lt_cc - logical function lt_cr(lhs, rhs) - complex, intent(in) :: lhs - real, intent(in) :: rhs - lt_cr = real(lhs) < rhs - end function lt_cr - logical function lt_rc(lhs, rhs) - real, intent(in) :: lhs - complex, intent(in) :: rhs - lt_rc = lhs < real(rhs) - end function lt_rc - logical function lt_ci(lhs, rhs) - complex, intent(in) :: lhs - integer, intent(in) :: rhs - lt_ci = real(lhs) < rhs - end function lt_ci - logical function lt_ic(lhs, rhs) - integer, intent(in) :: lhs - complex, intent(in) :: rhs - lt_ic = lhs < real(rhs) - end function lt_ic - -! <=, .le. - logical function le_cc(lhs, rhs) - complex, intent(in) :: lhs, rhs - le_cc = real(lhs) <= real(rhs) - end function le_cc - logical function le_cr(lhs, rhs) - complex, intent(in) :: lhs - real, intent(in) :: rhs - le_cr = real(lhs) <= rhs - end function le_cr - logical function le_rc(lhs, rhs) - real, intent(in) :: lhs - complex, intent(in) :: rhs - le_rc = lhs <= real(rhs) - end function le_rc - logical function le_ci(lhs, rhs) - complex, intent(in) :: lhs - integer, intent(in) :: rhs - le_ci = real(lhs) <= rhs - end function le_ci - logical function le_ic(lhs, rhs) - integer, intent(in) :: lhs - complex, intent(in) :: rhs - le_ic = lhs <= real(rhs) - end function le_ic - -! >, .gt. - logical function gt_cc(lhs, rhs) - complex, intent(in) :: lhs, rhs - gt_cc = real(lhs) > real(rhs) - end function gt_cc - logical function gt_cr(lhs, rhs) - complex, intent(in) :: lhs - real, intent(in) :: rhs - gt_cr = real(lhs) > rhs - end function gt_cr - logical function gt_rc(lhs, rhs) - real, intent(in) :: lhs - complex, intent(in) :: rhs - gt_rc = lhs > real(rhs) - end function gt_rc - logical function gt_ci(lhs, rhs) - complex, intent(in) :: lhs - integer, intent(in) :: rhs - gt_ci = real(lhs) > rhs - end function gt_ci - logical function gt_ic(lhs, rhs) - integer, intent(in) :: lhs - complex, intent(in) :: rhs - gt_ic = lhs > real(rhs) - end function gt_ic - -!! here are the redefined ones: -! >=, .ge. - logical function ge_cc(lhs, rhs) - complex, intent(in) :: lhs, rhs - ge_cc = real(lhs) >= real(rhs) - end function ge_cc - logical function ge_rr(lhs, rhs) - real, intent(in) :: lhs, rhs - ge_rr = lhs >= rhs - end function ge_rr - logical function ge_ii(lhs, rhs) - integer, intent(in) :: lhs, rhs - ge_ii = lhs >= rhs - end function ge_ii - logical function ge_aa(lhs, rhs) - character(len=*), intent(in) :: lhs, rhs - ge_aa = lhs >= rhs - end function ge_aa - logical function ge_cr(lhs, rhs) - complex, intent(in) :: lhs - real, intent(in) :: rhs - ge_cr = real(lhs) >= rhs - end function ge_cr - logical function ge_rc(lhs, rhs) - real, intent(in) :: lhs - complex, intent(in) :: rhs - ge_rc = lhs >= real(rhs) - end function ge_rc - logical function ge_ci(lhs, rhs) - complex, intent(in) :: lhs - integer, intent(in) :: rhs - ge_ci = real(lhs) >= rhs - end function ge_ci - logical function ge_ic(lhs, rhs) - integer, intent(in) :: lhs - complex, intent(in) :: rhs - ge_ic = lhs >= real(rhs) - end function ge_ic - logical function ge_ir(lhs, rhs) - integer, intent(in) :: lhs - real, intent(in) :: rhs - ge_ir = lhs >= rhs - end function ge_ir - logical function ge_ri(lhs, rhs) - real, intent(in) :: lhs - integer, intent(in) :: rhs - ge_ri = lhs >= rhs - end function ge_ri - -! ==, .eq. - logical function eq_cc(lhs, rhs) - complex, intent(in) :: lhs, rhs - eq_cc = real(lhs) == real(rhs) - end function eq_cc - logical function eq_rr(lhs, rhs) - real, intent(in) :: lhs, rhs - eq_rr = lhs == rhs - end function eq_rr - logical function eq_ii(lhs, rhs) - integer, intent(in) :: lhs, rhs - eq_ii = lhs == rhs - end function eq_ii - logical function eq_aa(lhs, rhs) - character(len=*), intent(in) :: lhs, rhs - eq_aa = lhs == rhs - end function eq_aa - logical function eq_cr(lhs, rhs) - complex, intent(in) :: lhs - real, intent(in) :: rhs - eq_cr = real(lhs) == rhs - end function eq_cr - logical function eq_rc(lhs, rhs) - real, intent(in) :: lhs - complex, intent(in) :: rhs - eq_rc = lhs == real(rhs) - end function eq_rc - logical function eq_ci(lhs, rhs) - complex, intent(in) :: lhs - integer, intent(in) :: rhs - eq_ci = real(lhs) == rhs - end function eq_ci - logical function eq_ic(lhs, rhs) - integer, intent(in) :: lhs - complex, intent(in) :: rhs - eq_ic = lhs == real(rhs) - end function eq_ic - logical function eq_ir(lhs, rhs) - integer, intent(in) :: lhs - real, intent(in) :: rhs - eq_ir = lhs == rhs - end function eq_ir - logical function eq_ri(lhs, rhs) - real, intent(in) :: lhs - integer, intent(in) :: rhs - eq_ri = lhs == rhs - end function eq_ri - -! /=, .ne. - logical function ne_cc(lhs, rhs) - complex, intent(in) :: lhs, rhs - ne_cc = real(lhs) /= real(rhs) - end function ne_cc - logical function ne_rr(lhs, rhs) - real, intent(in) :: lhs, rhs - ne_rr = lhs /= rhs - end function ne_rr - logical function ne_ii(lhs, rhs) - integer, intent(in) :: lhs, rhs - ne_ii = lhs /= rhs - end function ne_ii - logical function ne_aa(lhs, rhs) - character(len=*), intent(in) :: lhs, rhs - ne_aa = lhs /= rhs - end function ne_aa - logical function ne_cr(lhs, rhs) - complex, intent(in) :: lhs - real, intent(in) :: rhs - ne_cr = real(lhs) /= rhs - end function ne_cr - logical function ne_rc(lhs, rhs) - real, intent(in) :: lhs - complex, intent(in) :: rhs - ne_rc = lhs /= real(rhs) - end function ne_rc - logical function ne_ci(lhs, rhs) - complex, intent(in) :: lhs - integer, intent(in) :: rhs - ne_ci = real(lhs) /= rhs - end function ne_ci - logical function ne_ic(lhs, rhs) - integer, intent(in) :: lhs - complex, intent(in) :: rhs - ne_ic = lhs /= real(rhs) - end function ne_ic - logical function ne_ir(lhs, rhs) - integer, intent(in) :: lhs - real, intent(in) :: rhs - ne_ir = lhs /= rhs - end function ne_ir - logical function ne_ri(lhs, rhs) - real, intent(in) :: lhs - integer, intent(in) :: rhs - ne_ri = lhs /= rhs - end function ne_ri - -end module complexify diff --git a/deps/src/xfoil_cs/complexify.mod b/deps/src/xfoil_cs/complexify.mod deleted file mode 100644 index c8a84aa..0000000 Binary files a/deps/src/xfoil_cs/complexify.mod and /dev/null differ diff --git a/src/Xfoil.jl b/src/Xfoil.jl index 5b26c7f..c68fd60 100644 --- a/src/Xfoil.jl +++ b/src/Xfoil.jl @@ -1,15 +1,8 @@ module Xfoil -using Printf -export setCoordinates, solveAlpha, pane, bldump +using xfoil_light_jll, Printf -# Get XFOIL libraries -const depsfile = joinpath(dirname(@__FILE__), "..", "deps", "deps.jl") -if isfile(depsfile) - include(depsfile) -else - error("Xfoil.jl not properly installed. Please run Pkg.build(\"Xfoil\") then restart Julia.") -end +export setCoordinates, solveAlpha, pane, bldump # Constant variables for array dimensions const IBX=572 diff --git a/src/xfoilbasic.jl b/src/xfoilbasic.jl index 0be8fbd..d7e12d5 100644 --- a/src/xfoilbasic.jl +++ b/src/xfoilbasic.jl @@ -14,7 +14,7 @@ function setCoordinates(x::AbstractArray{<:Real,1},y::AbstractArray{<:Real,1}) xfoilglobals.nb[1] = nb xfoilglobals.xb[1:nb] = x xfoilglobals.yb[1:nb] = y - ccall( (:xfoil_, libxfoil), Nothing, ()) + ccall( (:xfoil_, libxfoil_light), Nothing, ()) return nothing end @@ -42,7 +42,7 @@ function pane(;npan::Integer=140, cvpar::Real=1.0, cterat::Real=0.15, xfoilglobals.xsref2[1] = xsref2 xfoilglobals.xpref1[1] = xpref1 xfoilglobals.xpref2[1] = xpref2 - ccall( (:pangen_, libxfoil), Nothing, ()) + ccall( (:pangen_, libxfoil_light), Nothing, ()) return nothing end @@ -60,7 +60,7 @@ function solveAlpha(angle::Real, re::Real; mach::Real=0.0, xfoilglobals.itmax[1] = iter xfoilglobals.acrit[1] = ncrit - ccall((:oper_, libxfoil), Nothing, ()) + ccall((:oper_, libxfoil_light), Nothing, ()) cl = xfoilglobals.cl[1] cd = xfoilglobals.cd[1] @@ -87,7 +87,7 @@ function bldump() theta = zeros(Float64, IZX) cf = zeros(Float64, IZX) - ccall( (:bldump_, libxfoil), Nothing, + ccall( (:bldump_, libxfoil_light), Nothing, (Ref{Int32}, Ref{Float64}, Ref{Float64}, Ref{Float64}, Ref{Float64}, Ref{Float64}, Ref{Float64}, Ref{Float64}), nelem, s, x, y, ue, dstar, theta, cf) diff --git a/src/xfoilbasic_cs.jl b/src/xfoilbasic_cs.jl index d1fecfb..32bdb05 100644 --- a/src/xfoilbasic_cs.jl +++ b/src/xfoilbasic_cs.jl @@ -14,7 +14,7 @@ function setCoordinates_cs(x::AbstractArray{<:Number,1}, y::AbstractArray{<:Numb xfoilglobals_cs.nb[1] = nb xfoilglobals_cs.xb[1:nb] = x xfoilglobals_cs.yb[1:nb] = y - ccall( (:xfoil_, libxfoil_cs), Nothing, ()) + ccall( (:xfoil_, libxfoil_light_cs), Nothing, ()) return nothing end @@ -42,7 +42,7 @@ function pane_cs(;npan::Integer=140, cvpar::Number=1.0, cterat::Number=0.15, xfoilglobals_cs.xsref2[1] = xsref2 xfoilglobals_cs.xpref1[1] = xpref1 xfoilglobals_cs.xpref2[1] = xpref2 - ccall( (:pangen_, libxfoil_cs), Nothing, ()) + ccall( (:pangen_, libxfoil_light_cs), Nothing, ()) return nothing end @@ -60,7 +60,7 @@ function solveAlpha_cs(angle::Number, re::Number; mach::Number=0.0, xfoilglobals_cs.minf1[1] = mach xfoilglobals_cs.itmax[1] = iter - ccall((:oper_, libxfoil_cs), Nothing, ()) + ccall((:oper_, libxfoil_light_cs), Nothing, ()) cl = xfoilglobals_cs.cl[1] cd = xfoilglobals_cs.cd[1] @@ -87,7 +87,7 @@ function bldump_cs() theta = zeros(ComplexF64, IZX) cf = zeros(ComplexF64, IZX) - ccall( (:bldump_, libxfoil_cs), Nothing, + ccall( (:bldump_, libxfoil_light_cs), Nothing, (Ref{Int32}, Ref{ComplexF64}, Ref{ComplexF64}, Ref{ComplexF64}, Ref{ComplexF64}, Ref{ComplexF64}, Ref{ComplexF64}, Ref{ComplexF64}), nelem, s, x, y, ue, dstar, theta, cf) diff --git a/src/xfoilglobals.jl b/src/xfoilglobals.jl index 2f5cd86..2f0d06e 100644 --- a/src/xfoilglobals.jl +++ b/src/xfoilglobals.jl @@ -411,14 +411,14 @@ Returns a globalstruct, which contains fields directly referencing XFOIL's globa """ function getglobals() - cr01 = cglobal((:cr01_,libxfoil),Float64) + cr01 = cglobal((:cr01_,libxfoil_light),Float64) version = unsafe_wrap(Array,cr01,1) - cr03 = cglobal((:cr03_,libxfoil),Float64) + cr03 = cglobal((:cr03_,libxfoil_light),Float64) aij = unsafe_wrap(Array,cr03,(IQX,IQX)) dij = unsafe_wrap(Array,cr03+sizeof(Float64)*IQX^2,(IZX,IZX)) - cr04 = cglobal((:cr04_,libxfoil),Float64) + cr04 = cglobal((:cr04_,libxfoil_light),Float64) qinv = unsafe_wrap(Array,cr04,IZX) qvis = unsafe_wrap(Array,cr04+sizeof(Float64)*IZX,IZX) cpi = unsafe_wrap(Array,cr04+sizeof(Float64)*(2*IZX),IZX) @@ -426,7 +426,7 @@ function getglobals() qinvu = unsafe_wrap(Array,cr04+sizeof(Float64)*(4*IZX),(IZX,2)) qinv_a = unsafe_wrap(Array,cr04+sizeof(Float64)*(6*IZX),IZX) - cr05 = cglobal((:cr05_,libxfoil),Float64) + cr05 = cglobal((:cr05_,libxfoil_light),Float64) x = unsafe_wrap(Array,cr05,IZX) y = unsafe_wrap(Array,cr05+sizeof(Float64)*IZX,IZX) xp = unsafe_wrap(Array,cr05+sizeof(Float64)*(2*IZX),IZX) @@ -442,7 +442,7 @@ function getglobals() wgap = unsafe_wrap(Array,cr05+sizeof(Float64)*(5*IZX+7),IWK) waklen = unsafe_wrap(Array,cr05+sizeof(Float64)*(5*IZX+7+IWK),1) - cr06 = cglobal((:cr06_,libxfoil),Float64) + cr06 = cglobal((:cr06_,libxfoil_light),Float64) gam = unsafe_wrap(Array,cr06,IQX) gamu = unsafe_wrap(Array,cr06+sizeof(Float64)*IQX,(IQX,2)) gam_a = unsafe_wrap(Array,cr06+sizeof(Float64)*(IQX*3),IQX) @@ -461,7 +461,7 @@ function getglobals() ante = unsafe_wrap(Array,cr06+sizeof(Float64)*(IQX*4+IZX*4+8),1) aste = unsafe_wrap(Array,cr06+sizeof(Float64)*(IQX*4+IZX*4+9),1) - cr07 = cglobal((:cr07_,libxfoil),Float64) + cr07 = cglobal((:cr07_,libxfoil_light),Float64) ssple = unsafe_wrap(Array,cr07,1) sspec = unsafe_wrap(Array,cr07+sizeof(Float64),IBX) xspoc = unsafe_wrap(Array,cr07+sizeof(Float64)*(1+IBX),IBX) @@ -486,7 +486,7 @@ function getglobals() clspec = unsafe_wrap(Array,cr07+sizeof(Float64)*(8+4*IBX+2*IBX*IPX+3*IPX+4*IQX),1) ffilt = unsafe_wrap(Array,cr07+sizeof(Float64)*(9+4*IBX+2*IBX*IPX+3*IPX+4*IQX),1) - cr09 = cglobal((:cr09_,libxfoil),Float64) + cr09 = cglobal((:cr09_,libxfoil_light),Float64) adeg = unsafe_wrap(Array,cr09+0*sizeof(Float64),1) alfa = unsafe_wrap(Array,cr09+1*sizeof(Float64),1) awake = unsafe_wrap(Array,cr09+2*sizeof(Float64),1) @@ -521,7 +521,7 @@ function getglobals() xcpmni = unsafe_wrap(Array,cr09+31*sizeof(Float64),1) xcpmnv = unsafe_wrap(Array,cr09+32*sizeof(Float64),1) - cr10 = cglobal((:cr10_,libxfoil),Float64) + cr10 = cglobal((:cr10_,libxfoil_light),Float64) xpref = unsafe_wrap(Array,cr10,IQX) cpref = unsafe_wrap(Array,cr10+sizeof(Float64)*IQX,IQX) verspol = unsafe_wrap(Array,cr10+sizeof(Float64)*(2*IQX),NPX) @@ -531,13 +531,13 @@ function getglobals() acritp = unsafe_wrap(Array,cr10+sizeof(Float64)*(2*IQX+3*NPX+IQX*2*NPX),NPX) xstripp = unsafe_wrap(Array,cr10+sizeof(Float64)*(2*IQX+4*NPX+IQX*2*NPX),(ISX,NPX)) - cr11= cglobal((:cr11_,libxfoil),Float64) + cr11= cglobal((:cr11_,libxfoil_light),Float64) pi = unsafe_wrap(Array,cr11+sizeof(Float64)*0,1) hopi = unsafe_wrap(Array,cr11+sizeof(Float64)*1,1) qopi = unsafe_wrap(Array,cr11+sizeof(Float64)*2,1) dtor = unsafe_wrap(Array,cr11+sizeof(Float64)*3,1) - cr12= cglobal((:cr12_,libxfoil),Float64) + cr12= cglobal((:cr12_,libxfoil_light),Float64) cvpar = unsafe_wrap(Array,cr12+sizeof(Float64)*0,1) cterat = unsafe_wrap(Array,cr12+sizeof(Float64)*1,1) ctrrat = unsafe_wrap(Array,cr12+sizeof(Float64)*2,1) @@ -546,7 +546,7 @@ function getglobals() xpref1 = unsafe_wrap(Array,cr12+sizeof(Float64)*5,1) xpref2 = unsafe_wrap(Array,cr12+sizeof(Float64)*6,1) - cr13 = cglobal((:cr12_,libxfoil),Float64) + cr13 = cglobal((:cr12_,libxfoil_light),Float64) size = unsafe_wrap(Array,cr13+sizeof(Float64)*0,1) scrnfr = unsafe_wrap(Array,cr13+sizeof(Float64)*1,1) plotar = unsafe_wrap(Array,cr13+sizeof(Float64)*2,1) @@ -577,7 +577,7 @@ function getglobals() xalwid = unsafe_wrap(Array,cr13+sizeof(Float64)*(26+3*4),1) xocwid = unsafe_wrap(Array,cr13+sizeof(Float64)*(27+3*4),1) - cr14 = cglobal((:cr14_,libxfoil),Float64) + cr14 = cglobal((:cr14_,libxfoil_light),Float64) xb = unsafe_wrap(Array,cr14,IBX) yb = unsafe_wrap(Array,cr14+sizeof(Float64)*IBX,IBX) xbp = unsafe_wrap(Array,cr14+sizeof(Float64)*(2*IBX),IBX) @@ -621,7 +621,7 @@ function getglobals() xtkp = unsafe_wrap(Array,cr14+sizeof(Float64)*(25*IBX+36),2*IBX) ytkp = unsafe_wrap(Array,cr14+sizeof(Float64)*(27*IBX+36),2*IBX) - cr15 = cglobal((:cr15_,libxfoil),Float64) + cr15 = cglobal((:cr15_,libxfoil_light),Float64) xssi = unsafe_wrap(Array,cr15,(IVX,ISX)) uedg = unsafe_wrap(Array,cr15+sizeof(Float64)*(IVX*ISX),(IVX,ISX)) uinv = unsafe_wrap(Array,cr15+sizeof(Float64)*(2*IVX*ISX),(IVX,ISX)) @@ -647,13 +647,13 @@ function getglobals() xssitr = unsafe_wrap(Array,cr15+sizeof(Float64)*(15*IVX*ISX+4+3*ISX),ISX) uinv_a = unsafe_wrap(Array,cr15+sizeof(Float64)*(15*IVX*ISX+4+4*ISX),(IVX,ISX)) - cr17 = cglobal((:cr17_,libxfoil),Float64) + cr17 = cglobal((:cr17_,libxfoil_light),Float64) rmsbl = unsafe_wrap(Array,cr17,1) rmxbl = unsafe_wrap(Array,cr17+sizeof(Float64),1) rlx = unsafe_wrap(Array,cr17+2*sizeof(Float64),1) vaccel = unsafe_wrap(Array,cr17+3*sizeof(Float64),1) - cr18 = cglobal((:cr18_,libxfoil),Float64) + cr18 = cglobal((:cr18_,libxfoil_light),Float64) xsf = unsafe_wrap(Array,cr18,1) ysf = unsafe_wrap(Array,cr18+sizeof(Float64),1) xoff = unsafe_wrap(Array,cr18+sizeof(Float64)*2,1) @@ -678,7 +678,7 @@ function getglobals() ysfp = unsafe_wrap(Array,cr18+sizeof(Float64)*21,1) gtick = unsafe_wrap(Array,cr18+sizeof(Float64)*22,1) - qmat = cglobal((:qmat_,libxfoil),Float64) + qmat = cglobal((:qmat_,libxfoil_light),Float64) q = unsafe_wrap(Array,qmat,(IQX,IQX)) dq = unsafe_wrap(Array,qmat+sizeof(Float64)*(IQX*IQX),IQX) dzdg = unsafe_wrap(Array,qmat+sizeof(Float64)*(IQX^2+IQX),IQX) @@ -695,14 +695,14 @@ function getglobals() z_qdof2 = unsafe_wrap(Array,qmat+sizeof(Float64)*(IQX^2+4*IQX+2*IZX+6),1) z_qdof3 = unsafe_wrap(Array,qmat+sizeof(Float64)*(IQX^2+4*IQX+2*IZX+7),1) - vmat = cglobal((:vmat_,libxfoil),Float64) + vmat = cglobal((:vmat_,libxfoil_light),Float64) va = unsafe_wrap(Array,vmat,(3,2,IZX)) vb = unsafe_wrap(Array,vmat+sizeof(Float64)*(3*2*IZX),(3,2,IZX)) vdel = unsafe_wrap(Array,vmat+sizeof(Float64)*(2*3*2*IZX),(3,2,IZX)) vm = unsafe_wrap(Array,vmat+sizeof(Float64)*(3*3*2*IZX),(3,IZX,IZX)) vz = unsafe_wrap(Array,vmat+sizeof(Float64)*(3*3*2*IZX+IZX*IZX),(3,2)) - ci01 = cglobal((:ci01_,libxfoil),Int32) + ci01 = cglobal((:ci01_,libxfoil_light),Int32) iq1 = unsafe_wrap(Array,ci01,1) iq2 = unsafe_wrap(Array,ci01+sizeof(Int32),1) nsp = unsafe_wrap(Array,ci01+sizeof(Int32)*2,1) @@ -713,7 +713,7 @@ function getglobals() nname = unsafe_wrap(Array,ci01+sizeof(Int32)*7,1) nprefix = unsafe_wrap(Array,ci01+sizeof(Int32)*8,1) - ci03 = cglobal((:ci03_,libxfoil),Int32) + ci03 = cglobal((:ci03_,libxfoil_light),Int32) ncpref = unsafe_wrap(Array,ci03,1) napol = unsafe_wrap(Array,ci03+sizeof(Int32),NPX) npol = unsafe_wrap(Array,ci03+sizeof(Int32)*(1+NPX),1) @@ -727,7 +727,7 @@ function getglobals() npolref = unsafe_wrap(Array,ci03+sizeof(Int32)*(4+6*NPX),1) ndref = unsafe_wrap(Array,ci03+sizeof(Int32)*(5+6*NPX),(4,NPX)) - ci04 = cglobal((:ci04_,libxfoil),Int32) + ci04 = cglobal((:ci04_,libxfoil_light),Int32) n = unsafe_wrap(Array,ci04,1) nb = unsafe_wrap(Array,ci04+sizeof(Int32)*1,1) nw = unsafe_wrap(Array,ci04+sizeof(Int32)*2,1) @@ -748,7 +748,7 @@ function getglobals() ncm = unsafe_wrap(Array,ci04+sizeof(Int32)*(15+2*ISX),1) ntk = unsafe_wrap(Array,ci04+sizeof(Int32)*(16+2*ISX),1) - ci05 = cglobal((:ci05_,libxfoil),Int32) + ci05 = cglobal((:ci05_,libxfoil_light),Int32) iblte = unsafe_wrap(Array,ci05,ISX) nbl = unsafe_wrap(Array,ci05+sizeof(Int32)*ISX,ISX) ipan = unsafe_wrap(Array,ci05+sizeof(Int32)*(2*ISX),(IVX,ISX)) @@ -756,11 +756,11 @@ function getglobals() nsys = unsafe_wrap(Array,ci05+sizeof(Int32)*(2*ISX+2*IVX*ISX),1) itran = unsafe_wrap(Array,ci05+sizeof(Int32)*(2*ISX+2*IVX*ISX+1),ISX) - ci06 = cglobal((:ci06_,libxfoil),Int32) + ci06 = cglobal((:ci06_,libxfoil_light),Int32) imxbl = unsafe_wrap(Array,ci06,1) ismxbl = unsafe_wrap(Array,ci06+sizeof(Int32),1) - cl01 = cglobal((:cl01_,libxfoil),Int32) + cl01 = cglobal((:cl01_,libxfoil_light),Int32) ok = unsafe_wrap(Array,cl01+sizeof(Int32)*0,1) limage = unsafe_wrap(Array,cl01+sizeof(Int32)*1,1) sharp = unsafe_wrap(Array,cl01+sizeof(Int32)*2,1) @@ -822,10 +822,10 @@ function getglobals() lhmomp = unsafe_wrap(Array,cl01+sizeof(Int32)*58,1) lexitflag = unsafe_wrap(Array,cl01+sizeof(Int32)*59,1) - cl02 = cglobal((:cl02_,libxfoil),Int32) + cl02 = cglobal((:cl02_,libxfoil_light),Int32) tforce = unsafe_wrap(Array,cl02,ISX) - cc01 = cglobal((:cc01_,libxfoil),UInt8) + cc01 = cglobal((:cc01_,libxfoil_light),UInt8) fname = unsafe_string(cc01+sizeof(UInt8)*0,64) name = unsafe_string(cc01+sizeof(UInt8)*64,48) ispars = unsafe_string(cc01+sizeof(UInt8)*(64+48),80) @@ -836,10 +836,10 @@ function getglobals() namepol = unsafe_string(cc01+sizeof(UInt8)*(5*64+48+80),48) nameref = unsafe_string(cc01+sizeof(UInt8)*(5*64+2*48+80),48) - cc02 = cglobal((:cc02_,libxfoil),UInt8) + cc02 = cglobal((:cc02_,libxfoil_light),UInt8) labref = unsafe_string(cc02,32) - cc03 = cglobal((:cc03_,libxfoil),UInt8) + cc03 = cglobal((:cc03_,libxfoil_light),UInt8) vmxbl = unsafe_string(cc03,1) return globalstruct( diff --git a/src/xfoilglobals_cs.jl b/src/xfoilglobals_cs.jl index 5cb29b9..1f5bac4 100644 --- a/src/xfoilglobals_cs.jl +++ b/src/xfoilglobals_cs.jl @@ -411,14 +411,14 @@ Returns a globalstruct, which contains fields directly referencing XFOIL's globa """ function getglobals_cs() - cr01 = cglobal((:cr01_,libxfoil_cs),ComplexF64) + cr01 = cglobal((:cr01_,libxfoil_light_cs),ComplexF64) version = unsafe_wrap(Array,cr01,1) - cr03 = cglobal((:cr03_,libxfoil_cs),ComplexF64) + cr03 = cglobal((:cr03_,libxfoil_light_cs),ComplexF64) aij = unsafe_wrap(Array,cr03,(IQX,IQX)) dij = unsafe_wrap(Array,cr03+sizeof(ComplexF64)*IQX^2,(IZX,IZX)) - cr04 = cglobal((:cr04_,libxfoil_cs),ComplexF64) + cr04 = cglobal((:cr04_,libxfoil_light_cs),ComplexF64) qinv = unsafe_wrap(Array,cr04,IZX) qvis = unsafe_wrap(Array,cr04+sizeof(ComplexF64)*IZX,IZX) cpi = unsafe_wrap(Array,cr04+sizeof(ComplexF64)*(2*IZX),IZX) @@ -426,7 +426,7 @@ function getglobals_cs() qinvu = unsafe_wrap(Array,cr04+sizeof(ComplexF64)*(4*IZX),(IZX,2)) qinv_a = unsafe_wrap(Array,cr04+sizeof(ComplexF64)*(6*IZX),IZX) - cr05 = cglobal((:cr05_,libxfoil_cs),ComplexF64) + cr05 = cglobal((:cr05_,libxfoil_light_cs),ComplexF64) x = unsafe_wrap(Array,cr05,IZX) y = unsafe_wrap(Array,cr05+sizeof(ComplexF64)*IZX,IZX) xp = unsafe_wrap(Array,cr05+sizeof(ComplexF64)*(2*IZX),IZX) @@ -442,7 +442,7 @@ function getglobals_cs() wgap = unsafe_wrap(Array,cr05+sizeof(ComplexF64)*(5*IZX+7),IWK) waklen = unsafe_wrap(Array,cr05+sizeof(ComplexF64)*(5*IZX+7+IWK),1) - cr06 = cglobal((:cr06_,libxfoil_cs),ComplexF64) + cr06 = cglobal((:cr06_,libxfoil_light_cs),ComplexF64) gam = unsafe_wrap(Array,cr06,IQX) gamu = unsafe_wrap(Array,cr06+sizeof(ComplexF64)*IQX,(IQX,2)) gam_a = unsafe_wrap(Array,cr06+sizeof(ComplexF64)*(IQX*3),IQX) @@ -461,7 +461,7 @@ function getglobals_cs() ante = unsafe_wrap(Array,cr06+sizeof(ComplexF64)*(IQX*4+IZX*4+8),1) aste = unsafe_wrap(Array,cr06+sizeof(ComplexF64)*(IQX*4+IZX*4+9),1) - cr07 = cglobal((:cr07_,libxfoil_cs),ComplexF64) + cr07 = cglobal((:cr07_,libxfoil_light_cs),ComplexF64) ssple = unsafe_wrap(Array,cr07,1) sspec = unsafe_wrap(Array,cr07+sizeof(ComplexF64),IBX) xspoc = unsafe_wrap(Array,cr07+sizeof(ComplexF64)*(1+IBX),IBX) @@ -486,7 +486,7 @@ function getglobals_cs() clspec = unsafe_wrap(Array,cr07+sizeof(ComplexF64)*(8+4*IBX+2*IBX*IPX+3*IPX+4*IQX),1) ffilt = unsafe_wrap(Array,cr07+sizeof(ComplexF64)*(9+4*IBX+2*IBX*IPX+3*IPX+4*IQX),1) - cr09 = cglobal((:cr09_,libxfoil_cs),ComplexF64) + cr09 = cglobal((:cr09_,libxfoil_light_cs),ComplexF64) adeg = unsafe_wrap(Array,cr09+0*sizeof(ComplexF64),1) alfa = unsafe_wrap(Array,cr09+1*sizeof(ComplexF64),1) awake = unsafe_wrap(Array,cr09+2*sizeof(ComplexF64),1) @@ -521,7 +521,7 @@ function getglobals_cs() xcpmni = unsafe_wrap(Array,cr09+31*sizeof(ComplexF64),1) xcpmnv = unsafe_wrap(Array,cr09+32*sizeof(ComplexF64),1) - cr10 = cglobal((:cr10_,libxfoil_cs),ComplexF64) + cr10 = cglobal((:cr10_,libxfoil_light_cs),ComplexF64) xpref = unsafe_wrap(Array,cr10,IQX) cpref = unsafe_wrap(Array,cr10+sizeof(ComplexF64)*IQX,IQX) verspol = unsafe_wrap(Array,cr10+sizeof(ComplexF64)*(2*IQX),NPX) @@ -531,13 +531,13 @@ function getglobals_cs() acritp = unsafe_wrap(Array,cr10+sizeof(ComplexF64)*(2*IQX+3*NPX+IQX*2*NPX),NPX) xstripp = unsafe_wrap(Array,cr10+sizeof(ComplexF64)*(2*IQX+4*NPX+IQX*2*NPX),(ISX,NPX)) - cr11= cglobal((:cr11_,libxfoil_cs),ComplexF64) + cr11= cglobal((:cr11_,libxfoil_light_cs),ComplexF64) pi = unsafe_wrap(Array,cr11+sizeof(ComplexF64)*0,1) hopi = unsafe_wrap(Array,cr11+sizeof(ComplexF64)*1,1) qopi = unsafe_wrap(Array,cr11+sizeof(ComplexF64)*2,1) dtor = unsafe_wrap(Array,cr11+sizeof(ComplexF64)*3,1) - cr12= cglobal((:cr12_,libxfoil_cs),ComplexF64) + cr12= cglobal((:cr12_,libxfoil_light_cs),ComplexF64) cvpar = unsafe_wrap(Array,cr12+sizeof(ComplexF64)*0,1) cterat = unsafe_wrap(Array,cr12+sizeof(ComplexF64)*1,1) ctrrat = unsafe_wrap(Array,cr12+sizeof(ComplexF64)*2,1) @@ -546,7 +546,7 @@ function getglobals_cs() xpref1 = unsafe_wrap(Array,cr12+sizeof(ComplexF64)*5,1) xpref2 = unsafe_wrap(Array,cr12+sizeof(ComplexF64)*6,1) - cr13 = cglobal((:cr12_,libxfoil_cs),ComplexF64) + cr13 = cglobal((:cr12_,libxfoil_light_cs),ComplexF64) size = unsafe_wrap(Array,cr13+sizeof(ComplexF64)*0,1) scrnfr = unsafe_wrap(Array,cr13+sizeof(ComplexF64)*1,1) plotar = unsafe_wrap(Array,cr13+sizeof(ComplexF64)*2,1) @@ -577,7 +577,7 @@ function getglobals_cs() xalwid = unsafe_wrap(Array,cr13+sizeof(ComplexF64)*(26+3*4),1) xocwid = unsafe_wrap(Array,cr13+sizeof(ComplexF64)*(27+3*4),1) - cr14 = cglobal((:cr14_,libxfoil_cs),ComplexF64) + cr14 = cglobal((:cr14_,libxfoil_light_cs),ComplexF64) xb = unsafe_wrap(Array,cr14,IBX) yb = unsafe_wrap(Array,cr14+sizeof(ComplexF64)*IBX,IBX) xbp = unsafe_wrap(Array,cr14+sizeof(ComplexF64)*(2*IBX),IBX) @@ -621,7 +621,7 @@ function getglobals_cs() xtkp = unsafe_wrap(Array,cr14+sizeof(ComplexF64)*(25*IBX+36),2*IBX) ytkp = unsafe_wrap(Array,cr14+sizeof(ComplexF64)*(27*IBX+36),2*IBX) - cr15 = cglobal((:cr15_,libxfoil_cs),ComplexF64) + cr15 = cglobal((:cr15_,libxfoil_light_cs),ComplexF64) xssi = unsafe_wrap(Array,cr15,(IVX,ISX)) uedg = unsafe_wrap(Array,cr15+sizeof(ComplexF64)*(IVX*ISX),(IVX,ISX)) uinv = unsafe_wrap(Array,cr15+sizeof(ComplexF64)*(2*IVX*ISX),(IVX,ISX)) @@ -647,13 +647,13 @@ function getglobals_cs() xssitr = unsafe_wrap(Array,cr15+sizeof(ComplexF64)*(15*IVX*ISX+4+3*ISX),ISX) uinv_a = unsafe_wrap(Array,cr15+sizeof(ComplexF64)*(15*IVX*ISX+4+4*ISX),(IVX,ISX)) - cr17 = cglobal((:cr17_,libxfoil_cs),ComplexF64) + cr17 = cglobal((:cr17_,libxfoil_light_cs),ComplexF64) rmsbl = unsafe_wrap(Array,cr17,1) rmxbl = unsafe_wrap(Array,cr17+sizeof(ComplexF64),1) rlx = unsafe_wrap(Array,cr17+2*sizeof(ComplexF64),1) vaccel = unsafe_wrap(Array,cr17+3*sizeof(ComplexF64),1) - cr18 = cglobal((:cr18_,libxfoil_cs),ComplexF64) + cr18 = cglobal((:cr18_,libxfoil_light_cs),ComplexF64) xsf = unsafe_wrap(Array,cr18,1) ysf = unsafe_wrap(Array,cr18+sizeof(ComplexF64),1) xoff = unsafe_wrap(Array,cr18+sizeof(ComplexF64)*2,1) @@ -678,7 +678,7 @@ function getglobals_cs() ysfp = unsafe_wrap(Array,cr18+sizeof(ComplexF64)*21,1) gtick = unsafe_wrap(Array,cr18+sizeof(ComplexF64)*22,1) - qmat = cglobal((:qmat_,libxfoil_cs),ComplexF64) + qmat = cglobal((:qmat_,libxfoil_light_cs),ComplexF64) q = unsafe_wrap(Array,qmat,(IQX,IQX)) dq = unsafe_wrap(Array,qmat+sizeof(ComplexF64)*(IQX*IQX),IQX) dzdg = unsafe_wrap(Array,qmat+sizeof(ComplexF64)*(IQX^2+IQX),IQX) @@ -695,14 +695,14 @@ function getglobals_cs() z_qdof2 = unsafe_wrap(Array,qmat+sizeof(ComplexF64)*(IQX^2+4*IQX+2*IZX+6),1) z_qdof3 = unsafe_wrap(Array,qmat+sizeof(ComplexF64)*(IQX^2+4*IQX+2*IZX+7),1) - vmat = cglobal((:vmat_,libxfoil_cs),ComplexF64) + vmat = cglobal((:vmat_,libxfoil_light_cs),ComplexF64) va = unsafe_wrap(Array,vmat,(3,2,IZX)) vb = unsafe_wrap(Array,vmat+sizeof(ComplexF64)*(3*2*IZX),(3,2,IZX)) vdel = unsafe_wrap(Array,vmat+sizeof(ComplexF64)*(2*3*2*IZX),(3,2,IZX)) vm = unsafe_wrap(Array,vmat+sizeof(ComplexF64)*(3*3*2*IZX),(3,IZX,IZX)) vz = unsafe_wrap(Array,vmat+sizeof(ComplexF64)*(3*3*2*IZX+IZX*IZX),(3,2)) - ci01 = cglobal((:ci01_,libxfoil_cs),Int32) + ci01 = cglobal((:ci01_,libxfoil_light_cs),Int32) iq1 = unsafe_wrap(Array,ci01,1) iq2 = unsafe_wrap(Array,ci01+sizeof(Int32),1) nsp = unsafe_wrap(Array,ci01+sizeof(Int32)*2,1) @@ -713,7 +713,7 @@ function getglobals_cs() nname = unsafe_wrap(Array,ci01+sizeof(Int32)*7,1) nprefix = unsafe_wrap(Array,ci01+sizeof(Int32)*8,1) - ci03 = cglobal((:ci03_,libxfoil_cs),Int32) + ci03 = cglobal((:ci03_,libxfoil_light_cs),Int32) ncpref = unsafe_wrap(Array,ci03,1) napol = unsafe_wrap(Array,ci03+sizeof(Int32),NPX) npol = unsafe_wrap(Array,ci03+sizeof(Int32)*(1+NPX),1) @@ -727,7 +727,7 @@ function getglobals_cs() npolref = unsafe_wrap(Array,ci03+sizeof(Int32)*(4+6*NPX),1) ndref = unsafe_wrap(Array,ci03+sizeof(Int32)*(5+6*NPX),(4,NPX)) - ci04 = cglobal((:ci04_,libxfoil_cs),Int32) + ci04 = cglobal((:ci04_,libxfoil_light_cs),Int32) n = unsafe_wrap(Array,ci04,1) nb = unsafe_wrap(Array,ci04+sizeof(Int32)*1,1) nw = unsafe_wrap(Array,ci04+sizeof(Int32)*2,1) @@ -748,7 +748,7 @@ function getglobals_cs() ncm = unsafe_wrap(Array,ci04+sizeof(Int32)*(15+2*ISX),1) ntk = unsafe_wrap(Array,ci04+sizeof(Int32)*(16+2*ISX),1) - ci05 = cglobal((:ci05_,libxfoil_cs),Int32) + ci05 = cglobal((:ci05_,libxfoil_light_cs),Int32) iblte = unsafe_wrap(Array,ci05,ISX) nbl = unsafe_wrap(Array,ci05+sizeof(Int32)*ISX,ISX) ipan = unsafe_wrap(Array,ci05+sizeof(Int32)*(2*ISX),(IVX,ISX)) @@ -756,11 +756,11 @@ function getglobals_cs() nsys = unsafe_wrap(Array,ci05+sizeof(Int32)*(2*ISX+2*IVX*ISX),1) itran = unsafe_wrap(Array,ci05+sizeof(Int32)*(2*ISX+2*IVX*ISX+1),ISX) - ci06 = cglobal((:ci06_,libxfoil_cs),Int32) + ci06 = cglobal((:ci06_,libxfoil_light_cs),Int32) imxbl = unsafe_wrap(Array,ci06,1) ismxbl = unsafe_wrap(Array,ci06+sizeof(Int32),1) - cl01 = cglobal((:cl01_,libxfoil_cs),Int32) + cl01 = cglobal((:cl01_,libxfoil_light_cs),Int32) ok = unsafe_wrap(Array,cl01+sizeof(Int32)*0,1) limage = unsafe_wrap(Array,cl01+sizeof(Int32)*1,1) sharp = unsafe_wrap(Array,cl01+sizeof(Int32)*2,1) @@ -822,10 +822,10 @@ function getglobals_cs() lhmomp = unsafe_wrap(Array,cl01+sizeof(Int32)*58,1) lexitflag = unsafe_wrap(Array,cl01+sizeof(Int32)*59,1) - cl02 = cglobal((:cl02_,libxfoil_cs),Int32) + cl02 = cglobal((:cl02_,libxfoil_light_cs),Int32) tforce = unsafe_wrap(Array,cl02,ISX) - cc01 = cglobal((:cc01_,libxfoil_cs),UInt8) + cc01 = cglobal((:cc01_,libxfoil_light_cs),UInt8) fname = unsafe_string(cc01+sizeof(UInt8)*0,64) name = unsafe_string(cc01+sizeof(UInt8)*64,48) ispars = unsafe_string(cc01+sizeof(UInt8)*(64+48),80) @@ -836,10 +836,10 @@ function getglobals_cs() namepol = unsafe_string(cc01+sizeof(UInt8)*(5*64+48+80),48) nameref = unsafe_string(cc01+sizeof(UInt8)*(5*64+2*48+80),48) - cc02 = cglobal((:cc02_,libxfoil_cs),UInt8) + cc02 = cglobal((:cc02_,libxfoil_light_cs),UInt8) labref = unsafe_string(cc02,32) - cc03 = cglobal((:cc03_,libxfoil_cs),UInt8) + cc03 = cglobal((:cc03_,libxfoil_light_cs),UInt8) vmxbl = unsafe_string(cc03,1) return globalstruct_cs(version, diff --git a/test/Project.toml b/test/Project.toml new file mode 100644 index 0000000..0c36332 --- /dev/null +++ b/test/Project.toml @@ -0,0 +1,2 @@ +[deps] +Test = "8dfed614-e22c-5e08-85e1-65c5234f0b40"